[R] lattice and several groups

[Laurent Rhelp]

Gabor Grothendieck a écrit :

> Try this version which corresponds to your latest version
> but makes use of panel.groups distinguishing the groups
> using group.number:
>
> # set custom col and pch here
> my.col <- 1:nlevels(df$f2)
> my.pch <- 1:nlevels(df$f1)
>
> pnl <- function(x, y, subscripts, pch, group.number, ...) {
>  panel <- c(panel.lmline, panel.loess, panel.loess)[[group.number]]
>  panel(x, y, ..., pch = pch[subscripts])
>  panel.xyplot(x, y, pch = my.pch[df[subscripts, "f1"]], ...)
> }
>
>
> xyplot(y ~ x | surveys, data = df, groups = df$f2, type = "b",
>       panel = panel.superpose,
>       panel.groups = pnl,
>       par.settings = list(superpose.line = list(col = my.col),
>          superpose.symbol = list(col = my.col))
>
> )
>
>
> key1 <- list(border = TRUE, colums = 2, text = list(levels(df$f1)),
>      points = list(pch = my.pch)
>
> )
>
> key2 <- list(border = TRUE, colums = 2, text = list(levels(df$f2)),
>      lines = list(col = my.col)
> )
>
> draw.key(key1, draw = TRUE, vp = viewport(.9, .9))
> draw.key(key2, draw = TRUE, vp = viewport(.75, .9))
>
>
> On 9/3/06, Laurent Rhelp <laurentRhelp at free.fr> wrote:
>
>> Gabor Grothendieck a écrit :
>>
>> > In thinking about this a bit more we can use
>> > panel.superpose/panel.groups to shorten it:
>> >
>> > # define data -- df
>> >
>> > # note that your val2 and val3 lines had a syntax
>> > # so we have commented them out and
>> > # replaced them as shown.
>> > n <- 18
>> > x1 <- seq(1,n)
>> > val1 <- -2*x1+50
>> > # val2 <- (-2*(x1-8)2)+100
>> > val2 <- (-2*(x1-8))+100
>> > # val3 <- (-2*(x1-8)2)+50
>> > val3 <- (-2*(x1-8))+50
>> > y <- c(val1,val2,val3)
>> > x <- rep(x1,3)
>> > f1 <- rep(c("mod1","mod2","mod3"),each=n/3)
>> > f1 <- rep(f1,3)
>> > f2 <- rep(c("g1","g2","g3"),each=n)
>> > df <- data.frame(x=x,y=y,f1=f1,f2=f2)
>> > surveys <-
>> > factor(c(rep("survey1",n*3),rep("survey2",n*3),rep("survey3",n*3)))
>> > df <- rbind(df,df,df)
>> > df <- data.frame(df,surveys=surveys)
>> >
>> > # create xyplot
>> >
>> > library(lattice)
>> > library(grid)
>> >
>> > # set custom col and pch here
>> > my.col <- 1:nlevels(df$f2)
>> > my.pch <- 1:nlevels(df$f1)
>> >
>> > pnl <- function(x, y, subscripts, pch, type, ...)
>> >   panel.xyplot(x, y, type = type, pch = my.pch[df[subscripts, "f1"]],
>> > ...)
>> >
>> > xyplot(y ~ x | surveys, data = df, groups = df$f2, type = "b",
>> >        panel = panel.superpose,
>> >        panel.groups = pnl,
>> >        par.settings = list(superpose.line = list(col = my.col),
>> >           superpose.symbol = list(col = my.col))
>> > )
>> >
>> >
>> > key1 <- list(border = TRUE, colums = 2, text = list(levels(df$f1)),
>> >       points = list(pch = my.pch)
>> > )
>> >
>> > key2 <- list(border = TRUE, colums = 2, text = list(levels(df$f2)),
>> >       lines = list(col = my.col)
>> > )
>> >
>> > draw.key(key1, draw = TRUE, vp = viewport(.9, .9))
>> > draw.key(key2, draw = TRUE, vp = viewport(.75, .9))
>> >
>> >
>> >
>> > On 8/30/06, Gabor Grothendieck <ggrothendieck at gmail.com> wrote:
>> >
>> >> Or maybe this is what you are looking for where pnl below was
>> >> created by modifying source to the panel.plot.default in the zoo
>> >> package (there might be a simpler way):
>> >>
>> >>
>> >> pnl <- function (x, y, subscripts, groups, col, pch, type, ...) {
>> >>    for (g in levels(groups)) {
>> >>        idx <- g == groups[subscripts]
>> >>        if (any(idx))
>> >>            panel.xyplot(x[idx], y[idx], ..., col = 
>> col[subscripts][idx],
>> >>                pch = pch[subscripts][idx], type = type)
>> >>    }
>> >> }
>> >>
>> >> xyplot(y ~ x | surveys, data = df, groups = df$f2, type = "b",
>> >>        col = as.numeric(df$f2), pch = as.numeric(df$f1), panel = pnl)
>> >>
>> >>
>> >> key1 <- list(border = TRUE, colums = 2, text = list(levels(df$f1)),
>> >>       points = list(pch = 1:nlevels(df$f1))
>> >> )
>> >>
>> >> key2 <- list(border = TRUE, colums = 2, text = list(levels(df$f2)),
>> >>       points = list(pch = 20, col = 1:nlevels(df$f2))
>> >> )
>> >>
>> >> draw.key(key1, draw = TRUE, vp = viewport(.9, .9))
>> >> draw.key(key2, draw = TRUE, vp = viewport(.75, .9))
>> >>
>> >>
>> >>
>> >>
>> >> On 8/30/06, Gabor Grothendieck <ggrothendieck at gmail.com> wrote:
>> >> > To handle conditioning on survey we provide a panel function
>> >> > that subsets col and pch:
>> >> >
>> >> > # define test data - df
>> >> >
>> >> > # note that your val2 and val3 lines had a syntax
>> >> > # so we have commented them out and
>> >> > # replaced them as shown.
>> >> > n <- 18
>> >> > x1 <- seq(1,n)
>> >> > val1 <- -2*x1+50
>> >> > # val2 <- (-2*(x1-8)2)+100
>> >> > val2 <- (-2*(x1-8))+100
>> >> > # val3 <- (-2*(x1-8)2)+50
>> >> > val3 <- (-2*(x1-8))+50
>> >> > y <- c(val1,val2,val3)
>> >> > x <- rep(x1,3)
>> >> > f1 <- rep(c("mod1","mod2","mod3"),each=n/3)
>> >> > f1 <- rep(f1,3)
>> >> > f2 <- rep(c("g1","g2","g3"),each=n)
>> >> > df <- data.frame(x=x,y=y,f1=f1,f2=f2)
>> >> > surveys <-
>> >> > factor(c(rep("survey1",n*3),rep("survey2",n*3),rep("survey3",n*3)))
>> >> > df <- rbind(df,df,df)
>> >> > df <- data.frame(df,surveys=surveys)
>> >> >
>> >> > # create xyplot
>> >> >
>> >> > library(lattice)
>> >> > library(grid)
>> >> >
>> >> > pnl <- function(x, y, groups, subscripts, col, pch, ...)
>> >> >        panel.xyplot(x, y, col = col[subscripts], pch =
>> >> pch[subscripts], ...)
>> >> >
>> >> > xyplot(y ~ x | surveys, data = df,
>> >> >        col = as.numeric(df$f1), pch = as.numeric(df$f2), panel = 
>> pnl)
>> >> >
>> >> >
>> >> > key1 <- list(border = TRUE, colums = 2, text = list(levels(df$f1)),
>> >> >       points = list(pch = 1:nlevels(df$f1))
>> >> > )
>> >> >
>> >> > key2 <- list(border = TRUE, colums = 2, text = list(levels(df$f2)),
>> >> >       points = list(pch = 20, col = 1:nlevels(df$f2))
>> >> > )
>> >> >
>> >> > # add legend
>> >> >
>> >> > draw.key(key1, draw = TRUE, vp = viewport(.9, .9))
>> >> > draw.key(key2, draw = TRUE, vp = viewport(.75, .9))
>> >> >
>> >> >
>> >> > On 8/30/06, Laurent Rhelp <laurentRhelp at free.fr> wrote:
>> >> > > Gabor Grothendieck a écrit :
>> >> > >
>> >> > > >Note that before entering this you need:
>> >> > > >
>> >> > > >library(lattice)
>> >> > > >library(grid) # to access the viewport function
>> >> > > >
>> >> > > >On 8/29/06, Gabor Grothendieck <ggrothendieck at gmail.com> wrote:
>> >> > > >
>> >> > > >
>> >> > > >>Try this:
>> >> > > >>
>> >> > > >>xyplot(val ~ x, data = df, type = "p",
>> >> > > >>       col = as.numeric(df$f1), pch = as.numeric(df$f2))
>> >> > > >>
>> >> > > >>key1 <- list(border = TRUE, colums = 2, text =
>> >> list(levels(df$f1)),
>> >> > > >>       points = list(pch = 1:nlevels(df$f1))
>> >> > > >>)
>> >> > > >>
>> >> > > >>key2 <- list(border = TRUE, colums = 2, text =
>> >> list(levels(df$f2)),
>> >> > > >>       points = list(pch = 20, col = 1:nlevels(df$f2))
>> >> > > >>)
>> >> > > >>
>> >> > > >>trellis.focus("panel", 1, 1)
>> >> > > >>draw.key(key1, draw = TRUE, vp = viewport(.9, .9))
>> >> > > >>draw.key(key2, draw = TRUE, vp = viewport(.75, .9))
>> >> > > >>trellis.unfocus()
>> >> > > >>
>> >> > > >>
>> >> > > >>On 8/29/06, Laurent Rhelp <laurentRhelp at free.fr> wrote:
>> >> > > >>
>> >> > > >>
>> >> > > >>>Dear R-list,
>> >> > > >>>
>> >> > > >>>    I would like to use the lattice library to show several
>> >> groups on
>> >> > > >>>the same graph. Here's my example :
>> >> > > >>>
>> >> > > >>>## the data
>> >> > > >>>f1 <-
>> >> factor(c("mod1","mod2","mod3"),levels=c("mod1","mod2","mod3"))
>> >> > > >>>f1 <- rep(f1,3)
>> >> > > >>>f2 <-
>> >> factor(rep(c("g1","g2","g3"),each=3),levels=c("g1","g2","g3"))
>> >> > > >>>df <- data.frame(val=c(4,3,2,5,4,3,6,5,4),
>> >> x=rep(c(1,2,3),3),f1=f1,f2=f2)
>> >> > > >>>#############################################################
>> >> > > >>>library(lattice)
>> >> > > >>>
>> >> > > >>>para.liste <- trellis.par.get()
>> >> > > >>>superpose.symbol <- para.liste$superpose.symbol
>> >> > > >>>superpose.symbol$pch <- c(1,2,3)
>> >> > > >>>trellis.par.set("superpose.symbol",superpose.symbol)
>> >> > > >>>
>> >> > > >>># Now I can see the group according to the f1 factor (with a
>> >> different
>> >> > > >>>symbol for every modality)
>> >> > > >>>xyplot( val~x,
>> >> > > >>>       data=df,
>> >> > > >>>       group=f1,
>> >> > > >>>       auto.key=list(space="right")
>> >> > > >>>      )
>> >> > > >>>
>> >> > > >>># or I can see the group according to the f2 factor
>> >> > > >>>xyplot( val~x,
>> >> > > >>>       data=df,
>> >> > > >>>       type="l",
>> >> > > >>>       group=f2,
>> >> > > >>>       auto.key=list(space="right",points=FALSE,lines=TRUE)
>> >> > > >>>      )
>> >> > > >>>
>> >> > > >>>How can I do to highlight both the f1 and f2 factors on one
>> >> panel with
>> >> > > >>>the legends, using the lattice function ?
>> >> > > >>>
>> >> > > >>>Thanks
>> >> > > >>>
>> >> > > >>>______________________________________________
>> >> > > >>>R-help at stat.math.ethz.ch 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.
>> >> > > >>>
>> >> > > >>>
>> >> > > >>>
>> >> > > >
>> >> > > >______________________________________________
>> >> > > >R-help at stat.math.ethz.ch 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.
>> >> > > >
>> >> > > >
>> >> > > >
>> >> > > >
>> >> > > Thank you, Gabor. The way to put the two legends is very
>> >> interesting.
>> >> > > For the graphs, in fact, my problem is to fit the data for every
>> >> level
>> >> > > of the f2 factor, showing the levels of the f1 factor in each
>> >> panel and
>> >> > > that for several surveys . Here's an example closer to my actual
>> >> data :
>> >> > >
>> >> > > ## the data
>> >> > >
>> >> > > n <- 18
>> >> > > x1 <- seq(1,n)
>> >> > > val1 <- -2*x1+50
>> >> > > val2 <- (-2*(x1-8)2)+100
>> >> > > val3 <- (-2*(x1-8)2)+50
>> >> > > y <- c(val1,val2,val3)
>> >> > > x <- rep(x1,3)
>> >> > > f1 <- rep(c("mod1","mod2","mod3"),each=n/3)
>> >> > > f1 <- rep(f1,3)
>> >> > > f2 <- rep(c("g1","g2","g3"),each=n)
>> >> > > df <- data.frame(x=x,y=y,f1=f1,f2=f2)
>> >> > >
>> >> > > surveys <-
>> >> > > 
>> factor(c(rep("survey1",n*3),rep("survey2",n*3),rep("survey3",n*3)))
>> >> > > df <- rbind(df,df,df)
>> >> > > df <- data.frame(df,surveys=surveys)
>> >> > >
>> >> 
>> #######################################################################
>> >> > > library(lattice)
>> >> > >
>> >> > > para.liste <- trellis.par.get()
>> >> > > superpose.symbol <- para.liste$superpose.symbol
>> >> > > superpose.symbol$pch <- c(1,2,3)
>> >> > > trellis.par.set("superpose.symbol",superpose.symbol)
>> >> > >
>> >> > > xyplot( y~x | surveys,         data=df,
>> >> > >       group=f1,
>> >> > >       auto.key=list(space="right")
>> >> > >      )
>> >> > >
>> >> > > xyplot( y~x | surveys  ,
>> >> > >       data=df,
>> >> > >       type="l",
>> >> > >       group=f2,
>> >> > >       auto.key=list(space="right",points=FALSE,lines=TRUE)
>> >> > >      )
>> >> > >
>> >> > > Certainly, I have to use the panel function but I don't know how
>> >> to mark
>> >> > > the f1 factor in each panel (I want to fit the values according
>> >> to the
>> >> > > f2 factor) !
>> >> > >
>> >> > >
>> >> > >
>> >> >
>> >>
>> >
>> >
>> Thank you for the three solutions. Spending time understanding them
>> allows me to well-understand the behavior of the lattice functions. The
>> last one is nice but the second one gave me the solution to adapt my
>> processing according to the groups which was another aim for me : I
>> wanted to do an linear regression for the g1 group and an loess
>> regression for the g1, g2 group. So I modified your pnl function as 
>> below :
>>
>>
>> pnl <- function (x, y, subscripts, groups, col, pch, type, ...) {
>>   for (g in levels(groups)) {
>>       idx <- g == groups[subscripts]
>>       if (any(idx)){
>>           panel.xyplot(x[idx], y[idx], ..., col = col[subscripts][idx],
>>               pch = pch[subscripts][idx], type = type)
>>
>>      ## to allow for the treatments according the groups
>>      switch(g,
>>        g1 = panel.lmline(x[idx], y[idx], ..., col = 
>> col[subscripts][idx],
>>               pch = pch[subscripts][idx]),
>>        g2 = panel.loess(x[idx], y[idx], ..., col = col[subscripts][idx],
>>               pch = pch[subscripts][idx]),
>>        g3 = panel.loess(x[idx], y[idx], ... , col = 
>> col[subscripts][idx],
>>               pch = pch[subscripts][idx])
>>
>>       )
>>         }
>>   }
>> }
>> ##
>> ##  Finally, with these data
>> ##  (I noticed that my paste failed for the syntax so I wrote 
>> (x1-8)*(x1-8))
>> ##
>> n <- 18
>> x1 <- seq(1,n)
>> val1 <- jitter(-2*x1+50,amount=10)
>> val2 <- jitter((-2*(x1-8)*(x1-8))+100,amount=10)
>> val3 <- jitter((-2*(x1-8)*(x1-8))+50,amount=10)
>> y <- c(val1,val2,val3)
>> x <- rep(x1,3)
>> f1 <- rep(c("mod1","mod2","mod3"),each=n/3)
>> f1 <- rep(f1,3)
>> f2 <- rep(c("g1","g2","g3"),each=n)
>> df <- data.frame(x=x,y=y,f1=f1,f2=f2)
>> surveys <-
>> factor(c(rep("survey1",n*3),rep("survey2",n*3),rep("survey3",n*3)))
>> df <- rbind(df,df,df)
>> df <- data.frame(df,surveys=surveys)
>> ##
>>
>>
>>
>> ## the graph
>>
>> xyplot(y ~ x | surveys, data = df, groups = df$f2, type = "b",
>>    col = as.numeric(df$f2), pch = as.numeric(df$f1), panel = pnl)
>>
>>
>> key1 <- list(border = TRUE, colums = 2, text = list(levels(df$f1)),
>>      points = list(pch = 1:nlevels(df$f1))
>> )
>>
>> key2 <- list(border = TRUE, colums = 2, text = list(levels(df$f2)),
>>      points = list(pch = 20, col = 1:nlevels(df$f2))
>> )
>>
>> draw.key(key1, draw = TRUE, vp = viewport(.9, .9))
>> draw.key(key2, draw = TRUE, vp = viewport(.75, .9))
>>
>> Thank you very much.
>> Laurent
>>
>>
>
>
It is great. I am impressed by the two lines :

 panel <- c(panel.lmline, panel.loess, panel.loess)[[group.number]]
 panel(x, y, ..., pch = pch[subscripts])

It seems magic. Thanks a lot.