Тепловая карта (растр) с иерархическими метками - PullRequest
0 голосов
/ 25 апреля 2019

Я пытаюсь создать тепловую карту с помощью функции ggplot2 geom_raster. Тепловая карта имеет множество y меток различной длины и иерархии.

Следующий код создает образец. Я создал функцию, которая генерирует усечение иерархии длин меток под названием cattrim (я с удовольствием использую чужую, если эта функция уже написана.

К сожалению, мне не удалось понять, как отменить список дискретных меток y, необходимых для того, чтобы категориальные переменные были читаемыми. Самый высокий уровень - это значения 1,2,3, следующий за ним - A, B, C, D, за которым следуют l, m, n, o.

В идеале они должны отображаться следующим образом:

1 A l
    m 
    n
  B m
    n
    o
2 A m
  C n
    o

R код:

library(ggplot2)
library(dplyr)
library(stringr)

n <- 100
x <- paste0(sample(rep(1:3,n)),"-",
            sample(rep(LETTERS[1:4],n)),"-",
            sample(rep(letters[10:15],n))) %>% sort

df <- tibble(lab = x, cat=ceiling(runif(length(x))*10), n=rpois(length(x),3.4) + 1)

df2 <- df %>% group_by(lab,cat) %>% summarize(n=sum(n)) %>% filter(n>10)

png("heatmap-cat1.png")
df2 %>%
  ggplot(aes(factor(cat), lab )) +
  geom_raster(aes(fill = n)) + theme_bw() +
  theme(axis.text.y = element_text(family="mono"))
dev.off()

Heatmap categorical 1

# Breaks input text into three columns which are trimmed to reduce the complexity of the data
cattrim <- function(x, sep="-", maxlen=20, closer=" ") {
  xf <-  factor(x)
  xfl <- levels(xf) %>% str_split_fixed(sep,3)

  # Remove leading and trailing white space
  xfl[,1] <- xfl[,1] %>% str_trim
  xfl[,2] <- xfl[,2] %>% str_trim
  xfl[,3] <- xfl[,3] %>% str_trim

  # Remove any redundant category titles
  xfl[-1,1][xfl[-1,1] == xfl[-nrow(xfl),1]] <- ""
  xfl[-1,2][xfl[-1,2] == xfl[-nrow(xfl),2]] <- ""

  # Make sure each category has the same length
  xfl[,1] <- xfl[,1] %>% format(width=max(nchar(.))) %>% str_sub(1,maxlen)
  xfl[,2] <- xfl[,2] %>% format(width=max(nchar(.))) %>% str_sub(1,maxlen)
  xfl[,3] <- xfl[,3] %>% format(width=max(nchar(.))) %>% str_sub(1,maxlen)
  levels(xf) <- apply(xfl, 1, paste, collapse=closer)
  xf
}

png("heatmap-cat2.png")
df2 %>%
  ggplot(aes(factor(cat), lab )) +
  geom_raster(aes(fill = n)) + theme_bw() +
  theme(axis.text.y = element_text(family="mono")) +
  scale_y_discrete(
    breaks = sort(unique(df2$lab)), 
    labels = cattrim(sort(unique(df2$lab)), maxlen = 15))
dev.off()

Heatmap with categorical labels after removing redundancy

...