[R] lattice and several groups
Gabor Grothendieck
ggrothendieck at gmail.com
Sun Sep 3 17:54:58 CEST 2006
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
>
>
More information about the R-help
mailing list