无法将 tableGrob 与 barplot (ggplot2) 对齐 - 希望表中的日期与绘图上的日期对齐

Question

所以，我已经按日期制作了这个类别条形图，我想在其下方放置一个数据表格。我可以组装它，但无法将桌子对齐。我的代码中的任何内容都可能是问题所在。我主要是在玩拼凑，但在那之前尝试过 grid.arrange 。我将不胜感激任何帮助，因为我对 gridExtra 或 patchwork 都不太熟悉。

这是数据和代码：

SNcats <- structure(list(spec.date = c("2022-01", "2022-01", "2022-01", 
"2022-02", "2022-02", "2022-02", "2022-03", "2022-03", "2022-03", 
"2022-04", "2022-04", "2022-04", "2022-05", "2022-05", "2022-05", 
"2022-06", "2022-06", "2022-06", "2022-07", "2022-07", "2022-07", 
"2022-08", "2022-08", "2022-08", "2022-09", "2022-09", "2022-09", 
"2022-10", "2022-10", "2022-10", "2022-11", "2022-11", "2022-11", 
"2022-12", "2022-12", "2022-12", "2023-01", "2023-01", "2023-01"
), Prevalence = c(35.7532730691516, 51.6020332612438, 87.3553063302596, 
39.8444277893643, 48.2160832971785, 88.0605110865005, 37.8209796975328, 
52.0475030126012, 89.8684827108602, 38.5822017341404, 46.8328075784517, 
85.415009306803, 37.5983114267099, 49.2418346993315, 86.8401461257731, 
37.073216269802, 50.973491711575, 88.0467079815322, 37.4924651917319, 
48.2141737283447, 85.7066389192143, 37.1730646315648, 50.507713438577, 
87.6807780703307, 34.011831202632, 54.668835496198, 88.6806667081123, 
33.4879698539608, 57.2879814032989, 90.7759512541417, 34.6890742481581, 
57.8203887753151, 92.5094630233588, 37.0324544253768, 54.7515011379788, 
91.783955355063, 36.4346779568341, 52.4230523876185, 88.8577303442384
), LL = c(31.0036784955892, 46.6865137568222, 84.0294744708075, 
35.8934911175723, 44.2294678836092, 85.5201746651143, 32.5918045075412, 
46.7021252787722, 86.6574439277593, 35.7332321084506, 43.9378408519578, 
83.2690129542333, 34.8236562801895, 46.4112667974695, 84.8490432647019, 
34.1589303783171, 47.9808527735242, 86.1062268727187, 35.170825504927, 
45.8461086423908, 83.8557052884791, 35.0257696395504, 48.2978225201125, 
86.1304138927419, 32.0510320212288, 52.6197412698121, 87.4441418189029, 
31.7620042685515, 55.4799317423969, 89.7021275089891, 32.9350706471155, 
56.001650789056, 91.5045773434199, 34.7511549769303, 52.4364225437364, 
90.6046115548134, 34.5985811363114, 50.5172303158065, 87.6570267772486
), UL = c(40.5028676427141, 56.5175527656655, 90.6811381897116, 
43.7953644611564, 52.2026987107478, 90.6008475078866, 43.0501548875245, 
57.3928807464302, 93.0795214939611, 41.4311713598303, 49.7277743049456, 
87.5610056593728, 40.3729665732303, 52.0724026011934, 88.8312489868442, 
39.9875021612869, 53.9661306496258, 89.9871890903457, 39.8141048785368, 
50.5822388142986, 87.5575725499494, 39.3203596235792, 52.7176043570414, 
89.2311422479195, 35.9726303840352, 56.7179297225839, 89.9171915973217, 
35.2139354393702, 59.096031064201, 91.8497749992943, 36.4430778492006, 
59.6391267615742, 93.5143487032977, 39.3137538738233, 57.0665797322211, 
92.9632991553127, 38.2707747773567, 54.3288744594304, 90.0584339112283
), SN.cat = structure(c(2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 
3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 
1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L, 2L, 3L, 1L), levels = c("S+", 
"S+N-", "S+N+"), class = "factor"), group = structure(c(3L, 2L, 
1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 
3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 2L, 1L, 3L, 
2L, 1L, 3L, 2L, 1L), levels = c("1", "2", "3"), class = "factor")), row.names = c(NA, 
-39L), class = "data.frame")



SNcats.w <- structure(list(SN.cat = c("S+", "S+N+", "S+N-"), `2022-01` = c("87.4 (84 - 90.7)", 
"51.6 (46.7 - 56.5)", "35.8 (31 - 40.5)"), `2022-02` = c("88.1 (85.5 - 90.6)", 
"48.2 (44.2 - 52.2)", "39.8 (35.9 - 43.8)"), `2022-03` = c("89.9 (86.7 - 93.1)", 
"52 (46.7 - 57.4)", "37.8 (32.6 - 43.1)"), `2022-04` = c("85.4 (83.3 - 87.6)", 
"46.8 (43.9 - 49.7)", "38.6 (35.7 - 41.4)"), `2022-05` = c("86.8 (84.8 - 88.8)", 
"49.2 (46.4 - 52.1)", "37.6 (34.8 - 40.4)"), `2022-06` = c("88 (86.1 - 90)", 
"51 (48 - 54)", "37.1 (34.2 - 40)"), `2022-07` = c("85.7 (83.9 - 87.6)", 
"48.2 (45.8 - 50.6)", "37.5 (35.2 - 39.8)"), `2022-08` = c("87.7 (86.1 - 89.2)", 
"50.5 (48.3 - 52.7)", "37.2 (35 - 39.3)"), `2022-09` = c("88.7 (87.4 - 89.9)", 
"54.7 (52.6 - 56.7)", "34 (32.1 - 36)"), `2022-10` = c("90.8 (89.7 - 91.8)", 
"57.3 (55.5 - 59.1)", "33.5 (31.8 - 35.2)"), `2022-11` = c("92.5 (91.5 - 93.5)", 
"57.8 (56 - 59.6)", "34.7 (32.9 - 36.4)"), `2022-12` = c("91.8 (90.6 - 93)", 
"54.8 (52.4 - 57.1)", "37 (34.8 - 39.3)"), `2023-01` = c("88.9 (87.7 - 90.1)", 
"52.4 (50.5 - 54.3)", "36.4 (34.6 - 38.3)")), row.names = c(NA, 
-3L), class = c("tbl_df", "tbl", "data.frame"))

library(ggplot2)
library(ggpattern)

g0 <- ggplot(SNcats, aes(x=spec.date, y=Prevalence, color=SN.cat, fill=SN.cat)) +
  geom_bar(stat="identity", position=position_dodge(0.85), width=0.8) +
  geom_errorbar( aes(x=spec.date, ymin=LL, ymax=UL, color="black"),
                 position=position_dodge(0.85), 
                 width=0.3) +   
  geom_bar_pattern(aes(pattern=SN.cat, fill=SN.cat, color=SN.cat),
                              position=position_dodge(0.85),
                              stat="identity") +
  theme_minimal() +
  theme(legend.title = element_blank())+
  labs(x="Date")+
  scale_color_manual(values=c("S+"= "steelblue4", "S+N-"="darkorange", "S+N+"="springgreen4"), aesthetics=c("color", "fill")) +
  scale_pattern_manual(values=c(rep(c('stripe', 'circle', 'crosshatch'),1))) 

library(gridExtra)

tt <- ttheme_default(
  base_size = 9,
  padding = unit(c(2, 4), "mm"),
  # Alternate the row fill colours
  core = list(fg_params=list(hjust = 1, x=1),
              bg_params=list(fill=c("white", "white"))),
  
  # Change column header to white text and red background
  colhead = list(fg_params=list(col="black"),
                 bg_params=list(fill="white")))

tbl <- tableGrob(SNcats.w, rows=NULL, theme=tt)

grid.arrange(g0, tbl, nrow=2, heights=c(1,0.5))

library(patchwork)

layout <- c(
  area(t = 1, l = 1, b = 8, r = 5),
  area(t = 9, l = 1, b = 10, r = 5))  # r = 4 shoves it off the left side

p1 <- g0 + tbl + plot_layout(design=layout) 

p1

Answer 1

您的表格图需要与主图具有相同的 x 轴比例。我将仅使用您的第一个数据框来生成此处的两个图。

你的主线剧情有问题。此处使用躲避条是不必要的，这会使查看数据中的模式变得更加困难，并且会扭曲进行组测量的表观时间。条形中的图案不会为显示的信息添加任何内容，似乎纯粹是为了装饰，但它们使一切看起来杂乱且不那么美观。我可能会在这里使用误差线和丝带：

library(tidyverse)
library(patchwork)

p1 <- SNcats %>%
  mutate(spec.date = lubridate::ym(spec.date)) %>%
  ggplot(aes(spec.date, Prevalence, ymin = LL, ymax = UL)) +
  geom_ribbon(aes(color = SN.cat, fill = after_scale(alpha(color, 0.1))),
              linetype = 0) +
  geom_errorbar(aes(color = SN.cat), width = 1) +
  geom_point(aes(color = SN.cat)) +
  scale_color_brewer(palette = "Set1") +
  theme_minimal() +
  scale_x_date(NULL, date_breaks = "month", date_labels = "%Y-%m") +
  theme(legend.position = "top")

 p2 <- SNcats %>%
  mutate(spec.date = lubridate::ym(spec.date)) %>%
  ggplot(aes(spec.date, SN.cat)) +
  geom_text(aes(label = paste0(round(Prevalence, 1), "\n",
                               " (", round(LL, 1),  " - ", 
                               round(UL, 1), ")")), size = 2.5) +
  scale_x_date(NULL, date_breaks = "month", date_labels = "%Y-%m",
               position = "top") +
  theme_void() +
  theme(axis.text.y = element_text())
 
p1 + p2 + plot_layout(heights = c(3, 1))