phoebe_tracking.R

library(tidyverse)
library(googlesheets4)
library(lubridate)
library(hms)
library(scales)
library(glue)
library(ggtext)
library(extrafont)

gs4_auth()

gs_id <- as_sheets_id("1d2z6533WvIUwWR78nE5gznn7OKkCue9COAn0dbfRTwI")

df <- read_sheet(gs_id) %>% 
  rename_all(tolower)


df_viz <- df %>% 
  filter(!is.na(time)) %>% 
  mutate(date = as_date(date),
         time = as_hms(time),
         date_time = ymd_hms(paste(date, time)),
         time_round = round_date(date_time, "15 minutes") %>% as_hms,
         date_clean = format.Date(date, "%b %d"),
         type = factor(type, c("Accident", "Walk", "Let out")),
         type_code = recode(type, 
                            "Accident" = -1,
                            "Walk" = 1,
                            "Let out" = 2)) %>%
  relocate(date_time, .before = 1) %>% 
  select(-time) %>%
  group_by(date, time_round) %>% 
  filter(type_code == min(type_code)) %>% 
  ungroup() %>% 
  mutate(fill_color = case_when(type == "Accident" ~ "#DD4326",
                                type == "Walk" ~ "#7E7E7E",
                                type == "Let out" ~ "#CFCFCF"))


df_full_blocks <- expand_grid(hour = (seq(0:23) - 1), seconds = seq(0, 45, by = 15)) %>% 
  mutate(time_round = as_hms(paste(hour, seconds, "00", sep = ":")),
         date_time = paste("2022-03-07", time_round) %>% as_datetime) %>%
  select(-hour, -seconds)


df_viz <- df_viz %>% 
  bind_rows(df_full_blocks) %>% 
  mutate(disp_time = date_time %>% 
           round_date("15 minutes") %>% 
           format("%r") %>% 
           str_replace("\\:00 ", " "),
         time_round = as.character(time_round)) 


df_stats <- df %>%
  filter(!is.na(time)) %>% 
  mutate(date = as_date(date)) %>% 
  filter(date > max(date) - 7) %>% 
  mutate(type = recode(type, 
                       "Let out" = "Walk/Let out",
                       "Walk" = "Walk/Let out")) %>% 
  count(type, name = "n_7day") %>% 
  mutate(avg_7day = n_7day / 7) #length(unique(df_stats$date)


df_viz %>% 
  ggplot(aes(date, fct_reorder(disp_time, time_round, max, .desc = TRUE), fill = fill_color)) +
  geom_tile(color = "white", width = .9, na.rm = TRUE) +
  scale_x_date(position = "top",
               date_breaks = "1 day",
               date_labels = "%b %d\n %a") +
  scale_y_discrete(labels = c("12 AM", "", "4 AM", "", "8 AM", "",
                              "12 PM","", "4 PM", "", "8 PM", ""),
                   breaks = c("12:00 AM", "02:00 AM", "04:00 AM", "06:00 AM", 
                              "08:00 AM", "10:00 AM", 
                              "12:00 PM", "02:00 PM", "04:00 PM", "06:00 PM", 
                              "08:00 PM", "10:00 PM")) +
  scale_fill_identity() +
  labs(x = NULL, y = NULL,
       title = glue("PHOEBE'S <span style='color:#DD4326'>ACCIDENTS</span> COMPARED TO WHEN SHE WAS <span style='color:#7E7E7E'>WALKED</span> OR <span style='color:#CFCFCF'>TAKEN OUT</span>"),
       subtitle = glue("Over the last 7 days, Phoebe has gone out {df_stats[df_stats$type == 'Walk/Let out',]$avg_7day %>% round(0)} times a day on average with {df_stats[df_stats$type == 'Accident',]$avg_7day %>% round(1)} accidents per day. Hugo typically went out 5 times a day.")) +
  theme_minimal() +
  theme(axis.title = element_blank(),
        panel.grid.major.x = element_blank(),
        plot.title = element_markdown(face = "bold"),
        plot.subtitle = element_markdown(),
        text = element_text(family = "Lato")
  )