r - 如何将基于点阵的图形转换为 ggplot2？

Question

附加的脚本对样本变量 x、y 和 z 执行等价测试。

equivalence.xyplot()真的很方便，虽然基本格子图形很难使用。如何使用 ggplot2 绘制这些数据而不是基本格子图形？

编辑：

例如， usingggplot(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

对于每个几何图形，我创建了一个 data.frame，其中的组件是传递给 lattice 函数的数据。例如 ：

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)