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))

然后您可以编辑绘图的纵横比，直到有正方形。

在ggplot中显示热图的问题

我的数据如下：

我的热图代码：

2 个答案: