Skip to content

Instantly share code, notes, and snippets.

@DavZim
Last active March 26, 2019 08:59
Show Gist options
  • Save DavZim/2e829ae24b2e272c409899e01d420479 to your computer and use it in GitHub Desktop.
Save DavZim/2e829ae24b2e272c409899e01d420479 to your computer and use it in GitHub Desktop.
################################################################################
# Goal of this short script is to show the basic inner workings of the
# tidyAnimatedVerbs package.


library(tidyverse)
library(gganimate)

# load all functions from the tidyAnimatedVerbs package
r <- unclass(lsf.str(envir = asNamespace("tidyAnimatedVerbs"), all = T))
for(name in r) eval(parse(text=paste0(name, '<-tidyAnimatedVerbs:::', name)))




####### Joins
x <- data_frame(
  id = 1:3,
  x = paste0("x", 1:3)
)
y <- data_frame(
  id = (1:4)[-3],
  y = paste0("y", (1:4)[-3])
)


(list_res <- process_join(x, y, "id"))
#> $x
#> # A tibble: 8 x 11
#>   .id     .id_long      .r .col  .val     .x    .y .width .side .color  .textcolor
#>   <chr>   <chr>      <dbl> <chr> <chr> <int> <dbl>  <dbl> <chr> <chr>   <chr>     
#> 1 .header .header_id     0 id    id        1     0      1 x     #737373 white     
#> 2 .header .header_x      0 x     x         2     0      1 x     #737373 white     
#> 3 1       1-1            1 id    1         1    -1      1 x     #E41A1C white     
#> 4 2       2-1            2 id    2         1    -2      1 x     #377EB8 white     
#> 5 3       3-1            3 id    3         1    -3      1 x     #4DAF4A white     
#> 6 1       1-1            1 x     x1        2    -1      1 x     #d0d0d0 black     
#> 7 2       2-1            2 x     x2        2    -2      1 x     #d0d0d0 black     
#> 8 3       3-1            3 x     x3        2    -3      1 x     #d0d0d0 black     
#> 
#> $y
#> # A tibble: 8 x 11
#>   .id     .id_long      .r .col  .val     .x    .y .width .side .color  .textcolor
#>   <chr>   <chr>      <dbl> <chr> <chr> <dbl> <dbl>  <dbl> <chr> <chr>   <chr>     
#> 1 .header .header_id     0 id    id        4     0      1 y     #737373 white     
#> 2 .header .header_y      0 y     y         5     0      1 y     #737373 white     
#> 3 1       1-1            1 id    1         4    -1      1 y     #E41A1C white     
#> 4 2       2-1            2 id    2         4    -2      1 y     #377EB8 white     
#> 5 4       4-1            3 id    4         4    -3      1 y     #984EA3 black     
#> 6 1       1-1            1 y     y1        5    -1      1 y     #d0d0d0 black     
#> 7 2       2-1            2 y     y2        5    -2      1 y     #d0d0d0 black     
#> 8 4       4-1            3 y     y4        5    -3      1 y     #d0d0d0 black  

step0 <- bind_rows(list_res$x, list_res$y) %>% mutate(.frame = 0, .alpha = 1)
static_plot(step0)

## continue workflow of joins
# combine the two datasets together:


step1 <- move_together(list_res$x, list_res$y, "left_join") %>% mutate(.frame = 1)

animate_plot(bind_rows(step0, step1))

########## Tidyr Gather Spread
# preprocess data:
# goal is to have a standardised structure of the data that can be plotted easily

long <- data_frame(
  year = c(2010L, 2011L, 2010L, 2011L, 2010L, 2011L),
  person = c("Alice", "Alice", "Bob", "Bob", "Charlie", "Charlie"),
  sales = c(105, 110, 100, 97, 90, 95)
)
process_long(long, ids = "year", key = "person", value = "sales")
#> # A tibble: 23 x 12
#>    .id   .id_map .key_map    .r .col  .val     .x    .y .type .header
#>    <chr> <chr>   <chr>    <dbl> <chr> <chr> <int> <dbl> <chr> <lgl>  
#>  1 Alic… year    Alice        0 id    year      1     0 id    TRUE   
#>  2 Bob_… year    Bob          0 id    year      1     0 id    TRUE   
#>  3 Char… year    Charlie      0 id    year      1     0 id    TRUE   
#>  4 key_… key     key          0 key   pers…     2     0 key   TRUE   
#>  5 valu… value   value        0 value sales     3     0 value TRUE   
#>  6 Alic… 2010    Alice        1 year  2010      1    -1 id    FALSE  
#>  7 Alic… 2011    Alice        2 year  2011      1    -2 id    FALSE  
#>  8 Bob_… 2010    Bob          3 year  2010      1    -3 id    FALSE  
#>  9 Bob_… 2011    Bob          4 year  2011      1    -4 id    FALSE  
#> 10 Char… 2010    Charlie      5 year  2010      1    -5 id    FALSE  
#> # ... with 13 more rows, and 2 more variables: .color <chr>, .alpha <dbl>

wide <- data_frame(
  year = 2010:2011,
  Alice = c(105, 110),
  Bob = c(100, 97),
  Charlie = c(90, 95)
)
process_wide(wide, ids = "year", key = "person")
#> # A tibble: 21 x 12
#>    .id   .id_map    .r .col  .val  .type    .x    .y .header .key_map
#>    <chr> <chr>   <dbl> <chr> <chr> <chr> <int> <dbl> <lgl>   <chr>   
#>  1 Alic… year        0 year  year  id        1     0 TRUE    Alice   
#>  2 Bob_… year        0 year  year  id        1     0 TRUE    Bob     
#>  3 Char… year        0 year  year  id        1     0 TRUE    Charlie 
#>  4 Alic… 2010        0 Alice Alice key       2     0 TRUE    Alice   
#>  5 Alic… 2011        0 Alice Alice key       2     0 TRUE    Alice   
#>  6 Bob_… 2010        0 Bob   Bob   key       3     0 TRUE    Bob     
#>  7 Bob_… 2011        0 Bob   Bob   key       3     0 TRUE    Bob     
#>  8 Char… 2010        0 Char… Char… key       4     0 TRUE    Charlie 
#>  9 Char… 2011        0 Char… Char… key       4     0 TRUE    Charlie 
#> 10 Alic… 2010        1 year  2010  id        1    -1 FALSE   Alice   
#> # ... with 11 more rows, and 2 more variables: .color <chr>, .alpha <dbl>

process_wide(wide, ids = "year", key = "person") %>% static_plot()

# basic workflow:
# 1. get the base data (say we use long) on the left-hand side and 
#   then calculate the second (wide) right-hand side dataset
lhs <- long
rhs <- spread(long, key = "person", value = "sales")

# process the data 
(lhs_proc <- process_long(lhs, "year", "person", "sales"))
#> # A tibble: 23 x 12
#>    .id   .id_map .key_map    .r .col  .val     .x    .y .type .header
#>    <chr> <chr>   <chr>    <dbl> <chr> <chr> <int> <dbl> <chr> <lgl>  
#>  1 Alic… year    Alice        0 id    year      1     0 id    TRUE   
#>  2 Bob_… year    Bob          0 id    year      1     0 id    TRUE   
#>  3 Char… year    Charlie      0 id    year      1     0 id    TRUE   
#>  4 key_… key     key          0 key   pers…     2     0 key   TRUE   
#>  5 valu… value   value        0 value sales     3     0 value TRUE   
#>  6 Alic… 2010    Alice        1 year  2010      1    -1 id    FALSE  
#>  7 Alic… 2011    Alice        2 year  2011      1    -2 id    FALSE  
#>  8 Bob_… 2010    Bob          3 year  2010      1    -3 id    FALSE  
#>  9 Bob_… 2011    Bob          4 year  2011      1    -4 id    FALSE  
#> 10 Char… 2010    Charlie      5 year  2010      1    -5 id    FALSE  
#> # ... with 13 more rows, and 2 more variables: .color <chr>, .alpha <dbl>
(rhs_proc <- process_wide(rhs, "year", "person", "sales"))
#> # A tibble: 21 x 12
#>    .id   .id_map    .r .col  .val  .type    .x    .y .header .key_map
#>    <chr> <chr>   <dbl> <chr> <chr> <chr> <int> <dbl> <lgl>   <chr>   
#>  1 Alic… year        0 year  year  id        1     0 TRUE    Alice   
#>  2 Bob_… year        0 year  year  id        1     0 TRUE    Bob     
#>  3 Char… year        0 year  year  id        1     0 TRUE    Charlie 
#>  4 Alic… 2010        0 Alice Alice key       2     0 TRUE    Alice   
#>  5 Alic… 2011        0 Alice Alice key       2     0 TRUE    Alice   
#>  6 Bob_… 2010        0 Bob   Bob   key       3     0 TRUE    Bob     
#>  7 Bob_… 2011        0 Bob   Bob   key       3     0 TRUE    Bob     
#>  8 Char… 2010        0 Char… Char… key       4     0 TRUE    Charlie 
#>  9 Char… 2011        0 Char… Char… key       4     0 TRUE    Charlie 
#> 10 Alic… 2010        1 year  2010  id        1    -1 FALSE   Alice   
#> # ... with 11 more rows, and 2 more variables: .color <chr>, .alpha <dbl>

# combine into a single data-frame
anim_df <- bind_rows(
  lhs_proc %>% mutate(.frame = 0),
  rhs_proc %>% mutate(.frame = 1)
)

# plot the anim_df
animate_plot(anim_df)

Created on 2018-08-23 by the reprex package (v0.2.0).

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment