[R] Coloring Stripchart Points, or Better, Lattice Equivalent

Deepayan Sarkar deepayan.sarkar at gmail.com
Tue Jun 24 22:59:39 CEST 2008


On 6/24/08, Bryan Hanson <hanson at depauw.edu> wrote:
> If anyone remains interested, the solution in base graphics is to modify
>  stripchart.default, the last couple of lines where the coloring of points
>  defaults in a way that depends on groups.  In my example, the groups are
>  being handled collectively with the coloring.  Code is below.
>
>  Deepayan has noted that stacking of this type is not possible in Lattice
>  graphics, and would have to be coded directly (probably not too much of a
>  modification of what I give here, but I'm a novice!).

Here's a lattice version (well, mainly it's a function to calculate
the y-coordinates; not very efficient, but should suffice for small
datasets):


## utility to compute y-coordinates retaining order

jitter.stack <- function(x, y = NULL, increment = 1)
{
    if (!is.null(y)) {
        yold <- y
        for (yval in unique(yold))
        {
            i <- yold == yval
            y[i] <- y[i] + jitter.stack(x[i], increment = increment)
        }
        y
    }
    else {
        y <- rep(0, length(x))
        for (xval in unique(x))
        {
            i <- x == xval
            y[i] <- increment * (seq_len(sum(i)) - 1)
        }
        y
    }
}


set.seed(13331)
samples <- 100 # must be even
index <- round(runif(samples, 1, 100)) # set up data
resp <- rbinom(samples, 1, 0.5)
yr <- rep(c("2005", "2006"), samples/2)
all <- data.frame(index, resp, yr)
all$sym <- ifelse(all$resp == 1, 1, 3)
all$col <- ifelse(all$yr == 2005, "red", "blue")


with(all,
     stripplot(interaction(yr, resp, sep = "/") ~ index,
               col = col, pch = sym,
               panel = function(x, y, ...) {
                   ynew <- jitter.stack(x, as.numeric(y), increment = 0.05)
                   panel.xyplot(x, ynew, ...)
               }))

with(all,
     stripplot(~ index,
               col = col, pch = sym, ylim = c(0, 5),
               panel = function(x, y, ...) {
                   ynew <- jitter.stack(x, as.numeric(y))
                   panel.xyplot(x, ynew, ...)
               }))


-Deepayan



More information about the R-help mailing list