отобразить проблему с тепловой картой в ggplot

Question

У меня есть данные с 10 группами, в каждой группе по 1440 человек.Каждая ячейка показывает пропорции от 0 до 70. Я хочу нарисовать тепловую карту, чтобы визуализировать изменение пропорций внутри и между группами.

Мои данные выглядят так:

### create dummy data 
data <- data.frame(
  group = sample(c("DPC", "IPC", "DPC+IPC", "EDU", "DPC+IPC+EDU",
                   "DPC+EDU", "IPC+EDU", "Rounds", "Handoff", "Misce"), 14400, replace = T, prob = c(0.1,0.1,0.1,
                                                                                                     0.1,0.1,0.1,
                                                                                                     0.1,0.1,0.1,
                                                                                                     0.1)),
  pct = runif(14400, min = 0, max = 70)
)



### gen id per group 
data <- transform(data, grpid = as.numeric(factor(group)))

library(dplyr)

data <- data %>%
  group_by(group) %>%
  mutate(id = row_number())

Мой код для карты тепла:

## plot the heatmap
library(ggplot2)


cols <- c(colorRampPalette(c('#e7f0fa', '#c9e2f6', '#95cbee', '#0099dc', '#4ab04a', '#ffd73e'))(10),
          colorRampPalette(c('#eec73a', '#e29421', '#e29421', '#f05336','#ce472e'), bias=2)(90))


ggplot(data, aes(x=id, y=group, fill = pct)) +
  geom_tile( color = "white") +theme_minimal() +
  scale_fill_gradientn(colours = cols, limits = c(0, max(map$pct)),
                       breaks = seq(0, 100, by = 10),
                       na.value = rgb(246, 246, 246, max = 255),
                       labels = c("0", "10", "20", "30", "40", "50", "60", "70", "80", "90", "100"),
                       guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10,
                                               guide_legend(title = "Time, %",
                                                            title.theme = element_text(
                                                              size = 1, 
                                                              face = "plain"))))+
  scale_x_continuous (expand = c(0,0), breaks = seq(1,1440, by = 60)) +
  labs(x = " ", y=" ", fill = " ") +
  theme(legend.position=c(.4, -.3),
        legend.direction="horizontal",
        legend.text=element_text(colour="grey20"),
        plot.margin=unit(c(1,1,-1,1), "cm"),
        #axis.text.x = element_text(angle = 30,hjust = 1,vjust = 1, size = 7),
        axis.text.y = element_text(size = 8),
        axis.ticks.y = element_blank(),
        axis.ticks.x = element_line(size = 0.1),
        panel.grid=element_blank(), aspect.ratio = (0.3)) + coord_fixed()

Полученный рисунок выглядит так:

Мой вопрос: как мне настроить фигуру, чтобы изменить линий на квадратов в каждой ячейке, аналогичной той, что на этом сайте?https://benjaminlmoore.wordpress.com/2015/04/09/recreating-the-vaccination-heatmaps-in-r/

Большое спасибо !!

Answer 1

Если вы действительно хотите, чтобы ваши плитки были квадратными, попробуйте сохранить график и установить ширину, которая будет намного больше, чем высота.Например,

ggplot(data, aes(x=id, y=group, fill = pct)) +
  geom_tile( color = "white") +theme_minimal() +
  scale_fill_gradientn(colours = cols, limits = c(0, max(data$pct)),
                       breaks = seq(0, 100, by = 10),
                       na.value = rgb(246, 246, 246, max = 255),
                       labels = c("0", "10", "20", "30", "40", "50", "60", "70", "80", "90", "100"),
                       guide = guide_colourbar(ticks = T, nbin = 50, barheight = .5, label = T, barwidth = 10,
                                               guide_legend(title = "Time, %",
                                                            title.theme = element_text(
                                                              size = 1, 
                                                              face = "plain"))))+
  scale_x_continuous (expand = c(0,0), breaks = seq(1,1440, by = 60)) +
  labs(x = " ", y=" ", fill = " ") +
  theme(legend.position= "none",
        legend.direction="horizontal",
        legend.text=element_text(colour="grey20"),
        axis.text.y = element_text(size = 3),
        axis.ticks.y = element_blank(),
        axis.ticks.x = element_line(size = 0.1),
        panel.grid=element_blank()) + 
  coord_fixed()
ggsave("my_heatmap.pdf", width = 80, height = 40 * 1 / 144, limitsize = FALSE)

даст вам что-то вроде

, но обратите внимание, что я показал только небольшую частьфактическая тепловая карта.

Answer 2

Я бы попробовал heatmap2

library(tidyverse)
library(gplots)
a <- rep("", 1501)
a[c(1, seq(0,1500, 50)[-1])] <- c(1, seq(0,1500, 50)[-1])
# the plot
data %>% 
  select(-grpid) %>% 
  spread(id, pct) %>% 
  with(.,heatmap.2(as.matrix(.[,-1]), , trace = "none", 
                   dendrogram = "row",
                   Colv =NULL,
                   labCol=a,
                   labRow=as.character(.$group),
                   cexRow=0.6))

Затем вы можете редактировать соотношение сторон графика, пока не появятся квадраты.