Question

我正在用R中的多项式回归分析差异得分。基于[Edwards and Parry's（1993）] [1]的建议，我一直在尝试将persp（）图与Contour（）图结合起来。我还需要在轮廓图上绘制前两个主轴。到目前为止，我的尝试只为我提供了每个单独的情节，但我不知道如何将它们结合起来。最终结果的示例是 this figure from Edwards and Parry (1993) ：

Edwards & Parry (1993) example difference score visualisation

我设法获得了persp（）的图。我还获得了等高线图。我似乎找不到任何将两者结合的方法。我已经成功使用管道中的add_surface()选项以绘图方式制作了绘图。我的输出问题是表面光滑，轮廓图缺少图中的值。基本上：按照源代码中的示例，以与我想要的外观极为相似的方式可视化persp（）和Contour（）。

我目前的尝试（采用简约代码）如下：

surface <- function(e, i){
  y <- .2*e + .14*i + .08*e^2 + + .1*e*i + .2*i^2
}

e <- i <- seq(-3, 3, length= 20)
y <- outer(e, i, surface)

persp(e, i, y,
      xlab = 'Explicit',
      ylab = 'Implicit',
      zlab = 'Depression',
      theta = 45)

contour(e,i,y)

所以基本上我的问题是：我怎样才能像Edwards and Parry（1993）那样用R绘制具有类似视觉样式的图。它不必是base-R，我对任何方法都感到满意。我已经在这个问题上停留了一个星期。

我想进行的尝试（将其与所需的最终结果进行比较）是

if(!"plotly" %in% installed.packages){install.packages('plotly')}
library(plotly)

plot_ly(z = ~y) %>% add_surface(x = ~e, y= ~i, z= ~y,
    contours = list(
      z = list(
        show=TRUE,
        usecolormap=FALSE,
        highlightcolor="#ff0000",
        project=list(z=TRUE)
      )
    )
) %>%
  layout(
    scene=list(
      xaxis = list(title = "Explicit"),
      yaxis = list(title = "Implicit"),
      zaxis = list(title = "Depression")
    )
  )

[1]：Edwards，J.R。和Parry，M.E。（1993）。关于使用多项式回归作为差异评分的替代方法。管理学院学报，36（6），1577–1613年。 https://doi.org/10.2307/256822

Answer 1

我找到了答案，我将在这里分享。似乎无法在base-R中完成。但是，RSM包允许将轮廓线添加到图的底部。

在这个答案中，我将给出一个最小的例子：

persp（）图
底部的轮廓线
x = y和x = -y轴的加法
第一和第二主轴的计算和加法

我唯一无法解决的问题是，现在在表面上绘制了线条。我不知道该怎么解决。

library(rsm)

x <- seq(-3,3,by=0.25) 
y <- seq(-3,3,by=0.25) 
d <- expand.grid(x=x,y=y)
z <- c(data=NA,1089)
b0 = .140; b1 = -.441; b2 = -.154; b3 = .161 ; b4 =-.106; b5 = .168

k=1
for (i in 1:25) {
  for (j in 1:25) {
    z[k]=b0+b1*x[i]+b2*y[j]+b3*x[i]*x[i]+b4*x[i]*y[j]+ b5*y[j]*y[j]
    k=k+1
  }  }

data.lm <- lm(z~poly(x,y,degree=2),data=d)

res1 <- persp(data.lm,x~y, 
              zlim=c(-2,max(z)),
              xlabs = c('X','Y'),
              zlab = 'Z',
              contour=list(z="bottom"),
              theta=55,
              phi=25)    

# draw x=y line (lightly dotted)
xy_pos <- matrix(c(-3,-3,3,3),ncol=2,byrow = T)
lines(trans3d(xy_pos[,2], xy_pos[,1], z=-2, pmat = res1$`y ~ x`$transf), 
      lty = 3,
      col = 'darkgrey')

# draw x=-y line (lightly dotted)
xy_neg <- matrix(c(-3,3,3,-3),ncol=2,byrow = T)
lines(trans3d(xy_neg[,2], xy_neg[,1], z=-2, pmat = res1$`y ~ x`$transf), 
      lty = 3,
      col = 'darkgrey')

# Find stationary points:
X0 <- (b2*b4 - 2*b1*b5) / (4*b3*b5 - b4^2)
Y0 <- (b1*b4 - 2*b2*b3) / (4*b3*b5 - b4^2)

# First Principal Axis
p11 = (b5-b3+sqrt((b3-b5)^2+b4^2))/b4
p10 = Y0 - p11*X0
Ypaf1 = p10 + p11*x

# plot first principal axis (full line)
xypaf1 <- matrix(c(Ypaf1[1], -3, Ypaf1[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf1[,2], xypaf1[,1], z=-2, pmat = res1$`y ~ x`$transf), 
      lty = 1,
      col = 'black')

# Second Principal Axis
p21 = (b5-b3-sqrt((b3-b5)^2+b4^2))/b4
p20 = Y0 - p21*X0
Ypaf2 = p20 + p21*x

# plot second principal axis (dashed line)
xypaf2 <- matrix(c(Ypaf2[1], -3, Ypaf2[25], 3),ncol=2, byrow=T)
lines(trans3d(xypaf2[,2], xypaf2[,1], z=-2, pmat = res1$`y ~ x`$transf), 
      lty = 2,
      col = 'black')

如何在R中将3d透视图与轮廓图结合

1 个答案: