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

[Deepayan Sarkar]

On 9/26/06, Benjamin Tyner <btyner at gmail.com> wrote:
> 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):

I don't think panel = panel.superpose is enough. Try

             panel = function(x, y, ...) {
                yy <- y[, drop = TRUE]
                yy.n <- as.numeric(yy)
                panel.superpose(x, yy.n, ...)
            },
            panel.groups =
            function(x, y, subscripts, duration, col, ...) {
                panel.abline(h = y, col = "lightgray")
                panel.xyplot(x, y, col = col, ...)
                panel.segments(x, y,
                               x + duration[subscripts], y,
                               col = col)
            },

-Deepayan

> 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
>