情节 - 不同表面的不同颜色

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

etvoilà，我们有一个统一的彩色情节。

---

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