Animated Bar Chart.Rmd

---
title: "Animated Bar Chart"
author: "ML"
date: "5/3/2020"
output: html_document
---

The following code was written for running on R version 4.0.0 with Windows 10 Pro. Running of this script requires the installation and loading of the following packages:

`tidyverse`, `gtsummary`, `ggplot2`, `gganimate`, `png`

```{r}

# check to see if packages are installed. Install them if they are not, then load them into the R session.

ipak <- function(pkg) {
  new.pkg <- pkg[!(pkg %in% installed.packages()[, "Package"])]
  if (length(new.pkg))
    install.packages(new.pkg, dependencies = TRUE)
  sapply(pkg, require, character.only = TRUE)
}

packages <- c("tidyverse", "gt", "gtsummary", "install_phantomjs", "ggplot2", "gganimate", "png")
ipak(packages)

#Warning in install.packages :
#  package ‘install_phantomjs’ is not available for this version of R

#PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

#webshot::install_phantomjs() # uncomment first time

setwd("C:/Users/MarkLaVenia/GitHub/rockr")

```

## Data preparation

All `R` code for calling and cleaning the raw data can be found in [R/twitter_api_poll_call.Rmd](https://github.com/MarkLaVenia/rockr/blob/master/R/twitter_api_poll_call.Rmd)

```{r}

load("data-raw/raw_twitter_api_poll_data.rda")

```

### Analysis file

Twitter polls provide data on the number of votes per poll response option, Accordingly, using the `mutate()` command we calculate the percentage of votes per response option.

```{r}

poll_data <- raw_twitter_api_poll_data %>% 
  mutate(poll_votes = rowSums(dplyr::select(., votes_1, votes_2, votes_3, votes_4), na.rm = TRUE)) %>% 
  mutate(option_percent_1 = (votes_1 / poll_votes) * 100,
         option_percent_2 = (votes_2 / poll_votes) * 100,
         option_percent_3 = (votes_3 / poll_votes) * 100,
         option_percent_4 = (votes_4 / poll_votes) * 100) 

names(poll_data)

poll_data <- poll_data %>% 
    pivot_longer(c(option_1:option_4), 
                 names_to="option_number", values_to="option") %>%
    pivot_longer(c(label_1:label_4), 
                 names_to="label_number", values_to="label") %>%
    pivot_longer(c(votes_1:votes_4), 
                 names_to="votes_number", values_to="votes") %>%
    pivot_longer(c(option_percent_1:option_percent_4), 
                 names_to="option_percent_number", values_to="percent") %>%
    filter(option_number == "option_1" & label_number == "label_1" & votes_number == "votes_1" & option_percent_number == "option_percent_1" | 
           option_number == "option_2" & label_number == "label_2" & votes_number == "votes_2" & option_percent_number == "option_percent_2" | 
             option_number == "option_3" & label_number == "label_3" & votes_number == "votes_3" & option_percent_number == "option_percent_3" | 
             option_number == "option_4" & label_number == "label_4" & votes_number == "votes_4" & option_percent_number == "option_percent_4") %>% 
  separate(col = option_number, into = c("option_number", "category"), sep = "_") %>%      select(-ends_with("_number")) %>% 
  mutate(year = ifelse(is.na(year), "[undefined]", year)) %>%
  filter(!is.na(option)) 

unique(poll_data$year)

save(poll_data, file = "data/poll_data.rda")

rm(raw_twitter_api_poll_data)

```

### Exploration

The first thing we do is make a quick check for data error red flags. Using the `group_by()` and `summarise(sum())` commands we calculate the sum of persentages for each response option for each poll; and using the `mutate(sprintf())` and `unique()` commands to verify that all polls sum to 100 percent.

```{r}

poll_EDA <- poll_data %>% 
  filter(year != 2001) %>%
  group_by(attachments_poll_ids) %>%
  summarise(poll_date = max(created_at),
            poll_type = max(poll_type),
            poll_votes = max(poll_votes),
            album_year = max(year),
            poll_percent_sum = sum(percent, na.rm = TRUE)) %>% 
  mutate(poll_percent_sum = sprintf("%0.1f", poll_percent_sum)) %>% ungroup() 

unique(poll_EDA$poll_percent_sum)
unique(poll_EDA$poll_type)
unique(poll_EDA$album_year)

```

And using the `ggplot()` function, we produce a visualization to inspect  
the number of votes per poll. We observe a suspiciously low number of votes for the 1982 final poll. Double-checking Twitter revealed that poll indeed did have a low response rate: shocking given it included bangers such as Maiden's *Number of the Beast* and Priest's *Screaming for Vengeance*.

```{r}

poll_EDA$poll_type <- factor(poll_EDA$poll_type, levels=c("Qualifying", "Final", "Final (alternate)", "Bonus"), labels=c("Qualifying", "Final", "Final (alternate)", "Bonus")) 

p <- poll_EDA %>%
  ggplot(aes(x = factor(attachments_poll_ids), y = poll_votes, fill = poll_type))  +
  geom_col(position = "dodge") +
  facet_grid(~ album_year, scales = "free_x", space = "free_x", switch = "x") +
  labs(title = 'Number of votes per poll') +
    labs(fill = "Poll type") +
    theme(strip.text.x = element_text(angle = 90, hjust = 0),
    strip.background = element_blank(),
    axis.line = element_blank(),
    axis.text.x = element_blank(),
    axis.ticks = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    panel.background = element_blank(),
    panel.border = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    plot.title = element_text(size = 14, hjust = 0.5, face = "bold", colour = "grey", vjust = 1.5),
    plot.background = element_blank())

p

ggsave("R/plots/poll_votes.png", width = 18, height = 6)

```

Using the `summarise(n_distinct())` command we see that across all qualifying and final polls, the data comprise *179* polls covering *247* bands cumulatively. Constraining to final polls only, the data comprise *31* polls covering *69* bands cumulatively.

```{r}

band_counts <- poll_data  %>% 
  filter(year != 2001 & (poll_type == "Qualifying" | poll_type == "Final")) %>%
  summarise(poll_counts_all = n_distinct(attachments_poll_ids),
    bands_counts_all = n_distinct(option),
    poll_counts_final = n_distinct(attachments_poll_ids[poll_type == 'Final']),
#    poll_counts_bonus = #n_distinct(attachments_poll_ids[poll_type == 'Bonus']),
    bands_counts_final = n_distinct(option[poll_type == 'Final']))

band_counts

```


Lastly, we use the `tbl_summary()` command to view the mean and standard deviation in poll votes by poll type.

```{r}

summary <- poll_EDA %>% dplyr::select(poll_type, poll_votes)

table1 <- tbl_summary(
  summary,
  by = poll_type,
  statistic = list(all_continuous() ~ "{mean} ({sd})"),
  digits = list(poll_votes ~ c(0, 1)),
  label = list(poll_votes = "Poll votes")) %>%
  add_n() %>%
  bold_labels() %>%
  as_gt() %>% 
  tab_header(
    title = "Summary statistics for poll votes by poll type")

table1

table1 %>%
  gtsave("table1.png", expand = 10,
    path = "R/plots")


```

Let's clean-up the environment from the exploratory data analysis before moving on.

```{r}

rm("band_counts", "p", "poll_EDA", "summary", "table1")

```


### Selection

We then reduce the dataframe to the observations of interest. 

- For all analyses, we drop observations for polls coded as invalid.
  - In the example data, one poll coded as invalid was conducted as an alternate final.
- For two analyses we retain data for only final polls, excluding data for bonus and qualifying polls and; for a third analysis we retained data for all valid polls, inclusive of bonus, qualifying, and final polls.

The steps that follow immediately track toward the creation of analysis files for the first two analyses. I circle back later to create the the third analysis file. In the code chunk below I load the saved, clean `poll_data` file so that I can start there when I return to create that third file.

```{r}

load("data/poll_data.rda")

album_finalpolls <-
  poll_data[poll_data$valid %in%  # include only valid polls
              c(1) &
              poll_data$poll_type %in%  # include only final polls
              c("Final"),]

rm(poll_data)

```

### Aggregation

To remedy instances where a given band appeared more than once in a given year

- we use the `group_by()` and `summarise_at()` commands to sum percentages or vote counts for each band per year.
- This scenario occurred in the 1970 final poll, where *Black Sabbath* had two albums that year;
  - other scenarios for this occur when analyzing bonus, qualifying, and final polls jointly.

```{r}

band_finalpolls <- album_finalpolls %>%
  group_by(option, year) %>%
  summarise_at(c("votes", "percent"), sum) %>%
  arrange(year, option)

rm(album_finalpolls)

```

### Structure

Ultimately we want a file in a long (tidy) format, with each band having a row for every year in the dataset regardless of whether the band had poll data for that year.  

- We first use the `pivot_wider()` command, followed by the `pivot_longer()` command to accomplish this.

```{r}

band_finalpolls_wide <- pivot_wider(
  data = band_finalpolls,
  id_cols = option,
  names_from = year,
  values_from = c("votes", "percent"))

rm(band_finalpolls)

```

### Computation

To calculate rolling averages and sums, we use 

- the `mutate(cummmean())` command with the `poll_percent` variable and
- the `mutate(cummsum())` command with the `album_votes` variable.

```{r}

band_finalpolls_long <- band_finalpolls_wide %>%
  pivot_longer(votes_1970:percent_2000,
    names_to = c(".value", "year"),
    names_pattern = "(.*)_(.*)",
    values_to = c("var1, var2")) %>%
  arrange(option, year) %>%
  mutate(poll_percent_cumulative = cummean(replace_na(percent, 0))) %>%
  mutate(album_votes_cumulative = cumsum(replace_na(votes, 0)))

rm(band_finalpolls_wide)

```

Here we'll create and save two of our analysis files.

```{r}

finalpolls_percent_analysisfile <- band_finalpolls_long  %>%
  select(option, year, poll_percent_cumulative) %>%
  rename (value = poll_percent_cumulative)

save(finalpolls_percent_analysisfile, file = "data/finalpolls_percent_analysisfile.rda")
rm(finalpolls_percent_analysisfile)

finalpolls_sum_analysisfile <- band_finalpolls_long  %>%
  select(option, year, album_votes_cumulative) %>%
  rename (value = album_votes_cumulative)

save(finalpolls_sum_analysisfile, file = "data/finalpolls_sum_analysisfile.rda")
rm(finalpolls_sum_analysisfile)

rm(band_finalpolls_long)

```

Before rendering our barcharts, we have one more analysis file to create and save. Here I assemble all the steps described above into a single code chunk, except starting with the clean `poll_data` data file we've already created and saved.

```{r}

load("data/poll_data.rda")

album_allpolls <-
  poll_data[poll_data$valid %in%  # include only valid polls
              c(1),]

rm(poll_data)

band_allpolls <- album_allpolls %>%
  group_by(option, year) %>%
  summarise_at(c("votes"), sum) %>%
  arrange(year, option)

rm(album_allpolls)

band_allpolls_wide <- pivot_wider(
  data = band_allpolls,
  id_cols = option,
  names_from = year,
  values_from = c("votes"))

rm(band_allpolls)

band_allpolls_long <- band_allpolls_wide %>%
  gather(year, votes, 3:33) %>%
  arrange(option, year) %>%
  mutate(album_votes_cumulative = cumsum(replace_na(votes, 0)))

rm(band_allpolls_wide)

allpolls_sum_analysisfile <- band_allpolls_long  %>%
  select(option, year, album_votes_cumulative) %>%
  rename (value = album_votes_cumulative)

save(allpolls_sum_analysisfile, file = "data/allpolls_sum_analysisfile.rda")
rm(allpolls_sum_analysisfile)

rm(band_allpolls_long)

```

### Format

The final step before plotting is to format the data for analysis by calling

- the `group_by()` and `mutate(rank())` commands to rank order the bands with each year and
- the `group_by()` and `filter()` commands to constrain the data to the top ranked bands for any given year.
  - Here we filter to the top 10 ranked bands.

Note that I use the # temporailly disable code. I do this so that this same chunk of code can serve all three analysis, enabling/disabling different lines of code depending on the analysis. I also use the # at the end of lines of code that are analysis-dependent to cue when and which to enable/disable.

Also observe that I do not save `formatted` files for each analysis. So, this script is structured for the analysts to move directly from creating the `formatted` file to rendering the bar chart before creating a `formatted` file for anaother analysis.


```{r}

#load("data/finalpolls_percent_analysisfile.rda") # for final polls percentages; render plot before disabling
#analysisfile <- finalpolls_percent_analysisfile # for final polls percentages; render plot before disabling

#load("data/finalpolls_sum_analysisfile.rda") # for final polls sums; render plot before disabling
#analysisfile <- finalpolls_sum_analysisfile # for final polls sums; render plot before disabling

load("data/allpolls_sum_analysisfile.rda") # for all polls sums; render plot before disabling
analysisfile <- allpolls_sum_analysisfile # for all polls sums; render plot before disabling

analysisfile_formatted <- analysisfile %>%
  group_by(year) %>%
  mutate(
    rank = rank(-value),
    value_rel = value / value[rank == 1],
    value_lbl = paste0(" ", round(value / 1))) %>%
  ungroup() %>%
  group_by(option) %>%
  filter(rank <= 10) %>%
  ungroup()

#check <- analysisfile_formatted %>% 
#  filter(rank <= 10) %>% 
#  arrange(option, year, rank)

#rm(finalpolls_percent_analysisfile) # for final polls percentages; render plot before disabling
#rm(finalpolls_sum_analysisfile) # for final polls sums; render plot before disabling
#rm(allpolls_sum_analysisfile) # for all polls sums; render plot before disabling
rm(analysisfile)

```

## Rendering animated bar charts

### Static plots

The first step to making an animated bar chart is to plot a series of static bar charts using the `ggplot()` function.

- Dissatisfied with the default colors, I create a custom array of colors and called it in using the `scale_colour_manual()` and `scale_fill_manual()` commands.
  - After all, *Black Sabbath* has to be *black* and *Deep Purple* has to be *purple*, *right*?
- Using the `unique()` command we can generate the list of bands in the plot for which colors are needed. 

Observe in the chunk below there are two lines of code to enable/disable depedning on whether it is an analysis that uses the percentage values or the sum values

```{r}

band_listlength <- n_distinct(analysisfile_formatted$option) # number of distinct bands for which colors are needed
band_listlength

band_list <- tibble(unique(analysisfile_formatted$option)) # generate list of bands for which colors are needed
band_list

mycolors_scale <- c(
  'AC/DC' = '#362f78',#new
  'Anthrax' = '#362f78',
  'Bathory' = '#936663',
  'Black Sabbath' = '#000000',
  'Budgie' = '#8B8B00',
  'Carcass' = '#8B8B00', #new
  'Celtic Frost' = '#03A89E',
  'Death' = '#8B1A1A',
  'Deep Purple' = '#551A8B',
  'Emperor' = '#551A8B', # new
  "Faith No More" = '#FFC125', #new
  "Guns N' Roses" = '#FFC125',
  'Iron Maiden' = '#458B00',
  'Judas Priest' = '#6E8243',
  'Kreator' = '#DC143C',
  'Led Zeppelin' = '#8A4C19',
  'Megadeth' = '#b91e45',
  'Mercyful Fate' = '#FF4500',
  'Metallica' = '#0000CD',
  'Motörhead' = '#2E382F',
  'Night Sun' = '#FCA811',
  'Pantera' = '#FCA811', #new
  'Queen' = '#cb54d6',
  'Rainbow' = '#9932CC',
  'Rush' = '#573420',
  'Scorpions' = '#D25117',
  'Sepultura' = '#C7B26F',
  'Slayer' = '#b10708',
  'Uriah Heep' = '#5c2c2d',
  'Van Halen' = '#3e45c4',
  'Voivod' = '#9F79EE'
)

mycolors_fill <- c(
  'AC/DC' = '#362f78',#new
  'Anthrax' = '#362f78',
  'Bathory' = '#936663',
  'Black Sabbath' = '#000000',
  'Budgie' = '#8B8B00',
  'Carcass' = '#8B8B00', #new
  'Celtic Frost' = '#03A89E',
  'Death' = '#8B1A1A',
  'Deep Purple' = '#551A8B',
  'Emperor' = '#551A8B', # new
  "Faith No More" = '#FFC125', #new
  "Guns N' Roses" = '#FFC125',
  'Iron Maiden' = '#458B00',
  'Judas Priest' = '#6E8243',
  'Kreator' = '#DC143C',
  'Led Zeppelin' = '#8A4C19',
  'Megadeth' = '#b91e45',
  'Mercyful Fate' = '#FF4500',
  'Metallica' = '#0000CD',
  'Motörhead' = '#2E382F',
  'Night Sun' = '#FCA811',
  'Pantera' = '#FCA811', #new
  'Queen' = '#cb54d6',
  'Rainbow' = '#9932CC',
  'Rush' = '#573420',
  'Scorpions' = '#D25117',
  'Sepultura' = '#C7B26F',
  'Slayer' = '#b10708',
  'Uriah Heep' = '#5c2c2d',
  'Van Halen' = '#3e45c4',
  'Voivod' = '#9F79EE'
)

staticplot = ggplot(analysisfile_formatted, aes(rank, group = option, fill = as.factor(option), color = as.factor(option))) +
  geom_tile(aes(y = value / 2, height = value, width = 0.9 ), alpha = 0.8, color = NA) +
  geom_text(aes(y = 0, label = paste(option, " ")), size = 10, vjust = 0.2, hjust = 1) +
#  geom_text(aes(y = value, label = paste(value_lbl, "%")), size = 7, hjust = 0) + # use for plot with percentage values
  geom_text(aes(y=value,label = value_lbl), size = 7, hjust = 0) + # use for plots with sum values
  geom_text(aes(x = 10, y=max(value), label = as.factor(year)), hjust = 1, vjust = 0, alpha = 0.5,  col = "gray", size = 40) +
  transition_states(year, state_length = 0, transition_length = 2) +
  coord_flip(clip = "off", expand = FALSE) +
  scale_y_continuous(labels = scales::comma) +
  scale_x_reverse() +
  scale_colour_manual(values = mycolors_scale) + # to call custom colors
  scale_fill_manual(values = mycolors_fill) + # to call custom colors
  guides(color = FALSE, fill = FALSE) +
  theme(
    axis.line = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    legend.position = "none",
    panel.background = element_blank(),
    panel.border = element_blank(),
    panel.grid.major = element_blank(),
    panel.grid.minor = element_blank(),
    plot.title = element_text(size = 30, hjust = 0.5, face = "bold", colour = "grey", vjust = 1),
    plot.subtitle = element_text(size = 24, hjust = 0.5, face = "italic", color = "grey"),
    plot.caption = element_text(size = 19, hjust = 0.5, face = "italic",  color = "grey"),
    plot.background = element_blank(),
    plot.margin = margin(4, 1.8, 1, 7.5, "cm")
  )

rm(analysisfile_formatted, band_list)

staticplot

```

### Animated plots

Then we use the `transition_states()` command to stitch together the individual static plots.

More enabling/disabling to do here depending on the analysis.

```{r}

anim = staticplot + transition_states(year, transition_length = 4, state_length = 1) +
  view_follow(fixed_x = TRUE)  +
  
#  labs(title = 'Best album cumulative percentage of votes aggregated by band', # for final polls percentages
       
  labs(title = 'Best album cumulative votes aggregated by band', # for final and all polls sums

       subtitle  =  "Top 10 Bands | 1970–2000",
       
#       caption  = "Data Source: @nickmoberly Twitter best album of the year final polls (excluding data for bonus and qualifying polls).\nValues indicate the percentage of votes from the polls for 1970 through a given year, weighted equally across years.") # for final polls percentages

 #      caption  = "Data Source: @nickmoberly Twitter best album of the year final polls (excluding data for bonus and qualifying polls).\nValues indicate the sum of votes from the polls for 1970 through a given year.") # for final polls sums

       caption  = "Data Source: @nickmoberly Twitter best album of the year polls, inclusive of all polls (bonus, qualifying, and grand finales).\nValues indicate the sum of votes from the polls for 1970 through a given year.") # for all polls sums



rm(staticplot)

anim 

```

And the final step is rendering the animated plots using the `animate(gifski_renderer())` command.

...and yet more enabling/disabling.

```{r}

animate(anim, 200, fps = 10, duration = 40, width = 1200, height = 1000,
  
#  renderer = gifski_renderer("R/plots/album_poll_final_percentage.gif")) # for final polls percentages

#  renderer = gifski_renderer("R/plots/album_poll_final_sum.gif")) # for final polls sums

  renderer = gifski_renderer("R/plots/album_poll_all_sum.gif")) # for all polls sums

rm(anim)

```

If you had gone through the full cycle of enabled/disabled code, you should have three animated bar charts saved as separate GIFS.

#### Bar Chart 1. *Best album cumulative percentage of votes aggregated by band*

This plot uses a rolling average of the `poll_percent` variable as the plotted metric, based on results according to the *final* polls.

#### Bar Chart 2. *Best album cumulative votes aggregated by band*

This plot uses a rolling sum of the `album_votes` variable as the plotted metric, based on results according to the *final* polls. 

#### Bar Chart 3. *Best album cumulative votes aggregated by band*

This plot uses a rolling sum of the `album_votes` variable as the plotted metric, based on results according to *all* polls.