3

This is a reproducible example of my heatmap that shows the differentially expressed genes in R plotly for multiple samples:

colMax <- function(data) sapply(data, max, na.rm = TRUE)
colMin <- function(data) sapply(data, min, na.rm = TRUE)
test <- structure(list(`#Log2FC_00e41e6a` = c(0, 0, 0, 0, 0, 0), `#Log2FC_0730216b` = c(0, 
0, 0, 2.85798206145049, 0, 0), `#Log2FC_07ccb4e9` = c(-2.92159741497064, 
0, -2.32475763591175, 0, 0, 0), `#Log2FC_1426b4bf` = c(0, 0, 
0, -2.95962954629017, 0, 0), `#Log2FC_181c6d37` = c(0, 0, 0, 
0, 0, 0), `#Log2FC_1d7ffbe7` = c(0, 0, 0, 0, 0, 0)), .Names = c("#Log2FC_00e41e6a", 
"#Log2FC_0730216b", "#Log2FC_07ccb4e9", "#Log2FC_1426b4bf", "#Log2FC_181c6d37", 
"#Log2FC_1d7ffbe7"), row.names = c("A1BG-AS1", "A1CF", "A2M", 
"A2ML1", "A4GALT", "AADAC"), class = "data.frame")

and this is the code to produce the R heatmap using plotly:

f1 <- list(
    family = "Arial, sans-serif",
    size = 5,
    color = "lightgrey")

f2 <- list(
    family = "Old Standard TT, serif",
    size = 10,
    color = "black")

a <- list(
  title = "",
  titlefont = f1,
  showticklabels = TRUE,
  tickangle = 45,
  tickfont = f2,
  exponentformat = "E")

plot_ly(z = as.matrix(test),
        zmin=round(min(colMin(test))),
        zmax=round(max(colMax(test))),
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colors = c("red", "green") ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

produces:

Heatmap

Question: How can I set the 0 value of the colorbar to black color ?

If I do:

plot_ly(z = as.matrix(test),
        zmin=round(min(colMin(test))),
        zmax=round(max(colMax(test))),
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colors = c("red", "black", "green") ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

Then this produce:

heatmap2

but the problem the reproducible example is a small set of my whole data. Applying it to my data gives a different scale where the 0 have a different color than black. This Stackoverflow question is a similar question but is different than mine where I only need a specific color for a specific value.

Edit 1: Also, from the answer of my previous question, @MarcoSandri said that by defining a colorscale array, we can pass these values to plotly. I tried :

colorScale <- data.frame(z=c(zmin=round(min(colMin(big_data))),
                             0,
                             zmax=round(max(colMax(big_data)))),
                         col=c("#ff0000", "#000000", "#00ff00"))
colorScale$col <- as.character(colorScale$col)

plot_ly(z = as.matrix(test),
        zmin=round(min(colMin(test))),
        zmax=round(max(colMax(test))),
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colorscale = colorScale ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

and:

heatmap 3

As you see, this has two issues, first the colors doesn't correspond to the values I gave in my array and second, similarly to the previous one, doesn't work on my whole data.

Thanks in advance !

user324810
  • 597
  • 8
  • 20

1 Answers1

3

Your color scale is not defined correctly. The z column of colorScale should be between 0 and 1 and not between zmin and zmax. See below a possibile solution:

ncols <- 7   # Number of colors in the color scale
mypalette <- colorRampPalette(c("#ff0000","#000000","#00ff00"))
cols <- mypalette(ncols)

zseq <- seq(0,1,length.out=ncols+1)
colorScale <- data.frame(
     z = c(0,rep(zseq[-c(1,length(zseq))],each=2),1),
     col=rep(cols,each=2)
)   
colorScale$col <- as.character(colorScale$col)

zmx <- round(max(test))
zmn <- round(min(test))
plot_ly(z = as.matrix(test),
        zmin=zmn,
        zmax=zmx,
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colorscale = colorScale,
        colorbar=list(ypad = 30, tick0=-zmn, dtick=1) ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))

enter image description here

EDIT
When the scale is not centered at zero this solution should work better.

mypal1 <- colorRampPalette(c("#ff0000","#000000"))
mypal2 <- colorRampPalette(c("#000000","#00ff00"))
x <- pretty(c(min(test),max(test)))
dltx <- diff(x)[1]
x <- sort(c(x,-dltx/16,dltx/16))
x <- x[x!=0]
x.resc <- (x-min(x))/(max(x)-min(x))
cols <- unique(c(mypal1(sum(x<=0)),mypal2(sum(x>0))))
colorScale <- data.frame(
     z = c(0,rep(x.resc[2:(length(x.resc)-1)],each=2),1),
     col=rep(cols,each=2)
)  

plot_ly(z = as.matrix(test),
        zmin=x[1],
        zmax=x[length(x)],
        x = colnames(test),
        xgap = 2,
        y = rownames(test),
        ygap = 2,
        type = "heatmap",
        colorscale = colorScale,
        colorbar=list(ypad = 30, tick0=x[1], dtick=dltx)  ) %>%
    layout(xaxis = a,
           margin = list(l =90,
                         r = 10,
                         b = 100,
                         t = 10))
Marco Sandri
  • 23,289
  • 7
  • 54
  • 58
  • sorry for the late reply and thanks for the provided possible solution. The colorscale of the colorbar works perfectly if the median is 0 (+2 to -2). When applying to my data in my case, the scale is (+15 to -22) and this shift the color of the 0 to a greenish zone. Once I set the scale to (+22 to -22) it works nicely. Any tips on what I could change ? Thanks ! – user324810 Apr 25 '18 at 08:01
  • This is the best answer for my situation! If I could vote more I would. I looked for a solid hour trying to find something that worked. Thanks @Marco Sandri – Matt Dzievit May 13 '20 at 04:08