[R] lattice and several groups
Laurent Rhelp
laurentRhelp at free.fr
Sun Sep 3 17:41:33 CEST 2006
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