Question: How to display the row label of a heatmap at the end of dendrogram branches?
0
gravatar for carol white
11.5 years ago by
carol white680
European Union
carol white680 wrote:
Hi, How is it possible to display the row label of a heatmap (either all or a selection of labels for subclusters) at the end of a row dendrogram branches using preferably, heamap.2 or heatmap? Cheers, Carol [[alternative HTML version deleted]]
• 1.9k views
ADD COMMENTlink modified 11.5 years ago by Artur Veloso340 • written 11.5 years ago by carol white680
Answer: How to display the row label of a heatmap at the end of dendrogram branches?
0
gravatar for Sean Davis
11.5 years ago by
Sean Davis21k
United States
Sean Davis21k wrote:
On Wed, May 28, 2008 at 11:44 AM, carol white <wht_crl at="" yahoo.com=""> wrote: > Hi, > How is it possible to display the row label of a heatmap (either all or a selection of labels for subclusters) at the end of a row dendrogram branches using preferably, heamap.2 or heatmap? > I don't think so. You can look at the Heatplus package or do a search of the archives for heatmap alternatives (there are many). Sean
ADD COMMENTlink written 11.5 years ago by Sean Davis21k
you could try to use the "add.expr" argument of heatmap.2 together with e.g. mtext to place labels for subclusters. add.expr: expression that will be evaluated after the call to 'image'. Can be used to add components to the plot. hth, Matthias Sean Davis wrote: > On Wed, May 28, 2008 at 11:44 AM, carol white <wht_crl at="" yahoo.com=""> wrote: > >> Hi, >> How is it possible to display the row label of a heatmap (either all or a selection of labels for subclusters) at the end of a row dendrogram branches using preferably, heamap.2 or heatmap? >> >> > > I don't think so. You can look at the Heatplus package or do a search > of the archives for heatmap alternatives (there are many). > > Sean > > _______________________________________________ > 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 > -- Dr. Matthias Kohl www.stamats.de
ADD REPLYlink written 11.5 years ago by Matthias Kohl160
Answer: How to display the row label of a heatmap at the end of dendrogram branches?
0
gravatar for Artur Veloso
11.5 years ago by
Artur Veloso340
Artur Veloso340 wrote:
Carol, I don't know if there is some way in the heatmap.2 function to do so, but if you change the function a little bit it is possible. All you have to do is change the following term: axis(4, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = cexRow) to this one: axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = cexRow) I already inserted the corrected function in the end of the e-mail to help you. The problem that you will run into is that now the labels are going to be colliding with the dendrogram. This can be fixed by changing the specifications of layout. I hope this helps. Cheers, Artur heatmap.2 <- function (x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, distfun = dist, hclustfun = hclust, dendrogram = c("both", "row", "column", "none"), symm = FALSE, scale = c("none", "row", "column"), na.rm = TRUE, revC = identical(Colv, "Rowv"), add.expr, breaks, col = "heat.colors", colsep, rowsep, sepcolor = "white", sepwidth = c(0.05, 0.05), cellnote, notecex = 1, notecol = "cyan", na.color = par("bg"), trace = c("column", "row", "both", "none"), tracecol = "cyan", hline = median(breaks), vline = median(breaks), linecol = tracecol, margins = c(5, 5), ColSideColors, RowSideColors, cexRow = 0.2 + 1/log10(nr), cexCol = 0.2 + 1/log10(nc), labRow = NULL, labCol = NULL, key = TRUE, keysize = 1.5, density.info = c("histogram", "density", "none"), denscol = tracecol, symkey = min(x < 0, na.rm = TRUE), densadj = 0.25, main = NULL, xlab = NULL, ylab = NULL, lmat = NULL, lhei = NULL, lwid = NULL, ...) { scale01 <- function(x, low = min(x), high = max(x)) { x <- (x - low)/(high - low) x } scale <- if (symm && missing(scale)) "none" else match.arg(scale) dendrogram <- match.arg(dendrogram) trace <- match.arg(trace) density.info <- match.argdensity.info) if (!missing(breaks) && (scale != "none")) warning("Using scale=\"row\" or scale=\"column\" when breaks are", "specified can produce unpredictable results.", "Please consider using only one or the other.") if ((Colv == "Rowv") && (!isTRUE(Rowv) || is.null(Rowv))) Colv <- FALSE 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") if (!is.numeric(margins) || length(margins) != 2) stop("`margins' must be a numeric vector of length 2") if (missing(cellnote)) cellnote <- matrix("", ncol = ncol(x), nrow = nrow(x)) if (!inherits(Rowv, "dendrogram")) { if (((!isTRUE(Rowv)) || (is.null(Rowv))) && (dendrogram %in% c("both", "row"))) { if (is.logical(Colv) && (Colv)) dendrogram <- "column" else dedrogram <- "none" warning("Discrepancy: Rowv is FALSE, while dendrogram is `", dendrogram, "'. Omitting row dendogram.") } } if (!inherits(Colv, "dendrogram")) { if (((!isTRUE(Colv)) || (is.null(Colv))) && (dendrogram %in% c("both", "column"))) { if (is.logical(Rowv) && (Rowv)) dendrogram <- "row" else dendrogram <- "none" warning("Discrepancy: Colv is FALSE, while dendrogram is `", dendrogram, "'. Omitting column dendogram.") } } if (inherits(Rowv, "dendrogram")) { ddr <- Rowv rowInd <- order.dendrogram(ddr) } else if (is.integer(Rowv)) { hcr <- hclustfun(distfun(x)) ddr <- as.dendrogram(hcr) ddr <- reorder(ddr, Rowv) rowInd <- order.dendrogram(ddr) if (nr != length(rowInd)) stop("row dendrogram ordering gave index of wrong length") } else if (isTRUE(Rowv)) { Rowv <- rowMeans(x, na.rm = na.rm) hcr <- hclustfun(distfun(x)) ddr <- as.dendrogram(hcr) ddr <- reorder(ddr, Rowv) rowInd <- order.dendrogram(ddr) if (nr != length(rowInd)) stop("row dendrogram ordering gave index of wrong length") } else { rowInd <- nr:1 } if (inherits(Colv, "dendrogram")) { ddc <- Colv colInd <- order.dendrogram(ddc) } else if (identical(Colv, "Rowv")) { if (nr != nc) stop("Colv = \"Rowv\" but nrow(x) != ncol(x)") if (exists("ddr")) { ddc <- ddr colInd <- order.dendrogram(ddc) } else colInd <- rowInd } else if (is.integer(Colv)) { hcc <- hclustfun(distfun(if (symm) x else t(x))) ddc <- as.dendrogram(hcc) ddc <- reorder(ddc, Colv) colInd <- order.dendrogram(ddc) if (nc != length(colInd)) stop("column dendrogram ordering gave index of wrong length") } else if (isTRUE(Colv)) { Colv <- colMeans(x, na.rm = na.rm) hcc <- hclustfun(distfun(if (symm) x else t(x))) ddc <- as.dendrogram(hcc) ddc <- reorder(ddc, Colv) colInd <- order.dendrogram(ddc) if (nc != length(colInd)) stop("column dendrogram ordering gave index of wrong length") } else { colInd <- 1:nc } x <- x[rowInd, colInd] x.unscaled <- x cellnote <- cellnote[rowInd, colInd] if (is.null(labRow)) labRow <- if (is.null(rownames(x))) (1:nr)[rowInd] else rownames(x) else labRow <- labRow[rowInd] if (is.null(labCol)) labCol <- if (is.null(colnames(x))) (1:nc)[colInd] else colnames(x) else labCol <- labCol[colInd] if (scale == "row") { x <- sweep(x, 1, rowMeans(x, na.rm = na.rm)) sx <- apply(x, 1, sd, na.rm = na.rm) x <- sweep(x, 1, sx, "/") } else if (scale == "column") { x <- sweep(x, 2, colMeans(x, na.rm = na.rm)) sx <- apply(x, 2, sd, na.rm = na.rm) x <- sweep(x, 2, sx, "/") } if (missing(breaks) || is.null(breaks) || length(breaks) < 1) if (missing(col)) breaks <- 16 else breaks <- length(col) + 1 if (length(breaks) == 1) { breaks <- seq(min(x, na.rm = na.rm), max(x, na.rm = na.rm), length = breaks) } nbr <- length(breaks) ncol <- length(breaks) - 1 if (class(col) == "function") col <- col(ncol) else if (is.character(col) && length(col) == 1) col <- do.call(col, list(ncol)) min.breaks <- min(breaks) max.breaks <- max(breaks) x[] <- ifelse(x < min.breaks, min.breaks, x) x[] <- ifelse(x > max.breaks, max.breaks, x) if (missing(lhei) || is.null(lhei)) lhei <- c(keysize, 4) if (missing(lwid) || is.null(lwid)) lwid <- c(keysize, 4) if (missing(lmat) || is.null(lmat)) { lmat <- rbind(4:3, 2:1) if (!missing(ColSideColors)) { if (!is.character(ColSideColors) || length(ColSideColors) != nc) stop("'ColSideColors' must be a character vector of length ncol(x)") lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1) lhei <- c(lhei[1], 0.2, lhei[2]) } if (!missing(RowSideColors)) { if (!is.character(RowSideColors) || length(RowSideColors) != nr) stop("'RowSideColors' must be a character vector of length nrow(x)") lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - 1), 1), lmat[, 2] + 1) lwid <- c(lwid[1], 0.2, lwid[2]) } lmat[is.na(lmat)] <- 0 } if (length(lhei) != nrow(lmat)) stop("lhei must have length = nrow(lmat) = ", nrow(lmat)) if (length(lwid) != ncol(lmat)) stop("lwid must have length = ncol(lmat) =", ncol(lmat)) op <- par(no.readonly = TRUE) on.exit(par(op)) layout(lmat, widths = lwid, heights = lhei, respect = FALSE) if (!missing(RowSideColors)) { par(mar = c(margins[1], 0, 0, 0.5)) image(rbind(1:nr), col = RowSideColors[rowInd], axes = FALSE) } if (!missing(ColSideColors)) { par(mar = c(0.5, 0, 0, margins[2])) image(cbind(1:nc), col = ColSideColors[colInd], axes = FALSE) } par(mar = c(margins[1], 0, 0, margins[2])) if (!symm || scale != "none") { x <- t(x) cellnote <- t(cellnote) } if (revC) { iy <- nr:1 ddr <- rev(ddr) x <- x[, iy] cellnote <- cellnote[, iy] } else iy <- 1:nr image(1:nc, 1:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 + c(0, nr), axes = FALSE, xlab = "", ylab = "", col = col, breaks = breaks, ...) if (!invalid(na.color) & anyis.na(x))) { mmat <- ifelseis.na(x), 1, NA) image(1:nc, 1:nr, mmat, axes = FALSE, xlab = "", ylab = "", col = na.color, add = TRUE) } axis(1, 1:nc, labels = labCol, las = 2, line = -0.5, tick = 0, cex.axis = cexCol) if (!is.null(xlab)) mtext(xlab, side = 1, line = margins[1] - 1.25) axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = cexRow) if (!is.null(ylab)) mtext(ylab, side = 4, line = margins[2] - 1.25) if (!missing(add.expr)) eval(substitute(add.expr)) if (!missing(colsep)) for (csep in colsep) rect(xleft = csep + 0.5, ybottom = rep(0, length(csep)), xright = csep + 0.5 + sepwidth[1], ytop = rep(ncol(x) + 1, csep), lty = 1, lwd = 1, col = sepcolor, border = sepcolor) if (!missing(rowsep)) for (rsep in rowsep) rect(xleft = 0, ybottom = (ncol(x) + 1 - rsep) - 0.5, xright = nrow(x) + 1, ytop = (ncol(x) + 1 - rsep) - 0.5 - sepwidth[2], lty = 1, lwd = 1, col = sepcolor, border = sepcolor) min.scale <- min(breaks) max.scale <- max(breaks) x.scaled <- scale01(t(x), min.scale, max.scale) if (trace %in% c("both", "column")) { for (i in colInd) { if (!is.null(vline)) { vline.vals <- scale01(vline, min.scale, max.scale) abline(v = i - 0.5 + vline.vals, col = linecol, lty = 2) } xv <- rep(i, nrow(x.scaled)) + x.scaled[, i] - 0.5 xv <- c(xv[1], xv) yv <- 1:length(xv) - 0.5 lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") } } if (trace %in% c("both", "row")) { for (i in rowInd) { if (!is.null(hline)) { hline.vals <- scale01(hline, min.scale, max.scale) abline(h = i + hline, col = linecol, lty = 2) } yv <- rep(i, ncol(x.scaled)) + x.scaled[i, ] - 0.5 yv <- rev(c(yv[1], yv)) xv <- length(yv):1 - 0.5 lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") } } if (!missing(cellnote)) text(x = c(row(cellnote)), y = c(col(cellnote)), labels = c(cellnote), col = notecol, cex = notecex) par(mar = c(margins[1], 0, 0, 0)) if (dendrogram %in% c("both", "row")) { plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none") } else plot.new() par(mar = c(0, 0, if (!is.null(main)) 5 else 0, margins[2])) if (dendrogram %in% c("both", "column")) { plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none") } else plot.new() if (!is.null(main)) title(main, cex.main = 1.5 * op[["cex.main"]]) if (key) { par(mar = c(5, 4, 2, 1), cex = 0.75) if (symkey) { max.raw <- max(abs(x), na.rm = TRUE) min.raw <- -max.raw } else { min.raw <- min(x, na.rm = TRUE) max.raw <- max(x, na.rm = TRUE) } z <- seq(min.raw, max.raw, length = length(col)) image(z = matrix(z, ncol = 1), col = col, breaks = breaks, xaxt = "n", yaxt = "n") par(usr = c(0, 1, 0, 1)) lv <- pretty(breaks) xv <- scale01(as.numeric(lv), min.raw, max.raw) axis(1, at = xv, labels = lv) if (scale == "row") mtext(side = 1, "Row Z-Score", line = 2) else if (scale == "column") mtext(side = 1, "Column Z-Score", line = 2) else mtext(side = 1, "Value", line = 2) if density.info == "density") { dens <- density(x, adjust = densadj, na.rm = TRUE) omit <- dens$x < min(breaks) | dens$x > max(breaks) dens$x <- dens$x[-omit] dens$y <- dens$y[-omit] dens$x <- scale01(dens$x, min.raw, max.raw) lines(dens$x, dens$y/max(dens$y) * 0.95, col = denscol, lwd = 1) axis(2, at = pretty(dens$y)/max(dens$y) * 0.95, pretty(dens$y)) title("Color Key\nand Density Plot") par(cex = 0.5) mtext(side = 2, "Density", line = 2) } else if density.info == "histogram") { h <- hist(x, plot = FALSE, breaks = breaks) hx <- scale01(breaks, min.raw, max.raw) hy <- c(h$counts, h$counts[length(h$counts)]) lines(hx, hy/max(hy) * 0.95, lwd = 1, type = "s", col = denscol) axis(2, at = pretty(hy)/max(hy) * 0.95, pretty(hy)) title("Color Key\nand Histogram") par(cex = 0.5) mtext(side = 2, "Count", line = 2) } else title("Color Key") } else plot.new() invisible(list(rowInd = rowInd, colInd = colInd)) } On Wed, May 28, 2008 at 11:44 AM, carol white <wht_crl@yahoo.com> wrote: > Hi, > How is it possible to display the row label of a heatmap (either all or a > selection of labels for subclusters) at the end of a row dendrogram branches > using preferably, heamap.2 or heatmap? > > Cheers, > > Carol > > > [[alternative HTML version deleted]] > > _______________________________________________ > Bioconductor mailing list > Bioconductor@stat.math.ethz.ch > https://stat.ethz.ch/mailman/listinfo/bioconductor > Search the archives: > http://news.gmane.org/gmane.science.biology.informatics.conductor > [[alternative HTML version deleted]]
ADD COMMENTlink written 11.5 years ago by Artur Veloso340
Thanks for all replies. Moreover, is it possible that some of the labels could be displayed selectively with hclust or plclust? how about displaying labels with coloring selectively some dendrogram branches? I also wanted to use clorder function but couldn't load it. in which package is it? thx Artur Veloso <abveloso@gmail.com> wrote: Carol, I don't know if there is some way in the heatmap.2 function to do so, but if you change the function a little bit it is possible. All you have to do is change the following term: axis(4, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = cexRow) to this one: axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = cexRow) I already inserted the corrected function in the end of the e-mail to help you. The problem that you will run into is that now the labels are going to be colliding with the dendrogram. This can be fixed by changing the specifications of layout. I hope this helps. Cheers, Artur heatmap.2 <- function (x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, distfun = dist, hclustfun = hclust, dendrogram = c("both", "row", "column", "none"), symm = FALSE, scale = c("none", "row", "column"), na.rm = TRUE, revC = identical(Colv, "Rowv"), add.expr, breaks, col = "heat.colors", colsep, rowsep, sepcolor = "white", sepwidth = c(0.05, 0.05), cellnote, notecex = 1, notecol = "cyan", na.color = par("bg"), trace = c("column", "row", "both", "none"), tracecol = "cyan", hline = median(breaks), vline = median(breaks), linecol = tracecol, margins = c(5, 5), ColSideColors, RowSideColors, cexRow = 0.2 + 1/log10(nr), cexCol = 0.2 + 1/log10(nc), labRow = NULL, labCol = NULL, key = TRUE, keysize = 1.5, density.info = c("histogram", "density", "none"), denscol = tracecol, symkey = min(x < 0, na.rm = TRUE), densadj = 0.25, main = NULL, xlab = NULL, ylab = NULL, lmat = NULL, lhei = NULL, lwid = NULL, ...) { scale01 <- function(x, low = min(x), high = max(x)) { x <- (x - low)/(high - low) x } scale <- if (symm && missing(scale)) "none" else match.arg(scale) dendrogram <- match.arg(dendrogram) trace <- match.arg(trace) density.info <- match.argdensity.info) if (!missing(breaks) && (scale != "none")) warning("Using scale=\"row\" or scale=\"column\" when breaks are", "specified can produce unpredictable results.", "Please consider using only one or the other.") if ((Colv == "Rowv") && (!isTRUE(Rowv) || is.null(Rowv))) Colv <- FALSE 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") if (!is.numeric(margins) || length(margins) != 2) stop("`margins' must be a numeric vector of length 2") if (missing(cellnote)) cellnote <- matrix("", ncol = ncol(x), nrow = nrow(x)) if (!inherits(Rowv, "dendrogram")) { if (((!isTRUE(Rowv)) || (is.null(Rowv))) && (dendrogram %in% c("both", "row"))) { if (is.logical(Colv) && (Colv)) dendrogram <- "column" else dedrogram <- "none" warning("Discrepancy: Rowv is FALSE, while dendrogram is `", dendrogram, "'. Omitting row dendogram.") } } if (!inherits(Colv, "dendrogram")) { if (((!isTRUE(Colv)) || (is.null(Colv))) && (dendrogram %in% c("both", "column"))) { if (is.logical(Rowv) && (Rowv)) dendrogram <- "row" else dendrogram <- "none" warning("Discrepancy: Colv is FALSE, while dendrogram is `", dendrogram, "'. Omitting column dendogram.") } } if (inherits(Rowv, "dendrogram")) { ddr <- Rowv rowInd <- order.dendrogram(ddr) } else if (is.integer(Rowv)) { hcr <- hclustfun(distfun(x)) ddr <- as.dendrogram(hcr) ddr <- reorder(ddr, Rowv) rowInd <- order.dendrogram(ddr) if (nr != length(rowInd)) stop("row dendrogram ordering gave index of wrong length") } else if (isTRUE(Rowv)) { Rowv <- rowMeans(x, na.rm = na.rm) hcr <- hclustfun(distfun(x)) ddr <- as.dendrogram(hcr) ddr <- reorder(ddr, Rowv) rowInd <- order.dendrogram(ddr) if (nr != length(rowInd)) stop("row dendrogram ordering gave index of wrong length") } else { rowInd <- nr:1 } if (inherits(Colv, "dendrogram")) { ddc <- Colv colInd <- order.dendrogram(ddc) } else if (identical(Colv, "Rowv")) { if (nr != nc) stop("Colv = \"Rowv\" but nrow(x) != ncol(x)") if (exists("ddr")) { ddc <- ddr colInd <- order.dendrogram(ddc) } else colInd <- rowInd } else if (is.integer(Colv)) { hcc <- hclustfun(distfun(if (symm) x else t(x))) ddc <- as.dendrogram(hcc) ddc <- reorder(ddc, Colv) colInd <- order.dendrogram(ddc) if (nc != length(colInd)) stop("column dendrogram ordering gave index of wrong length") } else if (isTRUE(Colv)) { Colv <- colMeans(x, na.rm = na.rm) hcc <- hclustfun(distfun(if (symm) x else t(x))) ddc <- as.dendrogram(hcc) ddc <- reorder(ddc, Colv) colInd <- order.dendrogram(ddc) if (nc != length(colInd)) stop("column dendrogram ordering gave index of wrong length") } else { colInd <- 1:nc } x <- x[rowInd, colInd] x.unscaled <- x cellnote <- cellnote[rowInd, colInd] if (is.null(labRow)) labRow <- if (is.null(rownames(x))) (1:nr)[rowInd] else rownames(x) else labRow <- labRow[rowInd] if (is.null(labCol)) labCol <- if (is.null(colnames(x))) (1:nc)[colInd] else colnames(x) else labCol <- labCol[colInd] if (scale == "row") { x <- sweep(x, 1, rowMeans(x, na.rm = na.rm)) sx <- apply(x, 1, sd, na.rm = na.rm) x <- sweep(x, 1, sx, "/") } else if (scale == "column") { x <- sweep(x, 2, colMeans(x, na.rm = na.rm)) sx <- apply(x, 2, sd, na.rm = na.rm) x <- sweep(x, 2, sx, "/") } if (missing(breaks) || is.null(breaks) || length(breaks) < 1) if (missing(col)) breaks <- 16 else breaks <- length(col) + 1 if (length(breaks) == 1) { breaks <- seq(min(x, na.rm = na.rm), max(x, na.rm = na.rm), length = breaks) } nbr <- length(breaks) ncol <- length(breaks) - 1 if (class(col) == "function") col <- col(ncol) else if (is.character(col) && length(col) == 1) col <- do.call(col, list(ncol)) min.breaks <- min(breaks) max.breaks <- max(breaks) x[] <- ifelse(x < min.breaks, min.breaks, x) x[] <- ifelse(x > max.breaks, max.breaks, x) if (missing(lhei) || is.null(lhei)) lhei <- c(keysize, 4) if (missing(lwid) || is.null(lwid)) lwid <- c(keysize, 4) if (missing(lmat) || is.null(lmat)) { lmat <- rbind(4:3, 2:1) if (!missing(ColSideColors)) { if (!is.character(ColSideColors) || length(ColSideColors) != nc) stop("'ColSideColors' must be a character vector of length ncol(x)") lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + 1) lhei <- c(lhei[1], 0.2, lhei[2]) } if (!missing(RowSideColors)) { if (!is.character(RowSideColors) || length(RowSideColors) != nr) stop("'RowSideColors' must be a character vector of length nrow(x)") lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - 1), 1), lmat[, 2] + 1) lwid <- c(lwid[1], 0.2, lwid[2]) } lmat[is.na(lmat)] <- 0 } if (length(lhei) != nrow(lmat)) stop("lhei must have length = nrow(lmat) = ", nrow(lmat)) if (length(lwid) != ncol(lmat)) stop("lwid must have length = ncol(lmat) =", ncol(lmat)) op <- par(no.readonly = TRUE) on.exit(par(op)) layout(lmat, widths = lwid, heights = lhei, respect = FALSE) if (!missing(RowSideColors)) { par(mar = c(margins[1], 0, 0, 0.5)) image(rbind(1:nr), col = RowSideColors[rowInd], axes = FALSE) } if (!missing(ColSideColors)) { par(mar = c(0.5, 0, 0, margins[2])) image(cbind(1:nc), col = ColSideColors[colInd], axes = FALSE) } par(mar = c(margins[1], 0, 0, margins[2])) if (!symm || scale != "none") { x <- t(x) cellnote <- t(cellnote) } if (revC) { iy <- nr:1 ddr <- rev(ddr) x <- x[, iy] cellnote <- cellnote[, iy] } else iy <- 1:nr image(1:nc, 1:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 + c(0, nr), axes = FALSE, xlab = "", ylab = "", col = col, breaks = breaks, ...) if (!invalid(na.color) & anyis.na(x))) { mmat <- ifelseis.na(x), 1, NA) image(1:nc, 1:nr, mmat, axes = FALSE, xlab = "", ylab = "", col = na.color, add = TRUE) } axis(1, 1:nc, labels = labCol, las = 2, line = -0.5, tick = 0, cex.axis = cexCol) if (!is.null(xlab)) mtext(xlab, side = 1, line = margins[1] - 1.25) axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = cexRow) if (!is.null(ylab)) mtext(ylab, side = 4, line = margins[2] - 1.25) if (!missing(add.expr)) eval(substitute(add.expr)) if (!missing(colsep)) for (csep in colsep) rect(xleft = csep + 0.5, ybottom = rep(0, length(csep)), xright = csep + 0.5 + sepwidth[1], ytop = rep(ncol(x) + 1, csep), lty = 1, lwd = 1, col = sepcolor, border = sepcolor) if (!missing(rowsep)) for (rsep in rowsep) rect(xleft = 0, ybottom = (ncol(x) + 1 - rsep) - 0.5, xright = nrow(x) + 1, ytop = (ncol(x) + 1 - rsep) - 0.5 - sepwidth[2], lty = 1, lwd = 1, col = sepcolor, border = sepcolor) min.scale <- min(breaks) max.scale <- max(breaks) x.scaled <- scale01(t(x), min.scale, max.scale) if (trace %in% c("both", "column")) { for (i in colInd) { if (!is.null(vline)) { vline.vals <- scale01(vline, min.scale, max.scale) abline(v = i - 0.5 + vline.vals, col = linecol, lty = 2) } xv <- rep(i, nrow(x.scaled)) + x.scaled[, i] - 0.5 xv <- c(xv[1], xv) yv <- 1:length(xv) - 0.5 lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") } } if (trace %in% c("both", "row")) { for (i in rowInd) { if (!is.null(hline)) { hline.vals <- scale01(hline, min.scale, max.scale) abline(h = i + hline, col = linecol, lty = 2) } yv <- rep(i, ncol(x.scaled)) + x.scaled[i, ] - 0.5 yv <- rev(c(yv[1], yv)) xv <- length(yv):1 - 0.5 lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") } } if (!missing(cellnote)) text(x = c(row(cellnote)), y = c(col(cellnote)), labels = c(cellnote), col = notecol, cex = notecex) par(mar = c(margins[1], 0, 0, 0)) if (dendrogram %in% c("both", "row")) { plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none") } else plot.new() par(mar = c(0, 0, if (!is.null(main)) 5 else 0, margins[2])) if (dendrogram %in% c("both", "column")) { plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none") } else plot.new() if (!is.null(main)) title(main, cex.main = 1.5 * op[["cex.main"]]) if (key) { par(mar = c(5, 4, 2, 1), cex = 0.75) if (symkey) { max.raw <- max(abs(x), na.rm = TRUE) min.raw <- -max.raw } else { min.raw <- min(x, na.rm = TRUE) max.raw <- max(x, na.rm = TRUE) } z <- seq(min.raw, max.raw, length = length(col)) image(z = matrix(z, ncol = 1), col = col, breaks = breaks, xaxt = "n", yaxt = "n") par(usr = c(0, 1, 0, 1)) lv <- pretty(breaks) xv <- scale01(as.numeric(lv), min.raw, max.raw) axis(1, at = xv, labels = lv) if (scale == "row") mtext(side = 1, "Row Z-Score", line = 2) else if (scale == "column") mtext(side = 1, "Column Z-Score", line = 2) else mtext(side = 1, "Value", line = 2) if density.info == "density") { dens <- density(x, adjust = densadj, na.rm = TRUE) omit <- dens$x < min(breaks) | dens$x > max(breaks) dens$x <- dens$x[-omit] dens$y <- dens$y[-omit] dens$x <- scale01(dens$x, min.raw, max.raw) lines(dens$x, dens$y/max(dens$y) * 0.95, col = denscol, lwd = 1) axis(2, at = pretty(dens$y)/max(dens$y) * 0.95, pretty(dens$y)) title("Color Key\nand Density Plot") par(cex = 0.5) mtext(side = 2, "Density", line = 2) } else if density.info == "histogram") { h <- hist(x, plot = FALSE, breaks = breaks) hx <- scale01(breaks, min.raw, max.raw) hy <- c(h$counts, h$counts[length(h$counts)]) lines(hx, hy/max(hy) * 0.95, lwd = 1, type = "s", col = denscol) axis(2, at = pretty(hy)/max(hy) * 0.95, pretty(hy)) title("Color Key\nand Histogram") par(cex = 0.5) mtext(side = 2, "Count", line = 2) } else title("Color Key") } else plot.new() invisible(list(rowInd = rowInd, colInd = colInd)) } On Wed, May 28, 2008 at 11:44 AM, carol white <wht_crl@yahoo.com> wrote: Hi, How is it possible to display the row label of a heatmap (either all or a selection of labels for subclusters) at the end of a row dendrogram branches using preferably, heamap.2 or heatmap? Cheers, Carol [[alternative HTML version deleted]] _______________________________________________ Bioconductor mailing list Bioconductor@stat.math.ethz.ch https://stat.ethz.ch/mailman/listinfo/bioconductor Search the archives: http://news.gmane.org/gmane.science.biology.informatics.conductor [[alternative HTML version deleted]]
ADD REPLYlink written 11.5 years ago by carol white680
Carol, What about the RowSideColors argument? This would create a color bar right next to the dendrogram indicating to what group each row came from. Could this help you? On Wed, May 28, 2008 at 4:43 PM, carol white <wht_crl@yahoo.com> wrote: > Thanks for all replies. > > Moreover, is it possible that some of the labels could be displayed > selectively with hclust or plclust? how about displaying labels with > coloring selectively some dendrogram branches? > > I also wanted to use clorder function but couldn't load it. in which > package is it? > > thx > > > *Artur Veloso <abveloso@gmail.com>* wrote: > > Carol, > > I don't know if there is some way in the heatmap.2 function to do so, but > if you change the function a little bit it is possible. All you have to do > is change the following term: > > axis(4, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = > cexRow) > > > to this one: > > > axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0, cex.axis = > cexRow) > > > I already inserted the corrected function in the end of the e-mail to help > you. The problem that you will run into is that now the labels are going to > be colliding with the dendrogram. This can be fixed by changing the > specifications of layout. > > I hope this helps. > > Cheers, > > Artur > > > > heatmap.2 <- function (x, Rowv = TRUE, Colv = if (symm) "Rowv" else TRUE, > distfun = dist, hclustfun = hclust, dendrogram = c("both", > "row", "column", "none"), symm = FALSE, scale = c("none", > "row", "column"), na.rm = TRUE, revC = identical(Colv, > "Rowv"), add.expr, breaks, col = "heat.colors", colsep, > rowsep, sepcolor = "white", sepwidth = c(0.05, 0.05), cellnote, > notecex = 1, notecol = "cyan", na.color = par("bg"), trace = > c("column", > "row", "both", "none"), tracecol = "cyan", hline = median(breaks), > vline = median(breaks), linecol = tracecol, margins = c(5, > 5), ColSideColors, RowSideColors, cexRow = 0.2 + 1/log10(nr), > cexCol = 0.2 + 1/log10(nc), labRow = NULL, labCol = NULL, > key = TRUE, keysize = 1.5, density.info = c("histogram", > "density", "none"), denscol = tracecol, symkey = min(x < > 0, na.rm = TRUE), densadj = 0.25, main = NULL, xlab = NULL, > ylab = NULL, lmat = NULL, lhei = NULL, lwid = NULL, ...) > { > scale01 <- function(x, low = min(x), high = max(x)) { > x <- (x - low)/(high - low) > x > } > scale <- if (symm && missing(scale)) > "none" > else match.arg(scale) > dendrogram <- match.arg(dendrogram) > trace <- match.arg(trace) > density.info <- match.argdensity.info) > if (!missing(breaks) && (scale != "none")) > warning("Using scale=\"row\" or scale=\"column\" when breaks are", > "specified can produce unpredictable results.", "Please > consider using only one or the other.") > if ((Colv == "Rowv") && (!isTRUE(Rowv) || is.null(Rowv))) > Colv <- FALSE > 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") > if (!is.numeric(margins) || length(margins) != 2) > stop("`margins' must be a numeric vector of length 2") > if (missing(cellnote)) > cellnote <- matrix("", ncol = ncol(x), nrow = nrow(x)) > if (!inherits(Rowv, "dendrogram")) { > if (((!isTRUE(Rowv)) || (is.null(Rowv))) && (dendrogram %in% > c("both", "row"))) { > if (is.logical(Colv) && (Colv)) > dendrogram <- "column" > else dedrogram <- "none" > warning("Discrepancy: Rowv is FALSE, while dendrogram is `", > dendrogram, "'. Omitting row dendogram.") > } > } > if (!inherits(Colv, "dendrogram")) { > if (((!isTRUE(Colv)) || (is.null(Colv))) && (dendrogram %in% > c("both", "column"))) { > if (is.logical(Rowv) && (Rowv)) > dendrogram <- "row" > else dendrogram <- "none" > warning("Discrepancy: Colv is FALSE, while dendrogram is `", > dendrogram, "'. Omitting column dendogram.") > } > } > if (inherits(Rowv, "dendrogram")) { > ddr <- Rowv > rowInd <- order.dendrogram(ddr) > } > else if (is.integer(Rowv)) { > hcr <- hclustfun(distfun(x)) > ddr <- as.dendrogram(hcr) > ddr <- reorder(ddr, Rowv) > rowInd <- order.dendrogram(ddr) > if (nr != length(rowInd)) > stop("row dendrogram ordering gave index of wrong length") > } > else if (isTRUE(Rowv)) { > Rowv <- rowMeans(x, na.rm = na.rm) > hcr <- hclustfun(distfun(x)) > ddr <- as.dendrogram(hcr) > ddr <- reorder(ddr, Rowv) > rowInd <- order.dendrogram(ddr) > if (nr != length(rowInd)) > stop("row dendrogram ordering gave index of wrong length") > } > else { > rowInd <- nr:1 > } > if (inherits(Colv, "dendrogram")) { > ddc <- Colv > colInd <- order.dendrogram(ddc) > } > else if (identical(Colv, "Rowv")) { > if (nr != nc) > stop("Colv = \"Rowv\" but nrow(x) != ncol(x)") > if (exists("ddr")) { > ddc <- ddr > colInd <- order.dendrogram(ddc) > } > else colInd <- rowInd > } > else if (is.integer(Colv)) { > hcc <- hclustfun(distfun(if (symm) > x > else t(x))) > ddc <- as.dendrogram(hcc) > ddc <- reorder(ddc, Colv) > colInd <- order.dendrogram(ddc) > if (nc != length(colInd)) > stop("column dendrogram ordering gave index of wrong length") > } > else if (isTRUE(Colv)) { > Colv <- colMeans(x, na.rm = na.rm) > hcc <- hclustfun(distfun(if (symm) > x > else t(x))) > ddc <- as.dendrogram(hcc) > ddc <- reorder(ddc, Colv) > colInd <- order.dendrogram(ddc) > if (nc != length(colInd)) > stop("column dendrogram ordering gave index of wrong length") > } > else { > colInd <- 1:nc > } > x <- x[rowInd, colInd] > x.unscaled <- x > cellnote <- cellnote[rowInd, colInd] > if (is.null(labRow)) > labRow <- if (is.null(rownames(x))) > (1:nr)[rowInd] > else rownames(x) > else labRow <- labRow[rowInd] > if (is.null(labCol)) > labCol <- if (is.null(colnames(x))) > (1:nc)[colInd] > else colnames(x) > else labCol <- labCol[colInd] > if (scale == "row") { > x <- sweep(x, 1, rowMeans(x, na.rm = na.rm)) > sx <- apply(x, 1, sd, na.rm = na.rm) > x <- sweep(x, 1, sx, "/") > } > else if (scale == "column") { > x <- sweep(x, 2, colMeans(x, na.rm = na.rm)) > sx <- apply(x, 2, sd, na.rm = na.rm) > x <- sweep(x, 2, sx, "/") > } > if (missing(breaks) || is.null(breaks) || length(breaks) < > 1) > if (missing(col)) > breaks <- 16 > else breaks <- length(col) + 1 > if (length(breaks) == 1) { > breaks <- seq(min(x, na.rm = na.rm), max(x, na.rm = na.rm), > length = breaks) > } > nbr <- length(breaks) > ncol <- length(breaks) - 1 > if (class(col) == "function") > col <- col(ncol) > else if (is.character(col) && length(col) == 1) > col <- do.call(col, list(ncol)) > min.breaks <- min(breaks) > max.breaks <- max(breaks) > x[] <- ifelse(x < min.breaks, min.breaks, x) > x[] <- ifelse(x > max.breaks, max.breaks, x) > if (missing(lhei) || is.null(lhei)) > lhei <- c(keysize, 4) > if (missing(lwid) || is.null(lwid)) > lwid <- c(keysize, 4) > if (missing(lmat) || is.null(lmat)) { > lmat <- rbind(4:3, 2:1) > if (!missing(ColSideColors)) { > if (!is.character(ColSideColors) || length(ColSideColors) != > nc) > stop("'ColSideColors' must be a character vector of length > ncol(x)") > lmat <- rbind(lmat[1, ] + 1, c(NA, 1), lmat[2, ] + > 1) > lhei <- c(lhei[1], 0.2, lhei[2]) > } > if (!missing(RowSideColors)) { > if (!is.character(RowSideColors) || length(RowSideColors) != > nr) > stop("'RowSideColors' must be a character vector of length > nrow(x)") > lmat <- cbind(lmat[, 1] + 1, c(rep(NA, nrow(lmat) - > 1), 1), lmat[, 2] + 1) > lwid <- c(lwid[1], 0.2, lwid[2]) > } > lmat[is.na(lmat)] <- 0 > } > if (length(lhei) != nrow(lmat)) > stop("lhei must have length = nrow(lmat) = ", nrow(lmat)) > if (length(lwid) != ncol(lmat)) > stop("lwid must have length = ncol(lmat) =", ncol(lmat)) > op <- par(no.readonly = TRUE) > on.exit(par(op)) > layout(lmat, widths = lwid, heights = lhei, respect = FALSE) > if (!missing(RowSideColors)) { > par(mar = c(margins[1], 0, 0, 0.5)) > image(rbind(1:nr), col = RowSideColors[rowInd], axes = FALSE) > } > if (!missing(ColSideColors)) { > par(mar = c(0.5, 0, 0, margins[2])) > image(cbind(1:nc), col = ColSideColors[colInd], axes = FALSE) > } > par(mar = c(margins[1], 0, 0, margins[2])) > if (!symm || scale != "none") { > x <- t(x) > cellnote <- t(cellnote) > } > if (revC) { > iy <- nr:1 > ddr <- rev(ddr) > x <- x[, iy] > cellnote <- cellnote[, iy] > } > else iy <- 1:nr > image(1:nc, 1:nr, x, xlim = 0.5 + c(0, nc), ylim = 0.5 + > c(0, nr), axes = FALSE, xlab = "", ylab = "", col = col, > breaks = breaks, ...) > if (!invalid(na.color) & anyis.na(x))) { > mmat <- ifelseis.na(x), 1, NA) > image(1:nc, 1:nr, mmat, axes = FALSE, xlab = "", ylab = "", > col = na.color, add = TRUE) > } > axis(1, 1:nc, labels = labCol, las = 2, line = -0.5, tick = 0, > cex.axis = cexCol) > if (!is.null(xlab)) > mtext(xlab, side = 1, line = margins[1] - 1.25) > axis(2, iy, labels = labRow, las = 2, line = -0.5, tick = 0, > cex.axis = cexRow) > if (!is.null(ylab)) > mtext(ylab, side = 4, line = margins[2] - 1.25) > if (!missing(add.expr)) > eval(substitute(add.expr)) > if (!missing(colsep)) > for (csep in colsep) rect(xleft = csep + 0.5, ybottom = rep(0, > length(csep)), xright = csep + 0.5 + sepwidth[1], > ytop = rep(ncol(x) + 1, csep), lty = 1, lwd = 1, > col = sepcolor, border = sepcolor) > if (!missing(rowsep)) > for (rsep in rowsep) rect(xleft = 0, ybottom = (ncol(x) + > 1 - rsep) - 0.5, xright = nrow(x) + 1, ytop = (ncol(x) + > 1 - rsep) - 0.5 - sepwidth[2], lty = 1, lwd = 1, > col = sepcolor, border = sepcolor) > min.scale <- min(breaks) > max.scale <- max(breaks) > x.scaled <- scale01(t(x), min.scale, max.scale) > if (trace %in% c("both", "column")) { > for (i in colInd) { > if (!is.null(vline)) { > vline.vals <- scale01(vline, min.scale, max.scale) > abline(v = i - 0.5 + vline.vals, col = linecol, > lty = 2) > } > xv <- rep(i, nrow(x.scaled)) + x.scaled[, i] - 0.5 > xv <- c(xv[1], xv) > yv <- 1:length(xv) - 0.5 > lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") > } > } > if (trace %in% c("both", "row")) { > for (i in rowInd) { > if (!is.null(hline)) { > hline.vals <- scale01(hline, min.scale, max.scale) > abline(h = i + hline, col = linecol, lty = 2) > } > yv <- rep(i, ncol(x.scaled)) + x.scaled[i, ] - 0.5 > yv <- rev(c(yv[1], yv)) > xv <- length(yv):1 - 0.5 > lines(x = xv, y = yv, lwd = 1, col = tracecol, type = "s") > } > } > if (!missing(cellnote)) > text(x = c(row(cellnote)), y = c(col(cellnote)), labels = > c(cellnote), > col = notecol, cex = notecex) > par(mar = c(margins[1], 0, 0, 0)) > if (dendrogram %in% c("both", "row")) { > plot(ddr, horiz = TRUE, axes = FALSE, yaxs = "i", leaflab = "none") > } > else plot.new() > par(mar = c(0, 0, if (!is.null(main)) 5 else 0, margins[2])) > if (dendrogram %in% c("both", "column")) { > plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none") > } > else plot.new() > if (!is.null(main)) > title(main, cex.main = 1.5 * op[["cex.main"]]) > if (key) { > par(mar = c(5, 4, 2, 1), cex = 0.75) > if (symkey) { > max.raw <- max(abs(x), na.rm = TRUE) > min.raw <- -max.raw > } > else { > min.raw <- min(x, na.rm = TRUE) > max.raw <- max(x, na.rm = TRUE) > } > z <- seq(min.raw, max.raw, length = length(col)) > image(z = matrix(z, ncol = 1), col = col, breaks = breaks, > xaxt = "n", yaxt = "n") > par(usr = c(0, 1, 0, 1)) > lv <- pretty(breaks) > xv <- scale01(as.numeric(lv), min.raw, max.raw) > axis(1, at = xv, labels = lv) > if (scale == "row") > mtext(side = 1, "Row Z-Score", line = 2) > else if (scale == "column") > mtext(side = 1, "Column Z-Score", line = 2) > else mtext(side = 1, "Value", line = 2) > if density.info == "density") { > dens <- density(x, adjust = densadj, na.rm = TRUE) > omit <- dens$x < min(breaks) | dens$x > max(breaks) > dens$x <- dens$x[-omit] > dens$y <- dens$y[-omit] > dens$x <- scale01(dens$x, min.raw, max.raw) > lines(dens$x, dens$y/max(dens$y) * 0.95, col = denscol, > lwd = 1) > axis(2, at = pretty(dens$y)/max(dens$y) * 0.95, pretty(dens$y)) > title("Color Key\nand Density Plot") > par(cex = 0.5) > mtext(side = 2, "Density", line = 2) > } > else if density.info == "histogram") { > h <- hist(x, plot = FALSE, breaks = breaks) > hx <- scale01(breaks, min.raw, max.raw) > hy <- c(h$counts, h$counts[length(h$counts)]) > lines(hx, hy/max(hy) * 0.95, lwd = 1, type = "s", > col = denscol) > axis(2, at = pretty(hy)/max(hy) * 0.95, pretty(hy)) > title("Color Key\nand Histogram") > par(cex = 0.5) > mtext(side = 2, "Count", line = 2) > } > else title("Color Key") > } > else plot.new() > invisible(list(rowInd = rowInd, colInd = colInd)) > } > > > On Wed, May 28, 2008 at 11:44 AM, carol white <wht_crl@yahoo.com> wrote: > >> Hi, >> How is it possible to display the row label of a heatmap (either all or a >> selection of labels for subclusters) at the end of a row dendrogram branches >> using preferably, heamap.2 or heatmap? >> >> Cheers, >> >> Carol >> >> >> [[alternative HTML version deleted]] >> >> _______________________________________________ >> Bioconductor mailing list >> Bioconductor@stat.math.ethz.ch >> https://stat.ethz.ch/mailman/listinfo/bioconductor >> Search the archives: >> http://news.gmane.org/gmane.science.biology.informatics.conductor >> > > > [[alternative HTML version deleted]]
ADD REPLYlink written 11.5 years ago by Artur Veloso340
Please log in to add an answer.

Help
Access

Use of this site constitutes acceptance of our User Agreement and Privacy Policy.
Powered by Biostar version 16.09
Traffic: 350 users visited in the last hour