• ggcalendar
• Step 00. Convenience functions, dates vectors to data frames.
  • Examples
• Step 1 & 2. Compute: from date to x/y, & define StatCalendar
  • Test it out
• Step 3. Let’s write a user-facing function stat_calendar()
  • Test stat_calendar
• aliasing and convenience
• defaults_calendar & ggcalendar() Thinking about set of scales/coords etc, that gives you a nice calendar (to wrap up into defaults)
  • theme_calendar, defaults_calendar & ggcalendar()
  • More
• NYC flights Example
• Births example
• data defaults to calendar year and aes(date = date)
• Minimal Viable Packaging
• Traditional README

<!-- README.md is generated from README.Rmd. Please edit that file -->

ggcalendar

<!-- badges: start -->

<!-- badges: end -->

Note: This README walks through package rational and contains the code that defines proposed package functions and in addition to first-cut testing. TLDR - Jump to traditional readme content

Here’s a proposal for creating calendars with ggplot2 via Stat extension.

When using calendars, ‘when?’ and ‘where?’ are the same question! So, ggcalendar introduces a new positional aesthetic: ‘date’. Let’s put things on the calendar!

In this proposed package, we’ll specify the position of a calendar event calendar using dates as the required aesthetic: aes(date = my_variable_of_dates)! Then you can use layers function stat_calendar() and derivative geom functions geom_text_calendar, geom_tile_calendar and geom_point_calendar to place specific grobs/mark in the plot space.

Under the hood, the compute_group functions finds the x and y position for the date in the month (x is day in week and y is week in month). Faceting by month is used to prevent over-plotting. Note: automatic faceting by month via ggcalendar() function presupposes that your variable is also named ‘date’.

Other possible directions would be to calculate x and y based on date in month and on month - instead of relying on faceting by month. Furthermore, a dedicated Coord could be created (Teun’s thought). Then maybe dates would just feed generically in as the ‘x’ aes - this sounds cool!

# library(ggcalendar)
library(ggplot2)
library(lubridate)
library(tidyverse)

# install.packages("devtools")
devtools::install_github("EvaMaeRey/ggcalendar")

Step 00. Convenience functions, dates vectors to data frames.

Because ggplot2’s diet is consists solely of dataframes, we create a number of convenience functions that will help us produce dataframes with column ‘date’ we can feed into ggplot2.

knitrExtra:::chunk_to_r("df_functions")

#' Title
#'
#' @return
#' @export
#'
#' @examples
df_today <- function(){

  data.frame(date = Sys.Date())

}

#' Title
#'
#' @param date 
#'
#' @return
#' @export
#'
#' @examples
df_day <- function(date = NULL){
  
  if(is.null(date)){date <- Sys.Date()}

  data.frame(date = date)

}


#' Title
#'
#' @param start_date 
#' @param end_date 
#'
#' @return
#' @export
#'
#' @examples
df_dates_interval <- function(start_date, end_date){

  data.frame(date = as.Date(start_date):as.Date(end_date) |>
    as.Date())

}

#' Title
#'
#' @param month 
#' @param year 
#'
#' @return
#' @export
#'
#' @examples
df_month <- function(month = NULL, year = NULL){

  if(is.null(month)){
    
    date <- Sys.Date()
    month <- lubridate::month(date) 
  }
   
  if(is.numeric(month)){ 
    
    month <- stringr::str_pad(month, width = 2, pad = "0")
    
  }
  
    if(is.null(year)){
    
    date <- Sys.Date()
    year <- lubridate::year(date)
    }

  
  paste0(year,"-", month, "-01") |>
    lubridate::as_date() ->
    start_date

  start_date |> lubridate::ceiling_date(unit = "month") ->
    end_date

    data.frame(date = 
                 df_dates_interval(start_date, 
                                       end_date - lubridate::days(1)))

}

#' Title
#'
#' @param date 
#'
#' @return
#' @export
#'
#' @examples
df_week <- function(date = NULL){

  if(is.null(date)){date <- Sys.Date()}

  start_date <- lubridate::floor_date(date, unit = "week")
  end_date <- lubridate::ceiling_date(date, unit = "week")

  data.frame(date = df_dates_interval(start_date, 
                        end_date - lubridate::days(1)) )

}

#' Title
#'
#' @param date 
#'
#' @return
#' @export
#'
#' @examples
return_df_hours_week <- function(date = NULL){

  if(is.null(date)){date <- Sys.Date()}

  start_date <- lubridate::floor_date(date, unit = "week")

  data.frame(date = (start_date + lubridate::hours(1:(24*7-1))))

}

#' Title
#'
#' @param year 
#'
#' @return
#' @export
#'
#' @examples
df_year <- function(year = NULL){

  if(is.null(year)){year <-  lubridate::year(Sys.Date())}

  paste0(year, "-01-01") |>
    lubridate::as_date() ->
  start_date

  start_date |> lubridate::ceiling_date(unit = "year") ->
    end_date

    data.frame(date = 
                 df_dates_interval(start_date, 
                                       end_date - lubridate::days(1)))
    
}

Examples

Let’s have a look at some of these.

df_today()
#>         date
#> 1 2024-09-03

df_day()
#>         date
#> 1 2024-09-03

df_dates_interval(start_date = "2024-10-02", end_date = "2024-10-04")
#>         date
#> 1 2024-10-02
#> 2 2024-10-03
#> 3 2024-10-04

df_week()
#>         date
#> 1 2024-09-01
#> 2 2024-09-02
#> 3 2024-09-03
#> 4 2024-09-04
#> 5 2024-09-05
#> 6 2024-09-06
#> 7 2024-09-07

df_year() |> head()
#>         date
#> 1 2024-01-01
#> 2 2024-01-02
#> 3 2024-01-03
#> 4 2024-01-04
#> 5 2024-01-05
#> 6 2024-01-06

df_month() |> head()
#>         date
#> 1 2024-09-01
#> 2 2024-09-02
#> 3 2024-09-03
#> 4 2024-09-04
#> 5 2024-09-05
#> 6 2024-09-06

return_df_hours_week() |> head()
#>                  date
#> 1 2024-09-01 01:00:00
#> 2 2024-09-01 02:00:00
#> 3 2024-09-01 03:00:00
#> 4 2024-09-01 04:00:00
#> 5 2024-09-01 05:00:00
#> 6 2024-09-01 06:00:00

Step 1 & 2. Compute: from date to x/y, & define StatCalendar

The computation that we want to be done under the hood relates to translating the here-to-fore unknown positional aesthetic ‘date’ to the first-class ‘x’ and ‘y’ positional aesthetic mappings, as well as variables that can be used in faceting (month).

knitrExtra:::chunk_to_r("get_week_of_month")

As a pre-step to computing many useful variables from our date variable, we focus on this (currently messy) conversion of vectors of dates to week of the month.

get_week_of_month <- function(x){
  
  (- lubridate::wday(x) + lubridate::day(x)) %/% 
    7 + 1 +
    ifelse(lubridate::wday(lubridate::floor_date(lubridate::as_date(x), "month")) == 1, 0, 1)
  
}

Next, we’ll define a compute group function. A number of variables are created by parsing our date variable.

Then, we’ll pass all this computation to define a new ggproto object StatCalendar. For maximum flexibility, our compute function doesn’t create ggplot2 core aesthetic channels ‘x’, ‘y’, and ‘label’ variables, but instead uses the default_aes field to state what should be first interpreted as x, y and label (thoughts? Maybe only ‘label’ should be managed like this).

knitrExtra:::chunk_to_r("compute_group_calendar")

compute_group_calendar <- function(data, scales){

  data |>
    dplyr::mutate(wday = lubridate::wday(.data$date)) |>
    dplyr::mutate(wday_abbr = lubridate::wday(.data$date, label = TRUE, abbr = TRUE)) |>
    dplyr::mutate(week_of_month = get_week_of_month(.data$date)) |>
    dplyr::mutate(day = lubridate::day(.data$date)) |>
    dplyr::mutate(year = lubridate::year(.data$date) - 2018) |>
    dplyr::mutate(month_abbr = lubridate::month(.data$date, abbr = TRUE, label = TRUE)) |>
    dplyr::mutate(hour = lubridate::hour(.data$date)) |>
    dplyr::mutate(year_academic =  lubridate::year(.data$date) +
                    ifelse(lubridate::month(date) >
                             6, 1, 0)) |>
    dplyr::mutate(month_academic_abbr = .data$month_abbr |>
                    factor(levels = c("Jul", "Aug", "Sep", "Oct", "Nov", "Dec",
                                      "Jan", "Feb", "Mar", "Apr", "May", "Jun")))

}

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(wday),
                                                            y = ggplot2::after_stat(week_of_month),
                                                            label = ggplot2::after_stat(day)))


StatWeekly <- ggplot2::ggproto(`_class` = "StatCalendar",
                               `_inherit` = ggplot2::Stat,
                               required_aes = c("date"),
                               compute_group = compute_group_calendar,
                               default_aes = ggplot2::aes(x = ggplot2::after_stat(wday),
                                                          y = ggplot2::after_stat(hour),