Как совместить трехмерный график с контурным графиком в R

Question

Я анализирую оценки различий с помощью полиномиальной регрессии по R. На основе рекомендаций [Edwards and Parry (1993)] [1] я пытался объединить график persp () с графиком contour (). Мне также необходимо построить первые две основные оси на контурной диаграмме. Мои попытки пока предоставили мне только каждый отдельный сюжет, но я не знаю, как их объединить. Примером конечного результата является :

Edwards & Parry (1993) пример визуализации различий

Мне удалось получить график 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)

Так что, в основном, мой вопрос: как я могу создать сюжет, подобный Эдвардсу и Парри (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')