Evolution acceptance and vaccination – https://twitter.com/ikashnitsky/status/1491829028667416578

evol-and-vaxx.R

#===============================================================================
# 2022-02-10 -- twitter
# Digitize data from: Miller, J. D., Scott, E. C., & Okamoto, S. (2006). Public Acceptance of Evolution. Science. https://doi.org/10.1126/science.1126746
# Ilya Kashnitsky, [email protected], @ikashnitsky
#===============================================================================

library(tidyverse)
library(magrittr)
library(hrbrthemes)
library(countrycode)
library(lubridate)
library(ggrepel)

# # copy ordered countries names from the paper (manual fixing for two words names)
# a <- c("Iceland", "500)", "Denmark", "(1013)", "Sweden", "(1023)", "France", "(1021)", "Japan", "(2146)", "United Kingdom", "(1308)", "Norway", "(976)", "Belgium", "(1024)", "Spain", "(1035)", "Germany", "(1507)", "Italy", "(1006)", "Netherlands", "(1005)", "Hungary", "(1000)", "Luxembourg", "(518)", "Ireland", "(1008)", "Slovenia", "(1061)", "Finland", "(1006)", "Czech Republic", "(1037)", "Estonia", "(1000)", "Portugal", "(1009)", "Malta", "(500)", "Switzerland", "(999)", "Slovak Republic", "(1241)", "Poland", "(999)", "Austria", "(1034)", "Croatia", "(1000)", "Romania", "(1005)", "Greece", "(1000)", "Bulgaria", "(1008)", "Lithuania", "(1003)", "Latvia", "(1034)", "Cyprus", "(505)", "United States", "(1484)", "Turkey", "(1005")
# 
# # take out only every second
# b <- a[seq(1, 67, 2)]
# 
# # now digitize
# library(digitize)
# p <- digitize("~/Downloads/fig-1.png") # note: here is a path to a local screenshot
# # next goes manual digitizing of the data, see my results here:
# # https://twitter.com/ikashnitsky/status/1491831174217535488
# 
# # put everything together
# evol <- tibble(
#     country = b,
#     evol_agree = p$x %>% rev
# ) %>%
#     mutate(iso_code = countrycode(country, origin = "country.name", destination = "iso3c"))

# read back the output of this manual data digitizing
evol <- read_csv("https://gist.githubusercontent.com/ikashnitsky/2b3745141f57d4b57a3d9c77a73b75ee/raw/b72ed6a635f75354af2e248604f2b5a11d7f9698/out-data.csv")

# vaccination data from OWD
# read from a local copy of the public dataset from
# https://covid.ourworldindata.org/data/owid-covid-data.csv
owd <- read.csv("~/data/owd/owid-covid-data.csv.gz")

vac <- owd %>%
    filter(year(date) == "2021") %>%
    group_by(iso_code, location) %>%
    summarise(
        vac_int = people_fully_vaccinated_per_hundred %>% divide_by(100) %>% mean(na.rm = T),
        vac_int_w = new_cases_per_million %>% prop.table %>%
            multiply_by(people_fully_vaccinated_per_hundred %>% divide_by(100)) %>% sum(na.rm = T),
        pop = population %>% mean
    )

# patch LUX - people vaccinated
lux <- owd %>%
    filter(year(date) == "2021", iso_code == "LUX") %>%
    group_by(iso_code, location) %>%
    summarise(
        vac_int = people_vaccinated_per_hundred %>% divide_by(100) %>% mean(na.rm = T),
        vac_int_w = new_cases_per_million %>% prop.table %>%
            multiply_by(people_vaccinated_per_hundred %>% divide_by(100)) %>% sum(na.rm = T),
        pop = population %>% mean
    )

vax <- vac %>% filter(!iso_code == "LUX") %>% bind_rows(lux)

df <- evol %>% left_join(vax)

# plot
df %>%
    ggplot(aes(evol_agree, vac_int))+
    geom_text_repel(
        aes(label = iso_code), size = 2, color = "#bababa",
        family = font_rc
    )+
    geom_point(color = 1, aes(size = pop))+
    scale_x_continuous(limits = c(20, NA), position = "top") +
    scale_y_continuous(limits = c(0, NA)) +
    theme_minimal(base_family = font_rc)+
    theme(plot.background = element_rect(color = NA, fill = "#fafafa"))+
    theme(
        legend.position = "none",
        plot.title = element_text(family = "Roboto Slab", face = 2),
        panel.grid.minor = element_blank()
    )+
    labs(
        y = "Integral vaccination measure [0, 1]",
        x = "Proportion accepting evolution",
        caption = "Data: Miller etal 2006; OWD // Design: @ikashnitsky",
        title = "Accepting evolution is associated with higher vaccine uptake"
    )

ggsave("~/Downloads/evolution-and-vaccination.png", width = 6.4, height = 3.6, type = "cairo-png")

out-data.csv