heatmap_2: How to change the legend on the color key?

0

Entering edit mode

Yen Ngo ▴ 20

@yen-ngo-3322

Last seen 10.2 years ago

Dear list, Using example from heatmap_2 (Heatplus) i could conduct a heatmap. However when i changed the color key according to a certain range, the labels on the color key didnt change. Is there a way to fix this? Thanks in advance. Yen mm = matrix(rnorm(1000, m=1), 100,10) mm = cbind(mm, matrix(rnorm(2000), 100, 20)) mm = cbind(mm, matrix(rnorm(1500, m=-1), 100, 15)) mm2 = matrix(rnorm(450), 30, 15) mm2 = cbind(mm2, matrix(rnorm(900,m=1.5), 30,30)) mm=rbind(mm, mm2) colnames(mm) = paste("Sample", 1:45) rownames(mm) = paste("Gene", 1:130) > max(apply(mm,1,max)) [1] 4.452612 windows() heat.col <- c("#FF0000FF", "#FF2400FF", "#FF4900FF", "#FF6D00FF" ,"#FF9200FF", "#FFB600FF", "#FFDB00FF", "#FFFF00FF", "#FFFF40FF", "#FFFFAAFF") heatmap_2(mm, Rowv = NA, Colv = NA, scale="none", legend=1,col=heat.col[length(heat.col):1]) ## Change the color key to 0-7 ## would like color key on the legend to indicate 0-7 not from 0 to the original max value. windows() heat.col <- c("#FF0000FF", "#FF2400FF", "#FF4900FF", "#FF6D00FF" ,"#FF9200FF", "#FFB600FF", "#FFDB00FF", "#FFFF00FF", "#FFFF40FF", "#FFFFAAFF") breaks <-seq(0, 7, length.out=11) heatmap_2(mm, Rowv = NA, Colv = NA, scale="none",breaks=breaks, legend=1,col=heat.col[length(heat.col):1]) [[alternative HTML version deleted]]

• 1.7k views

ADD COMMENT • link updated 15.7 years ago by Saroj Mohapatra ▴ 450 • written 15.7 years ago by Yen Ngo ▴ 20

0

Entering edit mode

Saroj Mohapatra ▴ 450

@saroj-mohapatra-1446

Last seen 10.2 years ago

Hi Yen: I think this is related to the fact that color legend is automatically derived from the data. If you look at the code for the function heatmap_2, e.g., > edit(heatmap_2) you would see a line dummy.x <- seq(min(x, na.rm = TRUE), *max(x, na.rm = TRUE)*, A crude solution is to create your own function (with a different name e.g., yen_heatmap_2) with an additional parameter max.legend.col and changing the term max(x, na.rm=TRUE) to max.legend.col. Then instead of calling heatmap_2 you call yen_heatmap_2(mm, max.legend.col=7). When you want the default setting, you call it with max.legend.col=max(x, na.rm=T) I checked and it seems to work. If you want, I would send you the function with these additional pieces. Hope that helps, Saroj Yen Ngo wrote: > > > Dear list, > > > > Using example from heatmap_2 (Heatplus) i could conduct a heatmap. > However when i changed the color key according to > > a certain range, the labels on the color key didnt change. Is there a > way to fix this? > > > > Thanks in advance. > > Yen > > > > > > mm = matrix(rnorm(1000, m=1), 100,10) > > mm = cbind(mm, matrix(rnorm(2000), 100, 20)) > > mm = cbind(mm, matrix(rnorm(1500, m=-1), 100, 15)) > > mm2 = matrix(rnorm(450), 30, 15) > > mm2 = cbind(mm2, matrix(rnorm(900,m=1.5), 30,30)) > > mm=rbind(mm, mm2) > > colnames(mm) = paste("Sample", 1:45) > > rownames(mm) = paste("Gene", 1:130) > > > > >> max(apply(mm,1,max)) >> > > [1] 4.452612 > > > > windows() > > heat.col <- c("#FF0000FF", "#FF2400FF", "#FF4900FF", "#FF6D00FF" > ,"#FF9200FF", > > "#FFB600FF", "#FFDB00FF", "#FFFF00FF", > "#FFFF40FF", "#FFFFAAFF") > > > > heatmap_2(mm, Rowv = NA, Colv = NA, scale="none", > > legend=1,col=heat.col[length(heat.col):1]) > > > > ## Change the color key to 0-7 > > ## would like color key on the legend to indicate 0-7 not from 0 to the > original max value. > > > > windows() > > heat.col <- c("#FF0000FF", "#FF2400FF", "#FF4900FF", "#FF6D00FF" > ,"#FF9200FF", > > "#FFB600FF", "#FFDB00FF", "#FFFF00FF", > "#FFFF40FF", "#FFFFAAFF") > > > > breaks <-seq(0, 7, length.out=11) > > heatmap_2(mm, Rowv = NA, Colv = NA, > > scale="none",breaks=breaks, > legend=1,col=heat.col[length(heat.col):1]) > > > > > [[alternative HTML version deleted]] > > _______________________________________________ > Bioconductor mailing list > Bioconductor at stat.math.ethz.ch > https://stat.ethz.ch/mailman/listinfo/bioconductor > Search the archives: http://news.gmane.org/gmane.science.biology.informatics.conductor >

ADD COMMENT • link 15.7 years ago Saroj Mohapatra ▴ 450

0

Entering edit mode

Dear Saroj, I would be very much appreciated to have your function. This would save my day. Thanks a lot. Yen -----Ursprungligt meddelande----- Fr?n: Saroj Mohapatra [mailto:smohapat at vbi.vt.edu] Skickat: den 6 mars 2009 19:21 Till: Yen Ngo Kopia: bioconductor at stat.math.ethz.ch ?mne: Re: [BioC] heatmap_2: How to change the legend on the color key? Hi Yen: I think this is related to the fact that color legend is automatically derived from the data. If you look at the code for the function heatmap_2, e.g., > edit(heatmap_2) you would see a line dummy.x <- seq(min(x, na.rm = TRUE), *max(x, na.rm = TRUE)*, A crude solution is to create your own function (with a different name e.g., yen_heatmap_2) with an additional parameter max.legend.col and changing the term max(x, na.rm=TRUE) to max.legend.col. Then instead of calling heatmap_2 you call yen_heatmap_2(mm, max.legend.col=7). When you want the default setting, you call it with max.legend.col=max(x, na.rm=T) I checked and it seems to work. If you want, I would send you the function with these additional pieces. Hope that helps, Saroj Yen Ngo wrote: > > > Dear list, > > > > Using example from heatmap_2 (Heatplus) i could conduct a heatmap. > However when i changed the color key according to > > a certain range, the labels on the color key didnt change. Is there a > way to fix this? > > > > Thanks in advance. > > Yen > > > > > > mm = matrix(rnorm(1000, m=1), 100,10) > > mm = cbind(mm, matrix(rnorm(2000), 100, 20)) > > mm = cbind(mm, matrix(rnorm(1500, m=-1), 100, 15)) > > mm2 = matrix(rnorm(450), 30, 15) > > mm2 = cbind(mm2, matrix(rnorm(900,m=1.5), 30,30)) > > mm=rbind(mm, mm2) > > colnames(mm) = paste("Sample", 1:45) > > rownames(mm) = paste("Gene", 1:130) > > > > >> max(apply(mm,1,max)) >> > > [1] 4.452612 > > > > windows() > > heat.col <- c("#FF0000FF", "#FF2400FF", "#FF4900FF", "#FF6D00FF" > ,"#FF9200FF", > > "#FFB600FF", "#FFDB00FF", "#FFFF00FF", > "#FFFF40FF", "#FFFFAAFF") > > > > heatmap_2(mm, Rowv = NA, Colv = NA, scale="none", > > legend=1,col=heat.col[length(heat.col):1]) > > > > ## Change the color key to 0-7 > > ## would like color key on the legend to indicate 0-7 not from 0 to the > original max value. > > > > windows() > > heat.col <- c("#FF0000FF", "#FF2400FF", "#FF4900FF", "#FF6D00FF" > ,"#FF9200FF", > > "#FFB600FF", "#FFDB00FF", "#FFFF00FF", > "#FFFF40FF", "#FFFFAAFF") > > > > breaks <-seq(0, 7, length.out=11) > > heatmap_2(mm, Rowv = NA, Colv = NA, > > scale="none",breaks=breaks, > legend=1,col=heat.col[length(heat.col):1]) > > > > > [[alternative HTML version deleted]] > > _______________________________________________ > Bioconductor mailing list > Bioconductor at stat.math.ethz.ch > https://stat.ethz.ch/mailman/listinfo/bioconductor > Search the archives: http://news.gmane.org/gmane.science.biology.informatics.conductor >

ADD REPLY • link 15.7 years ago Yen Ngo ▴ 20

0

Entering edit mode

my_heatmap_2=function (x, Rowv, Colv, distfun = dist, hclustfun = hclust, add.expr, scale = c("row", "column", "none"), na.rm = TRUE, do.dendro = c(TRUE, TRUE), legend = 0, legfrac = 8, col = heat.colors(12), trim, max.legend.col, ...) { scale <- match.arg(scale) if (length(di <- dim(x)) != 2 || !is.numeric(x)) stop("`x' must be a numeric matrix") nr <- di[1] nc <- di[2] if (nr <= 1 || nc <= 1) stop("`x' must have at least 2 rows and 2 columns") r.cex <- 0.2 + 1/log10(nr) c.cex <- 0.2 + 1/log10(nc) if (missing(Rowv)) Rowv <- rowMeans(x, na.rm = na.rm) if (missing(Colv)) Colv <- colMeans(x, na.rm = na.rm) if (!identical(Rowv, NA)) { if (!inherits(Rowv, "dendrogram")) { hcr <- hclustfun(distfun(x)) ddr <- as.dendrogram(hcr) ddr <- reorder(ddr, Rowv) } else ddr <- Rowv rowInd <- order.dendrogram(ddr) } else { rowInd = 1:nr do.dendro[1] = FALSE } if (!identical(Colv, NA)) { if (!inherits(Colv, "dendrogram")) { hcc <- hclustfun(distfun(t(x))) ddc <- as.dendrogram(hcc) ddc <- reorder(ddc, Colv) } else ddc <- Colv colInd <- order.dendrogram(ddc) } else { colInd = 1:nc do.dendro[2] = FALSE } x <- x[rowInd, colInd] if (scale == "row") { x <- sweep(x, 1, rowMeans(x, na.rm = na.rm)) sd <- apply(x, 1, sd, na.rm = na.rm) x <- sweep(x, 1, sd, "/") } else if (scale == "column") { x <- sweep(x, 2, colMeans(x, na.rm = na.rm)) sd <- apply(x, 2, sd, na.rm = na.rm) x <- sweep(x, 2, sd, "/") } op <- par(no.readonly = TRUE) on.exit(par(op)) if (!missing(trim)) { trim = min(trim[1], 1 - trim[1]) lo = quantile(x, trim, na.rm = na.rm) hi = quantile(x, 1 - trim, na.rm = na.rm) x[x < lo] = lo x[x > hi] = hi } do.xaxis = !is.null(colnames(x)) do.yaxis = !is.null(rownames(x)) margin = rep(0, 4) margin[1] = if (do.xaxis) 5 else 2 margin[2] = if (do.dendro[1]) 0 else 2 margin[3] = if (do.dendro[2]) 0 else 2 margin[4] = if (do.yaxis) 5 else 2 if (do.dendro[1] & do.dendro[2]) { ll = matrix(c(0, 3, 2, 1), 2, 2, byrow = TRUE) ll.width = c(1, 4) ll.height = c(1, 4) } else if (do.dendro[1]) { ll = matrix(c(2, 1), 1, 2, byrow = TRUE) ll.width = c(1, 4) ll.height = 4 } else if (do.dendro[2]) { ll = matrix(c(2, 1), 2, 1, byrow = FALSE) ll.width = 4 ll.height = c(1, 4) } else { ll = matrix(1, 1, 1) ll.width = 1 ll.height = 1 } if (legend %in% 1:4) { plotnum = max(ll) + 1 nc = ncol(ll) nr = nrow(ll) if (legend == 1) { ll = rbind(ll, if (nc == 1) plotnum else c(0, plotnum)) ll.height = c(ll.height, sum(ll.height)/(legfrac - 1)) leg.hor = TRUE } else if (legend == 2) { ll = cbind(if (nr == 1) plotnum else c(0, plotnum), ll) ll.width = c(sum(ll.width)/(legfrac - 1), ll.width) leg.hor = FALSE } else if (legend == 3) { ll = rbind(if (nc == 1) plotnum else c(0, plotnum), ll) ll.height = c(sum(ll.height)/(legfrac - 1), ll.height) leg.hor = TRUE } else if (legend == 4) { ll = cbind(ll, if (nr == 1) plotnum else c(0, plotnum)) ll.width = c(ll.width, sum(ll.width)/(legfrac - 1)) leg.hor = FALSE } } layout(ll, width = ll.width, height = ll.height, respect = TRUE) par(mar = margin) image(1:ncol(x), 1:nrow(x), t(x), axes = FALSE, xlim = c(0.5, ncol(x) + 0.5), ylim = c(0.5, nrow(x) + 0.5), xlab = "", ylab = "", col = col, ...) if (do.xaxis) { axis(1, 1:ncol(x), las = 2, line = -0.5, tick = 0, labels = colnames(x), cex.axis = c.cex) } if (do.yaxis) { axis(4, 1:nrow(x), las = 2, line = -0.5, tick = 0, labels = rownames(x), cex.axis = r.cex) } if (!missing(add.expr)) eval(substitute(add.expr)) if (do.dendro[1]) { mm = margin mm[2] = 3 mm[4] = 0 par(mar = mm) plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none") } if (do.dendro[2]) { mm = margin mm[1] = 0 mm[3] = 3 par(mar = mm) plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none") } if (legend %in% 1:4) { dummy.x <- seq(min(x, na.rm = TRUE), max.legend.col, length = length(col)) dummy.z <- matrix(dummy.x, ncol = 1) if (leg.hor) { par(mar = c(2, margin[2], 2, margin[4])) image(x = dummy.x, y = 1, z = dummy.z, yaxt = "n", col = col) } else { par(mar = c(margin[1], 2, margin[3], 2)) image(x = 1, y = dummy.x, z = t(dummy.z), xaxt = "n", col = col) } } invisible(list(rowInd = rowInd, colInd = colInd)) }

ADD REPLY • link 15.7 years ago Saroj Mohapatra ▴ 450

Login before adding your answer.