是否可以使用 ggplot 创建圆形时间线图？

Question

是否可以使用 ggplot 生成一年（或其他时间段）的饼图，其中楔形对应于特定日期分隔的时间段（然后可以使用 ggplot 的其他常用工具进行修改工具）？

这是我想做的事情的草图：

使用这两个日期（12 月 21 日和 3 月 21 日），我们可以将 purple/blue 区域定义为“冬季”；其他季节也可以做类似的事情。 R 已经理解日期，所以我认为它可能会像这样绘制时间段。虽然这不是一个超级复杂（甚至有用）的示例，但我认为它可能是一种有用的技术。

Answer 1

我们可以使用 geomtextpath 来获取圆形标签。假设我们要绘制季节、春分点和至点：

library(geomtextpath)

df <- data.frame(date = as.POSIXct(c("2022-03-20 15:33", "2022-06-21 10:13",
                               "2022-09-23 02:03", "2022-12-21 21:47")),
           event = c("Vernal Equinox", "Summer Solstice",
                     "Autumnal Equinox", "Winter Solstice"))

seasons <- data.frame(xmin = c(-Inf, 2/12, 5/12, 8/12, 11/12),
                      xmax = c(2/12, 5/12, 8/12, 11/12, Inf),
                      ymin = 0, ymax = 0.95,
                      season = c("Winter", "Spring", "Summer",
                                 "Autumn", "Winter"))

绘图代码可能如下所示：

ggplot() +
  geom_rect(data = seasons,
            aes(xmin = xmin,xmax = xmax, ymin = ymin, ymax = ymax, fill = season),
            alpha = 0.2) +
  geom_textpath(data = data.frame(x = seq(0.5/13, 12.5/13, length = 12), 
                                  y = 1, label = month.name),
                aes(x, y, label = label), size = 6) +
  geom_textpath(data = data.frame(x = c(0.5/12, 3.5/12, 6.5/12, 9.5/12), y = 0.8,
                                  season = c("Winter", "Spring", "Summer", "Autumn")),
                aes(x, y, color = season, label = season), size = 10,
                alpha = 0.5, fontface = 2) +
  geom_hline(yintercept = c(0.95, 1.05)) +
  geom_segment(data = data.frame(x = seq(0, 12/13, length = 12),
    xend = seq(0, 12/13, length = 12),
    y = 0.95, yend = 1.05), aes(x, y, xend = xend, yend = yend)) +
  geom_textsegment(data = df,  aes(x = lubridate::decimal_date(date) %% 1,
                   xend = lubridate::decimal_date(date) %% 1,
                   y = 0, yend = 0.95, label = event), vjust = -0.2) +
  scale_fill_manual(values = c(Winter = "deepskyblue4",
                               Spring = "yellowgreen",
                               Summer = "gold",
                               Autumn = "brown")) +
  scale_color_manual(values = c(Winter = "deepskyblue4",
                               Spring = "yellowgreen",
                               Summer = "gold",
                               Autumn = "brown")) +
  scale_x_continuous(limits = c(0, 1), expand = c(0, 0)) +
  scale_y_continuous(limits = c(0, 1.05)) +
  coord_polar() +
  theme_void() +
  theme(legend.position = "none")

编辑

对于评论中链接的re-creation礼拜日历，我们可以这样做：

library(geomtextpath)
library(dplyr)

decimal <- function(x) lubridate::decimal_date(x) %% 1

Seasons <- Seasons %>% 
  mutate(Start_Date = decimal(Start_Date),
         End_Date   = decimal(End_Date))
Seasons$Start_Date[1] <- -Inf
Seasons$End_Date[nrow(Seasons)] <- Inf


ggplot(Seasons) +
  geom_rect(aes(xmin = Start_Date, xmax = End_Date,
                ymin = 0, ymax = 0.95, fill = Season)) +
  geom_hline(yintercept = c(0.95, 1.05, 1.07)) +
  geom_segment(data = Separators, aes(x = x, xend = x, y = 0.95, yend = 1.07)) +
  geom_textpath(data = Months, aes(x = Date, y = pos, label = Month),
                fontface = 2) +
  geom_textsegment(data = Events, 
                   aes(x = decimal(Date), xend = decimal(Date), 
                       y = 0, yend = 0.95, label = Event), vjust = 1.1, 
                   hjust = 0.95) +
  geom_textpath(data = data.frame(x = c(0.7, 0.22), y = 0.8, 
                label = c("Time after Pentecost", "Lent")), 
                aes(x, y, label = label, group = x), spacing = 500) +
  scale_fill_manual(values = Season_Colours) +
  scale_x_continuous(limits = c(0, 1)) +
  coord_polar() +
  theme_void() +
  theme(legend.position = "none",
        plot.title = element_text(hjust = 0.5, face = 2)) +
  ggtitle("THE LITURGICAL YEAR")

礼仪数据

Events  <- data.frame(Event = c("Epiphany", "Ash Wednesday", 
                                "Easter Sunday", "Ascension", "Pentecost", 
                                "Trinity Sunday", "1st Sunday of Advent", 
                                "Immaculate Conception", "Christmas Day", 
                                "Epiphany"),
                      Date  = as.POSIXct(
                        c("2022-01-06", "2022-03-02", 
                          "2022-04-17", "2022-05-26", "2022-06-06", 
                          "2022-06-12", "2022-11-27", "2022-12-08", 
                          "2022-12-25", "2023-01-06")))

Seasons <- data.frame(Season = c("Christmas", "Time after Epiphany", 
                      "Septuagesima", "Lent", "Easter",
                      "Pentecost", "Time after Pentecost", 
                      "Advent", "Christmas"),
           Start_Date = as.POSIXct(c("2021-12-25",
             "2022-01-06", "2022-02-13", "2022-03-02",
             "2022-04-17", "2022-06-06", "2022-06-12",
             "2022-11-27", "2022-12-25"
           )),
           End_Date = as.POSIXct(c("2022-01-06",
             "2022-02-13", "2022-03-02",
             "2022-04-17", "2022-06-06", "2022-06-12",
             "2022-11-27", "2022-12-25", "2023-01-06"
           )))

Season_Colours <- c(`Time after Epiphany`  = "#7dca64",
                    Septuagesima           = "#896d96",
                    Lent                   = "#896d96",
                    Easter                 = "white",
                    Pentecost              = "#df0f33",
                    `Time after Pentecost` = "#7dca64",
                    Advent                 = "#896d96",
                    Christmas              = "white")

Months <- data.frame(Month = toupper(month.name),
                     Date  = seq(0.5/13, 12.5/13, length = 12),
                     pos   = 1)

Separators <- data.frame(x = seq(0, 12/13, length = 12))

是否可以使用 ggplot 创建圆形时间线图？

Is it possible to create a circular timeline plot with ggplot?

time

r

data-visualization

ggplot2