解决sugrrants::facet_calendar日期换行问题及替代方案

问题描述 #

使用sugrrants::facet_calendar生成日历图时，若月份需要超过默认的5行7列布局，月末日期会被换行到日历顶部（例如2025年3月的30日、31日），期望这些日期能显示在第6行。

可复现代码 #

library(hms)
library(sugrrants)
library(tidyverse)
tribble(~date_time, ~count,
        "2025-03-01 10:00 AM", 10,
        "2025-03-01 11:00 AM", 8,
        "2025-03-01 12:00 PM", 6,
        "2025-03-10 10:00 AM", 3,
        "2025-03-10 11:00 AM", 4,
        "2025-03-10 12:00 PM", 5,
        "2025-03-12 10:00 AM", 7,
        "2025-03-12 11:00 AM", 9,
        "2025-03-12 12:00 PM", 11,) |> 
  mutate(date_time = parse_date_time(date_time, orders = "ymd HM p")) |> 
  mutate(date = as.Date(date_time)) |> 
  mutate(time = as_hms(date_time)) |> 
  ggplot(aes(x = time)) +
  geom_line(aes(y = count)) +
  facet_calendar(~ date, week_start = 7)

调整参数时的错误 #

尝试通过facet_calendar的nrow/ncol参数修改行数时，设置非默认的NULL值会触发如下错误：

Error in `dplyr::tibble()`:
! Tibble columns must have compatible sizes.
- Size 31: Existing data.
- Size 186: Column `MROW`.
i Only values of size one are recycled.
Run `rlang::last_trace()` to see where the error occurred.
Warning message:
In row_idx[] <- map2(.x = row_idx, .y = n_idx, function(.x, .y) .x +  :
number of items to replace is not a multiple of replacement length

自定义解决方案 #

改用ggh4x::facet_manual并编写自定义函数生成布局，解决日期换行问题。替换后的facet代码行如下：

facet_manual(~ date, design = if_else(today() > last_day_of_month, get_facet_manual_design(last_day_of_month), get_facet_manual_design(today())))

其中last_day_of_month用于区分当前日期日历和过往月份日历。

以下是生成facet_manual布局字符串的自定义函数，供参考：

get_facet_manual_design <- function(input_date) {
  
  # 获取当月第一天
  first_this_month <- make_datetime(year(input_date), month(input_date), 1)
  
  # 计算月初需要的占位#数量（根据第一天的星期数）
  hashs_needed_start <- wday(first_this_month) - 1
  
  # 计算月末需要的占位#数量
  hashs_needed_end <- 7 - wday(input_date)
  
  # 计算当月需要的符号数量（对应天数）
  symbols_needed <- as.numeric(input_date - as.Date(first_this_month)) + 1
  
  # 符号库，用于对应每日的facet
  symbolbank <- c("1", "2", "3", "4", "5", "6", "7",
                  "8", "9", "A", "B", "C", "D", "E",
                  "F", "G", "H", "I", "J", "K", "L",
                  "M", "N", "O", "P", "Q", "R", "S",
                  "T", "U", "V", "W", "X", "Y", "Z")
  
  ##### 生成布局字符串
  # 初始化月初占位#
  design <- rep("#", hashs_needed_start)
  
  # 添加对应天数的符号
  design <- design |> 
    append(head(symbolbank, symbols_needed))
  
  # 添加月末占位#
  design <- design |> 
    append(rep("#", hashs_needed_end))
  
  # 计算需要插入的换行符数量
  number_newlines <- floor(length(design) / 7) - 1
  newlines <- c("")
  newlines <- append(newlines, rep("\n", number_newlines))
  
  # 插入换行符并整理成矩阵
  design <- rbind(newlines, matrix(design, ncol = length(newlines)))
  
  # 合并为最终布局字符串
  design <- design |> paste(collapse = "")
  this_months_design <- str_glue(design)
  
  return(this_months_design)
  
}

内容的提问来源于stack exchange，提问作者banjaloupe