Skip to content

Patch to coplot.R

3 messages · Dr. Thomas Baumann, Martin Maechler, thomas.baumann@ch.tum.de

#
---1149173172-1804289383-983267779=:26068
Content-Type: TEXT/plain; charset=us-ascii

Hello,

and a big thank you for providing R!

Please find attached a diff for coplot which you may want to consider
for the next release. The diff is against R 1.2.2. The reasons for this
patch are:

1. The boxes of coplot did not align very well with the panel graphs if
   applied to a factor

2. Putting the levels as axis labels instead of just numbers makes the
   plot more readable

I also include a sample dataset (test.asc) and a sample program to show
the differences.

Thanks for looking at the code.

Thomas


---1149173172-1804289383-983267779=:26068
Content-Type: TEXT/plain; NAME="coplot.diff"

*** /tmp/mycoplot.R	Tue Feb 27 09:08:13 2001
--- /tmp/coplot.R.orig	Tue Feb 27 09:08:13 2001
***************
*** 201,227 ****
                  ...)
          }
          if ((i == total.rows) && (j%%2 == 0)) 
!             if (nlevels(x) > 0)
!               axis(1, labels = levels(x), xpd = NA)
!             else
!               axis(1, xpd = NA)
          else if ((i == istart || index + columns > nplots) && 
              (j%%2 == 1)) 
!             if (nlevels(x) > 0)
!               axis(3, labels = levels(x), xpd = NA)
!             else
!               axis(3, xpd = NA)
!         if ((j == 1) && ((total.rows - i)%%2 == 0))
!             if (nlevels(y) > 0)
!               axis(2, labels = levels(y), xpd = NA)
!             else
!               axis(2, xpd = NA)
          else if ((j == columns || index == nplots) && ((total.rows - 
!             i)%%2 == 1))
!             if (nlevels(y) > 0)
!               axis(4, labels = levels(y), xpd = NA)
!             else
!               axis(4, xpd = NA)
          box()
      }
      if (have.b) {
--- 201,215 ----
                  ...)
          }
          if ((i == total.rows) && (j%%2 == 0)) 
!             axis(1, xpd = NA)
          else if ((i == istart || index + columns > nplots) && 
              (j%%2 == 1)) 
!             axis(3, xpd = NA)
!         if ((j == 1) && ((total.rows - i)%%2 == 0)) 
!             axis(2, xpd = NA)
          else if ((j == columns || index == nplots) && ((total.rows - 
!             i)%%2 == 1)) 
!             axis(4, xpd = NA)
          box()
      }
      if (have.b) {
***************
*** 255,274 ****
          par(fig = c(0, f.col, f.row, 1), mar = nmar, new = TRUE)
          plot.new()
          nint <- nrow(a.intervals)
!         pwoffs <- nint / 32
!         plot.window(c(min(a.intervals[is.finite(a.intervals)] + pwoffs),
!                       max(a.intervals[is.finite(a.intervals)]) - pwoffs),
!                     0.5 + c(0, nint), log = "")
!         rect(a.intervals[, 1], 1:nint - 0.5, a.intervals[, 2], 
!             1:nint + 0.5, col = gray(0.95))
!         if (!is.null(a.levels)) {
              mid <- apply(a.intervals, 1, mean)
              text(mid, 1:nint, a.levels)
              NULL
          }
!         axis(3, labels = FALSE, tick = FALSE, xpd = NA)
!         axis(1, labels = FALSE, tick = FALSE)
!         box(col = "grey")
          mtext(xlab[2], side = 3, at = mean(par("usr")[1:2]), 
              line = 3, xpd = NA)
      }
--- 243,262 ----
          par(fig = c(0, f.col, f.row, 1), mar = nmar, new = TRUE)
          plot.new()
          nint <- nrow(a.intervals)
!         plot.window(range(a.intervals[is.finite(a.intervals)]), 
!             0.5 + c(0, nint), log = "")
!         bg <- if (is.null(a.levels)) 
!             gray(0.9)
!         else {
              mid <- apply(a.intervals, 1, mean)
              text(mid, 1:nint, a.levels)
              NULL
          }
!         rect(a.intervals[, 1], 1:nint - 0.3, a.intervals[, 2], 
!             1:nint + 0.3, col = bg)
!         axis(3, xpd = NA)
!         axis(1, labels = FALSE)
!         box()
          mtext(xlab[2], side = 3, at = mean(par("usr")[1:2]), 
              line = 3, xpd = NA)
      }
***************
*** 284,304 ****
              par(fig = c(f.col, 1, 0, f.row), mar = nmar, new = TRUE)
              plot.new()
              nint <- nrow(b.intervals)
!             pwoffs <- nint / 32
!             plot.window(0.5 + c(0, nint),
!                         c(min(b.intervals[is.finite(b.intervals)] + pwoffs),
!                           max(b.intervals[is.finite(b.intervals)]) - pwoffs),
!                         log = "")
!             rect(1:nint - 0.5, b.intervals[, 1], 1:nint + 0.5, 
!                 b.intervals[, 2], col = gray(0.95))
!             if (!is.null(b.levels)) {
                  mid <- apply(b.intervals, 1, mean)
                  text(1:nint, mid, b.levels, srt = 90)
                  NULL
              }
!             axis(4, labels = FALSE, tick = FALSE, xpd = NA)
!             axis(2, labels = FALSE, tick = FALSE)
!             box(col = "grey")
              mtext(ylab[2], side = 4, at = mean(par("usr")[3:4]), 
                  line = 3, xpd = NA)
          }
--- 272,291 ----
              par(fig = c(f.col, 1, 0, f.row), mar = nmar, new = TRUE)
              plot.new()
              nint <- nrow(b.intervals)
!             plot.window(0.5 + c(0, nint), range(b.intervals, 
!                 finite = TRUE), log = "")
!             bg <- if (is.null(b.levels)) 
!                 gray(0.9)
!             else {
                  mid <- apply(b.intervals, 1, mean)
                  text(1:nint, mid, b.levels, srt = 90)
                  NULL
              }
!             rect(1:nint - 0.3, b.intervals[, 1], 1:nint + 0.3, 
!                 b.intervals[, 2], col = bg)
!             axis(4, xpd = NA)
!             axis(2, labels = FALSE)
!             box()
              mtext(ylab[2], side = 4, at = mean(par("usr")[3:4]), 
                  line = 3, xpd = NA)
          }

---1149173172-1804289383-983267779=:26068
Content-Type: TEXT/plain; NAME="mycoplot.R"

function (formula, data, given.values, panel = points, rows, 
    columns, show.given = TRUE, col = par("fg"), pch = par("pch"), 
    xlab = c(x.name, paste("Given :", a.name)), ylab = c(y.name, 
        paste("Given :", b.name)), subscripts = FALSE, number = 6, 
    overlap = 0.5, xlim, ylim, ...) 
{
    deparen <- function(expr) {
        while (is.language(expr) && !is.name(expr) && deparse(expr[[1]]) == 
            "(") expr <- expr[[2]]
        expr
    }
    bad.formula <- function() stop("invalid conditioning formula")
    bad.lengths <- function() stop("incompatible variable lengths")
    formula <- deparen(formula)
    if (!inherits(formula, "formula")) 
        bad.formula()
    y <- deparen(formula[[2]])
    rhs <- deparen(formula[[3]])
    if (deparse(rhs[[1]]) != "|") 
        bad.formula()
    x <- deparen(rhs[[2]])
    rhs <- deparen(rhs[[3]])
    if (is.language(rhs) && !is.name(rhs) && (deparse(rhs[[1]]) == 
        "*" || deparse(rhs[[1]]) == "+")) {
        have.b <- TRUE
        a <- deparen(rhs[[2]])
        b <- deparen(rhs[[3]])
    }
    else {
        have.b <- FALSE
        a <- rhs
    }
    if (missing(data)) 
        data <- parent.frame()
    x.name <- deparse(x)
    x <- eval(x, data, parent.frame())
    nobs <- length(x)
    y.name <- deparse(y)
    y <- eval(y, data, parent.frame())
    if (length(y) != nobs) 
        bad.lengths()
    a.name <- deparse(a)
    a <- eval(a, data, parent.frame())
    if (length(a) != nobs) 
        bad.lengths()
    if (is.character(a)) 
        a <- as.factor(a)
    a.levels <- NULL
    if (have.b) {
        b.levels <- NULL
        b.name <- deparse(b)
        b <- eval(b, data, parent.frame())
        if (length(b) != nobs) 
            bad.lengths()
        if (is.character(b)) 
            b <- as.factor(b)
        missingrows <- which(is.na(x) | is.na(y) | is.na(a) | 
            is.na(b))
    }
    else {
        missingrows <- which(is.na(x) | is.na(y) | is.na(a))
        b <- NULL
        b.name <- ""
    }
    number <- as.integer(number)
    if (length(number) == 0 || any(number < 1)) 
        stop("number must be integer >= 1")
    if (any(overlap >= 1)) 
        stop("overlap must be < 1 (and typically >= 0).")
    bad.givens <- function() stop("invalid given.values")
    if (missing(given.values)) {
        a.intervals <- if (is.factor(a)) {
            i <- 1:nlevels(a)
            a.levels <- levels(a)
            a <- as.numeric(a)
            cbind(i - 0.5, i + 0.5)
        }
        else co.intervals(a, number = number[1], overlap = overlap[1])
        b.intervals <- if (have.b) {
            if (is.factor(b)) {
                i <- 1:nlevels(b)
                b.levels <- levels(b)
                b <- as.numeric(b)
                cbind(i - 0.5, i + 0.5)
            }
            else {
                if (length(number) == 1) 
                  number <- rep(number, 2)
                if (length(overlap) == 1) 
                  overlap <- rep(overlap, 2)
                co.intervals(b, number = number[2], overlap = overlap[2])
            }
        }
    }
    else {
        if (!is.list(given.values)) 
            given.values <- list(given.values)
        if (length(given.values) != (if (have.b) 
            2
        else 1)) 
            bad.givens()
        a.intervals <- given.values[[1]]
        if (is.factor(a)) {
            if (is.character(a.intervals)) 
                a.intervals <- match(a.intervals, levels(a))
            a.intervals <- cbind(a.intervals - 0.5, a.intervals + 
                0.5)
            a.levels <- levels(a)
            a <- as.numeric(a)
        }
        else if (is.numeric(a)) {
            if (!is.numeric(a.intervals)) 
                bad.givens()
            if (!is.matrix(a.intervals) || ncol(a.intervals) != 
                2) 
                a.intervals <- cbind(a.intervals - 0.5, a.intervals + 
                  0.5)
        }
        if (have.b) {
            b.intervals <- given.values[[2]]
            if (is.factor(b)) {
                if (is.character(b.intervals)) 
                  b.intervals <- match(b.intervals, levels(b))
                b.intervals <- cbind(b.intervals - 0.5, b.intervals + 
                  0.5)
                b.levels <- levels(b)
                b <- as.numeric(b)
            }
            else if (is.numeric(b)) {
                if (!is.numeric(b.intervals)) 
                  bad.givens()
                if (!is.matrix(b.intervals) || ncol(b.intervals) != 
                  2) 
                  b.intervals <- cbind(b.intervals - 0.5, b.intervals + 
                    0.5)
            }
        }
    }
    if (any(is.na(a.intervals)) || (have.b && any(is.na(b.intervals)))) 
        bad.givens()
    if (have.b) {
        rows <- nrow(b.intervals)
        columns <- nrow(a.intervals)
        nplots <- rows * columns
        if (length(show.given) < 2) 
            show.given <- rep(show.given, 2)
    }
    else {
        nplots <- nrow(a.intervals)
        if (missing(rows)) {
            if (missing(columns)) {
                rows <- ceiling(round(sqrt(nplots)))
                columns <- ceiling(nplots/rows)
            }
            else rows <- ceiling(nplots/columns)
        }
        else if (missing(columns)) 
            columns <- ceiling(nplots/rows)
        if (rows * columns < nplots) 
            stop("rows * columns too small")
    }
    total.columns <- columns
    total.rows <- rows
    f.col <- f.row <- 1
    if (show.given[1]) {
        total.rows <- rows + 1
        f.row <- rows/total.rows
    }
    if (have.b && show.given[2]) {
        total.columns <- columns + 1
        f.col <- columns/total.columns
    }
    opar <- par(mfrow = c(total.rows, total.columns), oma = if (have.b) 
        rep(5, 4)
    else c(5, 6, 5, 4), mar = if (have.b) 
        rep(0, 4)
    else c(0.5, 0, 0.5, 0), new = FALSE)
    on.exit(par(opar))
    plot.new()
    if (missing(xlim)) 
        xlim <- range(x[is.finite(x)])
    if (missing(ylim)) 
        ylim <- range(y[is.finite(y)])
    pch <- rep(pch, length = nobs)
    col <- rep(col, length = nobs)
    do.panel <- function(index, subscripts = FALSE) {
        istart <- (total.rows - rows) + 1
        i <- total.rows - ((index - 1)%/%columns)
        j <- (index - 1)%%columns + 1
        par(mfg = c(i, j, total.rows, total.columns))
        plot.new()
        plot.window(xlim, ylim, log = "")
        if (any(is.na(id))) 
            id[is.na(id)] <- FALSE
        if (any(id)) {
            grid(lty = "solid")
            if (subscripts) 
                panel(x[id], y[id], subscripts = id, col = col[id], 
                  pch = pch[id], ...)
            else panel(x[id], y[id], col = col[id], pch = pch[id], 
                ...)
        }
        if ((i == total.rows) && (j%%2 == 0)) 
            if (nlevels(x) > 0)
              axis(1, labels = levels(x), xpd = NA)
            else
              axis(1, xpd = NA)
        else if ((i == istart || index + columns > nplots) && 
            (j%%2 == 1)) 
            if (nlevels(x) > 0)
              axis(3, labels = levels(x), xpd = NA)
            else
              axis(3, xpd = NA)
        if ((j == 1) && ((total.rows - i)%%2 == 0))
            if (nlevels(y) > 0)
              axis(2, labels = levels(y), xpd = NA)
            else
              axis(2, xpd = NA)
        else if ((j == columns || index == nplots) && ((total.rows - 
            i)%%2 == 1))
            if (nlevels(y) > 0)
              axis(4, labels = levels(y), xpd = NA)
            else
              axis(4, xpd = NA)
        box()
    }
    if (have.b) {
        count <- 1
        for (i in 1:rows) {
            for (j in 1:columns) {
                id <- ((a.intervals[j, 1] <= a) & (a <= a.intervals[j, 
                  2]) & (b.intervals[i, 1] <= b) & (b <= b.intervals[i, 
                  2]))
                do.panel(count, subscripts)
                count <- count + 1
            }
        }
    }
    else {
        for (i in 1:nplots) {
            id <- ((a.intervals[i, 1] <= a) & (a <= a.intervals[i, 
                2]))
            do.panel(i, subscripts)
        }
    }
    mtext(xlab[1], side = 1, at = 0.5 * f.col, outer = TRUE, 
        line = 3.5, xpd = NA)
    mtext(ylab[1], side = 2, at = 0.5 * f.row, outer = TRUE, 
        line = 3.5, xpd = NA)
    if (length(xlab) == 1) 
        xlab <- c(xlab, paste("Given :", a.name))
    if (show.given[1]) {
        mar <- par("mar")
        nmar <- mar + c(4, 0, 0, 0)
        par(fig = c(0, f.col, f.row, 1), mar = nmar, new = TRUE)
        plot.new()
        nint <- nrow(a.intervals)
        pwoffs <- nint / 32
        plot.window(c(min(a.intervals[is.finite(a.intervals)] + pwoffs),
                      max(a.intervals[is.finite(a.intervals)]) - pwoffs),
                    0.5 + c(0, nint), log = "")
        rect(a.intervals[, 1], 1:nint - 0.5, a.intervals[, 2], 
            1:nint + 0.5, col = gray(0.95))
        if (!is.null(a.levels)) {
            mid <- apply(a.intervals, 1, mean)
            text(mid, 1:nint, a.levels)
            NULL
        }
        axis(3, labels = FALSE, tick = FALSE, xpd = NA)
        axis(1, labels = FALSE, tick = FALSE)
        box(col = "grey")
        mtext(xlab[2], side = 3, at = mean(par("usr")[1:2]), 
            line = 3, xpd = NA)
    }
    else {
        mtext(xlab[2], side = 3, at = 0.5 * f.col, line = 3.25, 
            outer = TRUE, xpd = NA)
    }
    if (have.b) {
        if (length(ylab) == 1) 
            ylab <- c(ylab, paste("Given :", b.name))
        if (show.given[2]) {
            nmar <- mar + c(0, 4, 0, 0)
            par(fig = c(f.col, 1, 0, f.row), mar = nmar, new = TRUE)
            plot.new()
            nint <- nrow(b.intervals)
            pwoffs <- nint / 32
            plot.window(0.5 + c(0, nint),
                        c(min(b.intervals[is.finite(b.intervals)] + pwoffs),
                          max(b.intervals[is.finite(b.intervals)]) - pwoffs),
                        log = "")
            rect(1:nint - 0.5, b.intervals[, 1], 1:nint + 0.5, 
                b.intervals[, 2], col = gray(0.95))
            if (!is.null(b.levels)) {
                mid <- apply(b.intervals, 1, mean)
                text(1:nint, mid, b.levels, srt = 90)
                NULL
            }
            axis(4, labels = FALSE, tick = FALSE, xpd = NA)
            axis(2, labels = FALSE, tick = FALSE)
            box(col = "grey")
            mtext(ylab[2], side = 4, at = mean(par("usr")[3:4]), 
                line = 3, xpd = NA)
        }
        else {
            mtext(ylab[2], side = 4, at = 0.5 * f.row, line = 3.25, 
                outer = TRUE, xpd = NA)
        }
    }
    if (length(missingrows) > 0) {
        cat("\nMissing rows:", missingrows, "\n")
        invisible(missingrows)
    }
}

---1149173172-1804289383-983267779=:26068
Content-Type: TEXT/plain; NAME="test.asc"

RDA1
5 0
9 row.names
5 names
5 class
6 levels
3 cxt
2 0 0
1 0 0
5
-1
19 0 1
4
13 0 1
90
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 1
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 2
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 3
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 4
 5
 5
 5
 5
 5
 5
 5
 5
 5
 5
 5
 5
 5
 5
 5
2 0 0
1 0 0
4
-1
16 0 0
5
 3 WSA
 3 WSB
 3 WSC
 3 WSD
 3 WSE
-1
2 0 0
1 0 0
3
-1
16 0 0
1
 6 factor
-1
-1
-1
-1

13 0 1
90
 2
 2
 2
 2
 3
 4
 4
 4
 4
 5
 5
 5
 6
 6
 6
 6
 6
 6
 1
 2
 2
 2
 2
 2
 2
 4
 4
 4
 4
 5
 5
 5
 5
 5
 6
 6
 6
 6
 6
 6
 1
 2
 2
 2
 2
 2
 2
 4
 4
 4
 4
 5
 5
 6
 6
 6
 6
 6
 6
 1
 2
 2
 2
 4
 4
 4
 4
 5
 5
 6
 6
 6
 6
 6
 6
 1
 2
 2
 2
 3
 4
 4
 4
 5
 5
 6
 6
 6
 6
 6
2 0 0
1 0 0
4
-1
16 0 0
6
 2 Br
 2 Cr
 2 Ni
 3 PCP
 3 SRB
 3 URA
-1
2 0 0
1 0 0
3
-1
16 0 0
1
 6 factor
-1
-1
-1
-1

13 0 1
90
 1
 2
 4
 4
 4
 1
 2
 3
 4
 1
 3
 4
 1
 1
 1
 1
 1
 1
 1
 1
 1
 2
 2
 4
 4
 1
 2
 3
 4
 1
 3
 3
 4
 4
 1
 1
 1
 1
 1
 1
 1
 1
 1
 2
 2
 4
 4
 1
 2
 3
 4
 3
 4
 1
 1
 1
 1
 1
 1
 1
 1
 2
 4
 1
 2
 3
 4
 3
 4
 1
 1
 1
 1
 1
 1
 1
 1
 2
 4
 4
 1
 3
 4
 3
 4
 1
 1
 1
 1
 1
2 0 0
1 0 0
4
-1
16 0 0
4
 1 1
 2 20
 2 21
 2 22
-1
2 0 0
1 0 0
3
-1
16 0 0
1
 6 factor
-1
-1
-1
-1

14 0 0
90
 0.88690446
 0.88690513
 -0.008582909999999999
 0.84140389
 0.01547746
 0.82645292
 0.82645427
 0.76571345
 0.8263521
 0.37570381
 0.40361484
 0.40384806
 0.74884711
 0.94859763
 0.96677452
 0.97557102
 0.9832513000000001
 0.98572282
 0.99349502
 0.11416688
 0.8122289
 0.11418351
 0.88183559
 0.09723225000000001
 0.88183561
 0.83853386
 0.83863709
 0.74681656
 0.83251071
 0.8454432
 0.75563716
 0.92634558
 0.84537136
 0.97884589
 0.73673004
 0.96747265
 0.97369701
 0.98715169
 0.9914865
 0.99328531
 0.99652316
 0.25447211
 0.30372693
 0.25373806
 0.30371362
 0.2327828
 0.25372631
 0.96173564
 0.97069235
 0.95462282
 0.95459587
 0.91341539
 0.98234451
 0.60740805
 0.77592908
 0.93602096
 0.9867878
 0.98751514
 0.99363163
 0.9859177
 0.83318812
 0.83308551
 0.95750996
 0.91218418
 0.91217945
 0.8623662
 0.90722619
 0.89806433
 0.546805
 0.9623669500000001
 0.97003306
 0.97554032
 0.98202711
 0.98297822
 0.98880629
 0.99688566
 0.80436417
 0.88417903
 0.80423433
 0.45605293
 0.95874106
 0.56694216
 0.95734593
 0.87062068
 0.96359899
 0.9355361
 0.9629377
 0.96566601
 0.9679529100000001
 0.9834591
-1

2 0 0
1 0 0
3
-1
16 0 0
1
 10 data.frame
-1
2 0 0
1 0 0
2
-1
16 0 0
4
 6 loc.id
 7 chem.id
 4 mode
 6 fitpar
-1
2 0 0
1 0 0
1
-1
16 0 0
90
 1 1
 1 2
 1 3
 1 4
 1 5
 1 6
 1 7
 1 8
 1 9
 2 10
 2 11
 2 12
 2 13
 2 14
 2 15
 2 16
 2 17
 2 18
 2 19
 2 20
 2 21
 2 22
 2 23
 2 24
 2 25
 2 26
 2 27
 2 28
 2 29
 2 30
 2 31
 2 32
 2 33
 2 34
 2 35
 2 36
 2 37
 2 38
 2 39
 2 40
 2 41
 2 42
 2 43
 2 44
 2 45
 2 46
 2 47
 2 48
 2 49
 2 50
 2 51
 2 52
 2 53
 2 54
 2 55
 2 56
 2 57
 2 58
 2 59
 2 60
 2 61
 2 62
 2 63
 2 64
 2 65
 2 66
 2 67
 2 68
 2 69
 2 70
 2 71
 2 72
 2 73
 2 74
 2 75
 2 76
 2 77
 2 78
 2 79
 2 80
 2 81
 2 82
 2 83
 2 84
 2 85
 2 86
 2 87
 2 88
 2 89
 2 90
-1
-1
-1
-1
-1
-1
-1

---1149173172-1804289383-983267779=:26068
Content-Type: TEXT/plain; NAME="coplot_sample.R"

load("test.asc")
mycoplot(cxt$fitpar ~ unclass(cxt$loc.id)|
         cxt$chem.id * cxt$mode,
         panel = points,
         bg = "blue",
         col = "blue",
         pch = 21,
         xlab = c("Location", "Contaminant"),
         ylab = c(label, "CXTFit-Mode"),
         ylim = c(0.6,1)
       )


coplot(cxt$fitpar ~ unclass(cxt$loc.id)|
         cxt$chem.id * cxt$mode,
         panel = points,
         bg = "blue",
         col = "blue",
         pch = 21,
         xlab = c("Location", "Contaminant"),
         ylab = c(label, "CXTFit-Mode"),
         ylim = c(0.6,1)
       )

---1149173172-1804289383-983267779=:26068--
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
#
...

    Thomas> Please find attached a diff for coplot which you may want to
    Thomas> consider for the next release. 

Thank you, Thomas!

    Thomas> The diff is against R 1.2.2. 

unfortunately *not* :

-------- sorry for the excursion --- but I must say this loudly ---
	 {it's by far not the first time, and it's a real pain for us
 	 merging the code!}

  Please -- everyone -- do not consider the output

      > functionname

  (or ESS/Emacs C-c C-d)
  as the source of function  functionname.

  There is only one source, and that is in 
	R-<version>/src/library/<pkg>/R/<foobar>.R
  in our case in
	    R-1.2.2/src/library/base/R/coplot.R

  Again: 
    Please, please do NOT ever patch against the output of typing the
    function name, but please diff against the real source...


---------- end of excursion --------------------

    Thomas> Thanks for looking at the code.

I've been doing that for a bit, now ..


    Thomas> The reasons for this patch are:

    Thomas> 1. The boxes of coplot did not align very well with the panel
    Thomas> graphs if applied to a factor

hmm, well, that's also a matter of taste, but I tend to agree with your
choice (though it slightly complicates the code).

    Thomas> 2. Putting the levels as axis labels instead of just numbers
    Thomas> makes the plot more readable

yes, unless the levels happen to be 10-letter words -- which seems to
happen for some data / people. 
I think one should make this an option (on by default), and also consider using
abbreviate(levels(x), ...) 

    Thomas> I also include a sample dataset (test.asc) and a sample program
    Thomas> to show the differences.

thanks, these *were* useful.

Note however, that you changed more.
We had explicitly 
   - empty boxes when conditioning on  ordinal variables (aka factors)
   - gray boxes  when using "shingles", i.e. conditioning on continuous vars.

you have all boxes gray which I don't necessarily prefer.
(and you should say that you were changing this, too...).
One could consider using two different kinds of gray for the two,
very light gray for factors, darker one for `shingle bars'.

I'm a bit reluctant to change this; R has been a `ripe' piece of software
for a while and people don't necessarily want to see changes that they
can't easily revert.  Hence, the two bg colors (bar backgrounds) would
become function arguments as well....

opinions?

Martin
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._
#
On 27 Feb, Martin Maechler wrote:
sorry for any inconvenience, the next patches will definitely be against
the real source.
I fully agree with your opinion, since I do not like having all the
automatically generated diagrams looking different after an update. But
an easy option would be nice...

Thomas


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._