rgraphicsggplot2latticeequivalence

How to convert lattice-based graphics to ggplot2?


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)

enter image description here


Solution

  • This is not a final solution but a good start . I just go through lattice panel function and replace :

    1. xyplot ----------> geom_point
    2. panel.abline ----------> geom_abline
    3. grid.polygon ----------> geom_polygon
    4. panel.loess ----------> stat_smooth
    5. 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)
    

    enter image description here