TidyTuesday (August 14): Roman Emperors

roman_emperors.RMD

1. Line-Plot
2. Upset Plot (scroll down or Ctrl+F "Upset-Plot")


# ---- Line-Plot
# Packages

```{r}
pacman::p_load(dplyr, purrr, tidyr, ggplot2, ggtext, extrafont, 
               scales, ggrepel, forcats,
               dutchmasters, cowplot)

loadfonts(quiet = TRUE, device = "pdf") ## win
```

# Raw

```{r}
emperors_raw <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-08-13/emperors.csv")

glimpse(emperors_raw)
```

```{r}
emperors_raw %>% count(rise, sort = TRUE)
```

```{r}
emperors_raw %>% count(cause, sort = TRUE)
```

# Clean

```{r}
emperors_clean <- emperors_raw %>% 
  select(-verif_who) %>% 
  mutate(rise = fct_relevel(rise, 
                            "Seized Power", "Appointment by Army",
                            "Appointment by Praetorian Guard",
                            "Purchase", "Election", 
                            "Appointment by Senate", 
                            "Appointment by Emperor",
                            "Birthright"),
         cause = fct_relevel(cause, 
                             "Assassination", "Unknown", "Execution", 
                             "Died in Battle", "Captivity", "Suicide", "Natural Causes"),
         dynasty = case_when(
           name %in% c("Trajan Decius", "Hostilian", 
                       "Trebonianus Gallus", "Aemilian") ~ "Decian",
           name %in% c("Valerian", "Gallienus") ~ "Valerian",
           name %in% c("Cladius Gothicus", "Quintillus", 
                       "Aurelian") ~ "Gordian cont.",
           name %in% c("Tacitus", "Florianus", "Probus") ~ "Tacitus",
           name %in% c("Carus", "Numerian", "Carinus") ~ "Caran",
           TRUE ~ dynasty)) %>% 
  mutate(dynasty = case_when(
    dynasty == "Julio-Claudian" ~ "Julio-Claudian (27 B.C. - 68 A.D.)",
    dynasty == "Flavian" ~ "Flavian (68 - 96 A.D.)",
    dynasty == "Nerva-Antonine" ~ "Nerva-Antonine (96 - 192 A.D.)",
    dynasty == "Severan" ~ "Severan (193 - 235 A.D.)",
    dynasty == "Gordian" ~ "Gordian (238 - 249 A.D.)",
    dynasty == "Gordian cont." ~ "Gordian cont. (268 - 275 A.D.)",
    dynasty == "Decian" ~ "Decian (249 - 253 A.D.)", 
    dynasty == "Valerian" ~ "Valerian (253 - 268 A.D.)",
    dynasty == "Tacitus" ~ "Tacitus (275 - 282 A.D.)", 
    dynasty == "Caran" ~ "Caran (282 - 285 A.D.)",
    dynasty == "Constantinian" ~ "Diocletian (285 - 305 A.D.)"
  )) %>% 
  mutate(dynasty = as_factor(dynasty))
```

# Plots

- windowsFonts() stuff is one of many attempts of get the fonts to show up properly when I arranged two plots together. 
- Fonts work fine on one graph by doing the normal way with {extrafont} but when put together some words get squished...

## Rise
```{r, fig.width=18}
windowsFonts(quattro = windowsFont("Quattrocento")) 

emperors_riset2 <- emperors_clean %>% 
  filter(index <= 49) %>% 
  ggplot(aes(x = index, y = rise, group = 1)) +
  geom_path(color = "#657b83") +
  geom_point(aes(fill = dynasty), color = "grey",
             size = 5.5, shape = 21, stroke = 2) + 
  scale_x_continuous(expand = c(0.025, 0),
                   breaks = c(1, 49),
                   labels = c("26 B.C.", "305 A.D.")) +
  scale_fill_dutchmasters(palette = "pearl_earring") +
  labs(title = "The <b style='color: black'>Rise</b> & <b style='color: black'>Fall</b> of Roman Emperors <br>From Augustus (26 B.C. - 14 A.D.) to Diocletian (285 A.D. - 305 A.D.) <br>Transitions of Power Ordered by <b style='color:#228B22'>'Peaceful'</b> to <b style='color:#800000'>'Violent'</b> *",
       subtitle = "<b style='color: black'>Rise</b>",
       x = NULL, y = NULL) +
  theme_solarized() +
  theme(plot.title = element_markdown(size = 22, family = "quattro"),
        plot.subtitle = element_markdown(size = 22, family = "quattro"),
        plot.caption = element_text(size = 14),
        text = element_markdown(family = "quattro", face = "bold"), 
        axis.title.x = element_blank(),
        axis.text.x = element_blank(),
        axis.ticks = element_blank(),
        panel.grid = element_line(size = 1.5),
        panel.grid.minor.x = element_blank(),
        axis.text.y = element_text(size = 16),
        legend.title = element_text(size = 18, family = "quattro", face = "bold"),
        legend.text = element_text(size = 16, family = "quattro", face = "bold"),
        legend.key = element_rect(fill = "#fdf6e3"),
        legend.position = "none",
        plot.margin = unit(c(20, 20, 20, 20), "pt"))

emperors_riset2
```

## Fall
```{r, fig.width=18}
windowsFonts(quattro = windowsFont("Quattrocento"))

emperors_fallt2 <- emperors_clean %>% 
  filter(index <= 49) %>% 
  ggplot(aes(x = index, y = cause, group = 1)) +
  geom_path(color = "#657b83") +
  geom_point(aes(fill = dynasty), color = "grey",
             size = 5.5, shape = 21, stroke = 2) + 
  scale_x_continuous(expand = c(0.025, 0),
                   breaks = c(1, 49),
                   labels = c("26 B.C.", "305 A.D.")) +
  scale_fill_dutchmasters(palette = "pearl_earring") +
  guides(fill = guide_legend(title = "Dynasty", ncol = 3, 
                             direction = "horizontal", 
                             title.position = "top")) +
  labs(title = NULL,
       subtitle = "<b style='color: black'>Fall</b>",
       x = "The Principate Era", y = NULL,
       caption = glue::glue("
                            * Subjective and with many caveats
                            Data: Wikipedia
                            By @R_by_Ryo")) +
  theme_solarized() +
  theme(plot.subtitle = element_markdown(size = 22, family = "quattro"),
        plot.caption = element_text(size = 14),
        text = element_markdown(family = "quattro", face = "bold"), 
        axis.title.x = element_text(size = 16),
        axis.text.x = element_text(size = 16),
        axis.ticks = element_blank(),
        panel.grid = element_line(size = 1.5),
        panel.grid.minor.x = element_blank(),
        axis.text.y = element_text(size = 16),
        legend.title = element_text(size = 18, family = "quattro", face = "bold"),
        legend.text = element_text(size = 16, family = "quattro", face = "bold"),
        legend.key = element_rect(fill = "#fdf6e3"),
        legend.position = "bottom",
        legend.justification = c(0, 0),
        plot.margin = unit(c(20, 20, 20, 20), "pt"))

emperors_fallt2
```

## Together

- both patchwork and cowplot aren't working for me re: Windows and fonts when two plots are arranged together soo old school it is!

```{r, fig.height=20, fig.width=18}
library(gtable)
library(grid)

png("emperor_RiseFall_plot2.png", 
    width = 2000, height = 1800, res = 144, bg = "white")

one <- ggplotGrob(emperors_riset2)
two <- ggplotGrob(emperors_fallt2)

gg <- rbind(one, two, size = "last")
gg

gg$widths <- unit.pmax(one$widths, two$widths)

grid.newpage()
grid.draw(gg)

dev.off()
```

# ---- Upset-Plot
# Packages

```{r}
pacman::p_load(dplyr, purrr, tidyr, ggplot2, ggtext, extrafont, 
               scales, ggrepel, forcats, 
               dutchmasters, cowplot, 
               ## upset plots
               ggupset, magick)

loadfonts(quiet = TRUE, device = "pdf") ## win
```

# Data 

- same as above ^ plot RAW + CLEAN sections

# Plot

```{r, fig.height=5, fig.width=8}
emperors_clean %>% 
  mutate_at(c("rise", "cause"), as.character) %>% 
  mutate(rise = paste0("<b style='color: black'>Rise</b>: ", rise),
         cause = paste0("<b style='color: black'>Fall</b>: ", cause)) %>% 
  mutate(risefall = map2(rise, cause, ~c(.x, .y))) %>% 
  ggplot(aes(x = risefall)) +
  geom_bar(fill = "#8B0000") + 
  scale_x_upset(n_intersections = 10,
                expand = c(0.01, 0.01)) +
  scale_y_continuous(expand = c(0, 0),
                     labels = seq(0, 15, by = 2),
                     breaks = seq(0, 15, by = 2)) +
  labs(title = "The <b style='color: black'>Rise</b> & <b style='color: black'>Fall</b> of Roman Emperors",
       subtitle = "Many Emperors With A 'Rightful' Claim Met An <br> Untimely End By <b style='color: #8B0000'>Assassination</b> Or <b style='color: #8B0000'>Execution</b>.",
       caption = "<b style='color: black'>Source</b>: Wikipedia <br><b style='color: black'>By</b>: @R_by_Ryo",
       x = NULL, y = "Number of Occurence") +
  theme_combmatrix(
    text = element_text(family = "Quattrocento", color = "#657b83"),
    plot.title = element_markdown(family = "Quattrocento"),
    plot.subtitle = element_markdown(family = "Quattrocento"),
    plot.caption = element_markdown(family = "Quattrocento"),
    axis.title.y = element_blank(),
    axis.text.y = element_markdown(family = "Quattrocento", color = "#657b83", size = 10),
    plot.background = element_rect(fill = "#fdf6e3"),
    panel.background = element_rect(fill = "#fdf6e3"),
    combmatrix.panel.striped_background.color.one = "#d3d3d3",
    combmatrix.panel.point.color.fill = "#8B0000",
    combmatrix.panel.line.color = "#8B0000",   ## added this option in myself in my own version of the package...
    panel.grid.major.x = element_blank(),
    panel.grid.major.y = element_line(color = "#657b83"),
    panel.grid.minor.y = element_blank(),
    combmatrix.label.extra_spacing = 5,
    axis.ticks = element_blank())
```

```{r}
ggsave(filename = here::here("emperors_upsetplot.png"),
       height = 5, width = 8)
```

## Crop excess portion of img

```{r}
empupset <- magick::image_read(path = here::here("emperors_upsetplot.png"))

empupset

empupsetcrop <- magick::image_crop(empupset, "700x0-125")

magick::image_write(empupsetcrop, path = here::here("empupsetplot.png"),
                    format = "png", depth = 16)
```