使用 geom_segment() 绘制日历图

Question

我在 R 中有以下数据集。我的目标是制作一个 ggplot，其中 x 轴的刻度从 1 到 12（一月、二月、...、十二月），y 轴从 1 到 6 （num_months 变量[在示例中只有 1 和 6]）。然后，我想使用 geom_segment()，最小值为 start_month，最大值为 end_month（因此它们代表 num_months）。我想按可变年份水平分面。

到目前为止，我的主要问题是：

1. 我希望geom_segment占据“完整的月份”，所以如果开始和结束月份是5，即5月，我希望它在5月开始并在6月初结束（6）；
2. 有几个片段具有相同的持续时间（num_months），但我希望它们平行排列，这样它们就不会重叠并显示我想要显示的内容。
3. 我希望 num_months 看起来更像面板，因为它在数据可视化方面令人困惑。现在我做了一些盒子，但有些行超出了 num_months，并且这些行超出了，所以它们不是盒子。

data <- read_csv("num_months,start_month_year,end_month_year,B1,B1_p,year,start_month,end_month
1,6,6,3.3571016788482666,0.007681768853217363,2021,5,5
1,8,8,2.548985481262207,0.007373321335762739,2021,7,7
1,10,10,2.139772415161133,0.03452971577644348,2021,9,9
1,12,12,2.165775775909424,0.07796278595924377,2021,11,11
1,13,13,1.9506219625473022,0.09215697646141052,2021,12,12
1,23,23,2.7839596271514893,0.011407249607145786,2022,10,10
1,25,25,2.220555543899536,0.06181173026561737,2022,12,12
6,6,11,0.9881601333618164,0.08719704300165176,2021,5,10
6,8,13,1.438501238822937,0.032221969217061996,2021,7,12
6,9,14,1.16400945186615,0.09187468141317368,2021,8,1
6,10,15,1.5834165811538696,0.03494146466255188,2021,9,2
6,11,16,1.294316291809082,0.09792502969503403,2021,10,3
6,12,17,1.4204859733581543,0.0546354204416275,2021,11,4
6,20,25,1.07038414478302,0.0722803920507431,2022,7,12") %>%
  mutate(
    end_month = ifelse(start_month == end_month, end_month + 1, end_month),
    end_month = ifelse(end_month > 12, 1, end_month)  # Wrap around to January if end_month exceeds 12
  ) %>%
  group_by(year, num_months) %>%
  mutate(
    y_pos = num_months + (row_number() - 1) * 0.2  # Adding a systematic offset to y position
  ) %>%
  ungroup()

# Create the boxes for num_months
boxes <- data %>%
  group_by(year, num_months) %>%
  summarise(
    ymin = min(y_pos) - 0.3,
    ymax = max(y_pos) + 0.3
  ) %>%
  ungroup()

# Create the ggplot
p <- ggplot(data) +
  geom_rect(data = boxes, aes(xmin = 0.5, xmax = 12.5, ymin = ymin, ymax = ymax), fill = NA, color = "grey") +
  geom_segment(aes(x = start_month, xend = end_month, y = y_pos, yend = y_pos, color = as.factor(num_months)), size = 1) +
  scale_x_continuous(breaks = 1:12, limits = c(0.5, 12.5), labels = month.abb) +
  scale_y_continuous(breaks = 1:6, limits = c(0.5, 6.5), expand = expansion(mult = c(0.02, 0.1))) +  # Adjusting y-axis limits to accommodate offset
  facet_wrap(~ year) +
  labs(x = "Month", y = "Number of Months", color = "Number of Months") +
  theme_minimal() +
  theme(panel.spacing = unit(1, "lines"))  # Increase spacing between panels

print(p)

其外观如下：持续相同月数的段重叠。此外，面板中的行会显示不同的 num_months。

Answer 1

这是我的建议。最大的变化是：

• 我使用实际日期而不是数字作为 x 轴，开始日期为月初，结束日期为该月的最后一天。这使得这些片段“占据了整个月”。

• 由于您希望

  num_months

  看起来“更像面板”，因此我将它们包含在刻面中。 （请注意，您可以按行中的多个变量进行分面，因此如果您还想按行对

  country

  进行分面，您也可以这样做，请参阅

  ?facet_grid

  帮助页面底部的“边距”示例。 )

• 由于我们已经通过

  num_months

  进行了分面，这让我们可以使用分组的行号作为

  y

  的美感，均匀地间隔行，无论有多少行。

由于

theme_minimal()

不为其切面绘制面板，所以我切换到

theme_bw()

，但您当然可以根据需要自定义主题。

data <- read_csv("num_months,start_month_year,end_month_year,B1,B1_p,year,start_month,end_month
1,6,6,3.3571016788482666,0.007681768853217363,2021,5,5
1,8,8,2.548985481262207,0.007373321335762739,2021,7,7
1,10,10,2.139772415161133,0.03452971577644348,2021,9,9
1,12,12,2.165775775909424,0.07796278595924377,2021,11,11
1,13,13,1.9506219625473022,0.09215697646141052,2021,12,12
1,23,23,2.7839596271514893,0.011407249607145786,2022,10,10
1,25,25,2.220555543899536,0.06181173026561737,2022,12,12
6,6,11,0.9881601333618164,0.08719704300165176,2021,5,10
6,8,13,1.438501238822937,0.032221969217061996,2021,7,12
6,9,14,1.16400945186615,0.09187468141317368,2021,8,1
6,10,15,1.5834165811538696,0.03494146466255188,2021,9,2
6,11,16,1.294316291809082,0.09792502969503403,2021,10,3
6,12,17,1.4204859733581543,0.0546354204416275,2021,11,4
6,20,25,1.07038414478302,0.0722803920507431,2022,7,12") %>%
  mutate(
    start_dt = ymd(paste("2023", start_month, "01", sep = "-")),
    end_dt = ceiling_date(ymd(paste("2023", end_month, "01", sep = "-")), unit = "month") - 1,
    end_month = ifelse(start_month == end_month, end_month + 1, end_month),
    end_month = ifelse(end_month > 12, 1, end_month)  # Wrap around to January if end_month exceeds 12
  ) %>%
  group_by() %>%
  mutate(
    y_pos = num_months + (row_number() - 1) * 0.2,  # Adding a systematic offset to y position
    yy = row_number(),
    .by = c(year, num_months)
  )


ggplot(data) +
  geom_segment(aes(x = start_dt, xend = end_dt, y = yy, yend = yy, color = factor(num_months)), size = 1) +
  scale_x_date(
    date_labels = "%b", 
    date_breaks = "1 month",
    limits = ymd(c("2023-01-01", "2023-12-31")),
    expand = expansion(0, 0)
  ) +
  scale_y_continuous(labels = NULL) +
  facet_grid(rows = vars(num_months), cols = vars(year), space = "free_y", scales = "free_y") +
  labs(x = "Month", y = "Number of Months", color = "Number of Months") +
  theme_bw() +
  theme(
    panel.spacing = unit(1, "lines"),  # Increase spacing between panels
    panel.grid.major.y = element_blank(),
    axis.ticks.y = element_blank()
  )