Using discrete custom color in a plotly heatmap

后端 未结 4 478
暖寄归人
暖寄归人 2020-12-18 06:28

I\'m trying to generate a plotly heatmap, where I\'d like the colors to be specified by a discrete scale.

Here\'s what I mean:

Gene

相关标签:
4条回答
  • 2020-12-18 06:31

    Let's get a discrete colorscale

    df_colors = data.frame(range=c(0:11), colors=c(0:11))
    color_s <- setNames(data.frame(df_colors$range, df_colors$colors), NULL)
    for (i in 1:12) {
      color_s[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
      color_s[[1]][[i]] <-  i / 12 - (i %% 2) / 12
    }
    

    And get a nice colorbar by setting ticktext and squeezing it (len=0.2)

    colorbar=list(tickmode='array', tickvals=c(1:6), ticktext=levels(mat.intervals), len=0.2)
    

    All the code which needs to be added to your example

    df_colors = data.frame(range=c(0:11), colors=c(0:11))
    color_s <- setNames(data.frame(df_colors$range, df_colors$colors), NULL)
    
    for (i in 1:12) {
      color_s[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
      color_s[[1]][[i]] <-  i / 12 - (i %% 2) / 12
    }
    
    
    plot_ly(z=c(interval.df$expr), x=interval.df$sample, y=interval.df$gene, colorscale = color_s, type = "heatmap", hoverinfo = "x+y+z", colorbar=list(tickmode='array', tickvals=c(1:6), ticktext=levels(mat.intervals), len=0.2))
    
    0 讨论(0)
  • 2020-12-18 06:36

    Combining the answers of @Maximilian Peters and @R.S.:

    Data:

    require(permute)
    set.seed(1)
    mat <- rbind(cbind(matrix(rnorm(2500,2,1),nrow=25,ncol=500),matrix(rnorm(2500,-2,1),nrow=25,ncol=500)),
                 cbind(matrix(rnorm(2500,-2,1),nrow=25,ncol=500),matrix(rnorm(2500,2,1),nrow=25,ncol=500)))
    rownames(mat) <- paste("g",1:50,sep=".")
    colnames(mat) <- paste("s",1:1000,sep=".")
    hc.col <- hclust(dist(t(mat)))
    dd.col <- as.dendrogram(hc.col)
    col.order <- order.dendrogram(dd.col)
    hc.row <- hclust(dist(mat))
    dd.row <- as.dendrogram(hc.row)
    row.order <- order.dendrogram(dd.row)
    mat <- mat[row.order,col.order]
    

    Colors:

    require(RColorBrewer)
    mat.intervals <- cut(mat,breaks=6)
    interval.mat <- matrix(mat.intervals,nrow=50,ncol=1000,dimnames=list(rownames(mat),colnames(mat)))
    require(reshape2)
    interval.df <- reshape2::melt(interval.mat,varnames=c("gene","sample"),value.name="expr")
    interval.cols <- brewer.pal(6,"Set2")
    names(interval.cols) <- levels(mat.intervals)
    interval.cols2 <- rep(interval.cols, each=ncol(mat))
    color.df <- data.frame(range=c(0:(2*length(interval.cols)-1)),colors=c(0:(2*length(interval.cols)-1)))
    color.df <- setNames(data.frame(color.df$range,color.df$colors),NULL)
    for (i in 1:(2*length(interval.cols))) {
      color.df[[2]][[i]] <- interval.cols[[(i + 1) / 2]]
      color.df[[1]][[i]] <-  i/(2*length(interval.cols))-(i %% 2)/(2*length(interval.cols))
    }
    

    Plotting:

    plot_ly(z=c(interval.df$expr),x=interval.df$sample,y=interval.df$gene,colors=interval.cols2,type="heatmap",colorscale=color.df,
            colorbar=list(tickmode='array',tickvals=c(1:6),ticktext=names(interval.cols),len=0.2,outlinecolor="white",bordercolor="white",borderwidth=5,bgcolor="white"))
    

    It would be great if anyone can add:

    1. How to facet or create a narrow border between the facets.
    2. How to get the colorbar tick labels to appear exactly in the middle of each box in the colorbar
    0 讨论(0)
  • 2020-12-18 06:37

    I was thinking initially the same thing, which is to down-sample the gradient, but instead forcing harsher transitions seems to do the trick at least to make the colors more pronounced.

    interval.cols2 <- rep(interval.cols, each=1000)
    plot_ly(z=mat,x=colnames(mat),y=rownames(mat),type="heatmap",colors=interval.cols2)
    

    0 讨论(0)
  • 2020-12-18 06:49

    A nice way for creating discrete color breaks is given in question 59516054 . Given the offered Z_Breaks function, you can center the colorbar tick labels in the middle of each box by using the function:

    tickpos <- function(nFactor) {
        pos <- unique((head(Z_Breaks(nFactor), -1)) + head(Z_Breaks(nFactor))[2] / 2) * (nFactor - 1)
    }
    

    and then assigning it to the tickval argument of colorbar:

    colorbar <- list(tickvals = tickpos(nFactor), ticktext = names(colours))
    
    0 讨论(0)
提交回复
热议问题