Intro Thoughts
Status Quo
library(tidyverse)
# create default datetimes
ggcalendar::df_week(date = as_date("2024-08-12")) %>%
crossing(data.frame(time = hours(8:17))) %>%
mutate(datetime = date + time) ->
df_week_datetimes
df_week_datetimes %>%
head()
## # A tibble: 6 × 3
## date time datetime
## <date> <Period> <dttm>
## 1 2024-08-11 8H 0M 0S 2024-08-11 08:00:00
## 2 2024-08-11 9H 0M 0S 2024-08-11 09:00:00
## 3 2024-08-11 10H 0M 0S 2024-08-11 10:00:00
## 4 2024-08-11 11H 0M 0S 2024-08-11 11:00:00
## 5 2024-08-11 12H 0M 0S 2024-08-11 12:00:00
## 6 2024-08-11 13H 0M 0S 2024-08-11 13:00:00
df_week_datetimes %>%
ggplot() +
# Stat x and y from datetimes
aes(x = paste0(wday(date, label = T, abbr = T), "\n",
month(date, label = T, abbr = T)," " ,day(date)) %>%
fct_inorder()) +
aes(y = hms::as_hms(datetime)) +
# hour blocks - do with geom_rect instead, save xmin xmax etc in Stat
geom_tile(aes(y = hms::as_hms(datetime + minutes(30)))) +
aes(fill = I("white"),
color = I("grey"))
# probably better to just do date and adjust labels w scale_x... sec.axis = dup_axis(name = "Time of Day",labels = scales::label_time("%I %p")
# some theming default choices
last_plot() +
aes(fill = wday(date) %in% 2:6) +
scale_fill_manual(values =
c("grey98", "white")) +
guides(fill = "none") +
labs(x = NULL, y = NULL) +
theme_void() +
# coord page flips y (above)
coord_trans(y = "reverse") +
theme(axis.text.y = element_text(hjust = 1),
axis.text.x = element_text()) +
scale_y_time(breaks = hms::as_hms(c("08:00:00",
"9:00:00",
"10:00:00",
"11:00:00",
"12:00:00",
"13:00:00",
"14:00:00",
"15:00:00",
"16:00:00",
"17:00:00",
"18:00:00")
),
label = c("8am", "9am","10am","11am","12pm",
"1pm", "2pm", "3pm", "4pm", "", ""),
,
expand = expansion(mult = c(0,.1)))
# create helper for individual entries, day of week and time, event label
last_plot() +
annotate(geom = "label",
x = 6 - .5,
y = hms::as_hms("10:00:00"),
label = str_wrap("very important date", 10),
fill = NA,
vjust = 1,
hjust = 0,
label.size = NA,
lineheight = .8
)
Pull out peices
compute_group_weekly <- function(data, ...){
data |>
mutate(day = wday(datetime)) |>
mutate(day_name = paste0(wday(datetime, label = T, abbr = T), "\n",
month(datetime, label = T, abbr = T)," " , day(datetime)) %>%
fct_inorder()) |>
mutate(hour = hms::as_hms(datetime)) %>%
mutate(hour_mid = hms::as_hms(datetime + minutes(30)))
}
df_week_datetimes |>
compute_group_weekly()
## # A tibble: 70 × 7
## date time datetime day day_name hour hour_mid
## <date> <Period> <dttm> <dbl> <fct> <time> <time>
## 1 2024-08-11 8H 0M 0S 2024-08-11 08:00:00 1 "Sun\nAug 11" 08:00 08:30
## 2 2024-08-11 9H 0M 0S 2024-08-11 09:00:00 1 "Sun\nAug 11" 09:00 09:30
## 3 2024-08-11 10H 0M 0S 2024-08-11 10:00:00 1 "Sun\nAug 11" 10:00 10:30
## 4 2024-08-11 11H 0M 0S 2024-08-11 11:00:00 1 "Sun\nAug 11" 11:00 11:30
## 5 2024-08-11 12H 0M 0S 2024-08-11 12:00:00 1 "Sun\nAug 11" 12:00 12:30
## 6 2024-08-11 13H 0M 0S 2024-08-11 13:00:00 1 "Sun\nAug 11" 13:00 13:30
## 7 2024-08-11 14H 0M 0S 2024-08-11 14:00:00 1 "Sun\nAug 11" 14:00 14:30
## 8 2024-08-11 15H 0M 0S 2024-08-11 15:00:00 1 "Sun\nAug 11" 15:00 15:30
## 9 2024-08-11 16H 0M 0S 2024-08-11 16:00:00 1 "Sun\nAug 11" 16:00 16:30
## 10 2024-08-11 17H 0M 0S 2024-08-11 17:00:00 1 "Sun\nAug 11" 17:00 17:30
## # ℹ 60 more rows
StatWeekly <- ggproto("StatWeekly", Stat,
compute_group = compute_group_weekly,
required_aes = "datetime",
default_aes = aes(y = after_stat(hour),
x = after_stat(day)))
df_week_datetimes %>%
ggplot() +
# Stat x and y from datetimes
aes(datetime = datetime) +
geom_point(stat = StatWeekly, alpha = .2)
theme_weekly <- function(){
list(
theme_void(),
theme(axis.text.x = element_text(),
axis.text.y = element_text(hjust = 1, vjust = 1),
panel.grid.major.x = element_blank(),
panel.grid.minor.x = element_line(color = "grey"),
panel.grid.major.y = element_line(color = "grey"),
panel.grid.minor.y = element_blank())
)# use replace complete
}
last_plot() +
theme_weekly()
scale_y_weekly <- function(){
scale_y_time(breaks = hms::as_hms(c("08:00:00",
"9:00:00",
"10:00:00",
"11:00:00",
"12:00:00",
"13:00:00",
"14:00:00",
"15:00:00",
"16:00:00",
"17:00:00",
"18:00:00")
),
label = c("8am", "9am","10am","11am","12pm",
"1pm", "2pm", "3pm", "4pm", "", ""),
expand = expansion(mult = c(0,0)))
}
scale_x_weekly <- function(){
scale_x_continuous(expand = expansion(mult = c(0,0)),
limits = c(.5, 7.5),
breaks = 1:7)
}
last_plot() +
scale_y_weekly() +
scale_x_weekly()
coord_page <- function(){
coord_trans(y = "reverse")
}
last_plot() +
coord_page()
