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!).
Thanks, Bryan
stripchart.colsym <-
function(x, method="overplot", jitter=0.1, offset=1/3, vertical=FALSE,
group.names, add = FALSE, at = NULL,
xlim=NULL, ylim=NULL, ylab=NULL, xlab=NULL, dlab="", glab="",
log="", pch=0, col=par("fg"), cex=par("cex"), axes=TRUE,
frame.plot=axes, ...)
{
method <- pmatch(method, c("overplot", "jitter", "stack"))[1]
if(is.na(method) || method==0)
stop("invalid plotting method")
groups <-
if(is.list(x)) x
else if(is.numeric(x)) list(x)
if(0 == (n <- length(groups)))
stop("invalid first argument")
if(!missing(group.names))
attr(groups, "names") <- group.names
else if(is.null(attr(groups, "names")))
attr(groups, "names") <- 1:n
if(is.null(at))
at <- 1:n
else if(length(at) != n)
stop(gettextf("'at' must have length equal to the number %d of groups",
n), domain = NA)
if (is.null(dlab)) dlab <- deparse(substitute(x))
if(!add) {
dlim <- c(NA, NA)
for(i in groups)
dlim <- range(dlim, i[is.finite(i)], na.rm = TRUE)
glim <- c(1,n)# in any case, not range(at)
if(method == 2) { # jitter
glim <- glim + jitter * if(n == 1) c(-5, 5) else c(-2, 2)
} else if(method == 3) { # stack
glim <- glim + if(n == 1) c(-1,1) else c(0, 0.5)
}
if(is.null(xlim))
xlim <- if(vertical) glim else dlim
if(is.null(ylim))
ylim <- if(vertical) dlim else glim
plot(xlim, ylim, type="n", ann=FALSE, axes=FALSE, log=log, ...)
if (frame.plot) box()
if(vertical) {
if (axes) {
if(n > 1) axis(1, at=at, labels=names(groups), ...)
Axis(x, side = 2, ...)
}
if (is.null(ylab)) ylab <- dlab
if (is.null(xlab)) xlab <- glab
}
else {
if (axes) {
Axis(x, side = 1, ...)
if(n > 1) axis(2, at=at, labels=names(groups), ...)
}
if (is.null(xlab)) xlab <- dlab
if (is.null(ylab)) ylab <- glab
}
title(xlab=xlab, ylab=ylab)
}
csize <- cex*
if(vertical) xinch(par("cin")[1]) else yinch(par("cin")[2])
for(i in 1:n) {
x <- groups[[i]]
y <- rep.int(at[i], length(x))
if(method == 2) ## jitter
y <- y + stats::runif(length(y), -jitter, jitter)
else if(method == 3) { ## stack
xg <- split(x, factor(x))
xo <- lapply(xg, seq_along)
x <- unlist(xg, use.names=FALSE)
y <- rep.int(at[i], length(x)) +
(unlist(xo, use.names=FALSE) - 1) * offset * csize
}
if(vertical) points(y, x, col=col,
pch=pch, cex=cex)
else points(x, y, col=col,
pch=pch, cex=cex)
}
}
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, 3, 1)
all$col <- ifelse(all$yr == 2005, "red", "blue")
all$count <- rep(1, length(all$index))
all <- all[order(all$index, all$yr, all$resp),] # for easier inspection
row.names(all) <- c(1:samples) # for easier inspection
one <- all[(all$yr == 2005 & all$resp == 0),] # First 2005/0 at bottom
two <- all[(all$yr == 2005 & all$resp == 1),] # Then 2005/1
three <- all[(all$yr == 2006 & all$resp == 0),] # Now 2006/0
four <- all[(all$yr == 2006 & all$resp == 1),] # Finally 2006/1
par(mfrow = c(5, 1))
par(plt = c(0.1, 0.9, 0.25, 0.75))
stripchart(one$index, method = "stack", ylim = c(0,10), xlim = c(1,100), col
= one$col, pch = one$sym)
mtext("2005/0 only", side = 3)
stripchart(two$index, method = "stack", ylim = c(0,10), xlim = c(1,100), col
= two$col, pch = two$sym)
mtext("2005/1 only", side = 3)
stripchart(three$index, method = "stack", ylim = c(0,10), xlim = c(1,100),
col = three$col, pch = three$sym)
mtext("2006/0 only", side = 3)
stripchart(four$index, method = "stack", ylim = c(0,10), xlim = c(1,100),
col = four$col, pch = four$sym)
mtext("2006/1 only", side = 3)
stripchart.colsym(all$index, method = "stack", ylim = c(0,10), xlim =
c(1,100), col = all$col, pch = all$sym)
mtext("all data, colored and symbolized as above", side = 3)
______________________________________________
R-help@r-project.org mailing list
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.
