如何将基于图形的图形转换为ggplot2？

Question

附加的脚本对样本变量x,y和z执行等效性测试.

equivalence.xyplot()虽然基本的格子图形很难用,但它确实很方便.如何使用ggplot2绘制这些数据而不是基本点阵图形？

编辑:

例如,using ggplot(plot1)返回以下错误:

错误:ggplot2不知道如何处理类格子的数据

我不知道从哪里开始将格子类数据转换为ggplot2格式.关于将基于格子的图形转换为ggplot2的任何具体建议都将受到赞赏.

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

这不是最终的解决方案,而是一个良好的开端 .我只是通过lattice panel function并替换:

1. xyplot ----------> geom_point
2. panel.abline ----------> geom_abline
3. grid.polygon ----------> geom_polygon
4. panel.loess ----------> stat_smooth
5. panel.arrows ----------> geom_errobar

对于每个geom,我创建一个data.frame,其中组件是传递给晶格函数的数据.例如 :

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)

成为:

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)

最终结果是一个新函数equivalence.ggplot,它采用与以下相同的参数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

}

比较晶格和ggplot2结果:

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)