R help - Jun 2018 - verInd= and HorInd= arguments to pairs() function

After making scatterplot matrix, I determined I only needed the first 2 columns
of the matrix so I added verInd=1:2 to my pairs() call.  However, it did not
turn out as I expected.

Perhaps the attached pdf of the example code will make it through.  If not, my
description is "the wrong scatterplot pairs are in the wrong places"
for the last two pairs() calls.

Thanks,
Chris

################################################################

# fake data
xmat <- matrix(1:28, ncol=4)
lim <- range(xmat)

# what I expected
pairs(xmat, xlim=lim, ylim=lim) # 4x4 matrix of scatterplots
pairs(xmat, xlim=lim, ylim=lim, verInd=1:2, horInd=1:2) # 2x2 matrix of
scatterplots: upper left

# here comes trouble
pairs(xmat, xlim=lim, ylim=lim, horInd=1:2) # 2x4 matrix of scatterplots: but
not the top 2 rows (or bottom 2 rows)
pairs(xmat, xlim=lim, ylim=lim, verInd=1:2) # 4x2 matrix of scatterplots: but
not the left 2 columns (or right 2 columns)


###############################################################
> sessionInfo()
R version 3.5.0 (2018-04-23)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

Matrix products: default

locale:
[1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252  
LC_MONETARY=English_United States.1252
[4] LC_NUMERIC=C                           LC_TIME=English_United States.1252

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
[1] compiler_3.5.0 tools_3.5.0   
**********************************************************
Electronic Mail is not secure, may not be read every day, and should not be used
for urgent or sensitive issues

-------------- next part --------------
A non-text attachment was scrubbed...
Name: pairs.pdf
Type: application/pdf
Size: 9892 bytes
Desc: pairs.pdf
URL:
<https://stat.ethz.ch/pipermail/r-help/attachments/20180606/f4d28bf4/attachment.pdf>

Hi, Chris,

had the same problem (and first thought it was my fault), but there
seems to be a typo in the code of pairs.default. Below is a workaround.
Look for two comments (starting with #####) in the code to see what I
have changed to make it work at least the way I'd expect it in one of
your examples.

  Hth --  Gerrit


mypairs <- function (x, labels, panel = points, ...,
     horInd = 1:nc, verInd = 1:nc,
     lower.panel = panel, upper.panel = panel, diag.panel = NULL,
     text.panel = textPanel, label.pos = 0.5 + has.diag/3, line.main = 3,
     cex.labels = NULL, font.labels = 1, row1attop = TRUE, gap = 1,
     log = "") {
     if (doText <- missing(text.panel) || is.function(text.panel))
         textPanel <- function(x = 0.5, y = 0.5, txt, cex, font) text(x,
             y, txt, cex = cex, font = font)
     localAxis <- function(side, x, y, xpd, bg, col = NULL, main,
         oma, ...) {
         xpd <- NA
         if (side%%2L == 1L && xl[j])
             xpd <- FALSE
         if (side%%2L == 0L && yl[i])
             xpd <- FALSE
         if (side%%2L == 1L)
             Axis(x, side = side, xpd = xpd, ...)
         else Axis(y, side = side, xpd = xpd, ...)
     }
     localPlot <- function(..., main, oma, font.main, cex.main) plot(...)
     localLowerPanel <- function(..., main, oma, font.main, cex.main) 
lower.panel(...)
     localUpperPanel <- function(..., main, oma, font.main, cex.main) 
upper.panel(...)
     localDiagPanel <- function(..., main, oma, font.main, cex.main) 
diag.panel(...)
     dots <- list(...)
     nmdots <- names(dots)
     if (!is.matrix(x)) {
         x <- as.data.frame(x)
         for (i in seq_along(names(x))) {
             if (is.factor(x[[i]]) || is.logical(x[[i]]))
                 x[[i]] <- as.numeric(x[[i]])
             if (!is.numeric(unclass(x[[i]])))
                 stop("non-numeric argument to 'pairs'")
         }
     }
     else if (!is.numeric(x))
         stop("non-numeric argument to 'pairs'")
     panel <- match.fun(panel)
     if ((has.lower <- !is.null(lower.panel)) &&
!missing(lower.panel))
         lower.panel <- match.fun(lower.panel)
     if ((has.upper <- !is.null(upper.panel)) &&
!missing(upper.panel))
         upper.panel <- match.fun(upper.panel)
     if ((has.diag <- !is.null(diag.panel)) && !missing(diag.panel))
         diag.panel <- match.fun(diag.panel)
     if (row1attop) {
         tmp <- lower.panel
         lower.panel <- upper.panel
         upper.panel <- tmp
         tmp <- has.lower
         has.lower <- has.upper
         has.upper <- tmp
     }
     nc <- ncol(x)
     if (nc < 2L)
         stop("only one column in the argument to 'pairs'")
     if (!all(horInd >= 1L && horInd <= nc))
         stop("invalid argument 'horInd'")
     if (!all(verInd >= 1L && verInd <= nc))
         stop("invalid argument 'verInd'")
     if (doText) {
         if (missing(labels)) {
             labels <- colnames(x)
             if (is.null(labels))
                 labels <- paste("var", 1L:nc)
         }
         else if (is.null(labels))
             doText <- FALSE
     }
     oma <- if ("oma" %in% nmdots)
         dots$oma
     main <- if ("main" %in% nmdots)
         dots$main
     if (is.null(oma))
         oma <- c(4, 4, if (!is.null(main)) 6 else 4, 4)
     opar <- par(mfcol = c(length(horInd), length(verInd)),
##### Changed from mfrow to mfcol
                 mar = rep.int(gap/2, 4), oma = oma)
     on.exit(par(opar))
     dev.hold()
     on.exit(dev.flush(), add = TRUE)
     xl <- yl <- logical(nc)
     if (is.numeric(log))
         xl[log] <- yl[log] <- TRUE
     else {
         xl[] <- grepl("x", log)
         yl[] <- grepl("y", log)
     }
     for (j in if (row1attop) verInd else rev(verInd))
      for (i in horInd) {
##### Exchanged i and j. (i used to be in
##### the outer and j in the inner loop!)
         l <- paste0(ifelse(xl[j], "x", ""),
ifelse(yl[i], "y", ""))
         localPlot(x[, j], x[, i], xlab = "", ylab = "",
axes = FALSE,
             type = "n", ..., log = l)
         if (i == j || (i < j && has.lower) || (i > j &&
has.upper)) {
             box()
             if (i == 1 && (!(j%%2L) || !has.upper || !has.lower))
                 localAxis(1L + 2L * row1attop, x[, j], x[, i],
                   ...)
             if (i == nc && (j%%2L || !has.upper || !has.lower))
                 localAxis(3L - 2L * row1attop, x[, j], x[, i],
                   ...)
             if (j == 1 && (!(i%%2L) || !has.upper || !has.lower))
                 localAxis(2L, x[, j], x[, i], ...)
             if (j == nc && (i%%2L || !has.upper || !has.lower))
                 localAxis(4L, x[, j], x[, i], ...)
             mfg <- par("mfg")
             if (i == j) {
                 if (has.diag)
                   localDiagPanel(as.vector(x[, i]), ...)
                 if (doText) {
                   par(usr = c(0, 1, 0, 1))
                   if (is.null(cex.labels)) {
                     l.wid <- strwidth(labels, "user")
                     cex.labels <- max(0.8, min(2, 0.9/max(l.wid)))
                   }
                   xlp <- if (xl[i])
                     10^0.5
                   else 0.5
                   ylp <- if (yl[j])
                     10^label.pos
                   else label.pos
                   text.panel(xlp, ylp, labels[i], cex = cex.labels,
                     font = font.labels)
                 }
             }
             else if (i < j)
                 localLowerPanel(as.vector(x[, j]), as.vector(x[,
                   i]), ...)
             else localUpperPanel(as.vector(x[, j]), as.vector(x[,
                 i]), ...)
             if (any(par("mfg") != mfg))
                 stop("the 'panel' function made a new plot")
         }
         else par(new = FALSE)
     }
     if (!is.null(main)) {
         font.main <- if ("font.main" %in% nmdots)
             dots$font.main
         else par("font.main")
         cex.main <- if ("cex.main" %in% nmdots)
             dots$cex.main
         else par("cex.main")
         mtext(main, 3, line.main, outer = TRUE, at = 0.5, cex = cex.main,
             font = font.main)
     }
     invisible(NULL)
}



## Example:

mypairs(xmat, xlim=lim, ylim=lim, verInd=1:2, horInd=1:4)



Am 06.06.2018 um 23:55 schrieb Andrews, Chris:
> 
> After making scatterplot matrix, I determined I only needed the first 2
columns of the matrix so I added verInd=1:2 to my pairs() call.  However, it did
not turn out as I expected.
> 
> Perhaps the attached pdf of the example code will make it through.  If not,
my description is "the wrong scatterplot pairs are in the wrong
places" for the last two pairs() calls.
> 
> Thanks,
> Chris
> 
> ################################################################
> 
> # fake data
> xmat <- matrix(1:28, ncol=4)
> lim <- range(xmat)
> 
> # what I expected
> pairs(xmat, xlim=lim, ylim=lim) # 4x4 matrix of scatterplots
> pairs(xmat, xlim=lim, ylim=lim, verInd=1:2, horInd=1:2) # 2x2 matrix of
scatterplots: upper left
> 
> # here comes trouble
> pairs(xmat, xlim=lim, ylim=lim, horInd=1:2) # 2x4 matrix of scatterplots:
but not the top 2 rows (or bottom 2 rows)
> pairs(xmat, xlim=lim, ylim=lim, verInd=1:2) # 4x2 matrix of scatterplots:
but not the left 2 columns (or right 2 columns)
> 
> 
> ###############################################################
> 
>> sessionInfo()
> R version 3.5.0 (2018-04-23)
> Platform: x86_64-w64-mingw32/x64 (64-bit)
> Running under: Windows 7 x64 (build 7601) Service Pack 1
> 
> Matrix products: default
> 
> locale:
> [1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United
States.1252    LC_MONETARY=English_United States.1252
> [4] LC_NUMERIC=C                           LC_TIME=English_United
States.1252
> 
> attached base packages:
> [1] stats     graphics  grDevices utils     datasets  methods   base
> 
> loaded via a namespace (and not attached):
> [1] compiler_3.5.0 tools_3.5.0
> **********************************************************
> Electronic Mail is not secure, may not be read every day, and should not be
used for urgent or sensitive issues
> 
> 
> 
> ______________________________________________
> R-help at r-project.org mailing list -- To UNSUBSCRIBE and more, see
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide
http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
>

>>>>> Gerrit Eichner 
>>>>>     on Thu, 7 Jun 2018 09:03:46 +0200 writes:
    > Hi, Chris, had the same problem (and first thought it was
    > my fault), but there seems to be a typo in the code of
    > pairs.default. Below is a workaround.  Look for two
    > comments (starting with #####) in the code to see what I
    > have changed to make it work at least the way I'd expect
    > it in one of your examples.

    >   Hth -- Gerrit
> mypairs <- function (x, labels, panel = points, ...,
>      horInd = 1:nc, verInd = 1:nc,
>      lower.panel = panel, upper.panel = panel, diag.panel = NULL,
>      text.panel = textPanel, label.pos = 0.5 + has.diag/3, line.main = 3,
>      cex.labels = NULL, font.labels = 1, row1attop = TRUE, gap = 1,
>      log = "") {
>      if (doText <- missing(text.panel) || is.function(text.panel))
>          textPanel <- function(x = 0.5, y = 0.5, txt, cex, font) text(x,
>              y, txt, cex = cex, font = font)
>      localAxis <- function(side, x, y, xpd, bg, col = NULL, main,
>          oma, ...) {
>          xpd <- NA
>          if (side%%2L == 1L && xl[j])
>              xpd <- FALSE
>          if (side%%2L == 0L && yl[i])
>              xpd <- FALSE
>          if (side%%2L == 1L)
>              Axis(x, side = side, xpd = xpd, ...)
>          else Axis(y, side = side, xpd = xpd, ...)
>      }
>      localPlot <- function(..., main, oma, font.main, cex.main)
plot(...)
>      localLowerPanel <- function(..., main, oma, font.main, cex.main)
lower.panel(...)
>      localUpperPanel <- function(..., main, oma, font.main, cex.main)
upper.panel(...)
>      localDiagPanel <- function(..., main, oma, font.main, cex.main)
diag.panel(...)
>      dots <- list(...)
>      nmdots <- names(dots)
>      if (!is.matrix(x)) {
>          x <- as.data.frame(x)
>          for (i in seq_along(names(x))) {
>              if (is.factor(x[[i]]) || is.logical(x[[i]]))
>                  x[[i]] <- as.numeric(x[[i]])
>              if (!is.numeric(unclass(x[[i]])))
>                  stop("non-numeric argument to 'pairs'")
>          }
>      }
>      else if (!is.numeric(x))
>          stop("non-numeric argument to 'pairs'")
>      panel <- match.fun(panel)
>      if ((has.lower <- !is.null(lower.panel)) &&
!missing(lower.panel))
>          lower.panel <- match.fun(lower.panel)
>      if ((has.upper <- !is.null(upper.panel)) &&
!missing(upper.panel))
>          upper.panel <- match.fun(upper.panel)
>      if ((has.diag <- !is.null(diag.panel)) &&
!missing(diag.panel))
>          diag.panel <- match.fun(diag.panel)
>      if (row1attop) {
>          tmp <- lower.panel
>          lower.panel <- upper.panel
>          upper.panel <- tmp
>          tmp <- has.lower
>          has.lower <- has.upper
>          has.upper <- tmp
>      }
>      nc <- ncol(x)
>      if (nc < 2L)
>          stop("only one column in the argument to
'pairs'")
>      if (!all(horInd >= 1L && horInd <= nc))
>          stop("invalid argument 'horInd'")
>      if (!all(verInd >= 1L && verInd <= nc))
>          stop("invalid argument 'verInd'")
>      if (doText) {
>          if (missing(labels)) {
>              labels <- colnames(x)
>              if (is.null(labels))
>                  labels <- paste("var", 1L:nc)
>          }
>          else if (is.null(labels))
>              doText <- FALSE
>      }
>      oma <- if ("oma" %in% nmdots)
>          dots$oma
>      main <- if ("main" %in% nmdots)
>          dots$main
>      if (is.null(oma))
>          oma <- c(4, 4, if (!is.null(main)) 6 else 4, 4)
>      opar <- par(mfcol = c(length(horInd), length(verInd)),
> ##### Changed from mfrow to mfcol
>                  mar = rep.int(gap/2, 4), oma = oma)
>      on.exit(par(opar))
>      dev.hold()
>      on.exit(dev.flush(), add = TRUE)
>      xl <- yl <- logical(nc)
>      if (is.numeric(log))
>          xl[log] <- yl[log] <- TRUE
>      else {
>          xl[] <- grepl("x", log)
>          yl[] <- grepl("y", log)
>      }
>      for (j in if (row1attop) verInd else rev(verInd))
>       for (i in horInd) {
> ##### Exchanged i and j. (i used to be in
> ##### the outer and j in the inner loop!)
>          l <- paste0(ifelse(xl[j], "x", ""),
ifelse(yl[i], "y", ""))
>          localPlot(x[, j], x[, i], xlab = "", ylab =
"", axes = FALSE,
>              type = "n", ..., log = l)
>          if (i == j || (i < j && has.lower) || (i > j
&& has.upper)) {
>              box()
>              if (i == 1 && (!(j%%2L) || !has.upper || !has.lower))
>                  localAxis(1L + 2L * row1attop, x[, j], x[, i],
>                    ...)
>              if (i == nc && (j%%2L || !has.upper || !has.lower))
>                  localAxis(3L - 2L * row1attop, x[, j], x[, i],
>                    ...)
>              if (j == 1 && (!(i%%2L) || !has.upper || !has.lower))
>                  localAxis(2L, x[, j], x[, i], ...)
>              if (j == nc && (i%%2L || !has.upper || !has.lower))
>                  localAxis(4L, x[, j], x[, i], ...)
>              mfg <- par("mfg")
>              if (i == j) {
>                  if (has.diag)
>                    localDiagPanel(as.vector(x[, i]), ...)
>                  if (doText) {
>                    par(usr = c(0, 1, 0, 1))
>                    if (is.null(cex.labels)) {
>                      l.wid <- strwidth(labels, "user")
>                      cex.labels <- max(0.8, min(2, 0.9/max(l.wid)))
>                    }
>                    xlp <- if (xl[i])
>                      10^0.5
>                    else 0.5
>                    ylp <- if (yl[j])
>                      10^label.pos
>                    else label.pos
>                    text.panel(xlp, ylp, labels[i], cex = cex.labels,
>                      font = font.labels)
>                  }
>              }
>              else if (i < j)
>                  localLowerPanel(as.vector(x[, j]), as.vector(x[,
>                    i]), ...)
>              else localUpperPanel(as.vector(x[, j]), as.vector(x[,
>                  i]), ...)
>              if (any(par("mfg") != mfg))
>                  stop("the 'panel' function made a new
plot")
>          }
>          else par(new = FALSE)
>      }
>      if (!is.null(main)) {
>          font.main <- if ("font.main" %in% nmdots)
>              dots$font.main
>          else par("font.main")
>          cex.main <- if ("cex.main" %in% nmdots)
>              dots$cex.main
>          else par("cex.main")
>          mtext(main, 3, line.main, outer = TRUE, at = 0.5, cex = cex.main,
>              font = font.main)
>      }
>      invisible(NULL)
> }
> 
> 
> 
> ## Example:
> 
> mypairs(xmat, xlim=lim, ylim=lim, verInd=1:2, horInd=1:4)
Thank you, Chris, for the report and
Gerrit for your proposed fix !!

It looks good to me,  but I will test some more (also with
'row1attop=FALSE')  before committing the bug fix.

Best regards,

Martin Maechler
ETH Zurich and R Core Team
> Am 06.06.2018 um 23:55 schrieb Andrews, Chris:
> > 
> > After making scatterplot matrix, I determined I only needed the first
2 columns of the matrix so I added verInd=1:2 to my pairs() call.  However, it
did not turn out as I expected.
> > 
> > Perhaps the attached pdf of the example code will make it through.  If
not, my description is "the wrong scatterplot pairs are in the wrong
places" for the last two pairs() calls.
> > 
> > Thanks,
> > Chris
> > 
> > ################################################################
> > 
> > # fake data
> > xmat <- matrix(1:28, ncol=4)
> > lim <- range(xmat)
> > 
> > # what I expected
> > pairs(xmat, xlim=lim, ylim=lim) # 4x4 matrix of scatterplots
> > pairs(xmat, xlim=lim, ylim=lim, verInd=1:2, horInd=1:2) # 2x2 matrix
of scatterplots: upper left
> > 
> > # here comes trouble
> > pairs(xmat, xlim=lim, ylim=lim, horInd=1:2) # 2x4 matrix of
scatterplots: but not the top 2 rows (or bottom 2 rows)
> > pairs(xmat, xlim=lim, ylim=lim, verInd=1:2) # 4x2 matrix of
scatterplots: but not the left 2 columns (or right 2 columns)
> > 
> > 
> > ###############################################################
> > 
> >> sessionInfo()
> > R version 3.5.0 (2018-04-23)
> > Platform: x86_64-w64-mingw32/x64 (64-bit)
> > Running under: Windows 7 x64 (build 7601) Service Pack 1
> > 
> > Matrix products: default
> > 
> > locale:
> > [1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United
States.1252    LC_MONETARY=English_United States.1252
> > [4] LC_NUMERIC=C                           LC_TIME=English_United
States.1252
> > 
> > attached base packages:
> > [1] stats     graphics  grDevices utils     datasets  methods   base
> > 
> > loaded via a namespace (and not attached):
> > [1] compiler_3.5.0 tools_3.5.0
> > **********************************************************