3d - R: Adjust Color Gradient for 3DBarplot using latticeExtra cloud in R

Question

I am trying to change the colors of the 3d bar plot so that the colors go from green, to yellow, to orange, to light red, to red, to dark red. However, whenever I plot it, it looks like the colors start repeating after green. Is there something, I can do to fix this? The output that I get is:

The output that I want is this: enter image description here

This is the code, I am using. It gives me the first picture. That is not what want. I want the colors to look the way they look in the second picture.

library(latticeExtra)
myPalette <- colorRampPalette(rev(c("red2","tomato2","red4","orange", "gold1","forestgreen")))(6)
k <- read.table(text = 'x y z
NotKnown   0 Critical
NotKnown   0 Substantial
NotKnown   0 Significant
NotKnown   0 Moderate
NotKnown   0 Negligible
NotLikely  2 Critical
NotLikely  5 Substantial
NotLikely  7 Significant
NotLikely  0 Moderate
NotLikely  0 Negligible
Reasonable 0 Critical
Reasonable 1 Substantial
Reasonable 9 Significant
Reasonable 1 Moderate
Reasonable 0 Negligible
Likely     0 Critical
Likely     0 Substantial
Likely     1 Significant
Likely     0 Moderate
Likely     0 Negligible
VeryLikely 0 Critical
VeryLikely 0 Substantial
VeryLikely 0 Significant
VeryLikely 0 Moderate
VeryLikely 0 Negligible',header=TRUE)

k$x <- factor(k$x,levels = c("VeryLikely", "Likely","Reasonable","NotLikely","NotKnown"))
k$z <- factor(k$z,levels= c("Critical","Substantial","Significant","Moderate","Negligible"))

cloud(y~z+x, k, panel.3d.cloud=panel.3dbars, col.facet=myPalette, 
             xbase=0.8, ybase=0.8, xlab= "Severity",ylab="Probability",zlab="Number of Risks",scales=list(arrows=FALSE, col=1), 
             par.settings = list(axis.line = list(col = "transparent")))

question from:https://stackoverflow.com/questions/65837568/r-adjust-color-gradient-for-3dbarplot-using-latticeextra-cloud-in-r

Answer 1

I think this is what you are looking for

assign.color <- function(coordinate) {
  if (sum(coordinate) == 2)
    return("red4")
  
  if (sum(coordinate) == 3)
    return("red2")
  
  if (sum(coordinate) == 4)
    return("tomato2")
  
  if (sum(coordinate) == 5)
    return("orange")
  
  if (sum(coordinate) == 6)
    return("gold1")
  
  if (sum(coordinate) >= 7)
    return("forestgreen")
}

k$x.int <- as.integer(k$x)
k$z.int <- as.integer(k$z)

k$color <- apply(k,
                 MARGIN = 1,
                 FUN = function (row) {
                   return(assign.color(as.integer(c(row["x.int"], row["z.int"]))))
                 })

k$colorCode <- apply(k,
                     MARGIN = 1,
                     FUN = function(row) {
                       return(colorRampPalette(row["color"])(6)[1])
                     })


cloud(y~z+x, k, panel.3d.cloud=panel.3dbars, col.facet=k$colorCode, 
      xbase=0.8, ybase=0.8, xlab= "Severity",ylab="Probability",zlab="Number of Risks",scales=list(arrows=FALSE, col=1), 
      par.settings = list(axis.line = list(col = "transparent")))

produces

The key is to understand that the arugment col.facet from function cloud also accepts a vector that can be as long as the number of your data points.