class: center, middle ### Animation with `gganimate` and More Interactivity <img src="img/hero_wall_pink.png" width="800px"/> ### Kelly McConville .large[Math 241 | Week 10 | Spring 2021] --- ## Announcements/Reminders * Lab 7 is posted --- ## Goals for Today * Talk about the Final Project * Discuss issues with found data * Animation with `gganimate` * More interactivity with `plotly` --- ## Looking Ahead Next week we will cover interactivity with `shiny`. <img src="img/shiny.png" width="124" /> --- ### Looking (Much) Further Ahead: 2020-2021 Academic Year * Math 243: Statistical Learning + For a deep dive into predictive models + Fall + Pre-req: Math 141 * Math 343: Statistics Practicum + For practice conducting an empirical research project + Spring + Pre-req: Math 243 or Math 241 * Math 391: Probability Theory + Learn the language of statistical inference + Fall + Pre-req: Math 202 + Math 113 * CSCI 121: CS Fundamentals I + Introduction to CS + Fall/Spring --- ## Final Project * Goals: + Answer a question with data. + Learn and apply a new technique/R package. * Pick your own groups of 1-3 people. + Must pick your group by next Thursday. + Let me know via a DM in Slack if you need help finding a group. * Components + Data wrangling and/or web scraping + Data viz + Something new --- ## Final Project *Something New* Ideas * More advanced text analysis * Learn how to wrangling and join spatial data * New data visualization + Ex: Graph a network with `ggraph` * Modeling technique (that is new to you) + Ex: Regression trees + Ex: Clustering algorithm * Learn to work with a new data type (ex JSON, XML) in R. * **A new data source does not count!** --- ## Lab 6: Cautions of Found Data * **Found data**: Data that someone else collected but is relevant to your research question. -- Example: Data on **all** documented eruptions from the past 10,000 years + Reputable source: Smithsonian Institution's Global Volcanism Program + Big dataset: Around 10,000 eruptions -- **Why is it not a good reflection of ALL eruptions from the past 10,000 years?** <img src="slidesWk10Th_files/figure-html/unnamed-chunk-2-1.png" width="720" /> --- ## Lab 6: Cautions of Found Data * **Found data**: Data that someone else collected but is relevant to your research question. Example: Data on **all** documented eruptions from the past 10,000 years * Morals: + Big does not mean representative. + Always thoroughly explore and inspect the data. --- ## Move Over Nate Silver * [Hans Rosling](https://en.wikipedia.org/wiki/Hans_Rosling) + [The Joy of Stats](https://vimeo.com/18477762) -- ![Hans + Kelly](img/rosling_and_mcconville.JPG) --- ## Math 241 Names * When does each name peak? * Which do you think is more popular now? * Do you think they follow the same trend? ```r library(babynames) roster <- readr::read_csv(here::here("slides/math241names.csv")) %>% pull() baby_math241 <- babynames %>% filter(name %in% roster) %>% group_by(name) %>% summarize(max = max(n)) %>% slice_max(n = 5, order_by = max) %>% select(name) %>% pull() %>% str_to_lower() baby_math241 ``` ``` ## [1] "linda" "william" "jessica" "joshua" "ryan" ``` --- ## Math 241 Names * When does each name peak? * Which do you think is more popular now? * Do you think they follow the same trend? ```r baby_math241_years <- babynames %>% mutate(name = str_to_lower(name)) %>% filter(name %in% baby_math241) %>% group_by(year, name) %>% summarize(n = sum(n)) baby_math241_years ``` ``` ## # A tibble: 658 x 3 ## # Groups: year [138] ## year name n ## <dbl> <chr> <int> ## 1 1880 jessica 7 ## 2 1880 joshua 57 ## 3 1880 linda 27 ## 4 1880 william 9562 ## 5 1881 jessica 7 ## 6 1881 joshua 40 ## 7 1881 linda 38 ## 8 1881 william 8554 ## 9 1882 jessica 8 ## 10 1882 joshua 50 ## # … with 648 more rows ``` --- ## Math 241 Names Animated! ![](slidesWk10Th_files/figure-html/unnamed-chunk-5-1.gif)<!-- --> --- ## `gganimate` ```r library(gganimate) ``` * Extends `ggplot2` to allow for animation. + Additional layers * Core functions: + `transition_*()`: Defining the variable that controls the change and how it controls the change + `enter/exit*()`: Determining how data enters and exits + `view_*()`: Changing axes + `shadow_*()`: Giving the animation memory + `ease_aes()`: Timing the ease in and out of the animation --- ## Create a Static Version First ```r p <- ggplot(data = baby_math241_years, mapping = aes(x = year, y = n)) + geom_line(aes(color = name), size = 2) + theme(legend.position = "bottom", text = element_text(size=20)) + guides(color = guide_legend(nrow = 2)) p ``` <img src="slidesWk10Th_files/figure-html/unnamed-chunk-7-1.png" width="432" /> --- ### Then Animate! `transition_reveal()`: Adding each new frame on top of the previous frames ```r p_animate <- p + transition_reveal(along = year) p_animate ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-8-1.gif)<!-- --> --- ### Controlling the Animation ```r p_animate <- p + transition_reveal(year) animate(p_animate, fps = 5, end_pause = 20) ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-9-1.gif)<!-- --> --- ## Animate Previous Graphs ```r Eruptions <- read_csv("/home/courses/math241s21/Data/GVP_Eruption_Results.csv") aleutian_box <- c(bottom = 50.977, left = -172.164, top = 59.5617, right = -157.1507) aleutian <- ggmap::get_stamenmap(aleutian_box, maptype = "terrain-background", zoom = 5) Eruptions_aleutian <- Eruptions %>% filter(Longitude > -172.164, Longitude < -157.1507, Latitude > 50.977, Latitude < 59.5617) aleutian_count <- count(Eruptions_aleutian, VolcanoName, Longitude, Latitude) ``` --- ## Animate Previous Graphs ```r library(ggmap) p_aleutian <- aleutian %>% ggmap() + geom_point(data = Eruptions_aleutian, aes(Longitude, Latitude), inherit.aes = FALSE, color = "red") + theme_void() p_aleutian ``` <img src="slidesWk10Th_files/figure-html/unnamed-chunk-11-1.png" width="432" /> --- `transition_time()`: transition length between states set to actual time difference ```r p_aleutian <- p_aleutian + transition_time(time = StartYear) p_aleutian ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-12-1.gif)<!-- --> --- Impact of `group`? ```r p_aleutian <- aleutian %>% ggmap() + geom_point(data = Eruptions_aleutian, aes(Longitude, Latitude, group = VolcanoName), inherit.aes = FALSE, color = "red") + theme_void() + transition_time(time = StartYear) p_aleutian ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-13-1.gif)<!-- --> --- ## Animate Previous Graph ```r p_aleutian <- aleutian %>% ggmap() + geom_point(data = aleutian_count, aes(Longitude, Latitude, color = n, group = VolcanoName), inherit.aes = FALSE, size = 4) + theme_void() + scale_color_viridis_c() p_aleutian ``` <img src="slidesWk10Th_files/figure-html/unnamed-chunk-14-1.png" width="432" /> --- `transition_states()`: Cycling through the values of a variable ```r p_aleutian <- p_aleutian + transition_states(states = n, transition_length = 3, state_length = 5) p_aleutian ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-15-1.gif)<!-- --> --- * Can add labels with `labs()` and `glue` ```r p_aleutian + labs(title = "Volcano has erupted {previous_state} time(s)") ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-16-1.gif)<!-- --> --- ```r p_animate <- p + transition_reveal(year) + labs(title = "The Year is {round(frame_along, 0)}.") p_animate ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-17-1.gif)<!-- --> --- * Can modify how data enters and exits. ```r p_aleutian + enter_grow() + exit_shrink() ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-18-1.gif)<!-- --> --- * Can change the rate between transitions. ```r p_aleutian + ease_aes("cubic-in") ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-19-1.gif)<!-- --> --- ```r ggplot(data = baby_math241_years, mapping = aes(x = year, y = n)) + geom_point(aes(color = name), size = 3) + theme(legend.position = "bottom", text = element_text(size=20)) + transition_time(year) + view_follow() ``` --- ## Animate Previous Graphs ```r library(genius) hey_jude <- genius_lyrics(artist = "The Beatles", song = "Hey Jude") ``` ```r library(tidytext) p_jude <- hey_jude %>% unnest_tokens(output = word, input = lyric, token = "words") %>% anti_join(stop_words, by = "word") %>% count(word, sort = TRUE) %>% filter(n > 2) %>% mutate(word = fct_reorder(word, n)) %>% ggplot(mapping = aes(x = word, y = n)) + geom_col(fill = "#D63447") + coord_flip() ``` --- ## Animate Previous Graphs <img src="slidesWk10Th_files/figure-html/unnamed-chunk-23-1.png" width="432" /> --- * Shadow: Want to add memory ```r p_jude <- p_jude + transition_states(n) p_jude ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-24-1.gif)<!-- --> --- ```r p_jude + transition_states(n) + shadow_mark() ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-25-1.gif)<!-- --> --- ```r p_jude + transition_states(n) + shadow_mark() + enter_grow() ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-26-1.gif)<!-- --> --- ## Saving the Animation * Create a gif ```r anim_save("p_jude.gif", p_jude) ``` --- ## Why Add Animation to a Graph? -- * To engage the viewer * To accentuate the story * To add another variable to the plot But don't add animation just because you can. Drawbacks? -- * Require a higher level of attention * Can obscure the story --- ## Interactive Plots * We saw interactivity in maps last time with `leaflet`. + Want to showcase another interactive component: toggling data in and out of graph. * See first step in interactivity in plots with `plotly`. + But that will be fairly limited. + Add in more interactivity next week with `shiny`. --- ## Come Back to `leaflet` ```r library(leaflet) confirmed <- Eruptions %>% filter(EruptionCategory == "Confirmed Eruption") not_confirmed <- Eruptions %>% filter(EruptionCategory != "Confirmed Eruption") p_vol <- leaflet() %>% addTiles() %>% addCircleMarkers(lng = ~Longitude, lat = ~Latitude, radius = 2, stroke = FALSE, data = confirmed, color = "purple", group = "Confirmed") %>% addCircleMarkers(lng = ~Longitude, lat = ~Latitude, radius = 2, stroke = FALSE, data = not_confirmed, color = "red", group = "Not Confirmed") %>% # Layers control addLayersControl( overlayGroups = c("Confirmed", "Not Confirmed"), options = layersControlOptions(collapsed = FALSE)) ``` --- ```r p_vol ```
--- ## `plotly` * Also a JavaScript library ```r library(plotly) ggplotly(p) ```
--- ## `ggplotly()` * Translates a `ggplot` to a `plotly` + Conversion isn't always perfect. * Can also create graphs with `plot_ly()` + Another great final project idea: Learn `plot_ly()` --- ```r p_improved <- ggplotly(p, dynamicTicks = TRUE) %>% rangeslider() %>% layout(hovermode = "x") p_improved ```
--- ## `gganimate` for Fun * Convert svgs to csvs with [coordinator](https://spotify.github.io/coordinator/) * Create an animation with `gganimate` ```r hats <- read_csv(here::here("slides/hats.csv")) hats1 <- hats %>% filter(y <= 325) %>% arrange(x) hats2 <- hats %>% filter(y > 325) %>% arrange(x) hats_all <- bind_rows(hats1, hats2) %>% mutate(slide = row_number()) hats_gif <- ggplot(hats_all, aes(x=x, y=y)) + theme_void() + scale_y_reverse() + theme(plot.background = element_rect(fill = '#CA302F')) + geom_point(colour = 'white', size = 1) + transition_manual(slide, cumulative=TRUE) ``` --- ```r animate(hats_gif, end_pause = 30) ``` ![](slidesWk10Th_files/figure-html/unnamed-chunk-33-1.gif)<!-- -->