AE: Animated graphics

Suggested answers

Application exercise
Answers
Modified

March 21, 2024

library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.4.4     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.0
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(gganimate)

theme_set(theme_minimal())

Import data

freedom <- read_csv(
  file = "data/freedom.csv",
  # NA values are recorded as '-'
  na = "-"
  )
Rows: 205 Columns: 103
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (35): country, status_1990, status_1991, status_1992, status_1993, statu...
dbl (68): pr_1990, cl_1990, pr_1991, cl_1991, pr_1992, cl_1992, pr_1993, cl_...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
freedom
# A tibble: 205 × 103
   country       pr_1990 cl_1990 status_1990 pr_1991 cl_1991 status_1991 pr_1992
   <chr>           <dbl>   <dbl> <chr>         <dbl>   <dbl> <chr>         <dbl>
 1 Afghanistan         7       7 NF                7       7 NF                6
 2 Albania             7       6 NF                4       4 PF                4
 3 Algeria             4       4 PF                4       4 PF                7
 4 Andorra            NA      NA <NA>             NA      NA <NA>             NA
 5 Angola              7       7 NF                6       4 PF                6
 6 Antigua and …       3       2 F                 3       3 PF                3
 7 Argentina           1       3 F                 1       3 F                 2
 8 Armenia            NA      NA <NA>              5       5 PF                4
 9 Australia           1       1 F                 1       1 F                 1
10 Austria             1       1 F                 1       1 F                 1
# ℹ 195 more rows
# ℹ 95 more variables: cl_1992 <dbl>, status_1992 <chr>, pr_1993 <dbl>,
#   cl_1993 <dbl>, status_1993 <chr>, pr_1994 <dbl>, cl_1994 <dbl>,
#   status_1994 <chr>, pr_1995 <dbl>, cl_1995 <dbl>, status_1995 <chr>,
#   pr_1996 <dbl>, cl_1996 <dbl>, status_1996 <chr>, pr_1997 <dbl>,
#   cl_1997 <dbl>, status_1997 <chr>, pr_1998 <dbl>, cl_1998 <dbl>,
#   status_1998 <chr>, pr_1999 <dbl>, cl_1999 <dbl>, status_1999 <chr>, …
  • Data is in a wide format
    • pr_* - political rights, scores 1-7 (1 highest degree of freedom, 7 the lowest)
    • cl_* - civil liberties, scores 1-7 (1 highest degree of freedom, 7 the lowest)
    • status_* - freedom status (Free, Partly Free, and Not Free)

Calculate the top fifteen countries whose civil liberties scores have varied the most

freedom_to_plot <- freedom |>
  # calculate rowwise standard deviations (one row per country)
  rowwise() |>
  mutate(sd = sd(c_across(contains("cl_")), na.rm = TRUE)) |>
  ungroup() |>
  # find the 15 countries with the highest standard deviations
  relocate(country, sd) |>
  slice_max(order_by = sd, n = 15) |>
  # only keep countries with complete observations - necessary for future plotting
  drop_na()
freedom_to_plot
# A tibble: 11 × 104
   country    sd pr_1990 cl_1990 status_1990 pr_1991 cl_1991 status_1991 pr_1992
   <chr>   <dbl>   <dbl>   <dbl> <chr>         <dbl>   <dbl> <chr>         <dbl>
 1 The Ga… 1.24        2       2 F                 2       2 F                 1
 2 Sierra… 1.20        6       5 PF                6       5 PF                7
 3 Centra… 1.18        6       5 NF                6       5 PF                6
 4 Ghana   1.09        6       5 NF                6       6 NF                5
 5 Turkey  1.08        2       4 PF                2       4 PF                2
 6 Venezu… 1.07        1       3 F                 1       3 F                 3
 7 Kenya   1.07        6       6 NF                6       6 NF                4
 8 Liberia 1.06        7       7 NF                7       6 NF                7
 9 Bhutan  1.04        6       5 PF                6       5 PF                7
10 Malawi  1.00        7       6 NF                7       6 NF                6
11 Mali    0.992       6       5 NF                6       4 PF                2
# ℹ 95 more variables: cl_1992 <dbl>, status_1992 <chr>, pr_1993 <dbl>,
#   cl_1993 <dbl>, status_1993 <chr>, pr_1994 <dbl>, cl_1994 <dbl>,
#   status_1994 <chr>, pr_1995 <dbl>, cl_1995 <dbl>, status_1995 <chr>,
#   pr_1996 <dbl>, cl_1996 <dbl>, status_1996 <chr>, pr_1997 <dbl>,
#   cl_1997 <dbl>, status_1997 <chr>, pr_1998 <dbl>, cl_1998 <dbl>,
#   status_1998 <chr>, pr_1999 <dbl>, cl_1999 <dbl>, status_1999 <chr>,
#   pr_2000 <dbl>, cl_2000 <dbl>, status_2000 <chr>, pr_2001 <dbl>, …
# calculate position rankings rather than raw scores
freedom_ranked <- freedom_to_plot |>
  # only keep columns with civil liberties scores
  select(country, contains("cl_")) |>
  # wrangle the data to a long format
  pivot_longer(
    cols = -country,
    names_to = "year",
    values_to = "civil_liberty",
    names_prefix = "cl_",
    names_transform = list(year = as.numeric)
  ) |>
  # calculate rank within year - larger is worse, so reverse in the ranking
  group_by(year) |>
  mutate(rank_in_year = rank(-civil_liberty, ties.method = "first")) |>
  ungroup() |>
  # highlight Venezuela
  mutate(is_venezuela = if_else(country == "Venezuela", TRUE, FALSE))
freedom_ranked
# A tibble: 374 × 5
   country     year civil_liberty rank_in_year is_venezuela
   <chr>      <dbl>         <dbl>        <int> <lgl>       
 1 The Gambia  1990             2           11 FALSE       
 2 The Gambia  1991             2           11 FALSE       
 3 The Gambia  1992             2           11 FALSE       
 4 The Gambia  1993             2           11 FALSE       
 5 The Gambia  1994             6            2 FALSE       
 6 The Gambia  1995             6            2 FALSE       
 7 The Gambia  1996             6            2 FALSE       
 8 The Gambia  1997             6            2 FALSE       
 9 The Gambia  1998             5            2 FALSE       
10 The Gambia  1999             5            2 FALSE       
# ℹ 364 more rows

Faceted plot

freedom_faceted_plot <- freedom_ranked |>
  # civil liberty vs freedom rank
  ggplot(aes(x = civil_liberty, y = factor(rank_in_year), fill = is_venezuela)) +
  geom_col(show.legend = FALSE) +
  # change the color palette for emphasis of Venezuela
  scale_fill_manual(values = c("gray", "red")) +
  # facet by year
  facet_wrap(vars(year)) +
  # create explicit labels for civil liberties score,
  # leaving room for country text labels
  scale_x_continuous(
    limits = c(-5, 7),
    breaks = 1:7
  ) +
  geom_text(
    hjust = "right",
    aes(label = country),
    x = -1
  ) +
  # remove extraneous theme/label components
  theme(
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    axis.text.y = element_blank()
  ) +
  labs(x = NULL, y = NULL)
freedom_faceted_plot

Animated plot

freedom_bar_race <- freedom_faceted_plot +
  # remove faceting
  facet_null() +
  # label the current year in the top corner of the plot
  geom_text(
    x = 5, y = 11,
    hjust = "left",
    aes(label = as.character(year)),
    size = 10
  ) +
  # define group structure for transitions
  aes(group = country) +
  # temporal transition - ensure integer value for labeling
  transition_time(as.integer(year)) +
  labs(
    title = "Civil liberties rating, {frame_time}",
    subtitle = "1: Highest degree of freedom - 7: Lowest degree of freedom"
  )

# basic transition
animate(freedom_bar_race, nframes = 30, fps = 2)

# smoother transition
animate(freedom_bar_race, nframes = 300, fps = 15, start_pause = 10, end_pause = 10)

```{r}
#| gganimate: !expr list(nframes = 300, fps = 15, start_pause = 10, end_pause = 10)
freedom_bar_race
```

Acknowledgments

sessioninfo::session_info()
─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.3.2 (2023-10-31)
 os       macOS Ventura 13.5.2
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/New_York
 date     2024-03-26
 pandoc   3.1.1 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version  date (UTC) lib source
 bit           4.0.5    2022-11-15 [1] CRAN (R 4.3.0)
 bit64         4.0.5    2020-08-30 [1] CRAN (R 4.3.0)
 cli           3.6.2    2023-12-11 [1] CRAN (R 4.3.1)
 codetools     0.2-19   2023-02-01 [1] CRAN (R 4.3.2)
 colorspace    2.1-0    2023-01-23 [1] CRAN (R 4.3.0)
 crayon        1.5.2    2022-09-29 [1] CRAN (R 4.3.0)
 digest        0.6.34   2024-01-11 [1] CRAN (R 4.3.1)
 dplyr       * 1.1.4    2023-11-17 [1] CRAN (R 4.3.1)
 evaluate      0.23     2023-11-01 [1] CRAN (R 4.3.1)
 fansi         1.0.6    2023-12-08 [1] CRAN (R 4.3.1)
 farver        2.1.1    2022-07-06 [1] CRAN (R 4.3.0)
 fastmap       1.1.1    2023-02-24 [1] CRAN (R 4.3.0)
 forcats     * 1.0.0    2023-01-29 [1] CRAN (R 4.3.0)
 generics      0.1.3    2022-07-05 [1] CRAN (R 4.3.0)
 gganimate   * 1.0.8    2022-09-08 [1] CRAN (R 4.3.0)
 ggplot2     * 3.4.4    2023-10-12 [1] CRAN (R 4.3.1)
 gifski        1.12.0-2 2023-08-12 [1] CRAN (R 4.3.0)
 glue          1.7.0    2024-01-09 [1] CRAN (R 4.3.1)
 gtable        0.3.4    2023-08-21 [1] CRAN (R 4.3.0)
 here          1.0.1    2020-12-13 [1] CRAN (R 4.3.0)
 hms           1.1.3    2023-03-21 [1] CRAN (R 4.3.0)
 htmltools     0.5.7    2023-11-03 [1] CRAN (R 4.3.1)
 htmlwidgets   1.6.4    2023-12-06 [1] CRAN (R 4.3.1)
 jsonlite      1.8.8    2023-12-04 [1] CRAN (R 4.3.1)
 knitr         1.45     2023-10-30 [1] CRAN (R 4.3.1)
 lifecycle     1.0.4    2023-11-07 [1] CRAN (R 4.3.1)
 lubridate   * 1.9.3    2023-09-27 [1] CRAN (R 4.3.1)
 magrittr      2.0.3    2022-03-30 [1] CRAN (R 4.3.0)
 munsell       0.5.0    2018-06-12 [1] CRAN (R 4.3.0)
 pillar        1.9.0    2023-03-22 [1] CRAN (R 4.3.0)
 pkgconfig     2.0.3    2019-09-22 [1] CRAN (R 4.3.0)
 prettyunits   1.2.0    2023-09-24 [1] CRAN (R 4.3.1)
 progress      1.2.3    2023-12-06 [1] CRAN (R 4.3.1)
 purrr       * 1.0.2    2023-08-10 [1] CRAN (R 4.3.0)
 R6            2.5.1    2021-08-19 [1] CRAN (R 4.3.0)
 readr       * 2.1.5    2024-01-10 [1] CRAN (R 4.3.1)
 rlang         1.1.3    2024-01-10 [1] CRAN (R 4.3.1)
 rmarkdown     2.25     2023-09-18 [1] CRAN (R 4.3.1)
 rprojroot     2.0.4    2023-11-05 [1] CRAN (R 4.3.1)
 rstudioapi    0.15.0   2023-07-07 [1] CRAN (R 4.3.0)
 scales        1.2.1    2024-01-18 [1] Github (r-lib/scales@c8eb772)
 sessioninfo   1.2.2    2021-12-06 [1] CRAN (R 4.3.0)
 stringi       1.8.3    2023-12-11 [1] CRAN (R 4.3.1)
 stringr     * 1.5.1    2023-11-14 [1] CRAN (R 4.3.1)
 tibble      * 3.2.1    2023-03-20 [1] CRAN (R 4.3.0)
 tidyr       * 1.3.0    2023-01-24 [1] CRAN (R 4.3.0)
 tidyselect    1.2.0    2022-10-10 [1] CRAN (R 4.3.0)
 tidyverse   * 2.0.0    2023-02-22 [1] CRAN (R 4.3.0)
 timechange    0.2.0    2023-01-11 [1] CRAN (R 4.3.0)
 tweenr        2.0.2    2022-09-06 [1] CRAN (R 4.3.0)
 tzdb          0.4.0    2023-05-12 [1] CRAN (R 4.3.0)
 utf8          1.2.4    2023-10-22 [1] CRAN (R 4.3.1)
 vctrs         0.6.5    2023-12-01 [1] CRAN (R 4.3.1)
 vroom         1.6.5    2023-12-05 [1] CRAN (R 4.3.1)
 withr         2.5.2    2023-10-30 [1] CRAN (R 4.3.1)
 xfun          0.41     2023-11-01 [1] CRAN (R 4.3.1)
 yaml          2.3.8    2023-12-11 [1] CRAN (R 4.3.1)

 [1] /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────