如何在 R 中的圆形图中添加箱形图

问题描述 投票:0回答:1

我无法处理循环数据。尽管 12 月和 1 月在圆形背景下接近,但箱线图围绕整个圆延伸,无法正确反映它们的连续性。我该如何解决这个问题?

# Necessary libraries
library(ggplot2)
library(dplyr)
library(tidyr)
library(lubridate)
library(geomtextpath)

# Initial dataset with egg laying, hatching, and observation dates
df <- data.frame(
  date = as.Date(c("2019-01-08", "2023-01-18", "2023-01-18", "2024-01-21", 
                   "2018-12-30", "2023-03-31", "2023-12-27", "2024-02-24")),
  location = c("Obs1", "Obs2", "Obs3", "Obs4", "Obs5", "Obs6", "Obs7", "Obs8")
)

# Calculate hatching and egg laying dates
df <- df %>%
  mutate(
    hatching_date = date - weeks(5),
    egg_laying_date = hatching_date - weeks(4)
  )

# Transform data to long format
df_long <- df %>%
  pivot_longer(cols = c(date, hatching_date, egg_laying_date), 
               names_to = "date_type", values_to = "event_date") %>%
  mutate(
    month_shifted = (month(event_date) - 1) %% 12 + 1,  # Shift months so January is the start
    day_of_year_shifted = ((yday(event_date) + 0) %% 365) / 365,  # Adjust days for circular plot
    y_offset = case_when(
      date_type == "date" ~ 1,
      date_type == "hatching_date" ~ 0.85,    # Hatching slightly inward
      date_type == "egg_laying_date" ~ 0.75   # Egg laying further outward
    )
  )

# Create the circular plot with shifted dates
ggplot() +
  # Add month labels around the circle, starting from January as month 1
  geom_textpath(data = data.frame(x = seq(0.5/13, 12.5/13, length.out = 12), 
                                  y = 1.1, label = month.abb),
                aes(x, y, label = label), size = 5, color = "darkgrey") +
  # Add month dividers
  geom_segment(data = data.frame(x = seq(0, 11) / 12, xend = seq(0, 11) / 12,
                                 y = 0.55, yend = 1.15),
               aes(x = x, y = y, xend = xend, yend = yend), color = "grey50", linetype = "dashed") +
  # Add individual points for each event type
  geom_point(data = df_long, aes(x = day_of_year_shifted, y = y_offset, color = date_type), size = 3) +
  # Add labels for observation points
  geom_text(data = df_long %>% filter(date_type == "date"), aes(x = day_of_year_shifted, y = 1.2, label = location), size = 3) +
  # Add box plots based on date types and align them correctly
  geom_boxplot(data = df_long, aes(x = day_of_year_shifted, y = y_offset, fill = date_type, group = date_type),
               width = 0.05, alpha = 0.3, outlier.shape = NA) +
  # Customize colors and legend
  scale_color_manual(values = c(date = "red", hatching_date = "blue", egg_laying_date = "green")) +
  scale_fill_manual(values = c(date = "red", hatching_date = "blue", egg_laying_date = "green")) +
  # Polar coordinates for circular layout
  coord_polar() +
  # Additional theme adjustments
  theme_void() +
  labs(title = "Circular Timeline with January at the Top", color = "Date Type", fill = "Date Type") +
  theme(legend.position = "right")

我尝试过一些操作,例如从九月开始一年,这解决了我的问题,但如果数据全年分裂,可能没有帮助。我需要更可靠的解决方案。
图的图片链接:IMAGE

r ggplot2 graph calendar
1个回答
0
投票

可以使用 coord_radial 制作极坐标图,其中元素可以跨越 12 月至 1 月期间。

这是一个例子:

library(lubridate)
library(ggplot2)

# show 1 month segments in a polar(radial) coordinate system

df <- data.frame(
  date = as.Date(c("2021-01-01", 
                   "2022-02-27",
                   "2023-03-12",
                   "2024-04-16",
                   "2025-05-20",
                   "2026-06-02",
                   "2027-07-30",
                   "2028-08-15",
                   "2029-09-20",
                   "2030-10-25",
                   "2031-12-30",
                   "2032-12-15"
                   )),
  label = letters[1:12]
)

# use lubdridate to get the date interval between the min and max of df$date
# add a month, to include the month from that last date
span <- interval(min(df$date), max(df$date)+months(1))

# duration of the interval
dur <- as.duration(span)

# number of years in the interval
n_years <- as.numeric(dur, "years")

# create the breaks for the x axis, one break for every month
# every month since the first of df$date for 1 year()
start = min(df$date)

# end = start + 1 year + 1 month (to include the last month)
end = start + years(1) + months(1)
xbreaks <- seq(start, end, by = "1 month")

# there are only 12 months in a year, so we only need 12 breaks
xbreaks <- xbreaks[1:12]

xlimits = c(min(df$date), max(df$date) + months(1))

ggplot(df) +
  geom_segment(
    aes(
      x = date, xend = date+months(1), 
      y = year(date), yend = year(date+months(1)), 
      color = label
      ), 
  linewidth = 2
  ) +
  # the panel gris is foobar'd in this plot, so we'll just draw our own
  geom_hline(
    yintercept = c(2020.5, 2025.5, 2030.5, 2035.5), 
    color = "grey", linetype = "solid", linewidth = .1
    ) +
  # mark the beginning of each segment
  geom_text(
    aes(x = date, y = year(date), label = label), 
    color = "black"
    ) +
  coord_radial(
    theta = "x", 
    start = 0, 
    # this is to make repating months in a circle 
    end = 2*pi*n_years,
    direction = 1, 
    clip = "off", 
    expand =  FALSE, 
    inner.radius = .5
    )+
  scale_x_continuous(
    breaks = as.numeric(xbreaks), 
    limits = as.numeric(xlimits), 
    labels = format(xbreaks, "%b")
    )+
  scale_y_continuous(
    expand = c(0, 0), 
    limits = c(2020, 2035.5)
    )+
  theme_minimal()+
  theme(
    # don't draw the panel grid
    panel.grid = element_blank()
  )
  
  
© www.soinside.com 2019 - 2024. All rights reserved.