Я пытаюсь создать тепловую карту с помощью функции 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()
# 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()