Intro Thoughts
Status Quo
library(tidyverse)
compute_group_calendar <- function(data, scales){
data %>%
dplyr::mutate(num_day_of_week = lubridate::wday(.data$date)) %>%
dplyr::mutate(day_of_week = lubridate::wday(.data$date, label = TRUE, abbr = TRUE)) %>%
dplyr::mutate(week_of_month = (- lubridate::wday(.data$date) + lubridate::day(.data$date)) %/% 7 + 1 +
ifelse(lubridate::wday(lubridate::floor_date(lubridate::as_date(.data$date), "month")) == 1, -1, 0)
) %>%
dplyr::mutate(date_of_month = lubridate::day(.data$date)) %>%
dplyr::mutate(which_year = lubridate::year(.data$date) - 2018) %>%
dplyr::mutate(month = lubridate::month(.data$date, abbr = TRUE, label = TRUE)) %>%
dplyr::mutate(hour = lubridate::hour(.data$date)) %>%
dplyr::mutate(academic_year = lubridate::year(.data$date) +
ifelse(lubridate::month(date) >
6, 1, 0)) %>%
dplyr::mutate(academic_month = .data$month %>%
factor(levels = c("Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
"Jan", "Feb", "Mar", "Apr", "May", "Jun")))
}
ggcalendar::return_dates_year(1999) %>%
head() %>%
compute_group_calendar()
## date num_day_of_week day_of_week week_of_month date_of_month which_year
## 1 1999-01-01 6 Fri 0 1 -19
## 2 1999-01-02 7 Sat 0 2 -19
## 3 1999-01-03 1 Sun 1 3 -19
## 4 1999-01-04 2 Mon 1 4 -19
## 5 1999-01-05 3 Tue 1 5 -19
## 6 1999-01-06 4 Wed 1 6 -19
## month hour academic_year academic_month
## 1 Jan 0 1999 Jan
## 2 Jan 0 1999 Jan
## 3 Jan 0 1999 Jan
## 4 Jan 0 1999 Jan
## 5 Jan 0 1999 Jan
## 6 Jan 0 1999 Jan
StatCalendar <- ggplot2::ggproto(`_class` = "StatCalendar",
`_inherit` = ggplot2::Stat,
required_aes = c("date"),
compute_group = compute_group_calendar,
default_aes = ggplot2::aes(x = ggplot2::after_stat(day_of_week %>% as.numeric()),
y = ggplot2::after_stat(week_of_month),
label = ggplot2::after_stat(date_of_month)))
Experiment
x0 = 0
y0 = 0
library(ggstamp)
hspace <- 2
vspace <- 3
ggcalendar::return_dates_year(1999) %>%
# head() %>%
compute_group_calendar() %>%
mutate(x = day_of_week %>% as.numeric() + (as.numeric(month)-1)%%3*(7+hspace)) %>%
mutate(y = week_of_month + (as.numeric(month)-1)%/%3*(5+vspace)) %>%
ggplot() +
aes(x = x, y = y) +
geom_point() +
scale_y_reverse() +
geom_label(aes(label = month(date)))
