Make a circular calendar in ggplot2

calendar.R

library(tidyverse)

year <- 2019
start_date <- lubridate::date(str_glue("{year}-01-01"))  # there must be a better way??


month_colours <- c(
  "January"   = "#a5cdff",
  "February"  = "#c9e1ff",
  "March"     = "#b2edb6",
  "April"     = "#98e79e",
  "May"       = "#7fe186",
  "June"      = "#ffdd75",
  "July"      = "#ffeaac",
  "August"    = "#fff4d5",
  "September" = "#cf987e",
  "October"   = "#c47f5f",
  "November"  = "#9c654c",
  "December"  = "#6fafff"
)

dates <- 
  tibble(date  = seq(start_date, start_date + lubridate::years(1), by = 1)) %>% 
  mutate(month = lubridate::month(date, label = TRUE, abbr = FALSE))

# Work out the rotation required to put the solstace at the top
offset <- 
  dates %>% 
  mutate(i = row_number(),
         p = i / max(i),
         rad = p * 2*pi) %>% 
  filter(date == "2019-06-21") %>% 
  pull(rad)


ggplot(data = dates) +
  geom_bar(
    mapping = aes(x = 2, fill = month),
    width = 1
  ) +
  scale_fill_manual(values = month_colours, guide = FALSE) +
  coord_polar(theta = "y", start = offset, direction = -1) +
  xlim(0, 3) +
  theme_void()


# Fancier version with current date marking
dates %>% 
  group_by(month) %>%
  summarise(start = min(date),
            end   = max(date)) %>% 
  ggplot() +
  geom_rect(aes(ymin = start, ymax = end,
                xmin = 1,     xmax = 2, 
                fill = month),
            colour = NA) +
  annotate("segment", linetype = "dotted",
           x = 0.9, xend = 2.2,
           y = lubridate::today(),
           yend = lubridate::today()) +
  annotate("point",
           x = 2.2,
           y = lubridate::today(),
           size = 8,
           pch = 21,
           fill = "white") +
  annotate("text",
           x = 2.2,
           y = lubridate::today(),
           label = lubridate::day(lubridate::today())) +
  scale_fill_manual(values = month_colours, guide = FALSE) +
  coord_polar(theta = "y", start = offset, direction = 1) +
  xlim(0, 3) +
  theme_void()