lattice and several groups

Sun, Sep 3, 2006 8:54 AM

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

lattice and several groups

Thread (3 messages)