-3

添付のスクリプトは、サンプル変数 x、y、z に対して同等性テストを実行します。

equivalence.xyplot()ベースのラティス グラフィックスを操作するのは面倒ですが、非常に便利です。基本格子グラフィックスではなく、これらのデータをプロットするために ggplot2 を使用するにはどうすればよいですか?

編集：

たとえばggplot(plot1)、次のエラーを返します。

エラー: ggplot2 はクラス trellis のデータを処理する方法を知りません

trellis クラスのデータを 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)

ここに画像の説明を入力

4

1 に答える 1

9

これは最終的な解決策ではありませんが、良いスタートです. 私はただ通過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)

ここに画像の説明を入力

于 2013-07-15T02:04:38.407 に答える