add.flag <- function(pheatmap, kept.labels, repel.degree) { # repel.degree = number within [0, 1], which controls how much # space to allocate for repelling labels. ## repel.degree = 0: spread out labels over existing range of kept labels ## repel.degree = 1: spread out labels over the full y-axis heatmap <- pheatmap$gtable new.label <- heatmap$grobs[[which(heatmap$layout$name == "row_names")]] # keep only labels in kept.labels, replace the rest with "" new.label$label <- ifelse(new.label$label %in% kept.labels, new.label$label, "") # calculate evenly spaced out y-axis positions repelled.y <- function(d, d.select, k = repel.degree){ # d = vector of distances for labels # d.select = vector of T/F for which labels are significant # recursive function to get current label positions # (note the unit is "npc" for all components of each distance) strip.npc <- function(dd){ if(!"unit.arithmetic" %in% class(dd)) { return(as.numeric(dd)) } d1 <- strip.npc(dd$arg1) d2 <- strip.npc(dd$arg2) fn <- dd$fname return(lazyeval::lazy_eval(paste(d1, fn, d2))) } full.range <- sapply(seq_along(d), function(i) strip.npc(d[i])) selected.range <- sapply(seq_along(d[d.select]), function(i) strip.npc(d[d.select][i])) return(unit(seq(from = max(selected.range) + k*(max(full.range) - max(selected.range)), to = min(selected.range) - k*(min(selected.range) - min(full.range)), length.out = sum(d.select)), "npc")) } new.y.positions <- repelled.y(new.label$y, d.select = new.label$label != "") new.flag <- segmentsGrob(x0 = new.label$x, x1 = new.label$x + unit(0.15, "npc"), y0 = new.label$y[new.label$label != ""], y1 = new.y.positions) # shift position for selected labels new.label$x <- new.label$x + unit(0.2, "npc") new.label$y[new.label$label != ""] <- new.y.positions # add flag to heatmap heatmap <- gtable::gtable_add_grob(x = heatmap, grobs = new.flag, t = 4, l = 4 ) # replace label positions in heatmap heatmap$grobs[[which(heatmap$layout$name == "row_names")]] <- new.label # plot result grid.newpage() grid.draw(heatmap) # return a copy of the heatmap invisibly invisible(heatmap) }
Preview:
downloadDownload PNG
downloadDownload JPEG
downloadDownload SVG
Tip: You can change the style, width & colours of the snippet with the inspect tool before clicking Download!
Click to optimize width for Twitter