COVID-19 and other Pandemics

Visualizations

First we will look at the pandemics by decreasing death toll.

p <- pandem_df %>%
  ggplot(aes(x = reorder(Name, desc(-death_toll)), y = death_toll)) +
  geom_col(aes(fill = Name)) +
  scale_fill_manual(values = cols)  +
  theme_bw() +
  theme(axis.text.x = element_text(hjust=1, angle=45, 
                                   colour = text_col),
        axis.text.y = element_text(colour = text_col)) +
  guides(fill = FALSE) +
  labs(title = "Death Toll of Selected Pandemics",
       y = "Total Deaths", x = "Pandemic",
       caption = caption1) + coord_flip()

p + scale_y_continuous(breaks = c(1*10^1, 1*10^7, 1*10^8, 2*10^8 ),
                limits = c(NA, 2*10^8)) 

Looks like a log scale would help here. I’ll also add in more breaks to aid in comparison over the log scale.

p +  scale_y_log10(breaks = c(1*10^1, 1*10^2, 1*10^3, 1*10^4, 1*10^5,
                           1*10^6, 1*10^7, 1*10^8, 1*10^9, 1*10^10),
                limits = c(NA, 1*10^9)) 

We can then examine the death toll over time.

p <- pandem_df %>%
  ggplot(aes(x = reorder(Name, desc(-Start)), y = death_toll)) +
  geom_col(aes(fill = Name)) +
  scale_fill_manual(values = cols) + 
  theme_bw() +
  theme(axis.text.x = element_text(hjust=1, angle=45),
        axis.text.y = element_text(colour = text_col)) +
  guides(fill = FALSE) +
  labs(title = "Death Toll of Selected Pandemics",
       subtitle = "Ordered by least recent to most recent",
       y = "Total Deaths", x = "Pandemic",
       caption = caption1) + coord_flip()

p + scale_y_continuous(breaks = c(1*10^1, 1*10^7, 1*10^8, 2*10^8 ),
                     limits = c(NA, 2*10^8))

Again we will do a log transformation to better visualize.

 p + scale_y_log10(breaks = c(1*10^1, 1*10^2, 1*10^3, 1*10^4, 1*10^5,
                           1*10^6, 1*10^7, 1*10^8, 1*10^9, 1*10^10),
                limits = c(NA, 1*10^9))

We can also zoom our focus in to how the death toll compares to the most recent pandemics that have occurred during the modern medicine period in the 20th century.

# comparing to 20th century pandemics
pandem_19_df <- pandem_df %>%
  filter(Name %in% c("HIV/AIDS", "SARS", "Swine Flu", "Ebola", "MERS", "COVID-19"))
text_col <- ifelse(pandem_19_df$Name == "COVID-19", "#c51b7d", "#999999")
cols <- ifelse(pandem_19_df$Name == "HIV/AIDS", "#c51b7d", "#999999")

pandem_df %>%
  filter(Name %in% c("HIV/AIDS", "SARS", "Swine Flu", "Ebola", "MERS", "COVID-19")) %>%
  ggplot(aes(x = reorder(Name, desc(-Start)), y = death_toll)) +
  geom_col(aes(fill = Name)) +
  scale_fill_manual(values = cols) + 
  scale_y_log10((breaks = c(1*10^1, 1*10^2, 1*10^3, 1*10^4, 1*10^5,
                                1*10^6, 1*10^7,1*10^8))) +
  theme_bw() +
  theme(axis.text.x = element_text(hjust=1, angle=45),
        axis.text.y = element_text(colour = text_col)) +
  guides(fill = FALSE) +
  labs(title = "Death Toll of Selected Pandemics",
       subtitle = "Ordered by least recent to most recent",
       y = "Total Deaths (log scale)", x = "Recent Pandemics",
       caption = caption1) + coord_flip()

The deaths from HIV are an order of magnitude greater than the others, so if we drop that, we can compare on the normal scale without log transformation. Immediately notable is that despite the pandemic not being close to over, CoVD-19 has already killed more people than the previous coronavirus pandemics (MERS, SARS), and will be much deadlier than Ebola. Depending on containment efforts by governments, it seems likely that the death toll will exceed that of swine flu as well at this point.

#normal scale, no HIV/AIDS
pandem_df %>%
  filter(Name %in% c("SARS", "Swine Flu", "Ebola", "MERS", "COVID-19")) %>%
  ggplot(aes(x = reorder(Name, desc(-Start)), y = death_toll)) +
  geom_col(aes(fill = Name)) +
  scale_fill_manual(values = cols) + 
  theme_bw() +
  theme(axis.text.x = element_text(hjust=1, angle=45),
        axis.text.y = element_text(colour = text_col)) +
  guides(fill = FALSE) +
  labs(title = "Death Toll of Selected Pandemics",
       subtitle = "Ordered by least recent to most recent",
       y = "Total Deaths", x = " Recent Pandemics",
       caption = caption1) + coord_flip()

Finally I thought it would be interesting to examine the pandemics over time. Using geom_rect() we can see both the death toll on the y-axis, as well as the length of each pandemic on the x-axis. It’s interesting to see different disease dynamics this way. I think most notable to me is the HIV/AIDS pandemic. This pandemic looks similar to pre-modern medicine era ones despite occurring recently, and is indicative of the failure of government to act.

# over time with time extent (geom_rect)

pandem_df %>%
  ggplot(aes(ymin = 0, ymax = death_toll, fill = Name)) +
  geom_rect(aes(xmin = Start, xmax = End)) +
  theme_bw() +
  theme(legend.position="bottom") +
  scale_y_log10(breaks = c(1*10^1, 1*10^2, 1*10^3, 1*10^4, 1*10^5,
                            1*10^6, 1*10^7, 1*10^8, 1*10^9)) +
  scale_fill_manual(values = cols3) +
  labs(title = "Pandemics Throughout History",
       x = "Year", y = "Death Toll (log scale)",
       caption = caption1)

That’s it for now. I hope everyone is socially distancing and doing their part to help prevent this current pandemic from looking like pandemics from the past!