dblogr/

COVID Origin Polls

Polling results from various polls on the origins of covid

Prepare Data

# devtools::install_github("derekmichaelwright/agData")
library(agData)
# Prep data
myCaption1 <- "derekmichaelwright.github.io/dblogr/ | Data: Morning Consult"
myTitle1 <- "Morning Consult Poll"
mySubtitle1 <- "The share of adults who said the following comes closest to their opinion\nabout the origins of the COVID-19 pandemic"
d1 <- read.csv("data_morning_consult.csv") %>%
  mutate(Area = factor(Area, levels = rev(.$Area))) 
#
myCaption2 <- "derekmichaelwright.github.io/dblogr/ | Data: YouGov"
myTitle2 <- "35. COVID-19 Originated in Chinese Lab"
mySubtitle2 <- "Regardless of whether or not the virus responsible for COVID-19 was created or naturally mutated,\ndo you believe it is true or false that a laboratory in China was the origin of the virus?"
myAnswers <- c("Definatly false", "Propably false", "Not sure",
               "Probably true", "Definatly true")
d2 <- read.csv("data_yougov.csv", skip = 1, check.names = FALSE) %>%
  gather(Group, Percent, 2:ncol(.)) %>%
  mutate(Answer = factor(Answer, levels = myAnswers))
#
myCaption3 <- "derekmichaelwright.github.io/dblogr/ | Data: GCRI"
myTitle3 <- "Degree of belief in COVID-19 origin from natural zoonosis"
d3 <- read.csv("data_gcri.csv") %>%
  mutate(Interpretation = factor(Interpretation, levels = unique(.$Interpretation)),
         `Natural.Belief` = factor(`Natural.Belief`, levels = unique(.$`Natural.Belief`)))
#
myCaption4 <- "derekmichaelwright.github.io/dblogr/ | Data: Deseret News/HarrisX"
myTitle4 <- "Which theory about the origin of COVID-19 is most believable?"
myTitle5 <- "Are you satisfied or unsatisfied with the government's investigation into the origins of COVID-19?"
d4 <- read.csv("data_deseret.csv")

Morning Consult Poll

The share of adults who said the following comes closest to their opinion about the origins of the COVID-19 pandemic.

Surveys conducted March 14-April 2, 2023, among a representative sample of 2,200 U.S. adults and samples of roughly 1,000 adults in Australia and Latin American and European countries, with unweighted margins of error of +/- 2 and +/- 3 percentage points, respectively. Figures may not add up to 100% due to rounding.

# Prep data
myTraits <- c("Natural", "Unsure", "Lab Leak")
myColors <- c("darkred", "steelblue", "darkgreen")
yy <- d1 %>% 
  mutate(Natural.pos = Lab.Leak + Unsure,
         Lab.Leak.pos = Lab.Leak) 
xx <- d1 %>% gather(Trait, Value, 2:4) %>%
  mutate(Trait = gsub("\\."," ", Trait),
         Trait = factor(Trait, levels = myTraits))
# Plot
mp <- ggplot(xx, aes(x = Area)) +
  geom_col(aes(y = Value, fill = Trait), color = "black", alpha = 0.8)  +
  geom_text(data = yy, aes(y = Lab.Leak.pos, label = Lab.Leak), color = "white") +
  geom_text(data = yy, aes(y = Natural.pos, label = Natural), color = "white") +
  scale_fill_manual(name = NULL, values = myColors, breaks = rev(myTraits)) +
  scale_y_continuous(expand = c(0,0)) +
  theme_agData(legend.position = "bottom") +
  coord_flip() +
  labs(title = myTitle1, subtitle = mySubtitle1, 
       x = NULL, y = "Percent", caption = myCaption1)
ggsave("covid_origin_1_01.png", mp, width = 6, height = 4)

YOUGOV Poll

35. COVID-19 Originated in Chinese Lab

March 4 - 7, 2023 - 1500 U.S. Adult Citizens

Regardless of whether or not the virus responsible for COVID-19 was created or naturally mutated, do you believe it is true or false that a laboratory in China was the origin of the virus?

All Data

# Prep data
myColors <- c("darkred", "palevioletred3","black", "steelblue", "darkblue")
myGroups <- c("Total", "Female",  "Male", "White", "Black", "Hispanic",
              "Ages 18-29", "Ages 30-44", "Ages 45-64", "Ages 65+",
              "Income < 50K", "Income 50-100K", "Income100K+",
              "Urban", "Suburban", "Rural",
              "Democrat", "Liberal", "Biden Voters",  
              "Independent", "Moderate",
              "Republican", "Conservative", "Trump Voters")
xx <- d2 %>% filter(Group %in% myGroups) %>%
  mutate(Group = factor(Group, levels = rev(myGroups))) %>%
  group_by(Group) %>%
  reframe(Answer = Answer, Percent = 100 * Percent / sum(Percent))
yy <- xx %>% filter(Answer %in% c("Definatly true", "Probably true")) %>%
  group_by(Group) %>%
  reframe(Percent = round(sum(Percent)))
# Plot
mp <- ggplot(xx, aes(x= Group, y = Percent)) +
  geom_col(aes(fill = Answer), color = "black", alpha = 0.7) +
  geom_text(data = yy, aes(label = Percent), color = "white") +
  scale_fill_manual(name = NULL, values = myColors) +
  scale_y_continuous(breaks = seq(0,100, by = 10), expand = c(0.01,0)) +
  coord_flip() + guides(fill = guide_legend(reverse=TRUE)) +
  theme_agData(legend.position = "bottom") +
  labs(title = myTitle2, subtitle = mySubtitle2, 
       x = NULL, caption = myCaption2)
ggsave("covid_origin_2_01.png", mp, width = 8, height = 6)

Ordered

# Prep data
myColors <- c("darkred", "palevioletred3","black", "steelblue", "darkblue")
myGroups <- c("Trump Voters", "Republican", "Conservative", "Ages 65+", 
               "Ages 45-64", "Rural", "White", "Income100K+", "Income 50-100K", 
               "Suburban", "Total", "Male", "Female", "Income < 50K", 
               "Independent", "Urban", "Ages 30-44", "Black", "Hispanic",   
               "Democrat", "Ages 18-29", "Biden Voters", "Liberal")
xx <- d2 %>% filter(Group %in% myGroups) %>%
  mutate(Group = factor(Group, levels = rev(myGroups))) %>%
  group_by(Group) %>%
  reframe(Answer = Answer, Percent = 100 * Percent / sum(Percent))
yy <- xx %>% filter(Answer %in% c("Definatly true", "Probably true")) %>%
  group_by(Group) %>%
  reframe(Percent = round(sum(Percent)))
# Plot
mp <- ggplot(xx, aes(x = Group, y = Percent)) +
  geom_col(aes(fill = Answer), color = "black", alpha = 0.7) +
  geom_text(data = yy, aes(label = Percent), color = "white") +
  scale_fill_manual(name = NULL, values = myColors) +
  scale_y_continuous(breaks = seq(0,100, by = 10), expand = c(0.01,0)) +
  coord_flip() + guides(fill = guide_legend(reverse=TRUE)) +
  theme_agData(legend.position = "bottom") +
  labs(title = myTitle2, subtitle = mySubtitle2, 
       x = NULL, caption = myCaption2)
ggsave("covid_origin_2_02.png", mp, width = 8, height = 6)

Bar Charts

# Create plotting function
plotPoll_1 <- function(xx = d2, myGroups, myColors) {
  # Prep data
  xx <- xx %>% filter(Group %in% myGroups) %>%
    mutate(Group = factor(Group, levels = myGroups))
  # Plot
  ggplot(xx, aes(x = Answer, y = Percent, fill = Group)) +
    geom_col(position = "dodge", color = "black", alpha = 0.7) +
    scale_fill_manual(name = NULL, values = myColors) +
    theme_agData(legend.position = "bottom") +
    labs(title = myTitle2, subtitle = mySubtitle2, 
         x = NULL, caption = myCaption2)
}

Total

# Plot
mp <- plotPoll_1(myGroups = c("Female", "Total", "Male"), 
               myColors = c("palevioletred3", "darkblue", "steelblue"))
ggsave("covid_origin_3_01.png", mp, width = 7.5, height = 5)

Race

# Plot
mp <- plotPoll_1(myGroups = c("White", "Black", "Hispanic"), 
               myColors = c("grey80", "black", "darkgoldenrod2"))
ggsave("covid_origin_3_02.png", mp, width = 7.5, height = 5)

Age

# Plot
mp <- plotPoll_1(myGroups = c("Ages 18-29", "Ages 30-44", "Ages 45-64", "Ages 65+"), 
               myColors = c("steelblue", "darkblue", "darkred", "black"))
ggsave("covid_origin_3_03.png", mp, width = 7.5, height = 5)

Biden vs Trump

# Plot
mp <- plotPoll_1(myGroups = c("Biden Voters", "Trump Voters"), 
               myColors = c("darkblue", "darkred"))
ggsave("covid_origin_3_04.png", mp, width = 7.5, height = 5)

Ideology

# Plot
mp <- plotPoll_1(myGroups = c("Liberal", "Independent", "Conservative"), 
               myColors = c("darkblue", "steelblue", "darkred"))
ggsave("covid_origin_3_05.png", mp, width = 7.5, height = 5)

Pie

# Create plotting function
plotPoll_2 <- function(xx = d2, myGroups, 
                       myColors = c("darkred", "palevioletred3","black", "steelblue", "darkblue")) {
  # Prep data
  xx <- xx %>% filter(Group %in% myGroups) %>%
    mutate(Group = factor(Group, levels = myGroups)) %>%
    group_by(Group) %>%
    summarise(Answer = Answer,
              Percent = 100 * Percent / sum(Percent))
  # Plot
  ggplot(xx, aes(x = 1, y = Percent, fill = Answer)) +
    geom_col(lwd = 0.2, color = "black", alpha = 0.7) +
    coord_polar("y", start = 0) +
    facet_grid(. ~ Group) +
    scale_fill_manual(name = NULL, values = myColors) +
    xlim(0.548, 1.45) +
    theme_agData_pie(legend.position = "bottom") +
    labs(title = myTitle2, subtitle = mySubtitle2, 
         x = NULL, caption = myCaption2)
}

Total

# Plot
mp <- plotPoll_2(myGroups = "Total")
ggsave("covid_origin_4_01.png", mp, width = 8, height = 8)

Race

# Plot
mp <- plotPoll_2(myGroups = c("White", "Black", "Hispanic"))
ggsave("covid_origin_4_02.png", mp, width = 7.5, height = 4)

Age

# Plot
mp <- plotPoll_2(myGroups = c("Ages 18-29", "Ages 30-44", "Ages 45-64", "Ages 65+"))
ggsave("covid_origin_4_03.png", mp, width = 7.5, height = 3.5)

Biden vs Trump

# Plot
mp <- plotPoll_2(myGroups = c("Biden Voters", "Trump Voters"))
ggsave("covid_origin_4_04.png", mp, width = 7.5, height = 5)

Ideology

# Plot
mp <- plotPoll_2(myGroups = c("Liberal", "Independent", "Conservative"))
ggsave("covid_origin_4_05.png", mp, width = 7.5, height = 4)

Global Catastrophic Risk Institute

# Plot
mp <- ggplot(d3, aes(x = Natural.Belief, y = Number, fill = Interpretation)) +
  geom_col(alpha = 0.7, color = "black") +
  scale_fill_manual(name = NULL, values = c("darkred", "grey", "darkblue")) +
  theme_agData(legend.position = "top",
               axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(title = myTitle3, x = "Number of Experts", caption = myCaption3)
ggsave("covid_origin_5_01.png", mp, width = 6, height = 4)

Deseret

# Prep data
xx <- d4 %>% filter(Questions == "Origin")
# Plot
mp <- ggplot(xx, aes(x = "", y = Percent, fill = Answer)) +
  geom_col(alpha = 0.7, color = "black") +
  facet_grid(. ~ Answer) +
  coord_polar(theta="y") +
  ylim(c(0,100)) + 
  scale_fill_manual(name = NULL, values = c("darkgreen", "darkgoldenrod2")) +
  theme_agData_pie(legend.position = "none") +
  labs(title = myTitle4, x = "Number of Experts", caption = myCaption4)
ggsave("covid_origin_6_01.png", mp, width = 6, height = 4)

# Prep data
myPs <- c("Democrats","Other","Overall","Independants","Republicans")
xx <- d4 %>% filter(Questions == "Investigation") %>%
  mutate(Party = factor(Party, levels = myPs))
# Plot
mp <- ggplot(xx, aes(x = "", y = Percent, fill = Answer)) +
  geom_col(alpha = 0.7, color = "black") +
  facet_grid(Answer ~ Party) +
  coord_polar(theta="y") +
  ylim(c(0,100)) + 
  scale_fill_manual(name = NULL, values = c("darkgreen", "darkgoldenrod2")) +
  theme_agData_pie(legend.position = "none") +
  labs(title = myTitle5, x = "Number of Experts", caption = myCaption4)
ggsave("covid_origin_6_02.png", mp, width = 6, height = 4)

dblogr/


© Derek Michael Wright