Skip to content
Branch: master
Find file Copy path
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
370 lines (305 sloc) 13.1 KB
title: A Printable Custom Weekly Planner with ggplot2
author: Garrick Aden-Buie
date: '2019-06-22'
slug: ggplot2-weekly-planner
- Blog
- R
- ggplot2
- Productivity
- Scripts
description: "Use ggplot2 to organize your life."
twitterImage: "/blog/2019/2019-06-22-ggplot2-weekly-planner_files/figure-html/gcal-final-1.png"
keywords: rstats
chunk_output_type: console
<!-- Links -->
```{r setup, include=FALSE}
echo = TRUE, warning = FALSE, message = FALSE,
fig.width = 9, fig.height = 10
options(htmltools.dir.version = TRUE)
# If using lightbox for plots, set ` = FALSE`
# Usage: lightbox_img(knitr::fig_chunk("chunk-name", "png"))
lightbox_img <- function(url, alt = "", caption = "", img_extra = "", preview = TRUE) {
if (preview) {
'<a href="{url}" data-featherlight="image">
<div class="figure">
<img src="{url}" alt="{alt}" {img_extra}>
<p class="caption">{caption}</p>
} else {
if (alt == "") alt <- "static image of the plot"
glue::glue('<a href="{url}" data-featherlight="image">{alt}</a>')
<!-- Post -->
I was working on prioritizing some long term projects today and decided that _the one thing_ that would help me gain some clarity would be a weekly planner.
Rather than waste hours of productive time fighting popups and banner adds on the million and a half SEO-fueled malware-laden "free printable calendar" websites, I decided to waste not quite as many hours of productive time creating the exact calendar I wanted using [ggplot2]{.pkg}.
Here's the end result: a simple calendar where each week is a row.
Weeks start on Mondays because that's when a new week starts.
Important dates can be highlighted, for holidays or other days relevant to your projects.
I doubt it's bullet journal certified, but it worked for me and maybe it will for you too.
<a href="`r knitr::fig_chunk("gcal-final", "png")`">
<img src="`r knitr::fig_chunk("gcal-final", "png")`" style="max-width: 400px">
I'll break down the pieces that went into the calendar, but if you just want to make your own you can ~~jump to the end~~ use the [ggweekly] package I shared on GitHub and get straight to calendar printing and project planning.
**Update:** I realized it would be easier to share this code as a small R package rather than a gist or as a script embedded here.
You can now install [ggweekly]{.pkg} from [][ggweekly] and use the `ggweek_planner()` function to make your own custom, printable calendars.
## The Making of a Calendar
### Load the tidyverse
First, we need to load the usual suspects from the [tidyverse], plus the [lubridate]{.pkg} package (because dates).
```{r library}
# library(tidyverse)
Let's also save ourselves some extra typing and tell [lubridate]{.pkg} to always start weeks with Monday.
```{r lubridate-options}
options("lubridate.week.start" = 1)
### Create a tibble of dates
Next, I set up a tibble of dates and associated information (day of the week, month, year, etc.) that I'll need for the calendar grid.
I start by finding the nearest previous Monday to the starting date and creating a sequence of dates.
```{r seq_dates}
start_day <- floor_date(ymd("2019-06-24"), "week")
end_day <- ymd("2019-08-16")
seq_days <- seq(start_day, end_day, by = "day")
I'm also taking advantage of the fact that `tibble()` is similar to `mutate()` in that it allows you to create new columns that reference previous columns inside the `tibble` definition, rather than having a separate call to `mutate()`.
```{r dates}
dates <-
day = seq_days,
wday_name = wday(day, label = TRUE, abbr = TRUE),
weekend = wday(day) > 5,
isoweek = isoweek(day),
month = month(day, label = TRUE, abbr = FALSE),
isoyear = isoyear(day),
week_year = fct_rev(sprintf("%s - %s", isoyear, isoweek))
Note that I've used `isoweek()` and `isoyear()`, which also follow the convention of starting the week on Monday.
This way, I now have the week number to which each day in the sequence belongs, but because we may be interested in creating calendars that span multiple years, the addition of `isoyear()` protects against repeated week numbers.
This week year combination is destined for the *y* axis as it marks the row to which each day belongs.
The *y* axis is typically increasing, with the smallest value at the bottom.
This means that, if left as strings, the week of `"2019 - 25"` would be _below_ the week `"2019 - 26"`.
Because calendars are typically read top to bottom, I used `fct_rev()` here to both convert `{isoyear} - {isoweek}` into a factor and then reverse the factor order so that `2019 - 25` is the last factor.
```{r dates_week_year_factors}
# shows the _last 6_ week_year factor levels
dates %>% pull(week_year) %>% levels() %>% tail()
For a bit of convenience later, I then pull out the rows of `dates` representing the first day of the month, to use later when adding the colored boxes and text labels marking the start of a new month.
```{r day_one}
day_one <- dates %>%
filter(day(day) == 1)
### Better week labels
Quick, what's the starting date of week 31 in 2019?
Ok, fine, that was too hard.
What month of 2019 does week 31 belong to?
Trick question: that week starts on July 29, 2019 but ends on August 4th.
So... we need better axis labels than **2019 - 31**.
A reasonable replacement would be to use the day of the month of the week's starting day.
The following code filters `dates` to include the first day of each week (hint: it's Monday).
Then, I use `month(day, label = TRUE)` to get the abbreviated month name (`abbr = TRUE` is the default) that I'll append to the day of the month of each day.
But when a given week is preceded by a week from the same month, it would be visually distracting to see **Jul** repeated with each date — **Jul 1**, **Jul 8**, **Jul 15**, and so on — in the axis labels.
For easy scanning, I only included the month in the label if the month changed from the month before.
In other words, when `month == lag(month)`, I just need the day of the month the given week.
```{r week_start_labels}
week_start_labels <- dates %>%
filter(wday_name == "Mon") %>%
arrange(day) %>%
month = month(day, label = TRUE),
label = case_when(
month == lag(month) ~ paste(day(day)),
TRUE ~ sprintf("%s %4i", month, day(day))
) %>%
select(label, week_year) %>%
The last two lines there are a neat trick to take a two column `tibble` (or a two-element `list`) and convert it into a named vector using `purrr::reduce()`.
The first argument becomes the vector values and second argument becomes the vector names:
```{r reduce-set-names}
list(1:5, letters[1:5]) %>% purrr::reduce(setNames)
### A special tibble for special days
I used yet another tibble to store holidays and other important dates related to the project.
Each day can have a `label`, `color`, and/or `fill`.
```{r highlight_days}
highlight_days <- tribble(
~ day, ~ label, ~ color, ~ fill,
"2019-07-02", "Project Kick Off", "#02307a", "#02307a",
"2019-07-04", "July 4th", "#b4436c", "#b4436c",
"2019-07-12", "LOI Due", "#02307a", "#02307a",
"2019-07-26", "First Draft", "#02307a", "#02307a",
"2019-08-05", "Work week", "#02307a", "#02307a",
"2019-08-06", "", NA, "#02307a",
"2019-08-07", "", NA, "#02307a",
"2019-08-08", "", NA, "#02307a",
"2019-08-09", "", NA, "#02307a",
"2019-08-16", "Final Submission", "#02307a", "#02307a"
) %>%
mutate_at(vars(day), ymd)
### Finally, ggplot the calendar
Finally, we arrive at the main event, the actual creation of the calendar with [ggplot2]{.pkg}.
Here I use `geom_tile()` for each day, and then overlay tiles for the start-of-the-month days and the highlighted holiday and project-specific days.
I also used `geom_text()` to add annotations to the special days, which I pushed to the top or bottom left corner of the day box.
```{r gcal, fig.height=9, fig.width=7,"hide"}
gcal <-
dates %>%
# Softly fill in the weekend days
weekend = case_when(weekend ~ "#f8f8f8", TRUE ~ "#FFFFFF")
) %>%
ggplot() +
aes(wday_name, week_year) +
# the calendar grid
geom_tile(aes(fill = weekend), color = "#aaaaaa") +
# highlight first day of each month
data = day_one,
fill = "#f78154",
alpha = 0.25
) +
# add name of month to the first day
data = day_one,
aes(label = month),
family = "PT Sans Narrow",
color = "#f78154",
size = 4,
# push text to the top left corner
hjust = 0,
nudge_x = -0.45,
vjust = 1,
nudge_y = 0.45
) +
# highlight project-specific days
data = dates %>% inner_join(highlight_days, by = "day"),
aes(fill = fill),
alpha = 0.25
) +
# add the label from the highlighted days
data = dates %>% inner_join(highlight_days, by = "day"),
aes(label = label, color = color),
family = "PT Sans Narrow",
size = 2,
# push to bottom left corner
hjust = 0,
nudge_x = -0.45,
vjust = 0,
nudge_y = -0.40
) +
scale_x_discrete(position = "top") +
scale_y_discrete(labels = week_start_labels) +
scale_fill_identity() +
scale_color_identity() +
guides(fill = FALSE) +
theme_minimal(base_family = "PT Sans") +
axis.text = element_text("PT Sans Narrow"),
axis.title = element_blank(),
panel.grid = element_blank(), = element_text(face = "bold"), = element_blank(),
`r lightbox_img(knitr::fig_chunk("gcal", "png"), img_extra = 'height="400px"')`
### Calculate month boundaries
For a final touch, I wanted stronger differentiation between months.
In the following code, I convert `wday_name` and `week_year` into integers that indicate the center point of each box.
Then, using the fact that the top and bottom (and right and left) sides of the box are +/- 0.5 units from the center, I create three line segments.
The first extends from the bottom left corner of the day starting the week with the month change (left side of the plot) until the _left_ edge of the box representing the start of the next month.
The second segment line travels up the left edge of that box.
And the third and final segment travels from the top left corner of the month-changing day to the right edge of the plot.
```{r month_boundaries}
month_boundaries <- day_one %>%
select(day, month, wday_name, week_year) %>%
mutate_at(vars(wday_name, week_year), as.integer) %>%
left = map2(wday_name, week_year, ~ {
# n/a if month changes on first day
if (.x == 1) return(tibble(.missing = NA))
x = 0.5, xend = .x - 0.5,
y = .y - 0.5, yend = y
up = map2(wday_name, week_year, ~ {
# n/a if month changes on first day
if (.x == 1) return(tibble(.missing = NA))
x = .x - 0.5, xend = x,
y = .y - 0.5, yend = .y + 0.5
right = map2(wday_name, week_year, ~ {
x = .x - 0.5, xend = 7.5,
y = .y + 0.5, yend = y
Then, I use a quick for loop to add each of these segments to the calendar plot.
```{r gcal-final, fig.height=9, fig.width=7,"hide"}
for (boundary in c("left", "up", "right")) {
gcal <- gcal +
data = month_boundaries %>% unnest(!!rlang::sym(boundary)),
aes(x = x, y = y, xend = xend, yend = yend),
color = "#999999",
linetype = 2
`r lightbox_img(knitr::fig_chunk("gcal-final", "png"), img_extra = 'height="400px"')`
## A Weekly Planner Package {#ggweek_planner}
I originally thought I would simply include the code as a gist and move on with life, but I quickly realized that I might want to a) use this code again sometime and b) find some room for improvement and tweaks.
So I created [ggweekly], a small package for creating calendars like these. In packaging the code, I made a few tweaks and changes.
For example, I scraped the dates of federal holidays from the [U.S. Office of Personel Management]( and separated the highlighted and holiday days.
I also tweaked the function signatures a bit to make it more flexible.
Check out the package at [][ggweekly] and happy planning!
# create a calendar for April, May and June
start_day = "2019-04-01",
end_day = "2019-06-30",
You can’t perform that action at this time.