如何在 R 中用不同顏色繪制 3D 圖中的 2 個峰值（使用 x 軸，而不是 Z 軸）？

Question

我想在 3d 圖中為兩個不同顏色的峰着色，但它不起作用。 我找到的大部分幫助是按 z 軸着色，但我只想為峰值着色。

這是我到目前為止所得到的：

x <- seq(-10, 10, length = 100)
y <- x

norm <- function(x,y, mean1 = 3, var1 =2,mean2 = -3, var2 =2) {
  1/sqrt(2*var1^2*1)*exp(-((y-mean2)^2/(2*var2^2))) * 
    1/sqrt(2*var2^2*1)*exp(-((x-mean2)^2/(2*var1^2)))+
    1/sqrt(2*var2^2*1)*exp(-((y-mean1)^2/(2*var2^2))) * 
    1/sqrt(2*var1^2*1)*exp(-((x-mean1)^2/(2*var1^2)))      }



z <- outer(x, y, norm)
z[is.na(z)] <- 1

rbPal <- colorRampPalette(c('red','blue'))
Col <- rbPal(10)[as.numeric(cut(x = x,breaks = 2))]

persp(x, y, z, col = "blue", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
      border = border,
      shade = 0.6,
      zlim=c(0,.2))

其他嘗試，這更接近我想要的，但正如您所看到的，不是最佳的，因為“地板”與另一個峰重疊！

norm1 <- function(x,y, mean1 = 3, var1 =2,mean2 = -3, var2 =2) {
  1/sqrt(2*var1^2*1)*exp(-((y-mean2)^2/(2*var2^2))) * 
    1/sqrt(2*var2^2*1)*exp(-((x-mean2)^2/(2*var1^2)))
}
norm2 <- function(x,y, mean1 = 3, var1 =2,mean2 = -3, var2 =2) {
    1/sqrt(2*var2^2*1)*exp(-((y-mean1)^2/(2*var2^2))) * 
    1/sqrt(2*var1^2*1)*exp(-((x-mean1)^2/(2*var1^2)))      }

z1 <- outer(x, y, norm1)
z1[is.na(z1)] <- 1

z2 <- outer(x, y, norm2)
z2[is.na(z1)] <- 1

persp(x, y, z1, col ="red", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
      border = border,
      shade = 0.6,
      zlim=c(0,.2))

par(new=TRUE)
red.a = adjustcolor( "blue", alpha.f = .70)
persp(x, y, z2, col ="blue", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
      border = border,
      shade = 0.6,
      zlim=c(0,.2))

Answer 1

一種方法是將整個情節作為不同部分的拼貼畫。 在下面的代碼中，我沿對角線（在 xy 平面中）分割繪圖，使兩個峰具有不同的顏色。 但我認為沒有什么能阻止你在這里為 xy 平面的多個區域使用不同的顏色變得更漂亮。

x <- seq(-10, 10, length = 100)
y <- x

norm <- function(x,y, mean1 = 3, var1 =2,mean2 = -3, var2 =2) {
  1/sqrt(2*var1^2*1)*exp(-((y-mean2)^2/(2*var2^2))) * 
    1/sqrt(2*var2^2*1)*exp(-((x-mean2)^2/(2*var1^2)))+
    1/sqrt(2*var2^2*1)*exp(-((y-mean1)^2/(2*var2^2))) * 
    1/sqrt(2*var1^2*1)*exp(-((x-mean1)^2/(2*var1^2)))      }

z <- outer(x, y, norm)
z[is.na(z)] <- 1

rbPal <- colorRampPalette(c('red','blue'))
Col <- rbPal(10)[as.numeric(cut(x = x,breaks = 2))]

persp(x, y, z, col = "blue", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
    #  border = border,
      shade = 0.6,
      zlim=c(0,.2))

z2 <- z
for(i in 1:100){
  for(j in 1:(100-i)){
    z2[i,j] <- NA
  }
}



par(new=T)
graphics::persp(x, y, z2, col = "red", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
    #  border = border,
      shade = 0.6,
      zlim=c(0,.2))

或者，如果您只想將峰着色（例如，其他所有顏色均為灰色），您可以這樣做

z3 <- z
z3[z3<.03] <- NA
z4 <- z2
z4[z4<.03] <- NA

persp(x, y, z, col = "gray90", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
      #  border = border,
      shade = 0.6,
      zlim=c(0,.2))

par(new=T)
persp(x, y, z3, col = "skyblue1", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
      #  border = border,
      shade = 0.6,
      zlim=c(0,.2))

par(new=T)
persp(x, y, z4, col = "indianred1", 
      xlab = "", 
      ylab = "", zlab = "", 
      theta = 60,
      phi = 15,d = 10,
      #  border = border,
      shade = 0.6,
      zlim=c(0,.2))