[R] lattice 3x3 plot: force common y-limits accross rows and align x-axes

[Boris.Vasiliev at forces.gc.ca]

Good afternoon,

I would like to ask for help in controlling y-axis limits and labels in
lattice doplots.  Unfortunately, the problem is somewhat convoluted,
please bear with the long explanation.

I would like to create a 3x3 lattice of dotplots, say subject ~ count.
The plot is conditioned on variables treatment and risk: subject ~ count
| treatment + risk.  In the experiment,  not all subjects were exposed
to all combinations of treatment and risk.  For each risk, I would like
to show subject ~ count | treatment and order the subjects by the total
count.  At the same time, I would like the x-axes to be the same in all
panels and aligned by columns.

Here is a sample data set:

# raw data
df <- data.frame(subject=c('A','A','A','BB','BB','CCC','CCC','CCC',
                           'DD','DD','A','A','A','FFFF','FFFF',
                           'A','A','B','B'),
 
risk=c('high','high','high','high','high','high','high','high',
                        'med','med','med','med','med','med','med',
                        'low','low','low','low'),
 
treatment=c('none','optX','optZ','none','optZ','none','optX','optZ',
 
'none','optZ','none','optX','optZ','none','optZ',
                             'none','optX','none','optZ'),
                 count=c(5,10,2,3,5,8,1,2,
                         3,7,10,2,5,15,2,
                         7,7,10,8))
# re-level factors
df$risk <- factor(df$risk,levels=c('low','med','high'))
df$treatment <- factor(df$treatment,levels=c('none','optX','optZ'))


## > df
##    subject risk treatment count
## 1        A high      none     5
## 2        A high      optX    10
## 3        A high      optZ     2
## 4       BB high      none     3
## 5       BB high      optZ     5
## 6      CCC high      none     8
## 7      CCC high      optX     1
## 8      CCC high      optZ     2
## 9       DD  med      none     3
## 10      DD  med      optZ     7
## 11       A  med      none    10
## 12       A  med      optX     2
## 13       A  med      optZ     5
## 14    FFFF  med      none    15
## 15    FFFF  med      optZ     2
## 16       A  low      none     7
## 17       A  low      optX     7
## 18       B  low      none    10
## 19       B  low      optZ     8

One way to plot the data is to break-up the data into sub-frames, one
frame for each risk, order subjects by total counts, create dotplots,
and merge with trellis.c().  This almost works but in the merged plot I
cannot decrease column spacing to be small enough.  Also, the output of
trellis.c() would not work with useOuterStrips() which I really like.
My code is in TRY ONE below.

Another way to create the plot is specify y-limits for each panel with
custom prepanel and panel functions.  For each panel, the data-frame for
the panel row is isolated, subjects in the data-frame for the current
row are ordered by counts, panel y-limits are set to the re-ordered
levels, y-data for each panel is releveled, and data plotted with
standard panel.dotplot().  This somewhat works but lattice does not
honour the user-defined y-limits and labels are not correct.  I suspect
that it is not correct to use  y-relation="same" in this case but "free"
and "sliced" do not give correct results too. My code in in TRY TWO
below.

If anybody can offer any assistance with this problem, it would be much
appreciated,
Sincerely,
Boris.


#### BEGIN TRY ONE - MERGE LATTICE PLOTS ####
library(lattice)
library(latticeExtra)
library(grid)

for (irisk in levels(df$risk)) {
  # subset data frame
  df.irisk <- subset(df,risk==irisk)

  # order subjects by total count; store levels of subjectx variables
  # for later re-use in panel labels
  df.irisk$subjectx <- df.irisk$subject[,drop=TRUE]
  df.irisk$subjectx <- reorder(df.irisk$subjectx,df.irisk$count,sum)
  assign(paste('sbjx.',irisk,sep=''),levels(df.irisk$subjectx))

  # create dotplot and store it in oltc.{irisk} variable
  oltc.irisk <- dotplot(subjectx~count|treatment,data=df.irisk,
                        layout=c(3,1),type=c('p','h'),
                        xlim=c(-1,16),origin=0,
                        xlab="",ylab="")
  assign(paste('oltc.',irisk,sep=''),oltc.irisk)
}

# combine everthing in one plot
oltc <- c(low=oltc.low,med=oltc.med,high=oltc.high)
print(oltc)

# get rid of variable labels in middle and right column; decrease
# distance between columns.  But can't make inter-column spaces
# small enought and get rid of the panels in all but top rows.
laywid <- trellis.par.get('layout.widths')
laywid$between <- -5
laywid$axis.panel <- 0.7
yscales <- list(labels=list(sbjx.low,NULL,NULL,
                            sbjx.med,NULL,NULL,
                            sbjx.high,NULL,NULL))
oltd <- update(oltc,scales=list(y=yscales),
                    par.settings=list(layout.widths=laywid))
print(oltd)

#### END TRY ONE - MERGE LATTICE PLOTS ####

#### BEGIN TRY TWO - CUSTOM PREPANEL AND PANEL FUNCTIONS ####

prepanel.dotplot.x <- function(x,y,type,subscripts,...,data=NULL) {
  # find data-frame that corresponds to the entire row of the plot
  irisk <- levels(data$risk[subscripts,drop=TRUE])
  idata <- subset(data,risk==irisk)

  # in the sub-frame, order subjects by total counts
  idata$subjectx <- reorder(idata$subject[,drop=TRUE],idata$count,sum)

  # set y-limits
  ylim <- levels(idata$subjectx)

  # increment packet counter and print new panel limits
  pcknum = lattice.options()$packet.counter
  lattice.options(packet.counter=pcknum+1)
  cat(paste(pcknum,":",paste(ylim,collapse=", ")),sep="\n")
  return(list(ylim=ylim))
}

panel.dotplot.x <- function(x,y,type,subscripts,...,data=NULL) {
  # get the sub-frame for the row
  irisk <- levels(data$risk[subscripts,drop=TRUE])
  idata <- subset(data,risk==irisk)

  # in the sub-frame, order subjects by total counts
  idata$subjectx <- reorder(idata$subject[,drop=TRUE],idata$count,sum)

  # re-order y-variable to "correct levels"
  y <- factor(as.character(y),levels(idata$subjectx))

  # print levels of the releveled subjects - should be the same
  # as the output of prepanel.dotplot.x
  pnlnum <- panel.number()
  cat(paste(pnlnum,':',paste(levels(y),collapse=", ")),sep="\n")

  # call standard dotplot
  panel.dotplot(x,y,...)
}

# the data is plotted correctly but the labels and limits are not
correct
lattice.options(packet.counter=1)
oltc <- dotplot(subject~count|treatment+risk,data=df,
                layout=c(3,3),subscripts=TRUE,
                prepanel=function(...)
{prepanel.dotplot.x(...,data=df)},
                panel=function(...){panel.dotplot.x(...,data=df)},
                scales=list(y=list(relation='same')),
                drop.unused.levels=FALSE,
                xlim=c(0,16))
print(oltc)

#### END TRY TWO - CUSTOM PANEL AND PREPANEL FUNCTIONS ####