Prezentare generală
Oamenii din stările roșii duc o viață mai scurtă?
Acest proiect examinează dacă speranța de viață la nivel de stat este asociată statistic cu climatul politic al fiecărui stat în alegerile prezidențiale din 2024. Climatul politic este măsurat folosind marja de vot popular, definită ca (voturi Trump – voturi Harris) / (voturi Trump + voturi Harris). O valoare pozitivă indică un avantaj republican, iar o valoare negativă indică un avantaj democrat.
Nu prezic alegeri și nu pretind cauzalitatea. Există multe motive pentru care două state diferă în ceea ce privește speranța de viață – diferențe în venitul mediu, disponibilitatea asistenței medicale, ocupații cu riscuri diferite de muncă etc. Întreb doar dacă aceste două cantități măsurabile la nivel de stat se mișcă împreună.
O diagramă dispersată a speranței de viață față de marja de vot arată o tendință clar descendentă: statele cu marje de vot republicane mai mari tind să aibă speranță de viață mai mică, iar statele cu marje democratice mai mari tind să aibă o speranță de viață mai mare.
Coeficientul de corelație r este -0,50. Aceasta reprezintă o relație negativă moderată – nici slab, nici puternic, dar prezent fără greșeală. Un test de semnificație dă t = -4,041, p = .00019. Cu 51 de observații, această corelație este semnificativă statistic la nivelul .05.
Detalii
Am obținut date privind votul popular în procentul prezidențial din 2024 de la Comisia Electorală Federală. Trump a câștigat 31 din 51 de state (50 plus DC) în 2024. Pentru a vizualiza distribuția statelor, am grupat variabila marjei de vot în patru casete:
- Majoritatea dem: marjă ≤ -10%
- Dem Narrow: -10% < marjă ≤ 0
- Rep Îngustă: 0 < marjă ≤ 10%
- Majoritatea reprezentanților: marjă > 10%
24 din cele 31 de state ale lui Trump erau cu marje mai mari de 10%. O diagramă cu bare și o hartă a SUA arată câte state se încadrează în fiecare grup și unde sunt situate geografic.
CDC (Centre pentru Controlul și Prevenirea Bolilor) publică tabelele privind speranța de viață în funcție de stat. Acestea sunt tabele de viață ale perioadei, care arată speranța de viață a unui nou-născut sub ratele de mortalitate actuale, presupunând că ratele de deces specifice vârstei observate în acel an (de exemplu, 2022) rămân fixe pentru întreaga viață a nou-născutului. Hawaii are cea mai mare speranță de viață la 80,0 ani, iar Mississippi are cea mai scăzută 70,9 ani.
Următoarea hartă arată speranța de viață în funcție de stat. Am alocat statele pe quartile (cea mai scurtă speranță de viață, mai scurtă, mai lungă, cea mai lungă). Cred că există o relație în special cu statele din sud care au speranțe de viață scurte pe această hartă, în comparație cu marjele republicane din harta anterioară.
Coeficientul de corelație real este r = -0,50, care este moderat, dar semnificativ statistic.
De altfel, am avut o mică provocare să desenez hărțile cu biblioteca R usmap. Acea bibliotecă include Puerto Rico, care nu a fost în datele despre alegători sau despre speranța de viață, iar harta ar arăta Puerto Rico ca NA până când l-am exclus în declarația plot_usmap.
cod R
library(readxl)
pres <- read_excel("C:/Users/Jerry/Desktop/R_files/2024presgeresults.xlsx", n_max=51)
pres$TRUMP_PERCENT <- pres$TRUMP/(pres$TRUMP + pres$HARRIS) # ratio of popular votes
pres$HARRIS_PERCENT <- pres$HARRIS/(pres$TRUMP + pres$HARRIS)
pres$TRUMP_MARGIN <- round(pres$TRUMP_PERCENT - pres$HARRIS_PERCENT,3)
pres <- pres(, c("STATE", "TRUMP_MARGIN")) # states are 2 letter abbrevs
colnames(pres)(1) <- "state" # usmap requires state Column Name to be lowercase "state"
# CDC life expectancies by state: https://www.cdc.gov/nchs/data/nvsr/nvsr74/nvsr74-12.pdf
library(pdftools) # extract text from pdf file
library(tidyverse)
raw_text <- pdf_text("C:/Users/Jerry/Desktop/R_files/nvsr74-12.pdf")
page_text <- raw_text(3) # page 3 only
lines <- read_lines(page_text)
# data cleaning of life expectancy file:
clean_lines <- lines %>%
str_trim() %>% # Remove leading/trailing spaces
keep(~ .x != "") # Drop empty rows
# Extract column headers (row 6 contains headers):
headers <- str_split(clean_lines(6), "\\s{2,}")((1)) # these are partial headers
# Process the data rows (Rows 7 to the end):
data_rows <- clean_lines(7:(length(clean_lines)-3)) # delete footnotes
# Convert text lines into data frame:
life_exp <- data_rows %>%
# Split columns whenever there are 2 or more spaces
str_split_fixed("\\s{2,}", n = length(headers)) %>%
as_tibble(.name_repair = "minimal")
colnames(life_exp) <- c("State", "Tot_Rank", "Tot_LE", "Tot_SE", "Male_Rank", "Male_LE", "Male_SE",
"Fem_Rank", "Fem_LE", "Fem_SE")
life_exp$State <- gsub("\\.", "", life_exp$State) # delete periods
life_exp$State <- sub("\\s+$", "", life_exp$State) # delete spaces after last char
life_exp <- subset(life_exp, State != "United States")
# convert states from names to abbreviations; District of Columbia will be NA without next line:
life_exp$State <- c(state.abb, "DC")(match(life_exp$State, c(state.name, "District of Columbia"))) # Convert full name to 2-letter abbreviation
life_exp <- life_exp %>%
mutate(across(where(is.character) & -1, as.numeric)) # converts all character columns in a data frame into numeric columns, except for the very first column
life_exp <- life_exp(, c("State", "Tot_LE")) # states are 2 letter abbrevs
colnames(life_exp)(1) <- "state" # usmap requires state Column Name to be lowercase "state"
print(life_exp)
df <- merge(pres, life_exp, by = "state")
######## Display summaries: ########
library(ggplot2)
common_theme <- theme(
plot.title = element_text(size=15, face="bold"),
plot.subtitle = element_text(size=12.5, face="bold"),
axis.title = element_text(size=15, face="bold"),
axis.text = element_text(size=15, face="bold"),
legend.title = element_text(size=15, face="bold"),
legend.text = element_text(size=15, face="bold"))
df <- df %>%
mutate(TRUMP_MARGIN_RANGE = case_when(
TRUMP_MARGIN -.10 & TRUMP_MARGIN 0 & TRUMP_MARGIN .10 ~ "Rep Majority",
TRUE ~ NA_character_
)
)
percent_colors <- c("Dem Majority" = "#883068", "Dem Narrow" = "#4292C6",
"Rep Narrow" = "#FB6A4A", "Rep Majority" = "#CB181D")
df$TRUMP_MARGIN_RANGE <- factor(
df$TRUMP_MARGIN_RANGE,
levels = c("Dem Majority", "Dem Narrow", "Rep Narrow", "Rep Majority")
)
ggplot(df, aes(x = TRUMP_MARGIN_RANGE)) +
geom_bar(fill = percent_colors) +
geom_text(
stat = "count",
aes(label = after_stat(count)),
fontface = "bold",
vjust = -0.5
) +
labs(title="2024 Presidential Election Results by Vote Margin",
y = "Number of States", x = "% Popular Vote Margin") +
guides(fill = guide_legend(title = NULL)) +
scale_x_discrete(
labels = c(
"Dem Majority" = "Dem + 10% or more",
"Dem Narrow" = "Dem 0 - 10%",
"Rep Narrow" = "Rep 0 - 10%",
"Rep Majority" = "Rep + 10% or more")) +
common_theme
colSums(is.na(df)) # 0
colnames(df)(1) <- "state" # usmap requires state Column Name to be lowercase "state"
length(df$state) # 51
df$state <- trimws(toupper(df$state)) #51 states including DC
library(usmap)
unique(usmap::us_map(regions = "states")$full) # Includes Puerto Rico
plot_usmap(data = df, , regions = "states", values = "TRUMP_MARGIN_RANGE", exclude = "Puerto Rico") +
labs(title="2024 Presidential Election Results by Vote Margin") +
scale_fill_manual(values=percent_colors,
guide = guide_legend(title = NULL, direction="vertical"),
labels = c(
"Dem Majority" = "Dem + 10% or more",
"Dem Narrow" = "Dem 0 - 10%",
"Rep Narrow" = "Rep 0 - 10%",
"Rep Majority" = "Rep + 10% or more")
) +
theme(
legend.position = "bottom",
legend.box = "vertical",
plot.title = element_text(size=15, face="bold"),
legend.title = element_text(size=12, face="bold"),
legend.text = element_text(size=12, face="bold")
)
df <- df %>%
mutate(
LE_RANGE = case_when(
ntile(Tot_LE, 4) == 1 ~ "Shortest LE",
ntile(Tot_LE, 4) == 2 ~ "Shorter LE",
ntile(Tot_LE, 4) == 3 ~ "Longer LE",
ntile(Tot_LE, 4) == 4 ~ "Longest LE"
)
)
table(df$LE_RANGE)
LE_colors <- c(
"Shortest LE" = "#D1E5F0",
"Shorter LE" = "#92C5DE",
"Longer LE" = "#4393C3",
"Longest LE" = "#8B3C59"
)
df$LE_RANGE <- factor(
df$LE_RANGE,
levels = c("Shortest LE", "Shorter LE", "Longer LE", "Longest LE")
)
plot_usmap(data = df, regions = "states", values = "LE_RANGE", exclude = "Puerto Rico") +
labs(title="Life Expectancies by State") +
scale_fill_manual(values=LE_colors,
guide = guide_legend(title = NULL, direction="vertical")) +
theme(
legend.position = "bottom",
legend.box = "vertical",
plot.title = element_text(size=15, face="bold"),
legend.title = element_text(size=12, face="bold"),
legend.text = element_text(size=12, face="bold")
)
######## Corr coeff: ########
library(ggrepel)
ggplot(data = df, mapping = aes(x = TRUMP_MARGIN, y = Tot_LE)) +
geom_point(color = "#4D4D4D") +
geom_smooth(method = "lm", color = "steelblue", se = FALSE, linewidth = 1) +
geom_text_repel(
data = df(df$state %in% c("HI", "WV"), ),
aes(x = TRUMP_MARGIN, y = Tot_LE, label = state),
size = 4, color = "black", fontface = "bold", nudge_y = 0.25
) +
ggtitle("Life Expectancy vs % Popular Vote Margin by State") +
xlab("Pop Vote Margin %: Rep +, Dem - ") +
ylab("Life Expectancy") +
annotate(
"text",
x = min(df$TRUMP_MARGIN) + .02,
y = max(df$Tot_LE) - .02,
label = "r = -0.50",
hjust = 0, vjust = 1,
color = "gray20", fontface = "bold", size = 4) +
common_theme
r <- round(cor(df(, c("Tot_LE", "TRUMP_MARGIN")))(1, 2), 3) # -.50 is moderate (neither weak nor strong)
# statistical significance of correlation coefficient:
n <- nrow(df)
dof <- n - 2
t <- round(r*sqrt(n - 2) / sqrt(1 - r^2),3) # - 4.041
alpha <- .05
p_value <- round(2 * pt(abs
stat_signif <- if(p_value < alpha, "is statistically significant", "is not statistically significant")
cat("r = ", r, "p-value = ", p_value, stat_signif)
Sfârşit
