-3

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

Borealis
  • 8,044
  • 17
  • 64
  • 112
  • 4
    So in essence you have a personal preference for one graphics package over another and are offering a 100 point bounty to whoever does the conversion work for you? Now, where exactly is that a valid _programming question_ within the usual SO realm? – Dirk Eddelbuettel Jul 14 '13 at 03:53
  • 6
    @Dirk Let's break this question down: 1) reproduceable data? check 2) Clearly defined question relating to R programming? check 3) answerable question? check 4) A real programming problem? check... – Borealis Jul 14 '13 at 13:32
  • 14
    a ggplot2 question with reproducible code, not answered in several days, should be a hint that something's really wrong. Personally, I wasn't keen to install that `equivalence` package, find out what exactly is an "equivalence plot", when for all I know you haven't even tried to do it with ggplot2. A few lines, points, and a rectangle -- it doesn't look hard from the purely graphical perspective, frankly, provided you know what you're plotting. Bounties won't make a question more appealing, in fact they're rather useless; if you wanted to bring it back up, a good edit is infinitely better. – baptiste Jul 14 '13 at 14:17
  • 2
    Agree with @baptiste that some evidence of effort/explaining what you've already tried would help ... – Ben Bolker Jul 15 '13 at 00:42
  • 3
    I am also going to chime in to agree strongly with baptiste, particularly his first sentence. As soon as it became clear that the question included not even an _ounce_ of an attempt on your part, I moved on. One of the close reasons now read: "Questions asking for code must demonstrate a minimal understanding of the problem being solved. **Include attempted solutions, why they didn't work, and the expected results.**" – joran Jul 15 '13 at 01:36
  • I guess have another question for the OP. `ggplot2` graphics aren't that much easier to modify than lattice graphics, although they are more flexible in some ways. What kinds of things do you want to do with the graph that you are having trouble doing in lattice? – Ben Bolker Jul 15 '13 at 03:04
  • 2
    @Aaron -- `ggplot(plot1)` doesn't count at as an attempted solution - it implies no effort on your behalf. – mnel Jul 15 '13 at 03:05
  • 7
    @Aaron We're not being critical just for kicks, honest! You have to understand that whatever your intentions, your question basically amounts to: Here's a task specification, will someone please do it _for_ me? This is simply a somewhat more polite version of "I need to do X. Gimme teh codez!", and we **can't** allow things to devolve into that. – joran Jul 15 '13 at 04:06

1 Answers1

9

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

agstudy
  • 119,832
  • 17
  • 199
  • 261
  • It looks like the points aren't the same either, but I don't know why that would be (but it would explain why the regression lines aren't the same). – joran Jul 15 '13 at 02:15
  • @joran thanks! `equivalence.xyplot(mydata$y~mydata$x,` not `equivalence.xyplot(mydata$x~mydata$y,`..OP induce me to error...It looks better now – agstudy Jul 15 '13 at 02:25