>>>>> 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
> > **********************************************************
______________________________________________
R-help@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.
