5.1 Stacked ggplot with custom periodization colors
How to create a stacked bar chart to see your gps for the week. Label with your morphocycle/tactical periodization labels. And as a kicker - start your week on Thursday since that is your first game. Final output and code will look like this:
Code
library(lubridate)library(tibble)library(dplyr)library(ggplot2)library(gt)# DATA -----------------------------------------------------------------------------------------------------------------# Create our own dataraw_gps_df <-tibble(date =seq.Date(from =as.Date('2023-08-01'), to =as.Date('2023-08-14'), by ='days'),metric =c(0, 8, 12, 18, 6, 12, 20, 0, 6, 9, 7, 19, 4, 17) )raw_session_desc <-tibble(date =seq.Date(from =as.Date('2023-08-01'), to =as.Date('2023-08-14'), by ='days'),tp_code =c('Off', 'ReEntry', 'Strength', 'Match 1', 'Recovery', 'Activation','Match 2', 'Off', 'Strength', 'Speed', 'Activation', 'Match 1','ReEntry-Activation', 'Match 2') )# Color codes. Presented a little cleaner to read (for us humans)raw_tp_codes <-tribble(~tp_code, ~tp_color,'Off', 'grey','ReEntry', 'lightgreen','Strength', 'blue','Endurance', 'limegreen','Speed', 'yellow','Activation', '#fff5a9','ReEntry-Activation','lightgreen','Match 1', 'darkgreen','Match 2', 'darkgreen','Recovery', 'chartreuse')# CUSTOM FUNCTION ------------------------------------------------------------------------------------------------------# Custom function to change a day ("Sunday", "Monday", "Tuesday", etc) # into a number with Sun = 1. Surprised this isn't a function in lubridate.daynum <-function(day){ day <-tolower(day)if(grepl("su", day)) {return(1) } elseif (grepl("mo", day)) {return(2) } elseif (grepl("tu", day)) {return(3) } elseif (grepl("we", day)) {return(4) } elseif (grepl("th", day)) {return(5) } elseif (grepl("fr", day)) {return(6) } elseif (grepl("sa", day)) {return(7) } else {return(NA) }}# This is the order we want our week to be in. # Thursday is the first day, Wednesday is the last.week_order <-c('Thu', 'Fri', 'Sat', 'Sun', 'Mon', 'Tue', 'Wed' )# TRANSFORM ------------------------------------------------------------------------------------------------------------# Combine into one data framesession_df <- raw_gps_df |>left_join(raw_session_desc, by ='date') |>left_join(raw_tp_codes, by ='tp_code') |>mutate(week =floor_date(date, unit ='weeks', daynum(week_order[1])))cols <-distinct(session_df, tp_code, tp_color) |>deframe()# PLOT -----------------------------------------------------------------------------------------------------------------session_df |>ggplot(aes(x = week, y = metric, fill = tp_code, group = date)) +geom_col(position =position_stack(reverse =TRUE)) +scale_fill_manual(name ="Tact Periodization Days",values = cols, ) +scale_x_date(breaks = session_df$week,date_labels ="%m-%d") +theme_minimal()
First lets create some fake data to use. You would probably import these with read_csv, but I’m going to keep it simple and just create it here.
library(lubridate)library(tibble)library(dplyr)library(ggplot2)library(gt)# Create our own dataraw_gps_df <-tibble(date =seq.Date(from =as.Date('2023-08-01'), to =as.Date('2023-08-14'), by ='days'),metric =c(0, 8, 12, 18, 6, 12, 20, 0, 6, 9, 7, 19, 4, 17) )raw_session_desc <-tibble(date =seq.Date(from =as.Date('2023-08-01'), to =as.Date('2023-08-14'), by ='days'),tp_code =c('Off', 'ReEntry', 'Strength', 'Match 1', 'Recovery', 'Activation','Match 2', 'Off', 'Strength', 'Speed', 'Activation', 'Match 1','ReEntry-Activation', 'Match 2') )# Look at the dataraw_gps_df |>gt()
date
metric
2023-08-01
0
2023-08-02
8
2023-08-03
12
2023-08-04
18
2023-08-05
6
2023-08-06
12
2023-08-07
20
2023-08-08
0
2023-08-09
6
2023-08-10
9
2023-08-11
7
2023-08-12
19
2023-08-13
4
2023-08-14
17
raw_session_desc |>gt()
date
tp_code
2023-08-01
Off
2023-08-02
ReEntry
2023-08-03
Strength
2023-08-04
Match 1
2023-08-05
Recovery
2023-08-06
Activation
2023-08-07
Match 2
2023-08-08
Off
2023-08-09
Strength
2023-08-10
Speed
2023-08-11
Activation
2023-08-12
Match 1
2023-08-13
ReEntry-Activation
2023-08-14
Match 2
I usually import my data as raw_data <- ... as it’s a pain to trouble shoot and have to and have to to rerun the import from the top of the code.
# Plot datasession_df |>ggplot(aes(x = date, y = metric, fill = tp_code)) +geom_col() +theme_minimal()
It would be nice to use our own custom color scheme. Help on using custom color and labels in ggplot found here. The ‘trick’ is to use deframe, which converts a two-column data frames to a named vector or list, using the first column as name and the second column as value. If the input has only one column, an unnamed vector is returned
# Color codes. Presented a little cleaner to read (for us humans)raw_tp_codes <-tribble(~tp_code, ~tp_color,'Off', 'grey','ReEntry', 'lightgreen','Strength', 'blue','Endurance', 'limegreen','Speed', 'yellow','Activation', '#fff5a9','ReEntry-Activation','lightgreen','Match 1', 'darkgreen','Match 2', 'darkgreen','Recovery', 'chartreuse')# Import and combine datasession_df <- raw_gps_df |>left_join(raw_session_desc, by ='date')# deframe() converts two-column data frames to a named vector or listcols <-distinct(raw_tp_codes, tp_code, tp_color) |>deframe()# Following not used but may come in handy in the future# labs \<- distinct(raw_tp_codes, tp_code, tp_code) |> deframe()# PLotsession_df |>ggplot(aes(x = date, y = metric, fill = tp_code)) +geom_col(position='stack', stat='identity') +scale_color_manual(aesthetics ='fill',values = cols) +theme_minimal()
Warning in geom_col(position = "stack", stat = "identity"): Ignoring unknown
parameters: `stat`
# Custom function to change a day ("Sunday", "Monday", "Tuesday", etc) # into a number with Sun = 1. Surprised this isn't a function in lubridate.daynum <-function(day){ day <-tolower(day)if(grepl("su", day)) {return(1) } elseif (grepl("mo", day)) {return(2) } elseif (grepl("tu", day)) {return(3) } elseif (grepl("we", day)) {return(4) } elseif (grepl("th", day)) {return(5) } elseif (grepl("fr", day)) {return(6) } elseif (grepl("sa", day)) {return(7) } else {return(NA) }}# This is the order we want our week to be in. # Thursday is the first day, Wednesday is the last.week_order <-c('Thu', 'Fri', 'Sat', 'Sun', 'Mon', 'Tue', 'Wed' )# Combine session_df <- raw_gps_df |>left_join(raw_session_desc, by ='date') |>left_join(raw_tp_codes, by ='tp_code') |>mutate(week =floor_date(date, unit ='weeks', daynum(week_order[1])))cols <-distinct(session_df, tp_code, tp_color) |>deframe()session_df |>ggplot(aes(x = week, y = metric, fill = tp_code, group = date)) +geom_col(position =position_stack(reverse =TRUE)) +scale_fill_manual(name ="Tact Periodization Days",values = cols, ) +scale_x_date(breaks = session_df$week,date_labels ="%m-%d") +theme_minimal()
