[R] Lattice to ggplot2: Reference graphics across facets

[Jim Price]

Hi,

I'm playing with moving some of my lattice graphics into ggplot2, and I'd
like to ask how to achieve a couple of things, both of which are fully
illustrated in self-contained code (and mostly minimal, although that left
quite a bit) following this written description.

1. I quite often like to use a 'ghosted' reference across facets - for
example, in my example program below, the placebo quartiles and median are
reflected into each of the dose groups to facilitate easier cross
referencing. Note that this reflection is done per-row. Is there a simple
way of doing this in ggplot2 without having to create an artificial data set
to fool it?

2. Some of my clients like their x-axes (in the sample case, time) split
into well demarked components. I've done this in lattice by using custom
strip functions. Is such a thing possible in ggplot2?

Any help on these problems much appreciated.

Jim Price.
Strength in Numbers.

### Sample code ###


# Packages
library(plyr)
library(reshape2)
library(ggplot2)
library(lattice)
library(latticeExtra)



# User functions
Factor <- function(...) factor(..., levels = ...)
PAN <- function(x1, y1, x2, y2, txt, ...)
{
    panel.rect(x1, y1, x2, y2)
    panel.text(mean(c(x1, x2)), mean(c(y1, y2)), txt, ...)
}
q25 <- function(.x) quantile(.x, 0.25)
q75 <- function(.x) quantile(.x, 0.75)




# Create a dummy dataset
ecg <- expand.grid(
		   trt = Factor(c('Placebo', '100mg', '200mg', '400mg')),
		   subject = 1:50,
		   time = Factor(c('Screening', 'Pre-dose', 'Day 1', 'Day 2', 'Day 3',
'Day 4', 'Day 5', 'Day 7', 'Day 14', 'Day 21'))
		   )

ecg <- ddply(ecg, .(subject, trt), mutate,
	     int = rnorm(1, 65, 8) * c(
				       1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00,
				       1.00, 1.00, 1.00, 1.03, 1.04, 1.06, 1.08, 1.06, 1.03, 1.00,
				       1.00, 1.00, 1.02, 1.05, 1.08, 1.10, 1.11, 1.10, 1.06, 1.02,
				       1.00, 1.00, 1.04, 1.10, 1.13, 1.15, 1.16, 1.15, 1.16, 1.14
				       )[as.numeric(interaction(time, trt))],
	     Raw = round(rnorm(length(int), int, 5)),
	     base = Raw[time == 'Pre-dose'],
	     `Change from baseline` = Raw - base
	     )

ecg <- melt(ecg, id.vars = c('subject', 'trt', 'time'), measure.vars =
c('Raw', 'Change from baseline'), value.name = 'resp')

ecg$resp[ecg$variable == 'Change from baseline' & ecg$time %in%
c('Screening', 'Pre-dose')] <- NA



# Example lattice graphic
print(combineLimits(bwplot(
			   resp ~ time | trt * variable,
			   groups = trt,
			   data = ecg,
			   subscripts = TRUE,
			   panel = function(..., subscripts)
			   {
			       # Basic data manipulation
			       this <- ecg[subscripts, ]
			       placebos <- subset(ecg, variable == this$variable[1] & trt ==
'Placebo' & !is.na(resp))

			       medians <- ddply(placebos, .(time), summarize, 
						median = median(resp),
						h1 = fivenum(resp)[2],
						h2 = fivenum(resp)[4]
						)
			       medians$x <- as.numeric(medians$time)

			       # Structure, including reference lines
			       panel.grid(-1, 0)
			       panel.abline(v = c(2.5, 7.5), col =
trellis.par.get('reference.line')$col)
			       if(current.row() == 2)
				   panel.abline(h = 0, col = 'gray50')

			       # Add placebo quantile reference
			       with(medians, panel.polygon(c(x, rev(x)), c(h1, rev(h2)), col =
'gray80', border = NA, alpha = 0.75))

			       # Basic bar and whisker plot
			       panel.bwplot(..., subscripts = subscripts)

			       # Add placebo median reference
			       with(medians, panel.lines(x, median, col = 'gray40'))
			   },
			   as.table = TRUE,
			   ylab = '',
			   scales = list(
					 alternating = 1, tck = c(1, 0),
					 x = list(rot = 90),
					 y = list(relation = 'free', rot = 0)
					 ),
			   # Make correct room for the strips
			   lattice.options = list(
						  layout.heights = list(strip = list(x = c(1, 0))),
						  layout.widths = list(strip.left = list(x = c(0.5, 0, 0, 0)))
						  ),
			   # Two-level top strip, basic label then subgrouping
			   strip = function(...)
			   {
			       dots <- list(...)

			       if(dots$which.panel[2] == 1 & dots$which.given == 1)
			       {
				   l <- 10
				   PAN(0, 0.5, 1, 1, dots$factor.levels[dots$which.panel[1]])
				   PAN(0, 0, 2 / l, 0.5, 'Pre-dose', cex = 0.75)
				   PAN(2 / l, 0, 7 / 10, 0.5, 'In-patient', cex = 0.75)
				   PAN(7 / 10, 0, 1, 0.5, 'Out-patient', cex = 0.75)
			       }
			   },
			   # Standard strip
			   strip.left = function(...)
			   {
			       dots <- list(...)

			       if(dots$which.panel[1] == 1 & dots$which.given == 2)
			       {
				   PAN(0, 0, 1, 1, dots$factor.levels[dots$which.panel[2]], srt = 90)
			       }
			   }
			   )))



# Now the ggplot2 version
dev.new()

# Basic plot structure
p <- ggplot(ecg, aes(time, resp, color = trt)) 

# Underlying placebo quantiles - would like this reflected across the rows,
so that every row has an identical underlying ribbon
p <- p + stat_summary(aes(group = 1), subset(ecg, trt == 'Placebo'),
fun.ymin = 'q25', fun.ymax = 'q75', geom = 'ribbon', fill = 'gray80', colour
= NA)

# Basic plot
p <- p + geom_boxplot() 
p <- p + facet_grid(variable ~ trt, scales = 'free_y') 

# Median line - again, want to reflect across rows
p <- p + stat_summary(aes(group = 1), subset(ecg, trt == 'Placebo'), fun.y =
'median', geom = 'line', colour = 'gray60')

# Formatting
p <- p + labs(x = '', y = '')
p <- p + theme(legend.position = 'none')
p <- p + theme(axis.text.x = element_text(angle = 90, hjust = 1, vjust =
0.5))

print(p)






--
View this message in context: http://r.789695.n4.nabble.com/Lattice-to-ggplot2-Reference-graphics-across-facets-tp4647074.html
Sent from the R help mailing list archive at Nabble.com.