r - plotly - 不同表面的不同颜色

Question

使用 plotly我想让每个表面都有不同的颜色。

library(plotly)
t1 <- seq(-3, 3, 0.1); t2 <- seq(-3, 3, 0.1)

p1 <- matrix(nrow = length(t1), ncol = length(t2))
p2 <- matrix(nrow = length(t1), ncol = length(t2))

p8a1 <- 1.2
p8a2 <- 1
p8d <- -1
p8b1 <- 0.7
p8b2 <- 0.6

for (i in 1:length(t2)) {
   for (j in 1:length(t1)) {
      p1[i, j] <- 1 / (1 + exp(-1.7 * (p8a1 * t1[j] + p8a2 * t2[i] + p8d)))
      p2[i, j] <- (1 / (1 + exp(-1.7 * p8a1 * (t1[j]- p8b1)))) * 
                  (1 / (1 + exp(-1.7 * p8a2 * (t2[j]- p8b2))))
   }
}

df1 <- list(t1, t2, p1)
df2 <- list(t1, t2, p2)

names(df1) <- c("t1", "t2", "p1")
names(df2) <- c("t1", "t2", "p2")
m <- list(l = 10, r = 10, b = 5, t = 0, pad = 3)

p <- plot_ly(color = c("red", "blue")) %>%
     add_surface(x = df1$t1,
                 y = df1$t2,
                 z = df1$p1,
                 opacity = 0.8) %>%
     add_surface(x = df2$t1,
                 y = df2$t2,
                 z = df2$p2,
                 opacity = 1) %>%
     layout(autosize = F, width = 550, height = 550, margin = m,
            scene = list(xaxis = list(title = "Theta 1"),
                         yaxis = list(title = "Theta 2"),
                         zaxis = list(title = "P")),
            dragmode = "turntable")
p

不幸的是，我无法更改这两个表面的颜色。我尝试添加 color = I("red")和 color = I("blue")参数转换为 add_surface但这只是将两个表面的色阶从红色变为蓝色。

我也尝试添加 color = "red"进入 plot_ly()并添加 inherit = F进入第二 add_surface .这仅将第一个表面更改为红色，但仅将黄色默认颜色更改为红色。我希望有一个表面红色和第二个蓝色。

Answer 1

听起来微不足道，但在 Plotly 中有点棘手。曲面图的颜色要么来自 z 值，要么来自与 z 具有相同维度的数组。这个颜色数组只接受数值，不接受颜色字符串或 RGB 值。

所以让我们为我们的颜色定义一个数组

color <- rep(0, length(df1$p1))
dim(color) <- dim(df1$p1)

接下来我们需要欺骗 Plotly 忽略色阶。

surfacecolor=color,
             cauto=F,
             cmax=1,
             cmin=0

等等，我们有一个均匀着色的 plotly 。

library(plotly)
t1 <- seq(-3, 3, 0.1); t2 <- seq(-3, 3, 0.1)

p1 <- matrix(nrow = length(t1), ncol = length(t2))
p2 <- matrix(nrow = length(t1), ncol = length(t2))

p8a1 <- 1.2
p8a2 <- 1
p8d <- -1
p8b1 <- 0.7
p8b2 <- 0.6

for (i in 1:length(t2)) {
  for (j in 1:length(t1)) {
    p1[i, j] <- 1 / (1 + exp(-1.7 * (p8a1 * t1[j] + p8a2 * t2[i] + p8d)))
    p2[i, j] <- (1 / (1 + exp(-1.7 * p8a1 * (t1[j]- p8b1)))) * 
      (1 / (1 + exp(-1.7 * p8a2 * (t2[j]- p8b2))))
  }
}

df1 <- list(t1, t2, p1)
df2 <- list(t1, t2, p2)

names(df1) <- c("t1", "t2", "p1")
names(df2) <- c("t1", "t2", "p2")
m <- list(l = 10, r = 10, b = 5, t = 0, pad = 3)

color <- rep(0, length(df1$p1))
dim(color) <- dim(df1$p1)
p <- plot_ly(colors = c('red', 'blue')) %>%
  add_surface(x = df1$t1,
              y = df1$t2,
              z = df1$p1,
              opacity = 0.8,
              #surfacecolor=c('red')
              surfacecolor=color,
              cauto=F,
              cmax=1,
              cmin=0
  )
color2 <- rep(1, length(df2$p2))
dim(color2) <- dim(df2$p2 )

p <-  add_surface(p,
              x = df2$t1,
              y = df2$t2,
              z = df2$p2,
              opacity = 1,
              surfacecolor=color2,
              cauto=F,
              cmax=1,
              cmin=0)
p