moewarangel
commented
8 months ago Open moewarangel opened 8 months ago
moewarangel
commented
8 months ago moewarangel
commented
8 months ago function (x, diss = inherits(x, "dist"), Rowv = TRUE, Colv = TRUE,
dendrogram = c("both", "row", "column", "none"), dist.row,
dist.col, dist.FUN = gdist, dist.FUN.MoreArgs = list(method = "euclidean"),
hclust.row, hclust.col, hclust.FUN = hclust, hclust.FUN.MoreArgs = list(method = "ward.D"),
scale = c("none", "row", "column"), na.rm = TRUE, cluster.by.row = FALSE,
cluster.by.col = FALSE, kr = NA, kc = NA, row.clusters = NA,
col.clusters = NA, revR = FALSE, revC = FALSE, add.expr,
breaks, gene_position_breaks = NULL, x.center, color.FUN = gplots::bluered,
sepList = list(NULL, NULL), sep.color = c("gray45", "gray45"),
sep.lty = 1, sep.lwd = 2, cellnote, cex.note = 1, notecol = "cyan",
na.color = par("bg"), trace = c("none", "column", "row",
"both"), tracecol = "cyan", hline, vline, linecol = tracecol,
labRow = TRUE, labCol = TRUE, srtRow = NULL, srtCol = NULL,
sideRow = 4, sideCol = 1, margin.for.labRow, margin.for.labCol,
ColIndividualColors, RowIndividualColors, annotations_legend,
grouping_key_coln, cexRow, cexCol, cexAt = NULL, labRow.by.group = FALSE,
labCol.by.group = FALSE, key = TRUE, key.title = "Color Key",
key.xlab = "Value", key.ylab = "Count", keysize = 1.5, mapsize = 9,
mapratio = 4/3, sidesize = 3, cex.key.main = 0.75, cex.key.xlab = 0.75,
cex.key.ylab = 0.75, density.info = c("histogram", "density",
"none"), denscol = tracecol, densadj = 0.25, main = "Heatmap",
sub = "", xlab = "", ylab = "", cex.main = 2, cex.sub = 1.5,
font.main = 2, font.sub = 3, adj.main = 0.5, mgp.main = c(1.5,
0.5, 0), mar.main = 3, mar.sub = 3, if.plot = TRUE,
plot.row.partition = FALSE, plot.col.partition = FALSE,
cex.partition = 1.25, color.partition.box = "gray45", color.partition.border = "#FFFFFF",
plot.row.individuals = FALSE, plot.col.individuals = FALSE,
plot.row.clusters = FALSE, plot.col.clusters = FALSE, plot.row.clustering = FALSE,
plot.col.clustering = FALSE, plot.row.individuals.list = FALSE,
plot.col.individuals.list = FALSE, plot.row.clusters.list = FALSE,
plot.col.clusters.list = FALSE, plot.row.clustering.list = FALSE,
plot.col.clustering.list = FALSE, row.data = FALSE, col.data = FALSE,
if.plot.info = FALSE, text.box, cex.text = 1, force_lmat = NULL,
force_lwid = NULL, force_lhei = NULL, force_add = FALSE,
useRaster = TRUE, ...)
{
if (!is.matrix(x)) {
x <- as.matrix(x)
}
x.ori <- x
if (!inherits(x, "dist") & !is.matrix(x)) {
stop("x' should either be a matrix, a data.frame or adist' object.")
}
if (!sideRow %in% c(2, 4)) {
stop("sideRow must be either 2 or 4.")
}
if (!sideCol %in% c(1, 3)) {
stop("sideCol must be either 1 or 3.")
}
Rowv.ori <- Rowv
Colv.ori <- Colv
dendrogram <- match.arg(dendrogram)
if ((dendrogram %in% c("both", "row")) & !inherits(Rowv,
"dendrogram")) {
warning("Discrepancy: row dendrogram is asked; Rowv is set to TRUE'.") Rowv <- TRUE } if ((dendrogram %in% c("both", "col")) & !inherits(Colv, "dendrogram")) { warning("Discrepancy: col dendrogram is asked; Colv is set toTRUE'.")
Colv <- TRUE
}
if (identical(Rowv, FALSE) | missing(Rowv)) {
if (!identical(cluster.by.row, FALSE)) {
warning("Discrepancy: No row dendrogram is asked; cluster.by.row is set to FALSE'.") cluster.by.row <- FALSE } } else { if (!identical(cluster.by.row, TRUE)) { warning("Discrepancy: row dendrogram is asked; cluster.by.row is set toTRUE'.")
cluster.by.row <- TRUE
}
}
if (identical(Colv, FALSE) | .invalid(Colv)) {
if (!identical(cluster.by.col, FALSE)) {
warning("Discrepancy: No col dendrogram is asked; cluster.by.col is set to FALSE'.") cluster.by.col <- FALSE } } else { if (!identical(cluster.by.col, TRUE)) { warning("Discrepancy: col dendrogram is asked; cluster.by.col is set toTRUE'.")
cluster.by.col <- TRUE
}
}
if (!.invalid(kr)) {
if (is.numeric(kr)) {
if (!plot.row.partition) {
warning("Discrepancy: kr is set, therefore plot.row.partition is set to TRUE'.") plot.row.partition <- TRUE } } } if (!.invalid(kc)) { if (is.numeric(kc)) { if (!plot.col.partition) { warning("Discrepancy: kc is set, therefore plot.col.partition is set toTRUE'.")
plot.col.partition <- TRUE
}
}
}
symm <- isSymmetric(x)
di <- dim(x)
if (length(di) != 2 || !is.numeric(x)) {
stop("x' should only containnumeric' values and can be converted to a 2-D matrix.")
}
scale <- if (symm && .invalid(scale))
"none"
else match.arg(scale)
trace <- match.arg(trace)
density.info <- match.arg(density.info)
dist.FUN <- match.fun(dist.FUN)
hclust.FUN <- match.fun(hclust.FUN)
color.FUN <- match.fun(color.FUN)
if (!.invalid(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.")
}
nr <- di[1]
nc <- di[2]
if (nr <= 1 || nc <= 1)
stop("x' must have at least 2 rows and 2 columns") cexRow0 <- 0.2 + 1/log10(nr) cexCol0 <- 0.2 + 1/log10(nc) if (.invalid(cexRow)) { cexRow <- cexRow0 } else { cexRow <- cexRow0 * cexRow } if (.invalid(cexCol)) { cexCol <- cexCol0 } else { cexCol <- cexCol0 * cexCol } if (missing(Rowv)) Rowv <- FALSE if (.invalid(Colv)) Colv <- if (symm) Rowv else FALSE if (Colv == "Rowv") { if ((!isTRUE(Rowv) | !symm)) { Colv <- FALSE warning("Colv' is specified to use \"Rowv\", but either Rowv' is invalid orx' is not symmetric; Colv is suppressed.")
}
else {
Colv <- Rowv
}
}
flush.console()
if (!inherits(Colv, "dendrogram") & !identical(Colv, FALSE) |
(cluster.by.col & .invalid(col.clusters))) {
if (.invalid(hclust.col)) {
hclust.col <- .call.FUN(hclust.FUN, dist.col, MoreArgs = hclust.FUN.MoreArgs)
}
else {
if (length(hclust.col$order) != nc) {
stop("hclust.col' should have equal size as the cols.") } } } else { hclust.col <- NULL } ddr <- ddc <- NULL if (inherits(Rowv, "dendrogram")) { if (attr(Rowv, "members") != nr) { stop("Rowv' should contain equal size of members as the rows.")
}
ddr <- Rowv
rowInd <- seq_len(nr)
}
else {
rowInd <- nr:1
}
if (inherits(Colv, "dendrogram")) {
if (attr(Colv, "members") != nc) {
stop("Colv' should contain equal size of members as the cols.") } ddc <- Colv colInd <- order.dendrogram(ddc) } else if (identical(Colv, "Rowv")) { if (exists("ddr")) { ddc <- ddr colInd <- order.dendrogram(ddc) } else { colInd <- rowInd } } else if (is.integer(Colv)) { ddc <- as.dendrogram(hclust.col) ddc <- reorder(ddc, Colv) colInd <- order.dendrogram(ddc) if (nc != length(colInd)) { stop("colInd' is of wrong length.")
}
}
else if (isTRUE(Colv)) {
Colv <- colMeans(x, na.rm = TRUE)
ddc <- as.dendrogram(hclust.col)
ddc <- reorder(ddc, Colv)
colInd <- order.dendrogram(ddc)
if (nc != length(colInd))
stop("colInd' is of wrong length.") } else { colInd <- seq_len(nc) } if (is.null(ddr) & (dendrogram %in% c("both", "row"))) { warning("Discrepancy: Rowv is invalid or FALSE, while dendrogram is",
dendrogram, "'. Omitting row dendogram.")
if (is.logical(Colv) & (Colv.ori) & dendrogram == "both") {
dendrogram <- "column"
}
else {
dendrogram <- "none"
}
}
if (is.null(ddc) & (dendrogram %in% c("both", "column"))) {
warning("Discrepancy: Colv is invalid or FALSE, while dendrogram is ", dendrogram, "'. Omitting column dendogram.") if (is.logical(Rowv) & (identical(Rowv.ori, TRUE) | is.numeric(Rowv.ori) | inherits(Rowv.ori, "dendrogram")) & dendrogram == "both") { dendrogram <- "row" } else { dendrogram <- "none" } } if (is.null(ddr)) { if (isTRUE(cluster.by.row) | isTRUE(plot.row.partition) | isTRUE(plot.row.clusters) | isTRUE(plot.row.clustering)) { warning("Using invalidRowv' while allowing", "cluster.by.row' orplot.row.partition' or plot.row.clusters' orplot.row.clustering'",
"can produce unpredictable results; Forced to be disabled.")
}
}
if (is.null(ddc)) {
if (isTRUE(cluster.by.col) | isTRUE(plot.col.partition) |
isTRUE(plot.col.clusters) | isTRUE(plot.col.clustering)) {
warning("Using invalid Colv' while allowing", "cluster.by.col' or plot.col.partition' orplot.col.clusters' or plot.col.clustering'", "can produce unpredictable results; Forced to be disabled.") } } if (is.null(ddr)) cluster.by.row <- plot.row.partition <- plot.row.clusters <- plot.row.clustering <- FALSE if (is.null(ddc)) cluster.by.col <- plot.col.partition <- plot.col.clusters <- plot.col.clustering <- FALSE flush.console() x <- x[rowInd, colInd, drop = FALSE] if (!.invalid(cellnote)) { cellnote <- cellnote[rowInd, colInd, drop = FALSE] } if (identical(labRow, TRUE)) { labRow <- if (is.null(rownames(x))) (seq_len(nr))[rowInd] else rownames(x) } else if (identical(labRow, FALSE) | .invalid(labRow)) { labRow <- rep("", nrow(x)) } else if (is.character(labRow)) { labRow <- labRow[rowInd] } if (identical(labCol, TRUE)) { labCol <- if (is.null(colnames(x))) (seq_len(nc))[colInd] else colnames(x) } else if (identical(labCol, FALSE) | .invalid(labCol)) { labCol <- rep("", ncol(x)) } flush.console() x <- .scale.data(x, scale, na.rm) margin.for.labRow0 <- max(nchar(labRow, keepNA = FALSE)) * 0.75 + 0.2 margin.for.labCol0 <- max(nchar(labCol, keepNA = FALSE)) * 0.75 + 0.2 if (.invalid(margin.for.labRow)) { margin.for.labRow <- margin.for.labRow0 } if (margin.for.labRow < 2) { margin.for.labRow <- 2 } margin.for.labCol <- margin.for.labCol0 if (margin.for.labCol < 2) { margin.for.labCol <- 2 } if (!.invalid(labRow.by.group) & !identical(labRow.by.group, FALSE)) { group.value <- unique(labRow) group.index <- sapply(group.value, function(x, y) min(which(y == x)), y = labRow) labRow <- rep("", length(labRow)) labRow[group.index] <- group.value } if (!.invalid(labCol.by.group) & !identical(labCol.by.group, FALSE)) { group.value <- unique(labCol) group.index <- sapply(group.value, function(x, y) min(which(y == x)), y = labCol) labCol <- rep("", length(labCol)) labCol[group.index] <- group.value } flush.console() if (.invalid(breaks)) { breaks <- 16 } else { flog.debug(paste("inferCNV::heatmap.cnv, breaks parameter set to: [", paste(breaks, collapse = ","), "]", sep = "")) } if (!.invalid(x.center)) { if (is.numeric(x.center)) { x.range.old <- range(x, na.rm = TRUE) if (length(breaks) > 1) { x.range.old = range(breaks) } dist.to.x.center <- max(abs(x.range.old - x.center)) x.range <- c(x.center - dist.to.x.center, x.center + dist.to.x.center) if (length(breaks) > 1) { breaks = seq(x.range[1], x.range[2], length = 16) flog.debug(paste("inferCNV::heatmap.cnv, resetting breaks to adjusted x.range: [", paste(breaks, collapse = ","), "]", sep = "")) } } else { stop("x.center' should be numeric.")
}
}
else {
x.range <- range(x, na.rm = TRUE)
if (length(breaks) > 1) {
x.range = range(breaks)
}
}
flog.debug(paste("inferCNV::heatmap.cnv x range set to: ",
paste(x.range, collapse = ",")), sep = "")
if (length(breaks) == 1) {
breaks <- seq(min(min(x, na.rm = TRUE), x.range[1]),
max(max(x, na.rm = TRUE), x.range[2]), length.out = breaks)
}
nbr <- length(breaks)
ncolor <- length(breaks) - 1
colors <- color.FUN(ncolor)
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 (if.plot) {
ir <- length(plot.row.individuals.list)
ic <- length(plot.col.individuals.list)
cr <- length(plot.row.clustering.list)
cc <- length(plot.col.clustering.list)
flush.console()
if (mapratio <= 1) {
sr <- 12
sc <- sr mapratio
}
else {
sc <- 12
sr <- sc/mapratio
}
lmat <- matrix(1, nrow = sr, ncol = sc)
lwid <- c(rep(mapsize/sc, sc))
lhei <- c(rep(mapsize/mapratio/sr, sr))
if (plot.row.partition | plot.row.clusters) {
lmat <- cbind(max(lmat, na.rm = TRUE) + 1, lmat)
lwid <- c(0.3, lwid)
}
else {
lmat <- cbind(NA, lmat)
lwid <- c(0.02, lwid)
}
if (plot.col.partition | plot.col.clusters) {
lmat <- rbind(c(NA, rep(max(lmat, na.rm = TRUE) +
1, sc)), lmat)
lhei <- c(0.3/mapratio, lhei)
}
else {
lmat <- rbind(NA, lmat)
lhei <- c(0.02/mapratio, lhei)
}
if (!.invalid(RowIndividualColors)) {
if (!is.character(RowIndividualColors) || dim(RowIndividualColors)[1] !=
nr) {
stop("'RowIndividualColors' must be a character vector of length nrow(x)")
}
lmat <- cbind(c(rep(NA, nrow(lmat) - sr), rep(max(lmat,
na.rm = TRUE) + 1, sr)), lmat)
lwid <- c(0.2, lwid)
lmat <- cbind(c(rep(NA, nrow(lmat) - sr), rep(max(lmat,
na.rm = TRUE) + 1, sr)), lmat)
lwid <- c(0.2, lwid)
}
else {
lmat <- cbind(NA, lmat)
lwid <- c(0.02, lwid)
}
if (!.invalid(ColIndividualColors)) {
if (!is.character(ColIndividualColors) || length(ColIndividualColors) !=
nc) {
stop("'ColIndividualColors' must be a character vector of length ncol(x)")
}
lmat <- rbind(c(rep(NA, ncol(lmat) - sc), rep(max(lmat,
na.rm = TRUE) + 1, sc)), lmat)
lhei <- c(0.2/mapratio, lhei)
}
else {
lmat <- rbind(NA, lmat)
lhei <- c(0.02/mapratio, lhei)
}
lmat <- cbind(c(rep(NA, nrow(lmat) - sr), rep(max(lmat,
na.rm = TRUE) + 1, sr)), lmat)
lwid <- c(keysize, lwid)
lmat <- rbind(c(max(lmat, na.rm = TRUE) + 2, rep(NA,
ncol(lmat) - sc - 1), rep(max(lmat, na.rm = TRUE) +
1, sc)), lmat)
lhei <- c(keysize/mapratio, lhei)
if (.invalid(text.box)) {
text.box <- "made by\nFunction: heatmap.3\nPackage: GMD\nin R"
}
if (plot.row.individuals) {
lmat <- cbind(lmat, c(rep((1 + max(lmat, na.rm = TRUE)),
nrow(lmat) - sr), rep((ir:1) + max(lmat, na.rm = TRUE) +
(1), each = floor(sr/ir)), rep(NA, sr%%ir)))
lwid <- c(lwid, sidesize)
}
else {
lmat <- cbind(lmat, c(rep(NA, nrow(lmat))))
lwid <- c(lwid, 0.01)
}
if (plot.col.individuals) {
lmat <- rbind(lmat, c(rep((1 + max(lmat, na.rm = TRUE)),
ncol(lmat) - sc - 1), rep((seq_len(ic)) + max(lmat,
na.rm = TRUE) + (1), each = floor(sc/ic)), rep(NA,
sc%%ic), 999))
lhei <- c(lhei, sidesize/mapratio)
}
else {
lmat <- rbind(lmat, c(rep(NA, ncol(lmat))))
lhei <- c(lhei, 0.01/mapratio)
}
if (plot.row.clusters) {
lmat <- cbind(lmat, c(rep((1 + max(lmat[lmat !=
999], na.rm = TRUE)), nrow(lmat) - sr - 1),
rep((kr:1) + max(lmat[lmat != 999], na.rm = TRUE) +
(1), each = floor(sr/kr)), rep(NA, sr%%kr),
999))
lwid <- c(lwid, sidesize)
}
else {
lmat <- cbind(lmat, c(rep(NA, nrow(lmat))))
lwid <- c(lwid, 0.01)
}
if (plot.col.clusters) {
lmat <- rbind(lmat, c(rep((1 + max(lmat[lmat !=
999], na.rm = TRUE)), ncol(lmat) - sc - 2),
rep((seq_len(kc)) + max(lmat[lmat != 999], na.rm = TRUE) +
(1), each = floor(sc/kc)), rep(NA, sc%%kc),
999, 999))
lhei <- c(lhei, sidesize/mapratio)
}
else {
lmat <- rbind(lmat, c(rep(NA, ncol(lmat))))
lhei <- c(lhei, 0.01/mapratio)
}
if (plot.row.clustering) {
lmat <- cbind(lmat, c(rep((1 + max(lmat[lmat !=
999], na.rm = TRUE)), nrow(lmat) - sr - 2),
rep(c((cr:1) + max(lmat[lmat != 999], na.rm = TRUE) +
(1)), each = floor(sr/cr)), rep(NA, sr%%cr),
999, 999))
lwid <- c(lwid, sidesize)
}
else {
lmat <- cbind(lmat, c(rep(NA, nrow(lmat))))
lwid <- c(lwid, 0.01)
}
if (plot.col.clustering) {
lmat <- rbind(lmat, c(rep((1 + max(lmat[lmat !=
999], na.rm = TRUE)), ncol(lmat) - sc - 3),
rep((seq_len(cc)) + max(lmat[lmat != 999], na.rm = TRUE) +
(1), each = floor(sc/cc)), rep(NA, sc%%cc),
999, 999, 999))
lhei <- c(lhei, sidesize/mapratio)
}
else {
lmat <- rbind(lmat, c(rep(NA, ncol(lmat))))
lhei <- c(lhei, 0.01/mapratio)
}
lmat[is.na(lmat)] <- 0
if (any(lmat == 999)) {
flag.text <- TRUE
}
else {
flag.text <- FALSE
}
lmat[lmat == 999] <- max(lmat[lmat != 999]) + 1
if (!is.null(force_lmat)) {
lmat <- force_lmat
}
if (!is.null(force_lwid)) {
lwid <- force_lwid
}
if (!is.null(force_lhei)) {
lhei <- force_lhei
}
if (!force_add) {
layout(lmat, widths = lwid, heights = lhei, respect = FALSE)
}
if (revC) {
iy <- nr:1
ddc <- rev(ddc)
x <- x[iy, ]
if (!.invalid(cellnote)) {
cellnote <- cellnote[iy, ]
}
}
else {
iy <- seq_len(nr)
}
if (revR) {
ix <- nc:1
ddr <- rev(ddr)
x <- x[, ix]
if (!.invalid(cellnote)) {
cellnote <- cellnote[, ix]
}
}
else {
ix <- seq_len(nc)
}
margins <- c(margin.for.labCol, 0, 0, margin.for.labRow)
mgp <- c(3, 1, 0)
par(mar = margins, mgp = mgp)
outer = FALSE
x.save <- x
if (!symm || scale != "none") {
x <- t(x)
if (!.invalid(cellnote)) {
cellnote <- t(cellnote)
}
}
if (!is.null(gene_position_breaks)) {
image(gene_position_breaks, seq_len(nr + 1), x,
axes = FALSE, xlab = "", ylab = "", col = colors,
breaks = breaks, useRaster = FALSE, ...)
}
else {
image(seq_len(nc), seq_len(nr), x, axes = FALSE,
xlab = "", ylab = "", col = colors, breaks = breaks,
useRaster = useRaster, ...)
}
flog.info(paste("Colors for breaks: ", paste(colors,
collapse = ","), sep = " "))
flog.info(paste("Quantiles of plotted data range:",
paste(quantile(x), collapse = ","), sep = " "))
if (!.invalid(na.color) & any(is.na(x))) {
mmat <- ifelse(is.na(x), 1, NA)
if (!is.null(gene_position_breaks)) {
image(gene_position_breaks, seq_len(nr + 1),
mmat, axes = FALSE, xlab = "", ylab = "",
col = na.color, add = TRUE, useRaster = FALSE)
}
else {
image(seq_len(nc), seq_len(nr), mmat, axes = FALSE,
xlab = "", ylab = "", col = na.color, add = TRUE,
useRaster = useRaster)
}
}
if ((dendrogram %in% c("both", "col")) & sideCol ==
3) {
warning("Discrepancy: col dendrogram is asked; srtCol is set to 1.")
sideCol <- 1
}
if (!length(srtCol)) {
if (is.null(cexAt)) {
cexAt = seq_along(labCol)
}
axis(sideCol, cexAt, labels = labCol, las = 2, line = -0.5,
tick = 0, cex.axis = cexCol, outer = outer)
}
else {
if (sideCol == 1) {
if (sideCol == 1)
.sideCol <- par("usr")[3] - 0.5 srtCol/90
else .sideCol <- par("usr")[4] + 0.5 srtCol/90
text(seq_len(nc), .sideCol, labels = labCol,
srt = srtCol, pos = 1, xpd = TRUE, cex = cexCol)
}
}
if (!.invalid(xlab)) {
mtext(xlab, side = 1, line = margins[1] - 1.25)
}
if ((dendrogram %in% c("both", "row")) & sideRow ==
2) {
warning("Discrepancy: row dendrogram is asked; sideRow is set to 4.")
sideRow <- 4
}
if (!length(srtRow)) {
axis(sideRow, iy, labels = labRow, las = 2, line = -0.5,
tick = 0, cex.axis = cexRow, outer = outer)
}
else {
if (sideRow == 4) {
if (sideRow == 4)
.sideRow <- par("usr")[2] + 0.5 srtRow/90
else .sideRow <- par("usr")[1] - 0.5 srtRow/90
text(.sideRow, iy, labels = labRow, srt = srtRow,
pos = 1, xpd = TRUE, cex = cexRow)
}
}
if (!.invalid(ylab))
mtext(ylab, side = 4, line = margins[4] - 1.25)
if (!.invalid(add.expr))
eval(substitute(add.expr))
if (plot.row.partition | plot.row.clusters) {
plot.row.partitionList <- get.sep(clusters = row.clusters,
type = "row")
}
else {
plot.row.partitionList <- NULL
}
if (plot.col.partition | plot.col.clusters) {
plot.col.partitionList <- get.sep(clusters = col.clusters,
type = "column")
}
else {
plot.col.partitionList <- NULL
}
row.sepList <- sepList[[1]]
if (!.invalid(row.sepList)) {
for (i in seq_along(row.sepList)) {
i.sep <- row.sepList[[i]]
rect(xleft = i.sep[1] + 0.5, ybottom = i.sep[2] +
0.5, xright = i.sep[3] + 0.5, ytop = i.sep[4] +
0.5, lty = sep.lty, lwd = sep.lwd, col = FALSE,
border = sep.color[1])
}
}
col.sepList <- sepList[[2]]
if (!.invalid(col.sepList)) {
for (i in seq_along(col.sepList)) {
i.sep <- col.sepList[[i]]
rect(xleft = i.sep[1] + 0.5, ybottom = i.sep[2] +
0.5, xright = i.sep[3] + 0.5, ytop = i.sep[4] +
0.5, lty = sep.lty, lwd = sep.lwd, col = FALSE,
border = sep.color[2])
}
}
min.scale <- min(breaks)
max.scale <- max(breaks)
x.scaled <- .scale.x(t(x), min.scale, max.scale)
if (.invalid(hline))
hline = median(breaks)
if (.invalid(vline))
vline = median(breaks)
if (trace %in% c("both", "column")) {
for (i in colInd) {
if (!.invalid(vline)) {
vline.vals <- .scale.x(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 <- seq_along(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 (!.invalid(hline)) {
hline.vals <- .scale.x(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 (!.invalid(cellnote)) {
text(x = c(row(cellnote)), y = c(col(cellnote)),
labels = c(cellnote), col = notecol, cex = cex.note)
}
if (plot.row.partition | plot.row.clusters) {
par(mar = c(margins[1], 0.5, 0, 0.1))
row.clusters.unique <- unique(row.clusters)
row.clusters.unique <- row.clusters.unique[!is.na(row.clusters.unique)]
image(rbind(seq_len(nr)), xlim = 0.5 + c(0, 1),
ylim = 0.5 + c(0, nr), col = par("bg"), axes = FALSE,
add = force_add, useRaster = useRaster)
if (!.invalid(plot.row.partitionList)) {
for (i in seq_along(plot.row.partitionList)) {
i.sep <- plot.row.partitionList[[i]]
rect(xleft = 0 + 0.5, ybottom = i.sep[2] +
0.5, xright = 1 + 0.5, ytop = i.sep[4] +
0.5, lty = sep.lty, lwd = sep.lwd, col = color.partition.box,
border = color.partition.border)
g <- row.clusters.unique[i]
s <- g
text(x = 1, y = (i.sep[2] + 0.5 + i.sep[4] +
0.5)/2, labels = s, col = color.partition.border,
cex = cex.partition, srt = 90)
}
}
}
if (plot.col.partition | plot.col.clusters) {
par(mar = c(0.1, 0, 0, margins[4]))
col.clusters.unique <- unique(col.clusters)
col.clusters.unique <- col.clusters.unique[!is.na(col.clusters.unique)]
if (!is.null(gene_position_breaks)) {
image(cbind(seq_len(nc)), xlim = 0.5 + c(0,
nc), ylim = 0.5 + c(0, 1), col = par("bg"),
axes = FALSE, add = force_add, useRaster = useRaster)
}
else {
image(cbind(seq_len(nc)), xlim = 0.5 + c(0,
nc), ylim = 0.5 + c(0, 1), col = par("bg"),
axes = FALSE, add = force_add, useRaster = useRaster)
}
if (!.invalid(plot.col.partitionList)) {
for (i in seq_along(plot.col.partitionList)) {
i.sep <- plot.col.partitionList[[i]]
rect(xleft = i.sep[1] + 0.5, ybottom = 0 +
0.5, xright = i.sep[3] + 0.5, ytop = 1 +
0.5, lty = sep.lty, lwd = sep.lwd, col = color.partition.box,
border = color.partition.border)
g <- col.clusters.unique[i]
s <- g
text(x = (i.sep[1] + 0.5 + i.sep[3] + 0.5)/2,
y = 1, labels = s, col = color.partition.border,
cex = cex.partition, srt = 0)
}
}
}
if (!.invalid(RowIndividualColors)) {
par(mar = c(margins[1], 0, 0, 0.5))
image(rbind(seq_len(nr)), col = RowIndividualColors[rowInd,
1], axes = FALSE, add = FALSE, useRaster = useRaster)
if (dim(RowIndividualColors)[2] > 1) {
par(mar = c(margins[1], 0, 0, 0.5))
image(rbind(seq_len(nr)), col = RowIndividualColors[rowInd,
2], axes = FALSE, add = force_add, useRaster = useRaster)
}
}
if (!.invalid(ColIndividualColors)) {
par(mar = c(0.5, 0, 0, margins[4]))
if (!is.null(gene_position_breaks)) {
image(gene_position_breaks, 1, cbind(seq_len(nc)),
col = ColIndividualColors[colInd], axes = FALSE,
add = force_add, useRaster = FALSE)
}
else {
image(cbind(seq_len(nc)), col = ColIndividualColors[colInd],
axes = FALSE, add = force_add, useRaster = useRaster)
}
}
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.text(ylim = range(iy))
if (sideRow == 2) {
.sideRow <- par("usr")[2] - 0.5 srtCol/90
text(.sideRow, iy, labels = labRow, srt = srtRow,
pos = 1, xpd = TRUE, cex = cexRow)
}
}
par(mar = c(0, 0, 0, 0))
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
legend(x = 0.6, y = 1.2, legend = annotations_legend[,
1], cex = 1.2, fill = annotations_legend[, 2], ncol = grouping_key_coln)
mar3 <- (if (!is.null(main))
mar.main
else 0) + (if (!is.null(sub))
mar.sub
else 0)
par(mar = c(0, 0, mar3, margins[4]))
if (dendrogram %in% c("both", "column")) {
plot(ddc, axes = FALSE, xaxs = "i", leaflab = "none")
}
else {
if (key) {
.plot.text(xlim = range(seq_len(nc)))
}
if (sideCol == 3) {
.sideCol <- par("usr")[3] + 0.5 srtCol/90
text(seq_len(nc), .sideCol, labels = labCol,
srt = srtCol, pos = 1, xpd = TRUE, cex = cexCol)
}
}
if (is.null(sub)) {
main.line <- 1
}
else {
main.line <- 3
}
if (!is.null(main)) {
title(main, cex.main = cex.main, adj = adj.main,
mgp = mgp.main, font.main = font.main, line = main.line)
}
if (!is.null(sub)) {
title(sub, cex.main = cex.sub, adj = adj.main, mgp = mgp.main,
font.main = font.sub, line = 0)
}
if (key) {
cex.key <- 0.75
op.ori <- par()
par(mar = c(2, 1.5, 0.75, 1) keysize, cex = cex.key,
mgp = c(0.75, 0, 0), tcl = -0.05)
z <- seq(x.range[1], x.range[2], length = length(colors))
flog.debug(paste("::inferCNV::heatmap.cnv colorkey z range: ",
paste(z, collapse = ","), sep = ""))
flog.debug(paste("::inferCNV::heatmap.cnv colorkey breaks range: ",
paste(breaks, collapse = ","), sep = ""))
flog.debug(paste("::inferCNV::heatmap.cnv colorkey colors range: ",
paste(colors, collapse = ","), sep = ""))
image(z = matrix(z, ncol = 1), col = colors, breaks = breaks,
xaxt = "n", yaxt = "n", xlab = key.xlab, ylab = "",
main = "", add = force_add, useRaster = useRaster)
par(usr = c(0, 1, 0, 1))
lv <- pretty(breaks)
xv <- .scale.x(as.numeric(lv), x.range[1], x.range[2])
axis(1, at = xv, labels = lv, cex.axis = cex.key
1)
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 <- .scale.x(dens$x, x.range[1], x.range[2])
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), cex.axis = cex.key 1)
title(key.title, cex.main = cex.key, font.main = 1)
mtext(side = 2, "Density", line = 0.75, cex = cex.key)
}
else if (density.info == "histogram") {
h <- hist(x, plot = FALSE, breaks = breaks)
hx <- .scale.x(breaks, x.range[1], x.range[2])
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),
cex.axis = cex.key * 1)
title(key.title, cex.main = cex.key, font.main = 1)
mtext(side = 2, key.ylab, line = 0.75, cex = cex.key)
}
else {
title(key.title, cex.main = cex.key, font.main = 1)
}
par(mar = op.ori$mar, cex = op.ori$cex, mgp = op.ori$mgp,
tcl = op.ori$tcl, usr = op.ori$usr)
}
else {
if (!force_add) {
.plot.text()
}
}
if (plot.row.individuals) {
.plot.text("Row\nIndividuals", cex = cex.text, bg = "white")
for (i in seq_len(ir)) {
tmp <- plot.row.individuals.list[[i]]
for (j in seq_along(tmp)) {
eval(tmp[[j]])
}
}
}
if (plot.col.individuals) {
.plot.text("Column\nIndividuals", cex = cex.text,
bg = "white", srt = 90)
for (i in seq_len(ic)) {
tmp <- plot.col.individuals.list[[i]]
for (j in seq_along(tmp)) {
eval(tmp[[j]])
}
}
}
if (plot.row.clusters) {
.plot.text("Row\nClusters", cex = cex.text, bg = "white")
tmp <- plot.row.clusters.list[[1]]
row.data <- row.data[rowInd]
for (i in unique(row.clusters)) {
i.x <- row.data[row.clusters == i]
for (j in seq_along(tmp)) {
eval(tmp[[j]])
}
i.main <- sprintf("Row group %s (n=%s)", i,
length(i.x))
title(i.main, cex.main = 1, font.main = 1)
}
}
if (plot.col.clusters) {
.plot.text("Col\nClusters", cex = cex.text, bg = "white",
srt = 90)
tmp <- plot.col.clusters.list[[1]]
col.data <- if (revC)
col.data[rev(colInd)]
else col.data[colInd]
for (i in unique(col.clusters)) {
i.x <- col.data[col.clusters == i]
for (j in seq_along(tmp)) {
eval(tmp[[j]])
}
i.main <- sprintf("Col group %s (n=%s)", i,
length(i.x))
title(i.main, cex.main = 1, font.main = 1)
}
}
if (plot.row.clustering) {
.plot.text("Row\nClustering", cex = cex.text, bg = "white")
for (i in seq_len(cr)) {
tmp <- plot.row.clustering.list[[i]]
for (j in seq_along(tmp)) {
eval(tmp[[j]])
}
}
}
if (plot.col.clustering) {
.plot.text("Column\nClustering", cex = cex.text,
bg = "white", srt = 90)
for (i in seq_len(cc)) {
tmp <- plot.col.clustering.list[[i]]
for (j in seq_along(tmp)) {
eval(tmp[[j]])
}
}
}
if (!.invalid(text.box) & if.plot.info) {
.plot.text(text.box, cex = cex.text, bg = "gray75")
}
else {
if (flag.text) {
.plot.text()
}
}
}
else {
x.save <- x
}
ret <- list(x.ori = x.ori, x = x.save, rowInd = rowInd,
colInd = colInd, kr = kr, kc = kc)
invisible(ret)
}
moewarangel
commented
8 months ago Error in heatmap.cnv(obs_data, Rowv = obs_dendrogram, Colv = FALSE, cluster.by.row = TRUE, : 'RowIndividualColors' must be a character vector of length nrow(x) 此外: Warning messages: 1: In annoGene(rownames(dat), "SYMBOL", "human") : 1.23% of input IDs are fail to annotate... 2: In cbind(row_groupings, get_group_color_palette()(length(table(hcl_obs_annotations_groups)))[hcl_obs_annotations_groups]) : number of rows of result is not a multiple of vector length (arg 2) 3: In cbind(split_groups, row_groupings[, 1], hcl_obs_annotations_groups, : number of rows of result is not a multiple of vector length (arg 3) Called from: heatmap.cnv(obs_data, Rowv = obs_dendrogram, Colv = FALSE, cluster.by.row = TRUE, cluster.by.col = FALSE, main = cnv_title, ylab = cnv_obs_title, margin.for.labCol = 2, xlab = "Genomic Region", key = TRUE, labCol = contig_labels, cexCol = contig_lab_size, cexAt = c(1, contig_seps), notecol = "black", density.info = "histogram", denscol = "blue", trace = "none", dendrogram = "row", cexRow = 0.8, breaks = breaksList, gene_position_breaks = gene_position_breaks, scale = "none", x.center = x.center, color.FUN = col_pal, if.plot = !testing, sepList = contigSepList, sep.color = c("black", "black"), sep.lty = 1, sep.lwd = 1, RowIndividualColors = row_groupings, annotations_legend = annotations_legend, grouping_key_coln = grouping_key_coln, ColIndividualColors = contig_colors, key.title = "Distribution of Expression", key.xlab = "Modified Expression", key.ylab = "Count", force_lmat = layout_lmat, force_lwid = layout_lwid, force_lhei = layout_lhei, useRaster = useRaster)
Dear Professor, I hope this message finds you well. I am currently following your tutorial on single-cell genomic data analysis using infercnv and have encountered a specific issue at STEP 15 (computing tumor subclusters via leiden). The error message I received is as follows: Error during wrap-up: 'RowIndividualColors' must be a character vector of length nrow(x) Error: no more error handlers available (recursive errors?); invoking 'abort' restart This error seems to suggest a mismatch in the length of the 'RowIndividualColors' vector compared to the number of rows (genes) in my data matrix. I would greatly appreciate your guidance on how to correctly adjust or create the 'RowIndividualColors' vector to match the number of genes in my dataset. Any insights or suggestions you can provide would be immensely helpful. Thank you for your time and assistance. Best regards,