#GOT Animating the Shifting of Affiliations

My first steps using the gganimate package using Game of Thrones

data-visualization
ggplot2
animation
Author

Joshua Kunst Fuentes

Published

April 23, 2019

Introduction

Why use GOT data? Because I was participating in #datosdemiercoles which is the spanish version of #tidytuesday. So the data is given and the purpouse is to learn new packages using that data and share with the community, you know this already, right?

Secondly the package I want to learn beside {ggforce} is {gganimate} so a very first idea was represent every character as a point and move according the actual affiliations. A kind of copy inspiration from FlowingData’s A Day in the Life of Americans1

Disclaimers

  • I know the animation is not then best way to visualiza data! Don’t judge me please! But is fun to play with.
  • I don’t follow the series so I don’t know if the results or animations makes any sense.

The data, the wrangling and the cleaning

The data come from this post where the shifting affiliations are visualized using an alluyvial diagram. It’s a nice post by Matthew Lunkes where he tell all the process to get the final chart:

In this case the data can be downloaded from this repository https://github.com/MattLunkes/GoT_Affiliations.

Code
library(tidyverse)

data <- read_csv("https://raw.githubusercontent.com/MattLunkes/GoT_Affiliations/master/got_char.csv")
data
# A tibble: 488 × 11
   Name   Origin Start…¹ End o…² End o…³ End o…⁴ End o…⁵ End o…⁶ End o…⁷ End o…⁸
   <chr>  <chr>  <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>   <chr>  
 1 Tyrio… House… King R… King J… King J… King J… King T… Daener… Daener… Daener…
 2 Cerse… House… King R… King J… King J… King J… King T… King T… Queen … Queen …
 3 Daene… House… Visery… Daener… Daener… Daener… Daener… Daener… Daener… Daener…
 4 Jon S… House… King R… Night'… Wildli… Night'… Night'… Deceas… Jon Sn… Daener…
 5 Sansa… House… King R… King J… King J… King J… Petyr … Roose … Jon Sn… Jon Sn…
 6 Arya … House… King R… Other,… Other,… Other,… Other,… Other,… Jon Sn… Jon Sn…
 7 Jaime… House… King R… King J… King J… King J… King T… King T… Queen … Queen …
 8 Jorah… House… Visery… Daener… Daener… Daener… Daener… Daener… Daener… Daener…
 9 Theon… House… King R… Robb S… Balon … King J… King T… Balon … Daener… Daener…
10 Samwe… House… Night'… Night'… Night'… Night'… Night'… Night'… Night'… Night'…
# … with 478 more rows, 1 more variable: Episodes <dbl>, and abbreviated
#   variable names ¹​`Starting Affiliation`, ²​`End of S1`, ³​`End of S2`,
#   ⁴​`End of S3`, ⁵​`End of S4`, ⁶​`End of S5`, ⁷​`End of S6`, ⁸​`End of S7`

As we see, the data comes in a not tidy way so gather is our friend here.

Code
data_long <- data |>
  janitor::clean_names() |> 
  rename(end_of_s0 = starting_affiliation) |>
  select(-episodes, -origin) |> 
  gather(season, affiliation, -name) |> 
  mutate(
    season = as.numeric(str_extract(season, "\\d+")),
    affiliation = case_when(
      affiliation == "King Robert Baratheon" ~ "Baratheon",
      affiliation == "Viserys Targaryen" ~ "Targaryen",
      affiliation == "King Joffrey Baratheon" ~ "Lannister",
      affiliation == "Daenerys Targaryen" ~ "Targaryen",
      affiliation == "Night's Watch" ~ "Night's Watch",
      affiliation == "Other, Westeros" ~ "Westeros",
      affiliation == "Wildlings" ~ "Wildlings",
      affiliation == "King Tommen Baratheon" ~ "Lannister",
      affiliation == "Petyr Baelish, Lord Protector of the Vale" ~ "The Vale",
      affiliation == "Other, Essos" ~ "Essos",
      affiliation == "Roose Bolton, Lord Paramount of the North" ~ "Bolton",
      affiliation == "Queen Cersei Lannister" ~ "Lannister",
      affiliation == "Jon Snow, King in the North" ~ "Stark",
      TRUE ~ affiliation
      )
    )

# there are some repeated characters?
data_long <- data_long |> 
  semi_join(count(data, Name) |> filter(n == 1), by = c("name" = "Name")) |> 
  # importante for the ggrepel part
  arrange(season, name, affiliation)

data_long
# A tibble: 3,592 × 3
   name            season affiliation  
   <chr>            <dbl> <chr>        
 1 Addam Marbrand       0 Baratheon    
 2 Adrack Humble        0 Baratheon    
 3 Aeron Greyjoy        0 Baratheon    
 4 Aggo                 0 Khal Drogo   
 5 Alliser Thorne       0 Night's Watch
 6 Alton Lannister      0 Baratheon    
 7 Alys Karstark        0 Baratheon    
 8 Amory Lorch          0 Baratheon    
 9 Anara                0 Essos        
10 Anguy                0 Baratheon    
# … with 3,582 more rows

Affiliations Positions

At the beginning I think use a circular layout and see what happend but the result was far for beign interesting, and as we can see I was a failure in my first attempt using {gganimate}.

Well, so the next idea and step was to get closer the affilations related. How can be two affiliations be related? An answer can be the the amount of characters which move from one to another.

Code
ts <- data_long |> 
  distinct(season) |> 
  pull() |> 
  head(-1)

change_season <- map_df(ts, function(t = 0){
  
  dout <- full_join(
    data_long |> filter(season == t),
    data_long |> filter(season == t + 1),
    by = "name", 
    suffix = c("_before", "_actual")
  ) |> 
    count(from = affiliation_before, to = affiliation_actual)
  
  dout <- dout |> 
    filter(complete.cases(dout)) |> 
    mutate(season = t)
  
  dout
  
})

change_total <- change_season |> 
  group_by(from, to) |> 
  summarise(n = sum(n)) |> 
  ungroup()

change_total
# A tibble: 119 × 3
   from                                    to                                  n
   <chr>                                   <chr>                           <int>
 1 Balon Greyjoy, King of the Iron Islands Balon Greyjoy, King of the Iro…    31
 2 Balon Greyjoy, King of the Iron Islands Deceased                            7
 3 Balon Greyjoy, King of the Iron Islands Euron Greyjoy, King of the Iro…     4
 4 Balon Greyjoy, King of the Iron Islands Lannister                           1
 5 Balon Greyjoy, King of the Iron Islands Targaryen                           3
 6 Baratheon                               Balon Greyjoy, King of the Iro…     9
 7 Baratheon                               Brotherhood Without Banners         5
 8 Baratheon                               Deceased                           15
 9 Baratheon                               Essos                               1
10 Baratheon                               House Arryn (Neutral)              12
# … with 109 more rows

Now, with this data we can use the {igraph} package and the graph_from_data_frame function to get a graph from the previous data frame and then get a layout.

Code
library(igraph)

g <- graph_from_data_frame(change_total, directed = FALSE)

# https://igraph.org/r/doc/strength.html
E(g)$weight <- pull(change_total, n)
V(g)$degree <- degree(g)

V(g)$label.cex <- 0.5

plot(g)

Nice! but we need the positions instead of the image. So we’ll use the layout_with_fr to get some layout of our graph.

Code
set.seed(123)
layout <- layout_with_fr(g)

affiliations <- tibble(
  affiliation = V(g)$name,
  x = layout[, 2],
  y = layout[, 1],
  degree = degree(g)
)

affiliations <- data_long |> 
  count(affiliation) |> 
  left_join(affiliations, ., by = "affiliation")

affiliations
# A tibble: 27 × 5
   affiliation                                 n     x       y degree
   <chr>                                   <int> <dbl>   <dbl>  <dbl>
 1 Balon Greyjoy, King of the Iron Islands    46 -1.85  0.535       9
 2 Baratheon                                 200 -1.56  0.153      11
 3 Bolton                                     18 -2.35  0.595       5
 4 Brotherhood Without Banners                52 -1.52  0.774       6
 5 Deceased                                  826 -2.27 -0.181      26
 6 Dothraki                                  100 -3.00 -1.20        6
 7 Essos                                     262 -2.06 -0.641      16
 8 Essos Slavers                             113 -2.05 -1.35        6
 9 Euron Greyjoy, King of the Iron Islands     4 -1.96  1.61        2
10 High Sparrow                                7 -3.06 -0.0212      4
# … with 17 more rows

At this point we are ready to use ggplot and check!

Code
p1 <- ggplot(affiliations, aes(x, y, color = affiliation, label = affiliation, size = degree)) +
  geom_point() +
  geom_text() +
  scale_size(range = c(1, 4)) +
  theme(legend.position = "none") +
  labs(title = "igraph laytout")
p1

This is really an improvement from the the circular layout. The downside is the main affiliations are too close so the text is overlaping. A simple solution to this was generate an equidistant sequence for every set of coordinates, \(x\) and \(y\).

Code
affiliations <- affiliations |> 
  arrange(y) |> 
  mutate(y = seq(1:n())) |> 
  arrange(x) |> 
  mutate(x = seq(1:n())) |> 
  mutate_at(vars(x, y), ~ (.x - mean(.x))/sd(.x))

We can compare the results:

Happy with the effect of a simple fix for the overlaping text. And I think this change keep the spirit of the original graph’s shape.

Character positions

To get the character positions for every step/time/season we decided to put them in the corresponding affiliation making a circle around it and then adding a random noise

Code
get_reg_poly_coords <- function(sides = 5, radius = 1, x0 = 0, y0 = 0) {
  # https://stackoverflow.com/a/7198179/829971
  x <- radius * cos(2*pi*(1:sides)/sides) + x0
  y <- radius * sin(2*pi*(1:sides)/sides) + y0
  return(tibble(x, y))
}

characters <- data_long |> 
  count(season, affiliation) |>
  mutate(coords = map2(n, 1/nrow(affiliations), get_reg_poly_coords)) |> 
  unnest(c(coords)) |> 
  select(-season, -affiliation)

characters <- bind_cols(data_long, characters) |> 
  left_join(affiliations, by = c("affiliation"),  suffix = c(".character", ".affiliation")) |> 
  mutate(
    x = x.character +  x.affiliation,
    y = y.character +  y.affiliation
  ) |> 
  mutate_at(vars(x, y), ~ .x + runif(length(.x), -1, 1)/nrow(affiliations))
Code
p <- ggplot() +
  geom_point(aes(x, y, color = affiliation), alpha = 0.5, data = characters) +
  geom_text(aes(x, y, size = n, label = affiliation), alpha = 0.5, data = affiliations) +
  scale_size_area() +
  scale_color_viridis_d() +
  theme(legend.position = "none")
p

Nice! We are almost there.

Some details before the magic

To get a very style GOT theme we need first the font, you can download from this link https://fontmeme.com/fonts/game-of-thrones-font/.2 and use it with the {extrafont} package.

We’ll select some important characters to use with {ggrepel} package:

Code
main_characters <- data |>
  select(name = Name, Episodes) |> 
  arrange(desc(Episodes)) |>
  head(5)

knitr::kable(main_characters)
name Episodes
Tyrion Lannister 61
Cersei Lannister 58
Daenerys Targaryen 56
Jon Snow 56
Sansa Stark 54

Animation is HERE

First we need some setup for the font and colors.

Code
library(extrafont)
loadfonts(device = "win") # yeah, win! :/

font <- "Game of Thrones"
font2 <- "Roboto Condensed"
bckground <- "black"
color1 <- "#959394"
color2 <- "white"
seed <- 123

theme_set(theme_gray())

Then, the usual {ggplot2} syntax.

Code
p <- ggplot() +
  # maint characters labels
  ggrepel::geom_text_repel(
  # geom_text(
    aes(x, y, label = name),
    seed = seed,
    # box.padding = .5, force = 0.25,, max.iter = 5000,
    color = color1,
    size = 3,
    family = font2,
    vjust = "inward", hjust = "inward",
    data = semi_join(characters, main_characters, by = "name")
  ) +
  # https://stackoverflow.com/a/34398935/829971
  # maint characters points
  geom_point(
    aes(x, y),
    size = 3,
    alpha = 0.50,
    color = color2,
    stroke = 0,
    shape = 16,
    data = semi_join(characters, main_characters, by = "name")
  ) +
  # rest of points
  geom_point(
    aes(x, y),
    size = 3,
    alpha = 0.20,
    color = color2,
    stroke = 0,
    shape = 16,
    data = anti_join(characters, main_characters, by = "name") 
  ) +
  # labels affiliations
  geom_text(
    aes(x, y + 3 / nrow(affiliations), label = affiliation, size = degree),
    data = affiliations,
    color = color1,
    alpha = 0.80,
    family = font
  ) +
  scale_size(range = c(2, 5)) +
  labs(
    title = "#",
    caption = "#DatosDeMiercoles por @jbkunst\njkunst.com",
    x = NULL,
    y = NULL
  ) +
  theme(
    legend.position = "none",
    panel.border = element_blank(),
    panel.background = element_blank(),
    panel.grid = element_blank(),
    axis.text.x = element_blank(),
    axis.text.y = element_blank(),
    axis.ticks = element_blank(),
    rect = element_rect(fill = bckground, color = bckground),
    text  = element_text(family = font, colour = color1, size = 15),
    plot.title = element_text(family = font, colour = color1, size = 25),
    plot.subtitle = element_text(family = font2, colour = color1, size = 13),
    plot.caption = element_text(family = font2, colour = color1, size = 10),
  )

Finally add the {gganimate} magic:

Code
library(gganimate)

p <- p +
  labs(subtitle = "Affiliation changes in season {trunc(frame_time)}") +
  transition_time(season) +
  shadow_wake(wake_length = 0.005, alpha = TRUE, exclude_layer = 1) +
  ease_aes("exponential-in-out")

For test purposes I recommend reduce de fps to 10, and duration as much you can according how many frames you are using so you can to check if the output animation is what you want quickly, then for the final output use at least 30 fps to get a smooth transition.

Code
animate(p, fps = 30, duration = 8*3, width = 1000, height = 800)

And voilà:

Footnotes

  1. https://flowingdata.com/2015/12/15/a-day-in-the-life-of-americans/↩︎

  2. Thanks to (violetrzn)[https://twitter.com/violetrzn], https://github.com/violetr/tidytuesday/blob/master/datosdem2.R#L8↩︎

Reuse

https://creativecommons.org/licenses/by/4.0/

Citation

BibTeX citation:
@online{kunstfuentes2019,
  author = {Joshua Kunst Fuentes},
  title = {\#GOT {Animating} the {Shifting} of {Affiliations}},
  date = {2019-04-23},
  url = {https://jkunst.com/blog/posts/2019-04-23-got-animating-the-shifting-of-affiliations},
  langid = {en}
}
For attribution, please cite this work as:
Joshua Kunst Fuentes. 2019. “#GOT Animating the Shifting of Affiliations.” April 23, 2019. https://jkunst.com/blog/posts/2019-04-23-got-animating-the-shifting-of-affiliations.