[R] dotplot, dropping unused levels of 'y'

[Benjamin Tyner]

Deepayan Sarkar wrote:

> On 9/15/06, Benjamin Tyner <btyner at gmail.com> wrote:
>
>> In dotplot, what's the best way to suppress the unused levels of 'y' on
>> a per-panel basis? This is useful for the case that 'y' is a factor
>> taking perhaps thousands of levels, but for a given panel, only a
>> handfull of these levels ever present.
>
>
> It's a bit problematic. Basically, you can use
> relation="free"/"sliced", but y behaves as as.numeric(y) would. So, if
> the small subset in each panel are always more or less contiguous (in
> terms of the levels being close to each other) then you would be fine.
> Otherwise you would not. In that case, you can still write your own
> prepanel and panel functions, e.g.:
> -------------
>
> library(lattice)
>
> y <- factor(sample(1:100), levels = 1:100)
> x <- 1:100
> a <- gl(9, 1, 100)
>
> dotplot(y ~ x | a)
>
> p <-
>    dotplot(y ~ x | a,
>            scales = list(y = list(relation = "free", rot = 0)),
>
>            prepanel = function(x, y, ...) {
>                yy <- y[, drop = TRUE]
>                list(ylim = levels(yy),
>                     yat = sort(unique(as.numeric(yy))))
>            },
>
>            panel = function(x, y, ...) {
>                yy <- y[, drop = TRUE]
>                panel.dotplot(x, yy, ...)
>            })
>
> ----------
>
> Hope that gives you what you want.
>
> Deepayan

I've been trying to extend this to allow groups, but am running into a 
bit of trouble. For example, the following doesn't quite work: (some of 
the unused factor levels are suppressed per panel, but not all):

set.seed(47905)
temp3<-data.frame(s_port=factor(rpois(100,10)),
                  POSIXtime=structure(1:100,class=c("POSIXt","POSIXct")),
                  l_ipn=factor(rpois(100,10)),
                  duration=runif(100),
                  locality=sample(1:4,replace=TRUE,size=100),
                  l_role=sample(c(-1,1),replace=TRUE,size=100))

plot<-dotplot(s_port~POSIXtime|l_ipn,
              data=temp3,
              layout=c(1,1),
              pch="|",
              col=1:8,
              duration=temp3$duration,
              auto.key=list(col=1:8,points=FALSE),
              groups=locality*l_role,
              prepanel = function(x, y, ...) {
                 yy <- y[, drop = TRUE]
                 list(ylim = levels(yy),
                      yat = sort(unique(as.numeric(yy))))
              },
              panel = panel.superpose,
              panel.groups = function(x, y, subscripts, duration, col, 
...) {
                 yy <- y[, drop = TRUE]
                 yy.n <- as.numeric(yy)
                 panel.abline(h=yy.n,col="lightgray")
                 panel.xyplot(x=x,y=yy.n,subscripts=subscripts,col=col,...)
                 panel.segments(x,
                                yy.n,
                                x+duration[subscripts],
                                yy.n,
                                col = col)
              },
              scales=list(y=list(relation="free"),
                          x=list(rot=45)),
              xlab="time",
              ylab="source port")



Thanks,
Ben