US Wisconsin Data Analysis
Giovanni Valentini
2026-07-25
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
suppressPackageStartupMessages(library(dplyr))
library(ggplot2)
library(readr)
library(tidyr)1 - Select Wisconsin Data
midwest_df <- midwest
table(midwest$state, midwest$inmetro)##
## 0 1
## IL 74 28
## IN 55 37
## MI 58 25
## OH 48 40
## WI 52 20election_df <- read_csv(file = "C:/Giovanni/Datasets/us_pres_2016_by_county.csv")## Rows: 9297 Columns: 9
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (3): county.name, state.name, party
## dbl (5): county.fips, vote.count, county.total.count, national.party.percent...
## lgl (1): is.national.winner
##
## ℹ 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.state_name <- params$us_state
state_abb <- toupper(stringr::str_sub(state_name, start = 1, end = 2))
election_state <- election_df %>% filter(state.name == tolower(state_name))
midwest_state <- midwest_df %>% filter(state == state_abb)election_state_wide <- election_state %>% select(county.fips:county.total.count) %>%
mutate(vote_percent = round(100 * vote.count / county.total.count, digits = 2)) %>%
pivot_wider(names_from = party, values_from = c(vote.count, vote_percent))
election_state_wide <- election_state_wide %>%
mutate(TRUMP_Won = vote.count_R > vote.count_D) %>%
mutate(county.name = toupper(county.name))state_df <- midwest_state %>%
inner_join(election_state_wide, by = c("county" = "county.name"))state_df %>% select(county, poptotal, percollege, percbelowpoverty) %>% head(12)## # A tibble: 12 × 4
## county poptotal percollege percbelowpoverty
## <chr> <int> <dbl> <dbl>
## 1 ADAMS 15682 12.4 14.4
## 2 ASHLAND 16307 18.3 16.2
## 3 BARRON 40750 19.4 11.6
## 4 BAYFIELD 14008 25.8 16.6
## 5 BROWN 194594 26.3 9.17
## 6 BUFFALO 13584 17.9 11.9
## 7 BURNETT 13084 13.7 15.5
## 8 CALUMET 34291 19.8 4.87
## 9 CHIPPEWA 52360 18.2 10.5
## 10 CLARK 31647 13.8 13.8
## 11 COLUMBIA 45088 20.9 7.49
## 12 CRAWFORD 15940 16.6 14.6state_df %>% select(starts_with("perc"), vote_percent_R) %>% cor()## percwhite percblack percamerindan percasian
## percwhite 1.00000000 -0.24861553 -0.95349267 0.01851358
## percblack -0.24861553 1.00000000 -0.04814217 0.23227363
## percamerindan -0.95349267 -0.04814217 1.00000000 -0.14623665
## percasian 0.01851358 0.23227363 -0.14623665 1.00000000
## percother -0.17217872 0.78788064 -0.08093962 0.21446688
## perchsd 0.27306746 0.05689862 -0.32845749 0.52425868
## percollege 0.18199665 0.17632934 -0.27663446 0.64134932
## percprof 0.11571845 0.21990837 -0.22186132 0.64590226
## percpovertyknown -0.04117616 -0.04134942 0.07970576 -0.39425151
## percbelowpoverty -0.79997308 0.03711702 0.82112207 -0.14520628
## percchildbelowpovert -0.79969472 0.14857719 0.79262991 -0.20709696
## percadultpoverty -0.77039404 0.01955211 0.78835350 -0.03482458
## percelderlypoverty -0.23873699 -0.25018106 0.35242050 -0.46135492
## vote_percent_R 0.52540516 -0.39046007 -0.40459517 -0.39269264
## percother perchsd percollege percprof
## percwhite -0.17217872 0.27306746 0.1819966 0.1157184
## percblack 0.78788064 0.05689862 0.1763293 0.2199084
## percamerindan -0.08093962 -0.32845749 -0.2766345 -0.2218613
## percasian 0.21446688 0.52425868 0.6413493 0.6459023
## percother 1.00000000 0.08530314 0.1788158 0.2172845
## perchsd 0.08530314 1.00000000 0.8965341 0.7898463
## percollege 0.17881580 0.89653415 1.0000000 0.9451241
## percprof 0.21728450 0.78984634 0.9451241 1.0000000
## percpovertyknown -0.08754600 -0.17168908 -0.2579804 -0.3854103
## percbelowpoverty -0.07849133 -0.54828757 -0.4180433 -0.2638651
## percchildbelowpovert 0.00147731 -0.58562496 -0.4695220 -0.3338617
## percadultpoverty -0.06792728 -0.45017180 -0.3023456 -0.1309704
## percelderlypoverty -0.39358727 -0.73490972 -0.6810609 -0.5671526
## vote_percent_R -0.24265075 -0.30033114 -0.4061048 -0.4650230
## percpovertyknown percbelowpoverty percchildbelowpovert
## percwhite -0.04117616 -0.79997308 -0.79969472
## percblack -0.04134942 0.03711702 0.14857719
## percamerindan 0.07970576 0.82112207 0.79262991
## percasian -0.39425151 -0.14520628 -0.20709696
## percother -0.08754600 -0.07849133 0.00147731
## perchsd -0.17168908 -0.54828757 -0.58562496
## percollege -0.25798037 -0.41804331 -0.46952195
## percprof -0.38541032 -0.26386514 -0.33386174
## percpovertyknown 1.00000000 -0.06238444 0.05070614
## percbelowpoverty -0.06238444 1.00000000 0.96866781
## percchildbelowpovert 0.05070614 0.96866781 1.00000000
## percadultpoverty -0.18573469 0.98157168 0.92332030
## percelderlypoverty 0.09160712 0.66760012 0.61575321
## vote_percent_R 0.22973542 -0.36094117 -0.32910477
## percadultpoverty percelderlypoverty vote_percent_R
## percwhite -0.77039404 -0.23873699 0.5254052
## percblack 0.01955211 -0.25018106 -0.3904601
## percamerindan 0.78835350 0.35242050 -0.4045952
## percasian -0.03482458 -0.46135492 -0.3926926
## percother -0.06792728 -0.39358727 -0.2426507
## perchsd -0.45017180 -0.73490972 -0.3003311
## percollege -0.30234559 -0.68106087 -0.4061048
## percprof -0.13097036 -0.56715256 -0.4650230
## percpovertyknown -0.18573469 0.09160712 0.2297354
## percbelowpoverty 0.98157168 0.66760012 -0.3609412
## percchildbelowpovert 0.92332030 0.61575321 -0.3291048
## percadultpoverty 1.00000000 0.59653789 -0.4080634
## percelderlypoverty 0.59653789 1.00000000 0.1470301
## vote_percent_R -0.40806342 0.14703012 1.0000000Step 2 - Visualizations
state_df %>% ggplot(aes(x = percollege, y = percbelowpoverty)) +
geom_point(aes(color = TRUMP_Won), size = 2) +
geom_hline(yintercept = median(state_df$percbelowpoverty)) +
geom_vline(xintercept = median(state_df$percollege)) +
coord_cartesian(ylim = c(0, 25)) +
theme(legend.position = "top")
state_df %>% ggplot(aes(x = percprof, y = percbelowpoverty)) +
geom_point(aes(color = TRUMP_Won), size = 2) +
geom_hline(yintercept = median(state_df$percbelowpoverty)) +
geom_vline(xintercept = median(state_df$percprof)) +
coord_cartesian(ylim = c(0, 25)) +
theme(legend.position = "top")
state_df %>% filter(poptotal < 100000) %>% ggplot(aes(x = poptotal)) +
geom_histogram(bins = 8, aes(fill = TRUMP_Won)) +
theme(legend.position = "top")
state_df %>% ggplot(aes(x = percollege)) +
geom_histogram(bins = 8, aes(fill = TRUMP_Won)) +
theme(legend.position = "top")
Step 3 - Plotting maps
state_map <- map_data(map = "county", region = tolower(state_name)) %>%
rename(state = region, region = subregion)state_df %>% ggplot(aes(fill = vote_percent_R, color = I("blue"))) +
scale_fill_gradient(low = "yellow", high = "darkgreen") +
geom_map(map = state_map, aes(map_id = tolower(county))) +
expand_limits(x = state_map$long, y = state_map$lat) +
coord_fixed(ratio = 1.25) + theme_bw() +
labs(title = paste("TRUMP 2016 vote percentage -", state_name), fill = "vote %")
state_df %>% ggplot(aes(fill = vote_percent_R, color = I("blue"))) +
scale_fill_fermenter(palette = 3, direction = 1) + # try palette 4, 5, 7, 8, 9
geom_map(map = state_map, aes(map_id = tolower(county))) +
expand_limits(x = state_map$long, y = state_map$lat) +
coord_fixed(ratio = 1.25) + theme_bw() +
labs(title = paste("TRUMP 2016 vote percentage -", state_name), fill = "vote %")
state_df %>% ggplot(aes(fill = percbelowpoverty, color = I("blue"))) +
scale_fill_fermenter(palette = 6, direction = 1) + # try palette 4, 7, 8, 9
geom_map(map = state_map, aes(map_id = tolower(county))) +
expand_limits(x = state_map$long, y = state_map$lat) +
coord_fixed(ratio = 1.25) + theme_bw() +
labs(title = paste("Population below poverty -", state_name, "- year 2000"), fill = "percentage")
state_df %>% ggplot(aes(fill = percollege, color = I("blue"))) +
scale_fill_fermenter(palette = 7, direction = 1) + # try palette 4, 7, 8, 9
geom_map(map = state_map, aes(map_id = tolower(county))) +
expand_limits(x = state_map$long, y = state_map$lat) +
coord_fixed(ratio = 1.25) + theme_bw() +
labs(title = paste("Population that attended college -", state_name, "- year 2000"))
state_df %>% ggplot(aes(fill = percwhite, color = I("blue"))) +
scale_fill_fermenter(palette = 4, direction = 1) + # try palette 4, 7, 8, 9
geom_map(map = state_map, aes(map_id = tolower(county))) +
expand_limits(x = state_map$long, y = state_map$lat) +
coord_fixed(ratio = 1.25) + theme_bw() +
labs(title = paste("White population -", state_name, "- year 2000"))
state_df %>% ggplot(aes(fill = percblack, color = I("blue"))) +
scale_fill_fermenter(palette = 6, direction = 1) + # try palette 4, 7, 8, 9
geom_map(map = state_map, aes(map_id = tolower(county))) +
expand_limits(x = state_map$long, y = state_map$lat) +
coord_fixed(ratio = 1.25) + theme_bw() +
labs(title = paste("Black population -", state_name, "- year 2000"))
Step 4 - Principal Component Analysis
state_df %>% select(c(county, poptotal, percamerindan)) %>%
arrange(desc(percamerindan)) %>% head()## # A tibble: 6 × 3
## county poptotal percamerindan
## <chr> <int> <dbl>
## 1 MENOMINEE 3890 89.2
## 2 SAWYER 14181 15.3
## 3 ASHLAND 16307 9.06
## 4 FOREST 8776 8.89
## 5 BAYFIELD 14008 8.85
## 6 VILAS 17707 8.66state_df_filtered <- state_df %>% select(c(2:3, 12:15, 18:20, 23, 27, 37:38)) %>%
filter(county != "MENOMINEE") # filter out the outlier
str(state_df_filtered)## tibble [71 × 13] (S3: tbl_df/tbl/data.frame)
## $ county : chr [1:71] "ADAMS" "ASHLAND" "BARRON" "BAYFIELD" ...
## $ state : chr [1:71] "WI" "WI" "WI" "WI" ...
## $ percwhite : num [1:71] 95.7 90.4 99 90.7 95.9 ...
## $ percblack : num [1:71] 2.3913 0.1042 0.0982 0.207 0.5201 ...
## $ percamerindan : num [1:71] 0.797 9.064 0.513 8.852 1.988 ...
## $ percasian : num [1:71] 0.357 0.282 0.233 0.171 1.296 ...
## $ perchsd : num [1:71] 67 75.3 73 78.5 82.6 ...
## $ percollege : num [1:71] 12.4 18.3 19.4 25.8 26.3 ...
## $ percprof : num [1:71] 2.39 4.37 3.24 5.84 4.62 ...
## $ percbelowpoverty: num [1:71] 14.44 16.22 11.55 16.58 9.17 ...
## $ inmetro : int [1:71] 0 0 0 0 1 0 0 1 1 0 ...
## $ vote_percent_R : num [1:71] 58.9 41.1 60.1 43.3 52.1 ...
## $ TRUMP_Won : logi [1:71] TRUE FALSE TRUE FALSE TRUE TRUE ...pca_model <- prcomp(x = state_df_filtered[, -c(1:2, 11, 13)], scale = FALSE)
summary(pca_model)## Importance of components:
## PC1 PC2 PC3 PC4 PC5 PC6 PC7
## Standard deviation 10.5389 6.4403 3.9869 3.11205 2.20285 1.48313 0.53148
## Proportion of Variance 0.5981 0.2234 0.0856 0.05215 0.02613 0.01185 0.00152
## Cumulative Proportion 0.5981 0.8215 0.9071 0.95922 0.98535 0.99719 0.99872
## PC8 PC9
## Standard deviation 0.47051 0.13115
## Proportion of Variance 0.00119 0.00009
## Cumulative Proportion 0.99991 1.00000pve <- round(100 * pca_model$sdev^2 / sum(pca_model$sdev^2), digits = 2)
pve## [1] 59.81 22.34 8.56 5.22 2.61 1.18 0.15 0.12 0.01plot(cumsum(pve), xlab = "Number of Principal Components",
ylab = "Cumulative Proportion of Variance", type = "b", ylim = c(0, 100))
pca_model$rotation## PC1 PC2 PC3 PC4 PC5
## percwhite 0.155523831 -0.38924321 0.64400529 0.298136022 0.13655611
## percblack -0.109938407 0.18484805 -0.21132089 -0.589752898 0.31461817
## percamerindan 0.004316067 0.20334648 -0.37985363 0.387206121 -0.57788905
## percasian -0.035806894 -0.01603171 -0.01892867 0.003182195 0.07984533
## perchsd -0.344019168 -0.47065716 -0.18935302 0.085362241 -0.27790115
## percollege -0.447108292 -0.42251942 -0.35240663 0.194449573 0.39764918
## percprof -0.147337226 -0.08914313 -0.12054037 0.115120131 0.22149878
## percbelowpoverty 0.039576668 0.46569929 -0.12200568 0.595820874 0.48640309
## vote_percent_R 0.787969250 -0.38451393 -0.45441526 -0.003901008 0.14502830
## PC6 PC7 PC8 PC9
## percwhite -0.01480462 -0.29165812 0.006026865 0.465517597
## percblack -0.21051860 -0.36477151 0.003584643 0.533765832
## percamerindan 0.22366017 -0.24514751 -0.010657819 0.469279990
## percasian 0.01024342 0.83882388 0.117454504 0.523632667
## perchsd -0.73269434 0.01589483 -0.051599894 -0.002477802
## percollege 0.41814265 -0.11358471 0.336613950 -0.019795430
## percprof 0.15352861 0.06017066 -0.928988895 0.057349810
## percbelowpoverty -0.40792354 -0.03710570 0.083829435 -0.016618187
## vote_percent_R -0.06063850 0.00173674 -0.004736672 0.003059564biplot(pca_model, pc.biplot = FALSE,
xlabs = state_df_filtered$county, cex =c(0.7, 1))
library(ggbiplot)
ggbiplot(pca_model, choices = 1:2, labels = state_df_filtered$county,
labels.size = 3, varname.color = "darkblue", circle = TRUE,
groups = state_df_filtered$TRUMP_Won,
ellipse = TRUE) + theme_bw() +
labs(fill = "TRUMP Won", color = "TRUMP Won") +
theme(legend.position = "top")
state_df %>% select(c(2, 4:5, 19, 27:28, 37:38)) %>% arrange(desc(vote_percent_R))## # A tibble: 72 × 8
## county area poptotal percollege inmetro category vote_percent_R TRUMP_Won
## <chr> <dbl> <int> <dbl> <int> <chr> <dbl> <lgl>
## 1 FLORENCE 0.03 4590 15.6 0 AAR 71.4 TRUE
## 2 TAYLOR 0.057 18901 15.1 0 AAR 69.5 TRUE
## 3 OCONTO 0.06 30226 13.4 0 AAR 66.3 TRUE
## 4 WASHINGT… 0.025 95328 23.4 1 HLU 66.3 TRUE
## 5 GREEN LA… 0.022 18651 17.3 0 AAR 66.2 TRUE
## 6 MARINETTE 0.082 40548 15.4 0 AAR 64.8 TRUE
## 7 SHAWANO 0.054 37157 14.8 0 AAR 64.5 TRUE
## 8 RUSK 0.055 15079 16.8 0 AAR 64.4 TRUE
## 9 WAUSHARA 0.037 19385 15.1 0 AAR 63.9 TRUE
## 10 CLARK 0.072 31647 13.8 0 LAR 63.6 TRUE
## # ℹ 62 more rows