class: inverse, center, middle # 36-315: Statistical Graphics and Visualization ## Lecture 15 Meghan Hall <br> Department of Statistics & Data Science <br> Carnegie Mellon University <br> June 28, 2021 --- layout: true <div class="my-footer"><span>cmu-36315.netlify.app</span></div> --- # Schedule <br> .large[Presentation sign-ups this AM] <br> .large[Lab 10 tomorrow, due Wednesday] <br> .medium[HW 5 due tomorrow] <br> .large[Last live lecture today] <br> .medium[Wednesday: special topics] --- # What do you turn in? <br> .large[Final report: 11:30am EDT Friday] <br> .medium[.html] <br> .medium[.Rmd (don't forget `echo = FALSE` to suppress code)] <br> .large[Final presentation: right after] <br> .medium[.Rmd file only] <br> .medium[probably won't knit, that's fine! just to check] --- # Today <br> .large[Adding another layer to our plots] <br> .medium[animation with `gganimate`] <br> .medium[interactivity with `plotly`] <br> .large[Functional programming with `purrr`] <br> .medium[`map` functions as an alternative to for loops] --- # `gganimate` <br> .large[Adds animation to existing plots] <br> .medium[[https://gganimate.com/](https://gganimate.com/)] <br> .medium[using various `transition_*` functions] <br> .large[Many other options we won't discuss today] <br> .medium[can specify how data & aesthetics fade, change, etc.] <br> .large[Can run plots like usual or:] <br> .medium[use `anim_save("filepath")` to save as gif] <br> .medium[will save last-run animation] --- # `gganimate` .large[When should you *not* animate?] <br> .medium[when it doesn't add anything to the plot] <br> -- ```r penguins %>% ggplot(aes(x = body_mass_g, y = bill_length_mm, color = species)) + geom_point(alpha = 0.7, size = 4) + scale_color_brewer(type = "qual", name = NULL) + labs(x = "Body Mass (g)", y = "Bill Length (mm)") + lab_theme() + theme(legend.position = c(0.8, 0.2), legend.text = element_text(size = 14), axis.title = element_text(size = 13)) ``` --- # `gganimate` <img src="figs/Lec15/animate-1-1.png" width="504" style="display: block; margin: auto;" /> --- # `gganimate` .large[When should you *not* animate?] <br> .medium[when it doesn't add anything to the plot] <br> ```r penguins %>% ggplot(aes(x = body_mass_g, y = bill_length_mm, color = species)) + geom_point(alpha = 0.7, size = 4) + scale_color_brewer(type = "qual", name = NULL) + labs(x = "Body Mass (g)", y = "Bill Length (mm)") + lab_theme() + theme(legend.position = c(0.8, 0.2), legend.text = element_text(size = 14), axis.title = element_text(size = 13)) %>% * transition_states(species, * transition_length = 0.5, * state_length = 1) ``` --- # `gganimate` .center[![logo](figs/Lec15/scatter.gif)] --- # `gganimate` .large[When can you add animation?] <br> .medium[when it adds depth & emphasis to your story/conclusion] <br> -- ```r third_place %>% ggplot(aes(x = round, y = points, group = name, color = name)) + geom_line(size = 2) + scale_color_manual(values = c("#E0610E","#F596C8","#FFF500"), name = NULL) + scale_x_continuous(breaks = seq(1, 17, 1)) + labs(title = "The race for third place in the 2020 F1 season", y = "Accumulated points", x = NULL) + lab_theme() + theme(legend.position = c(0.3, 0.7), panel.grid.major.x = element_blank(), legend.text = element_text(size = 13)) ``` --- # `gganimate` <img src="figs/Lec15/animate-3-1.png" width="504" style="display: block; margin: auto;" /> --- # `gganimate` .large[When can you add animation?] <br> .medium[when it adds depth & emphasis to your story/conclusion] <br> ```r third_place %>% ggplot(aes(x = round, y = points, group = name, color = name)) + geom_line(size = 2) + scale_color_manual(values = c("#E0610E","#F596C8","#FFF500"), name = NULL) + scale_x_continuous(breaks = seq(1, 17, 1)) + labs(title = "The race for third place in the 2020 F1 season", y = "Accumulated points", x = NULL) + lab_theme() + theme(legend.position = c(0.3, 0.7), panel.grid.major.x = element_blank(), legend.text = element_text(size = 13)) + * transition_reveal(round) ``` --- # `gganimate` .center[![logo](figs/Lec15/line-graph.gif)] --- # `gganimate` .large[When can you add animation?] <br> .medium[when it adds another useful dimension (usually time)] <br> -- ```r txhousing %>% group_by(city, year) %>% summarize(median = mean(median, na.rm = TRUE), listings = mean(listings, na.rm = TRUE)) %>% ggplot(aes(x = median, y = listings, color = city == "Houston", size = city == "Houston")) + geom_point(show.legend = FALSE) + scale_color_manual(values = c("black","#bb0000")) + scale_size_manual(values = c(2, 4)) + scale_x_continuous(labels = dollar, name = "Median Price") + scale_y_continuous(labels = label_number_si()) + lab_theme() + labs(x = "Median Price", y = "Avg. of Monthly Listings", subtitle = "Houston in red") ``` --- # `gganimate` <img src="figs/Lec15/animate-5-1.png" width="504" style="display: block; margin: auto;" /> --- # `gganimate` .large[When can you add animation?] <br> .medium[when it adds another useful dimension (usually time)] <br> ```r txhousing %>% group_by(city, year) %>% summarize(median = mean(median, na.rm = TRUE), listings = mean(listings, na.rm = TRUE)) %>% ggplot(aes(x = median, y = listings, color = city == "Houston", size = city == "Houston")) + geom_point(show.legend = FALSE) + scale_color_manual(values = c("black","#bb0000")) + scale_size_manual(values = c(2, 4)) + scale_x_continuous(labels = dollar, name = "Median Price") + scale_y_continuous(labels = label_number_si()) + lab_theme() + labs(x = "Median Price", y = "Avg. of Monthly Listings", * title = 'Year: {frame_time}', subtitle = "Houston in red") + * transition_time(year) ``` --- # `gganimate` .center[![logo](figs/Lec15/scatter-year.gif)] --- # `plotly` <br> .large[Adds interactivity (namely tooltips) to existing plots] <br> .medium[[https://plotly.com/ggplot2/](https://plotly.com/ggplot2/)] <br> .large[Assign your plot to an object] <br> .medium[and call within `ggplotly`] --- # `plotly` ```r scatter_plain <- penguins %>% ggplot(aes(x = body_mass_g, y = flipper_length_mm, color = species)) + geom_jitter(size = 3, alpha = 0.8) + scale_color_brewer(type = "qual", name = NULL) + labs(x = "Body Mass (g)", y = "Flipper Length (mm)") + lab_theme() ``` <img src="figs/Lec15/plotly-2-1.png" width="504" style="display: block; margin: auto;" /> --- # `plotly` ```r ggplotly(scatter_plain) ```
--- # `plotly` ```r scatter_sex <- penguins %>% ggplot(aes(x = body_mass_g, y = flipper_length_mm, color = species, * text = paste("sex:", sex))) + geom_jitter(size = 3, alpha = 0.8) + scale_color_brewer(type = "qual", name = NULL) + labs(x = "Body Mass (g)", y = "Flipper Length (mm)") + lab_theme() ``` <img src="figs/Lec15/plotly-5-1.png" width="504" style="display: block; margin: auto;" /> --- # `plotly` ```r ggplotly(scatter_sex, tooltip = c("text", "species")) ```
--- # `plotly` ```r scatter_more <- penguins %>% * mutate(`Body mass` = paste(body_mass_g, "grams"), * `Flipper length` = paste0(flipper_length_mm, "mm")) %>% ggplot(aes(x = body_mass_g, y = flipper_length_mm, color = species, * text = paste("sex:", sex), label = `Body mass`, * label1 = `Flipper length`)) + geom_jitter(size = 3, alpha = 0.8) + scale_color_brewer(type = "qual", name = NULL) + labs(x = "Body Mass (g)", y = "Flipper Length (mm)") + lab_theme() ``` --- # `plotly` ```r ggplotly(scatter_more, tooltip = c("text", "species", "Body mass", "Flipper length")) ```
--- # `plotly` <img src="figs/Lec15/plotly-9-1.png" width="504" style="display: block; margin: auto;" /> --- # `plotly` ```r heat <- lincoln_weather %>% select(CST, temp = `Max Temperature [F]`) %>% mutate(date = ymd(CST), month = month(date, label = TRUE), day = day(date), * date_show = paste(month, day)) %>% * ggplot(aes(x = month, y = day, text = date_show, fill = temp)) + geom_tile(color = "white") + scale_y_continuous(trans = "reverse", breaks = seq(1, 31, 5)) + labs(title = "Maximum temperature by day in Lincoln, NE in 2016") + scale_fill_scico(palette = "imola", breaks = seq(20, 90, 10), name = " °F") + guides(fill = guide_colorsteps()) + theme(axis.ticks = element_blank(), panel.background = element_blank(), axis.title = element_blank(), axis.text = element_text(face = 2)) + coord_cartesian(expand = FALSE) ``` --- # `plotly` ```r ggplotly(heat, tooltip = c("text", "temp")) ```
--- # `purrr` <br> .large[Part of the `tidyverse`] <br> .medium[[https://purrr.tidyverse.org/](https://purrr.tidyverse.org/)] <br> .medium[[https://r4ds.had.co.nz/iteration.html#the-map-functions](https://r4ds.had.co.nz/iteration.html#the-map-functions)] <br> .large[Useful for *functional programming*] <br> .medium[provides an alternative to for loops] <br> .large[`map_*` functions allow you to iterate over elements] --- # `purrr` ```r class(penguins$bill_depth_mm) ``` ``` ## [1] "numeric" ``` -- ```r penguins %>% map_chr(class) ``` ``` ## species island bill_length_mm bill_depth_mm ## "factor" "factor" "numeric" "numeric" ## flipper_length_mm body_mass_g sex year ## "integer" "integer" "factor" "integer" ``` -- ```r new_df <- penguins %>% map_df(class) ``` <table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;"> <thead> <tr> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> species </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> island </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> bill_length_mm </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> bill_depth_mm </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> flipper_length_mm </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> body_mass_g </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> sex </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> year </th> </tr> </thead> <tbody> <tr> <td style="text-align:left;"> factor </td> <td style="text-align:left;"> factor </td> <td style="text-align:left;"> numeric </td> <td style="text-align:left;"> numeric </td> <td style="text-align:left;"> integer </td> <td style="text-align:left;"> integer </td> <td style="text-align:left;"> factor </td> <td style="text-align:left;"> integer </td> </tr> </tbody> </table> --- # `purrr` ```r penguins %>% map_dbl(mean, na.rm = TRUE) ``` ``` ## species island bill_length_mm bill_depth_mm ## NA NA 43.92193 17.15117 ## flipper_length_mm body_mass_g sex year ## 200.91520 4201.75439 NA 2008.02907 ``` -- ```r penguins %>% select_if(is.numeric) %>% map_dbl(mean, na.rm = TRUE) ``` ``` ## bill_length_mm bill_depth_mm flipper_length_mm body_mass_g ## 43.92193 17.15117 200.91520 4201.75439 ## year ## 2008.02907 ``` --- # `purrr` <br> .large[Very helpful for a very common task:] <br> .medium[split your data frame into pieces] <br> .medium[apply a function to perform an action on each piece] <br> .medium[put those pieces back together] <br> .large[The previous examples used known functions (`class`, `mean`)] <br> .medium[but we can also use user-defined functions] --- # `purrr` .center[Throughout the season, how did **Montreal's** standings points compare to the playoff threshold?] .center[`nhl2021_games`] .center[![logo](figs/Lec12/nhl_logo.png)] --- # `purrr` .center[`nhl2021_games`] <table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;"> <thead> <tr> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> game_id </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> game_date </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> away_team </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> home_team </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> home_score </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> away_score </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> max_period </th> </tr> </thead> <tbody> <tr> <td style="text-align:right;"> 2020020001 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:left;"> PIT </td> <td style="text-align:left;"> PHI </td> <td style="text-align:right;"> 6 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020002 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:left;"> CHI </td> <td style="text-align:left;"> T.B </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 1 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020003 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:left;"> MTL </td> <td style="text-align:left;"> TOR </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 4 </td> </tr> <tr> <td style="text-align:right;"> 2020020004 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:left;"> VAN </td> <td style="text-align:left;"> EDM </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020005 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:left;"> STL </td> <td style="text-align:left;"> COL </td> <td style="text-align:right;"> 1 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020006 </td> <td style="text-align:left;"> 2021-01-14 </td> <td style="text-align:left;"> WSH </td> <td style="text-align:left;"> BUF </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 6 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020007 </td> <td style="text-align:left;"> 2021-01-14 </td> <td style="text-align:left;"> BOS </td> <td style="text-align:left;"> N.J </td> <td style="text-align:right;"> 2 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 5 </td> </tr> <tr> <td style="text-align:right;"> 2020020008 </td> <td style="text-align:left;"> 2021-01-14 </td> <td style="text-align:left;"> NYI </td> <td style="text-align:left;"> NYR </td> <td style="text-align:right;"> 0 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020009 </td> <td style="text-align:left;"> 2021-02-22 </td> <td style="text-align:left;"> DAL </td> <td style="text-align:left;"> FLA </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 1 </td> <td style="text-align:right;"> 3 </td> </tr> <tr> <td style="text-align:right;"> 2020020010 </td> <td style="text-align:left;"> 2021-01-14 </td> <td style="text-align:left;"> CAR </td> <td style="text-align:left;"> DET </td> <td style="text-align:right;"> 0 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 3 </td> </tr> </tbody> </table> --- # `purrr` ```r north_div <- nhl2021_games %>% mutate(winner = ifelse(home_score > away_score, "home", "away")) %>% pivot_longer(home_team:away_team, names_to = c("home_away", ".value"), names_pattern = "(.+)_(.+)") %>% mutate(points = case_when(winner == home_away ~ 2, winner != home_away & max_period > 3 ~ 1, TRUE ~ 0)) %>% filter(team %in% c("WPG", "EDM", "CGY", "VAN", "MTL", "OTT", "WPG", "TOR")) %>% arrange(game_date) ``` <table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;"> <thead> <tr> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> game_id </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> game_date </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> home_score </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> away_score </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> max_period </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> winner </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> home_away </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> team </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> points </th> </tr> </thead> <tbody> <tr> <td style="text-align:right;"> 2020020003 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:left;"> home </td> <td style="text-align:left;"> home </td> <td style="text-align:left;"> TOR </td> <td style="text-align:right;"> 2 </td> </tr> <tr> <td style="text-align:right;"> 2020020003 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:left;"> home </td> <td style="text-align:left;"> away </td> <td style="text-align:left;"> MTL </td> <td style="text-align:right;"> 1 </td> </tr> <tr> <td style="text-align:right;"> 2020020004 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:left;"> away </td> <td style="text-align:left;"> home </td> <td style="text-align:left;"> EDM </td> <td style="text-align:right;"> 0 </td> </tr> <tr> <td style="text-align:right;"> 2020020004 </td> <td style="text-align:left;"> 2021-01-13 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:left;"> away </td> <td style="text-align:left;"> away </td> <td style="text-align:left;"> VAN </td> <td style="text-align:right;"> 2 </td> </tr> </tbody> </table> --- # `purrr` ```r north_total <- north_div %>% group_by(team) %>% mutate(total_points = cumsum(points)) %>% summarize(total_points = max(total_points)) %>% arrange(desc(total_points)) ``` <table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;"> <thead> <tr> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> team </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> total_points </th> </tr> </thead> <tbody> <tr> <td style="text-align:left;"> TOR </td> <td style="text-align:right;"> 77 </td> </tr> <tr> <td style="text-align:left;"> EDM </td> <td style="text-align:right;"> 72 </td> </tr> <tr> <td style="text-align:left;"> WPG </td> <td style="text-align:right;"> 63 </td> </tr> <tr> <td style="text-align:left;"> MTL </td> <td style="text-align:right;"> 59 </td> </tr> <tr> <td style="text-align:left;"> CGY </td> <td style="text-align:right;"> 55 </td> </tr> <tr> <td style="text-align:left;"> OTT </td> <td style="text-align:right;"> 51 </td> </tr> <tr> <td style="text-align:left;"> VAN </td> <td style="text-align:right;"> 50 </td> </tr> </tbody> </table> --- # `purrr` ```r north_total %>% * ggplot(aes(x = team, y = total_points, fill = team == "MTL")) + geom_bar(stat = "identity", show.legend = FALSE) + * scale_fill_manual(values = c("dark grey", "#AF1E2D")) + * geom_hline(yintercept = pluck(north_total, 2, 4), color = "black", size = 2) + labs(x = NULL, y = "Standings points", title = "Montreal's standings points, 2021 season", subtitle = "Compared to playoffs threshold in black") + lab_theme() ``` --- # `purrr` <img src="figs/Lec15/example-6-1.png" width="504" style="display: block; margin: auto;" /> --- # `purrr` Start with an example: what was the status as of April 1? ```r north_div %>% filter(game_date <= "2021-04-01") %>% mutate(game_date = "2021-04-01") %>% group_by(team, game_date) %>% mutate(total_points = cumsum(points)) %>% summarize(total_points = max(total_points)) %>% arrange(desc(total_points)) %>% ungroup() %>% mutate(rank = row_number(), threshold = ifelse(rank == 4, total_points, NA)) ``` <table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;"> <thead> <tr> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> team </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> game_date </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> total_points </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> rank </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> threshold </th> </tr> </thead> <tbody> <tr> <td style="text-align:left;"> TOR </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 49 </td> <td style="text-align:right;"> 1 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> WPG </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 46 </td> <td style="text-align:right;"> 2 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> EDM </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 45 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> MTL </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 41 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 41 </td> </tr> <tr> <td style="text-align:left;"> CGY </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 35 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> VAN </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 35 </td> <td style="text-align:right;"> 6 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> OTT </td> <td style="text-align:left;"> 2021-04-01 </td> <td style="text-align:right;"> 28 </td> <td style="text-align:right;"> 7 </td> <td style="text-align:right;"> </td> </tr> </tbody> </table> --- # `purrr` Create the function with the game date as the argument ```r points_by_day <- function(day) { north_div %>% filter(game_date <= day) %>% mutate(game_date = day) %>% group_by(team, game_date) %>% mutate(total_points = cumsum(points)) %>% summarize(total_points = max(total_points)) %>% arrange(desc(total_points)) %>% ungroup() %>% mutate(rank = row_number(), threshold = ifelse(rank == 4, total_points, NA)) } ``` --- # `purrr` Apply the function with `map_df`: apply the `points_by_day` function to every unique value of `game_date` from `north_div` ```r points_by_day_df <- map_df(unique(north_div$game_date), points_by_day) ``` -- That df has the following for every game day: <table class="table" style="font-size: 16px; width: auto !important; margin-left: auto; margin-right: auto;"> <thead> <tr> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> team </th> <th style="text-align:left;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> game_date </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> total_points </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> rank </th> <th style="text-align:right;font-weight: bold;color: white !important;background-color: #bb0000 !important;"> threshold </th> </tr> </thead> <tbody> <tr> <td style="text-align:left;"> TOR </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 36 </td> <td style="text-align:right;"> 1 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> EDM </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 28 </td> <td style="text-align:right;"> 2 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> WPG </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 27 </td> <td style="text-align:right;"> 3 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> MTL </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 23 </td> <td style="text-align:right;"> 4 </td> <td style="text-align:right;"> 23 </td> </tr> <tr> <td style="text-align:left;"> CGY </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 22 </td> <td style="text-align:right;"> 5 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> VAN </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 20 </td> <td style="text-align:right;"> 6 </td> <td style="text-align:right;"> </td> </tr> <tr> <td style="text-align:left;"> OTT </td> <td style="text-align:left;"> 2021-03-01 </td> <td style="text-align:right;"> 17 </td> <td style="text-align:right;"> 7 </td> <td style="text-align:right;"> </td> </tr> </tbody> </table> --- # `gganimate` Use this new df with a `transition_manual` layer to create the animation ```r *points_by_day_df %>% ggplot(aes(x = team, y = total_points, fill = team == "MTL")) + geom_bar(stat = "identity", show.legend = FALSE) + scale_fill_manual(values = c("dark grey", "#AF1E2D")) + * geom_hline(aes(yintercept = threshold), color = "black", size = 2) + labs(x = NULL, y = "Standings points", * title = "Montreal's standings points: {current_frame}", subtitle = "Compared to playoffs threshold in black") + lab_theme() + theme(panel.grid.major.x = element_blank()) + * transition_manual(game_date) ``` --- # `gganimate` .center[![logo](figs/Lec15/MTL_pts.gif)] --- # Upcoming <br> .large[Homework 5 due Tuesday] <br> .large[Lab 10 due Wednesday] <br> .large[Final reports due 11:30am EDT Friday] <br> .medium[no matter when your presentation is]