How to convert lattice-based graphics to ggplot2? - r

Question

The attached script performs equivalence tests on sample variables x, y and z.
equivalence.xyplot() is really handy, although the base lattice graphics are a pain to work with. How can I use ggplot2 to plot these data rather than the base lattice graphics?
Edit:
For example, using ggplot(plot1) returns the following error:
Error: ggplot2 doesn't know how to deal with data of class trellis
I'm not sure where to begin converting the trellis class of data to ggplot2 format. Any specific advice on converting trellis-based graphics to ggplot2 would be appreciated.
require(equivalence)
require(gridExtra)
require(lattice)
x = c(1,4,3,5,3,7,8,6,7,8,9)
y = c(1,5,4,5,3,6,7,6,7,2,8)
z = c(2,4,3,5,4,7,8,5,6,6,9)
mydata = data.frame(x,y,z)
plot1 = equivalence.xyplot(mydata$x~mydata$y,alpha=0.05, b0.ii=0.25, b1.ii=0.25)
plot2 = equivalence.xyplot(mydata$x~mydata$z,alpha=0.05, b0.ii=0.25, b1.ii=0.25)
plot3 = equivalence.xyplot(mydata$y~mydata$z,alpha=0.05, b0.ii=0.25, b1.ii=0.25)
# Combine plots into one figure
grid.arrange(plot1, plot2, plot3, ncol=2)

Answer 1

This is not a final solution but a good start . I just go through lattice panel function and replace :
xyplot ----------> geom_point
panel.abline ----------> geom_abline
grid.polygon ----------> geom_polygon
panel.loess ----------> stat_smooth
panel.arrows ----------> geom_errobar
For each geom, I create a data.frame which components are the data passed to the lattice function. For example :
panel.arrows(x.bar, ybar.hat$fit + ybar.hat$se.fit *
t.quant, x.bar, ybar.hat$fit - ybar.hat$se.fit *
t.quant, col = "darkgrey", length = 0.05, angle = 90,
code = 3)
becomes :
dat.arrow <- data.frame(x=x.bar, ymax= ybar.hat$fit + ybar.hat$se.fit *
t.quant, ymin= ybar.hat$fit - ybar.hat$se.fit *
t.quant)
pl <- pl + geom_errorbar(data=dat.arrow, aes(x,ymin=ymin,ymax=ymax),
col = "darkgrey", width = 0.10)
The final result is a new function equivalence.ggplot that take the same parameters as equivalence.xyplot:
equivalence.ggplot <- function(x,y, alpha, b0.ii, b1.ii,
b0.absolute = FALSE,add.smooth=FALSE){
x.bar <- mean(x, na.rm = TRUE)
min.x <- min(x, na.rm = TRUE)
max.x <- max(x, na.rm = TRUE)
the.model <- lm(y ~ x)
if (b0.absolute)
y.poly <- x.bar + b0.ii * c(-1, 1, 1, -1)
else y.poly <- x.bar * (1 + b0.ii * c(-1, 1, 1, -1))
dat.poly <- data.frame(x = c(min.x, min.x, max.x, max.x),
y = y.poly)
dat <- data.frame(x,y)
p <- function(dat,dat.poly){
h <- ggplot(dat) +
geom_polygon(data=dat.poly,aes(x,y),col = "light gray", fill = gray(0.9)) +
geom_point(aes(x,y)) +
stat_smooth(data=dat,col='black',
aes(x=x,y=y),method="lm", se=FALSE,
fullrange =TRUE)+
theme_bw()
if (add.smooth)
h <- h + geom_smooth(aes(x,y),method='loess')
h
}
pl <- p(dat,dat.poly)
n <- sum(complete.cases(cbind(x, y)))
ybar.hat <- predict(the.model, newdata = data.frame(x = x.bar),
se = TRUE)
t.quant <- qt(1 - alpha/2, df.residual(the.model))
dat.arrow <- data.frame(x=x.bar, ymax= ybar.hat$fit + ybar.hat$se.fit *
t.quant, ymin= ybar.hat$fit - ybar.hat$se.fit *
t.quant)
pl <- pl +
geom_errorbar(data=dat.arrow, aes(x,ymin=ymin,ymax=ymax),
col = "darkgrey", width = 0.10)
pl
se.slope <- coef(summary(the.model))[2, 2]
dat.arrow1 <- data.frame(x=x.bar, ymax= ybar.hat$fit + se.slope * t.quant *
x.bar, ymin=ybar.hat$fit - se.slope * t.quant *
x.bar)
pl <- pl +
geom_errorbar(data=dat.arrow1, aes(x,ymin=ymin,ymax=ymax),
col = "black", width = 0.10)
addLines <- function(pl,the.model){
pl <- pl + geom_abline(intercept = coef(summary(the.model))[1, 1], slope = 1 -
b1.ii, col = "darkgrey", lty = 2) +
geom_abline(intercept = coef(summary(the.model))[1, 1], slope = 1 +
b1.ii, col = "darkgrey", lty = 2)
}
pl <- addLines(pl,the.model)
pl
}
Comparing the lattice and the ggplot2 result :
library(gridExtra)
p.gg <- equivalence.ggplot(mydata$x,mydata$y,alpha=0.05, b0.ii=0.25, b1.ii=0.25)
p.lat <- equivalence.xyplot(mydata$y~mydata$x,alpha=0.05, b0.ii=0.25, b1.ii=0.25)
grid.arrange(p.gg,p.lat)