[R] verInd= and HorInd= arguments to pairs() function
Martin Maechler
m@ech|er @end|ng |rom @t@t@m@th@ethz@ch
Thu Jun 7 18:35:48 CEST 2018
>>>>> 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
> > **********************************************************
More information about the R-help
mailing list