Understanding Party Realignment
Tika Horigene
2024-10-12
library(readr)
library(tidyverse)Wake County
wake_2016_voter_reg <-read_delim("C:/Users/khori/OneDrive/POS4931/Wake_20161108.txt", delim = ",", col_names = TRUE)## Rows: 1271218 Columns: 90
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (63): county_desc, ncid, status_cd, voter_status_desc, reason_cd, voter...
## dbl (9): county_id, voter_reg_num, house_num, zip_code, mail_zipcode, age,...
## lgl (14): absent_ind, name_prefx_cd, unit_designator, mail_addr3, mail_addr...
## date (4): snapshot_dt, registr_dt, cancellation_dt, load_dt
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.current_wake_voter_reg<- read_delim("C:/Users/khori/OneDrive/POS4931/ncvoter92.txt", delim = "\t", col_names = TRUE)## Rows: 959656 Columns: 67
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: "\t"
## chr (46): county_desc, voter_reg_num, ncid, last_name, first_name, middle_na...
## dbl (8): county_id, zip_code, birth_year, age_at_year_end, nc_senate_abbrv,...
## lgl (13): full_phone_number, township_abbrv, township_desc, fire_dist_abbrv,...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.wake_2016_filtered <- wake_2016_voter_reg %>%
filter(party_cd %in% c("REP", "DEM", "UNA", "LIB", "GRE")) %>%
select(
ncid,
party_2016 = party_cd,
race_code,
gender = sex_code,
age
) %>%
mutate(county = "Wake")
current_wake_filtered <- current_wake_voter_reg %>%
filter(party_cd %in% c("REP", "DEM", "UNA", "LIB", "GRE")) %>%
select(
ncid,
party_now = party_cd,
race_code,
gender = gender_code,
birth_year
) %>%
mutate(
age = 2024 - birth_year,
county = "Wake"
)#Did The Same For The Rest of The Counties
Combine All Filtered Counties
north_carolina_2016 <- bind_rows(
newhanover_2016_filtered,
robeson_2016_filtered,
buncombe_2016_filtered,
union_2016_filtered,
franklin_2016_filtered,
mecklenburg_2016_filtered,
guilford_2016_filtered,
cumberland_2016_filtered,
forsyth__2016_filtered,
wake_2016_filtered
)
north_carolina_current <- bind_rows(
current_newhanover_filtered,
current_robeson_filtered,
current_buncombe_filtered,
current_union_filtered,
current_franklin_filtered,
current_mecklenburg_filtered,
current_guilford_filtered,
current_cumberland_filtered,
forsyth_filtered,
current_wake_filtered
)north_carolina <- north_carolina_2016 %>%
inner_join(north_carolina_current, by = "ncid", suffix = c("_2016", "_current"))# Saved my created north_carolina data set as a txt file on my computer
north_carolina <- read_delim("north_carolina.txt", delim = "\t", escape_double = FALSE, trim_ws = TRUE)## Rows: 2418909 Columns: 13
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: "\t"
## chr (10): ncid, party_2016, race_code_2016, gender_2016, county_2016, party_...
## dbl (3): age_2016, birth_year, age_current
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.head(north_carolina)## # A tibble: 6 × 13
## ncid party_2016 race_code_2016 gender_2016 age_2016 county_2016 party_now
## <chr> <chr> <chr> <chr> <dbl> <chr> <chr>
## 1 DB36734 REP W F 74 New Hanover REP
## 2 DB36738 DEM W M 66 New Hanover DEM
## 3 DB36739 DEM W F 60 New Hanover DEM
## 4 DB36740 DEM W M 66 New Hanover DEM
## 5 DB36741 REP W F 83 New Hanover REP
## 6 DB36746 REP W M 57 New Hanover REP
## # ℹ 6 more variables: race_code_current <chr>, gender_current <chr>,
## # birth_year <dbl>, age_current <dbl>, county_current <chr>, age_group <chr>Summarize Changes Across All Counties
final_party_changes <- north_carolina %>%
count(party_2016, party_now) %>%
mutate(proportion = n / sum(n))
final_party_changes## # A tibble: 22 × 4
## party_2016 party_now n proportion
## <chr> <chr> <int> <dbl>
## 1 DEM DEM 862388 0.357
## 2 DEM GRE 231 0.0000955
## 3 DEM LIB 1765 0.000730
## 4 DEM REP 39472 0.0163
## 5 DEM UNA 113977 0.0471
## 6 GRE DEM 1 0.000000413
## 7 GRE UNA 5 0.00000207
## 8 LIB DEM 1407 0.000582
## 9 LIB GRE 10 0.00000413
## 10 LIB LIB 5341 0.00221
## # ℹ 12 more rowsTotal Party Changes With Proportions, Excluding No-change Cases and Only Including Significant Proportions
final_party_changes2 <- north_carolina %>%
count(party_2016, party_now) %>%
filter(party_2016 != party_now) %>%
mutate(proportion = n / sum(n))
final_party_changes2## # A tibble: 18 × 4
## party_2016 party_now n proportion
## <chr> <chr> <int> <dbl>
## 1 DEM GRE 231 0.000577
## 2 DEM LIB 1765 0.00441
## 3 DEM REP 39472 0.0985
## 4 DEM UNA 113977 0.285
## 5 GRE DEM 1 0.00000250
## 6 GRE UNA 5 0.0000125
## 7 LIB DEM 1407 0.00351
## 8 LIB GRE 10 0.0000250
## 9 LIB REP 980 0.00245
## 10 LIB UNA 3310 0.00826
## 11 REP DEM 23423 0.0585
## 12 REP GRE 46 0.000115
## 13 REP LIB 2812 0.00702
## 14 REP UNA 97227 0.243
## 15 UNA DEM 70522 0.176
## 16 UNA GRE 215 0.000537
## 17 UNA LIB 2942 0.00735
## 18 UNA REP 42194 0.105filtered_party_changes <- final_party_changes2 %>% filter(proportion > 0.01)
filtered_party_changes## # A tibble: 6 × 4
## party_2016 party_now n proportion
## <chr> <chr> <int> <dbl>
## 1 DEM REP 39472 0.0985
## 2 DEM UNA 113977 0.285
## 3 REP DEM 23423 0.0585
## 4 REP UNA 97227 0.243
## 5 UNA DEM 70522 0.176
## 6 UNA REP 42194 0.105Find The Group and Groups With The Biggest Change
biggest_party_change <- final_party_changes %>%
arrange(desc(proportion)) %>%
slice(1)
biggest_party_change## # A tibble: 1 × 4
## party_2016 party_now n proportion
## <chr> <chr> <int> <dbl>
## 1 DEM DEM 862388 0.357biggest_party_change2 <- final_party_changes2 %>%
arrange(desc(proportion))
biggest_party_change2## # A tibble: 18 × 4
## party_2016 party_now n proportion
## <chr> <chr> <int> <dbl>
## 1 DEM UNA 113977 0.285
## 2 REP UNA 97227 0.243
## 3 UNA DEM 70522 0.176
## 4 UNA REP 42194 0.105
## 5 DEM REP 39472 0.0985
## 6 REP DEM 23423 0.0585
## 7 LIB UNA 3310 0.00826
## 8 UNA LIB 2942 0.00735
## 9 REP LIB 2812 0.00702
## 10 DEM LIB 1765 0.00441
## 11 LIB DEM 1407 0.00351
## 12 LIB REP 980 0.00245
## 13 DEM GRE 231 0.000577
## 14 UNA GRE 215 0.000537
## 15 REP GRE 46 0.000115
## 16 LIB GRE 10 0.0000250
## 17 GRE UNA 5 0.0000125
## 18 GRE DEM 1 0.00000250Sankey Diagram
library(ggalluvial)
library(ggplot2)alluvial_data <- filtered_party_changes %>%
mutate(
party_2016 = factor(party_2016, levels = c("DEM", "REP", "UNA", "LIB", "GRE")),
party_now = factor(party_now, levels = c("DEM", "REP", "UNA", "LIB", "GRE")),
percentage = n / sum(n) * 100,
label = sprintf("%.2f%%", percentage)
)
party_colors <- c(
"DEM" = "blue",
"REP" = "red",
"UNA" = "purple")
ggplot(alluvial_data, aes(axis1 = party_2016, axis2 = party_now, y = n)) +
geom_alluvium(aes(fill = party_2016), width = 1/12, alpha = 0.8) +
geom_stratum(width = 1/8, fill = "white", color = "black") +
geom_text(stat = "stratum", aes(label = after_stat(stratum)), size = 4) +
geom_text(aes(x = 1, label = label), position = position_stack(vjust = 0.5), size = 3) +
scale_x_discrete(labels = c("2016 Party", "2024 Party"), expand = c(0.05, 0.05)) +
scale_fill_manual(values = party_colors) +
theme_minimal() +
labs(
title = "Party Affiliation Changes (2016 to 2024)",
x = NULL,
y = NULL
) +
theme(
legend.position = "none",
axis.text.y = element_blank(),
axis.ticks.y = element_blank(),
axis.text.x = element_text(size = 12)
)
Summarize Changes By Counties
county_party_changes <- north_carolina %>%
group_by(county_current, party_2016, party_now) %>%
summarise(count = n(), .groups = "drop")
county_party_changes## # A tibble: 197 × 4
## county_current party_2016 party_now count
## <chr> <chr> <chr> <int>
## 1 Buncombe DEM DEM 55838
## 2 Buncombe DEM GRE 18
## 3 Buncombe DEM LIB 96
## 4 Buncombe DEM REP 3381
## 5 Buncombe DEM UNA 8970
## 6 Buncombe LIB DEM 123
## 7 Buncombe LIB LIB 419
## 8 Buncombe LIB REP 83
## 9 Buncombe LIB UNA 284
## 10 Buncombe REP DEM 1359
## # ℹ 187 more rowsCounty-Level Variation Map
library(sf)
nc_shapefile <- st_read("C:/Users/khori/OneDrive/POS4931/nc_2020")## Reading layer `nc_2020' from data source `C:\Users\khori\OneDrive\POS4931\nc_2020' using driver `ESRI Shapefile'
## Simple feature collection with 2662 features and 52 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 406832.8 ymin: 2698.609 xmax: 3070216 ymax: 1043624
## Projected CRS: NAD83 / North Carolina (ftUS)# Calculating the changes in voter affiliations (to Democrat, Republican, and Unaffiliated) for each county and computing the net change
county_dominance <- county_party_changes %>%
group_by(county_current) %>%
summarise(
change_dem = sum(count[party_now == "DEM"]) - sum(count[party_2016 == "DEM"]),
change_rep = sum(count[party_now == "REP"]) - sum(count[party_2016 == "REP"]),
change_una = sum(count[party_now == "UNA"]) - sum(count[party_2016 == "UNA"]),
net_change = change_dem - change_rep, # Net change: Positive for Dem, Negative for Rep
.groups = "drop"
)
county_dominance## # A tibble: 10 × 5
## county_current change_dem change_rep change_una net_change
## <chr> <int> <int> <int> <int>
## 1 Buncombe -5411 -1319 6721 -4092
## 2 Cumberland -6156 1977 3901 -8133
## 3 Forsyth -5408 -3841 9108 -1567
## 4 Franklin -2268 -56 2205 -2212
## 5 Guilford -8004 -3269 11028 -4735
## 6 Mecklenburg -8393 -13339 21131 4946
## 7 New Hanover -2886 -2620 5358 -266
## 8 Robeson -8190 2927 5227 -11117
## 9 Union -4875 11 4676 -4886
## 10 Wake -8501 -21333 29291 12832# Standardize capitalization for the county names
nc_shapefile$COUNTY_NAM <- tolower(nc_shapefile$COUNTY_NAM)
county_dominance$county <- tolower(county_dominance$county_current)#Combining spatial data with county-level voter shifts using a left join
nc_data <- nc_shapefile %>%
left_join(county_dominance, by = c("COUNTY_NAM" = "county"))
head(nc_data)## Simple feature collection with 6 features and 57 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 1410440 ymin: 546324.5 xmax: 1901586 ymax: 852039.3
## Projected CRS: NAD83 / North Carolina (ftUS)
## PREC_ID ENR_DESC COUNTY_NAM COUNTY_ID G20PRERTRU G20PREDBID G20PRELJOR
## 1 01 PATTERSON alamance 1 2299 566 27
## 2 02 COBLE alamance 1 2387 559 15
## 3 07 ALBRIGHT alamance 1 1996 581 20
## 4 H08 H08 guilford 41 73 614 3
## 5 079 079 mecklenburg 60 469 1223 8
## 6 03S SOUTH BOONE alamance 1 2624 2710 58
## G20PREGHAW G20PRECBLA G20PREOWRI G20USSRTIL G20USSDCUN G20USSLBRA G20USSCHAY
## 1 6 5 4 2205 564 68 51
## 2 4 4 3 2290 570 65 32
## 3 9 1 4 1917 588 63 23
## 4 1 2 2 70 595 11 12
## 5 9 2 6 418 1190 64 29
## 6 20 12 10 2548 2629 154 42
## G20GOVRFOR G20GOVDCOO G20GOVLDIF G20GOVCPIS G20LTGRROB G20LTGDHOL G20ATGRONE
## 1 2209 661 19 13 2336 556 2266
## 2 2264 677 18 9 2391 556 2323
## 3 1936 644 19 3 2013 578 1957
## 4 63 621 3 6 76 615 79
## 5 418 1250 33 17 460 1232 443
## 6 2401 2950 45 23 2685 2674 2602
## G20ATGDSTE G20TRERFOL G20TREDCHA G20SOSRSYK G20SOSDMAR G20AUDRSTR G20AUDDWOO
## 1 618 2240 611 2251 617 2247 608
## 2 614 2319 603 2270 663 2301 612
## 3 616 1968 595 1903 659 1927 629
## 4 611 89 598 67 617 77 610
## 5 1244 495 1182 427 1259 443 1236
## 6 2731 2694 2609 2508 2806 2545 2746
## G20AGRRTRO G20AGRDWAD G20INSRCAU G20INSDGOO G20LABRDOB G20LABDHOL G20SPIRTRU
## 1 2401 485 2304 561 2293 573 2301
## 2 2468 472 2381 537 2362 563 2361
## 3 2078 502 1999 561 1981 575 1962
## 4 76 613 73 613 72 618 70
## 5 454 1230 461 1225 447 1232 467
## 6 2838 2482 2665 2619 2618 2670 2628
## G20SPIDMAN G20SSCRNEW G20SSCDBEA G20SSCRBER G20SSCDINM G20SSCRBAR G20SSCDDAV
## 1 558 2239 630 2275 588 2259 596
## 2 551 2306 625 2359 568 2315 601
## 3 593 1923 643 1970 587 1952 603
## 4 617 67 619 76 612 80 604
## 5 1216 441 1245 449 1234 469 1216
## 6 2662 2561 2764 2605 2702 2605 2684
## G20SACRWOO G20SACDSHI G20SACRGOR G20SACDCUB G20SACRDIL G20SACDSTY G20SACRCAR
## 1 2290 566 2276 571 2296 548 2280
## 2 2354 558 2347 562 2367 534 2349
## 3 1967 578 1945 596 1977 570 1963
## 4 81 607 76 612 74 614 77
## 5 461 1212 452 1227 465 1209 454
## 6 2672 2606 2623 2642 2668 2590 2632
## G20SACDYOU G20SACRGRI G20SACDBRO county_current change_dem change_rep
## 1 567 2274 568 <NA> NA NA
## 2 555 2359 543 <NA> NA NA
## 3 579 1954 585 <NA> NA NA
## 4 602 76 602 Guilford -8004 -3269
## 5 1224 456 1220 Mecklenburg -8393 -13339
## 6 2625 2607 2653 <NA> NA NA
## change_una net_change geometry
## 1 NA NA MULTIPOLYGON (((1839240 762...
## 2 NA NA MULTIPOLYGON (((1840089 807...
## 3 NA NA MULTIPOLYGON (((1871943 801...
## 4 11028 -4735 MULTIPOLYGON (((1702355 805...
## 5 21131 4946 MULTIPOLYGON (((1410451 548...
## 6 NA NA MULTIPOLYGON (((1840533 835...ggplot(nc_data) +
geom_sf(aes(fill = net_change)) +
scale_fill_gradient2(
low = "red", # Leaning Republican
mid = "white", # Neutral or Unaffiliated
high = "blue", # Leaning Democratic
midpoint = 0,
name = "Net Change"
) +
labs(
title = "Net Party Affiliation Changes by County (2016 to Current)",
subtitle = "Blue: Democratic Gains | Red: Republican Gains | White: Neutral/Unaffiliated",
fill = "Net Change"
) +
theme_minimal() +
theme(
plot.title = element_text(hjust = 0.5, size = 16),
plot.subtitle = element_text(hjust = 0.5, size = 12),
axis.text = element_blank(),
axis.title = element_blank()
)
The Odds of Switching to Republican (2024) Based On Different Demographics
#Preparing demographic data with categorized variables and indicators for party switching
demograph_north_carolina <- north_carolina %>%
mutate(
switched_to_rep = ifelse(party_now == "REP" & party_2016 != "REP", 1, 0),
switched_to_dem = ifelse(party_now == "DEM" & party_2016 != "DEM", 1, 0),
switched_to_una = ifelse(party_now == "UNA" & party_2016 != "UNA", 1, 0),
gender_current = relevel(
factor(gender_current, levels = c("F", "M", "U"), labels = c("Female", "Male", "Undesignated")),
ref = "Male" ),
race_code_current = factor(race_code_current, levels = c("W", "B", "A", "I", "M", "O", "P", "U"),
labels = c("White", "Black or African American", "Asian",
"American Indian or Alaska Native", "Two or More Races",
"Other", "Native Hawaiian or Pacific Islander", "Undesignated")),
age_group = case_when(
age_current < 30 ~ "18-29",
age_current >= 30 & age_current < 50 ~ "30-49",
age_current >= 50 & age_current < 65 ~ "50-64",
age_current >= 65 ~ "65+"
) %>% factor(levels = c("18-29", "30-49", "50-64", "65+"))
)
head(demograph_north_carolina)## # A tibble: 6 × 16
## ncid party_2016 race_code_2016 gender_2016 age_2016 county_2016 party_now
## <chr> <chr> <chr> <chr> <dbl> <chr> <chr>
## 1 DB36734 REP W F 74 New Hanover REP
## 2 DB36738 DEM W M 66 New Hanover DEM
## 3 DB36739 DEM W F 60 New Hanover DEM
## 4 DB36740 DEM W M 66 New Hanover DEM
## 5 DB36741 REP W F 83 New Hanover REP
## 6 DB36746 REP W M 57 New Hanover REP
## # ℹ 9 more variables: race_code_current <fct>, gender_current <fct>,
## # birth_year <dbl>, age_current <dbl>, county_current <chr>, age_group <fct>,
## # switched_to_rep <dbl>, switched_to_dem <dbl>, switched_to_una <dbl>logistic_model_rep <- glm(
switched_to_rep ~ gender_current + race_code_current + age_group ,
data = demograph_north_carolina,
family = binomial()
)
summary(logistic_model_rep)##
## Call:
## glm(formula = switched_to_rep ~ gender_current + race_code_current +
## age_group, family = binomial(), data = demograph_north_carolina)
##
## Coefficients:
## Estimate Std. Error
## (Intercept) -3.288515 0.017504
## gender_currentFemale -0.088469 0.007412
## gender_currentUndesignated 0.417694 0.017986
## race_code_currentBlack or African American -1.456999 0.013476
## race_code_currentAsian -0.015737 0.025334
## race_code_currentAmerican Indian or Alaska Native 1.003887 0.019769
## race_code_currentTwo or More Races -0.623860 0.052428
## race_code_currentOther 0.060850 0.018520
## race_code_currentNative Hawaiian or Pacific Islander 1.014452 0.283338
## race_code_currentUndesignated -0.192005 0.017800
## age_group30-49 0.263529 0.017698
## age_group50-64 0.213273 0.018071
## age_group65+ 0.073561 0.018155
## z value Pr(>|z|)
## (Intercept) -187.873 < 2e-16 ***
## gender_currentFemale -11.937 < 2e-16 ***
## gender_currentUndesignated 23.223 < 2e-16 ***
## race_code_currentBlack or African American -108.117 < 2e-16 ***
## race_code_currentAsian -0.621 0.534495
## race_code_currentAmerican Indian or Alaska Native 50.781 < 2e-16 ***
## race_code_currentTwo or More Races -11.899 < 2e-16 ***
## race_code_currentOther 3.286 0.001017 **
## race_code_currentNative Hawaiian or Pacific Islander 3.580 0.000343 ***
## race_code_currentUndesignated -10.787 < 2e-16 ***
## age_group30-49 14.890 < 2e-16 ***
## age_group50-64 11.802 < 2e-16 ***
## age_group65+ 4.052 5.08e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 720545 on 2418908 degrees of freedom
## Residual deviance: 698256 on 2418896 degrees of freedom
## AIC: 698282
##
## Number of Fisher Scoring iterations: 7library(broom)
odds_ratios_rep <- tidy(logistic_model_rep) %>%
mutate(
odds_ratio = exp(estimate),
lower_ci = exp(estimate - 1.96 * std.error),
upper_ci = exp(estimate + 1.96 * std.error)
)
odds_ratios_rep## # A tibble: 13 × 8
## term estimate std.error statistic p.value odds_ratio lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Interce… -3.29 0.0175 -188. 0 0.0373 0.0361 0.0386
## 2 gender_c… -0.0885 0.00741 -11.9 7.63e- 33 0.915 0.902 0.929
## 3 gender_c… 0.418 0.0180 23.2 2.68e-119 1.52 1.47 1.57
## 4 race_cod… -1.46 0.0135 -108. 0 0.233 0.227 0.239
## 5 race_cod… -0.0157 0.0253 -0.621 5.34e- 1 0.984 0.937 1.03
## 6 race_cod… 1.00 0.0198 50.8 0 2.73 2.63 2.84
## 7 race_cod… -0.624 0.0524 -11.9 1.19e- 32 0.536 0.484 0.594
## 8 race_cod… 0.0608 0.0185 3.29 1.02e- 3 1.06 1.02 1.10
## 9 race_cod… 1.01 0.283 3.58 3.43e- 4 2.76 1.58 4.81
## 10 race_cod… -0.192 0.0178 -10.8 3.98e- 27 0.825 0.797 0.855
## 11 age_grou… 0.264 0.0177 14.9 3.82e- 50 1.30 1.26 1.35
## 12 age_grou… 0.213 0.0181 11.8 3.80e- 32 1.24 1.19 1.28
## 13 age_grou… 0.0736 0.0182 4.05 5.08e- 5 1.08 1.04 1.12The Odds of Switching to Democrat(2024) Based On Different Demographics
logistic_model_dem <- glm(
switched_to_dem ~ gender_current + race_code_current + age_group,
data = demograph_north_carolina,
family = binomial()
)
summary(logistic_model_dem)##
## Call:
## glm(formula = switched_to_dem ~ gender_current + race_code_current +
## age_group, family = binomial(), data = demograph_north_carolina)
##
## Coefficients:
## Estimate Std. Error
## (Intercept) -2.747841 0.011906
## gender_currentFemale 0.194293 0.007076
## gender_currentUndesignated 0.389545 0.016298
## race_code_currentBlack or African American 0.098357 0.007782
## race_code_currentAsian 0.339223 0.022609
## race_code_currentAmerican Indian or Alaska Native -0.365028 0.037908
## race_code_currentTwo or More Races 0.166402 0.034282
## race_code_currentOther 0.376812 0.016491
## race_code_currentNative Hawaiian or Pacific Islander 1.087134 0.277042
## race_code_currentUndesignated 0.193848 0.015792
## age_group30-49 -0.252438 0.011483
## age_group50-64 -0.924124 0.012795
## age_group65+ -1.253085 0.013437
## z value Pr(>|z|)
## (Intercept) -230.789 < 2e-16 ***
## gender_currentFemale 27.457 < 2e-16 ***
## gender_currentUndesignated 23.902 < 2e-16 ***
## race_code_currentBlack or African American 12.639 < 2e-16 ***
## race_code_currentAsian 15.004 < 2e-16 ***
## race_code_currentAmerican Indian or Alaska Native -9.629 < 2e-16 ***
## race_code_currentTwo or More Races 4.854 1.21e-06 ***
## race_code_currentOther 22.849 < 2e-16 ***
## race_code_currentNative Hawaiian or Pacific Islander 3.924 8.71e-05 ***
## race_code_currentUndesignated 12.275 < 2e-16 ***
## age_group30-49 -21.984 < 2e-16 ***
## age_group50-64 -72.224 < 2e-16 ***
## age_group65+ -93.254 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 803542 on 2418908 degrees of freedom
## Residual deviance: 781025 on 2418896 degrees of freedom
## AIC: 781051
##
## Number of Fisher Scoring iterations: 6odds_ratios_dem <- tidy(logistic_model_dem) %>%
mutate(
odds_ratio = exp(estimate),
lower_ci = exp(estimate - 1.96 * std.error),
upper_ci = exp(estimate + 1.96 * std.error))
odds_ratios_dem## # A tibble: 13 × 8
## term estimate std.error statistic p.value odds_ratio lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Interce… -2.75 0.0119 -231. 0 0.0641 0.0626 0.0656
## 2 gender_c… 0.194 0.00708 27.5 5.78e-166 1.21 1.20 1.23
## 3 gender_c… 0.390 0.0163 23.9 2.93e-126 1.48 1.43 1.52
## 4 race_cod… 0.0984 0.00778 12.6 1.28e- 36 1.10 1.09 1.12
## 5 race_cod… 0.339 0.0226 15.0 6.89e- 51 1.40 1.34 1.47
## 6 race_cod… -0.365 0.0379 -9.63 6.02e- 22 0.694 0.644 0.748
## 7 race_cod… 0.166 0.0343 4.85 1.21e- 6 1.18 1.10 1.26
## 8 race_cod… 0.377 0.0165 22.8 1.50e-115 1.46 1.41 1.51
## 9 race_cod… 1.09 0.277 3.92 8.71e- 5 2.97 1.72 5.10
## 10 race_cod… 0.194 0.0158 12.3 1.23e- 34 1.21 1.18 1.25
## 11 age_grou… -0.252 0.0115 -22.0 4.09e-107 0.777 0.760 0.795
## 12 age_grou… -0.924 0.0128 -72.2 0 0.397 0.387 0.407
## 13 age_grou… -1.25 0.0134 -93.3 0 0.286 0.278 0.293The Odds of Switching to Unaffiliated (2024) Based On Different Demographics
logistic_model_una <- glm(
switched_to_una ~ gender_current + race_code_current + age_group,
data = demograph_north_carolina,
family = binomial()
)
summary(logistic_model_una)##
## Call:
## glm(formula = switched_to_una ~ gender_current + race_code_current +
## age_group, family = binomial(), data = demograph_north_carolina)
##
## Coefficients:
## Estimate Std. Error
## (Intercept) -2.195124 0.009977
## gender_currentFemale -0.037511 0.004785
## gender_currentUndesignated 0.524085 0.010996
## race_code_currentBlack or African American -0.341620 0.005782
## race_code_currentAsian -0.397535 0.020042
## race_code_currentAmerican Indian or Alaska Native 0.360399 0.018116
## race_code_currentTwo or More Races -0.298920 0.028763
## race_code_currentOther -0.049371 0.013022
## race_code_currentNative Hawaiian or Pacific Islander 0.533879 0.239720
## race_code_currentUndesignated 0.082834 0.010791
## age_group30-49 0.225798 0.009923
## age_group50-64 -0.126079 0.010363
## age_group65+ -0.513466 0.010667
## z value Pr(>|z|)
## (Intercept) -220.014 < 2e-16 ***
## gender_currentFemale -7.839 4.55e-15 ***
## gender_currentUndesignated 47.662 < 2e-16 ***
## race_code_currentBlack or African American -59.078 < 2e-16 ***
## race_code_currentAsian -19.835 < 2e-16 ***
## race_code_currentAmerican Indian or Alaska Native 19.895 < 2e-16 ***
## race_code_currentTwo or More Races -10.393 < 2e-16 ***
## race_code_currentOther -3.791 0.00015 ***
## race_code_currentNative Hawaiian or Pacific Islander 2.227 0.02594 *
## race_code_currentUndesignated 7.676 1.64e-14 ***
## age_group30-49 22.754 < 2e-16 ***
## age_group50-64 -12.166 < 2e-16 ***
## age_group65+ -48.134 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1448844 on 2418908 degrees of freedom
## Residual deviance: 1420972 on 2418896 degrees of freedom
## AIC: 1420998
##
## Number of Fisher Scoring iterations: 5odds_ratios_una <- tidy(logistic_model_una ) %>%
mutate(
odds_ratio = exp(estimate),
lower_ci = exp(estimate - 1.96 * std.error),
upper_ci = exp(estimate + 1.96 * std.error)
)
odds_ratios_una## # A tibble: 13 × 8
## term estimate std.error statistic p.value odds_ratio lower_ci upper_ci
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 (Interce… -2.20 0.00998 -220. 0 0.111 0.109 0.114
## 2 gender_c… -0.0375 0.00479 -7.84 4.55e- 15 0.963 0.954 0.972
## 3 gender_c… 0.524 0.0110 47.7 0 1.69 1.65 1.73
## 4 race_cod… -0.342 0.00578 -59.1 0 0.711 0.703 0.719
## 5 race_cod… -0.398 0.0200 -19.8 1.48e- 87 0.672 0.646 0.699
## 6 race_cod… 0.360 0.0181 19.9 4.54e- 88 1.43 1.38 1.49
## 7 race_cod… -0.299 0.0288 -10.4 2.68e- 25 0.742 0.701 0.785
## 8 race_cod… -0.0494 0.0130 -3.79 1.50e- 4 0.952 0.928 0.976
## 9 race_cod… 0.534 0.240 2.23 2.59e- 2 1.71 1.07 2.73
## 10 race_cod… 0.0828 0.0108 7.68 1.64e- 14 1.09 1.06 1.11
## 11 age_grou… 0.226 0.00992 22.8 1.30e-114 1.25 1.23 1.28
## 12 age_grou… -0.126 0.0104 -12.2 4.70e- 34 0.882 0.864 0.900
## 13 age_grou… -0.513 0.0107 -48.1 0 0.598 0.586 0.611