class: center, middle, inverse, title-slide .title[ # Clustering ] .subtitle[ ## Part 1b ] .author[ ### Prof. Ryan Weldzius ] .institute[ ### Villanova University ] --- <style type="text/css"> .small .remark-code { /*Change made here*/ font-size: 85% !important; } .tiny .remark-code { /*Change made here*/ font-size: 50% !important; } </style> # Agenda 1. Application of k-means clustering --- # Clustering to Learn about MCs ``` r library(tidyverse) dat <- read_csv('../Data/H097_members.csv') glimpse(dat) ``` ``` ## Rows: 445 ## Columns: 22 ## $ congress <dbl> 97, 97, 97, 97, 97, … ## $ chamber <chr> "President", "House"… ## $ icpsr <dbl> 99907, 10717, 10721,… ## $ state_icpsr <dbl> 99, 41, 41, 41, 41, … ## $ district_code <dbl> 0, 2, 1, 4, 3, 5, 7,… ## $ state_abbrev <chr> "USA", "AL", "AL", "… ## $ party_code <dbl> 200, 200, 200, 100, … ## $ occupancy <dbl> 0, 0, 0, 0, 0, 0, 0,… ## $ last_means <dbl> 0, 1, 1, 1, 1, 1, 1,… ## $ bioname <chr> "REAGAN, Ronald Wils… ## $ bioguide_id <chr> NA, "D000326", "E000… ## $ born <dbl> 1911, 1925, 1928, 19… ## $ died <dbl> 2004, 2008, 2019, 20… ## $ nominate_dim1 <dbl> 0.692, 0.398, 0.177,… ## $ nominate_dim2 <dbl> -0.713, -0.057, 0.16… ## $ nominate_log_likelihood <dbl> -103.6031, -328.0376… ## $ nominate_geo_mean_probability <dbl> 0.74100, 0.58100, 0.… ## $ nominate_number_of_votes <dbl> 345, 605, 628, 648, … ## $ nominate_number_of_errors <dbl> 43, 134, 118, 59, 74… ## $ conditional <lgl> NA, NA, NA, NA, NA, … ## $ nokken_poole_dim1 <dbl> NA, 0.486, 0.156, -0… ## $ nokken_poole_dim2 <dbl> NA, -0.364, 0.006, 0… ``` --- # DW-NOMINATE - DW-NOMINATE is a measure of how frequently different legislators vote together -- - Often interpreted as "ideology" -- - Two-dimensions: -- 1. Standard left-right ideology (size of gov, redistribution, etc.) 2. Second dimension changes, but typically **salient social issues** -- - Can `\(k\)`-means clustering help us learn about legislators? --- # 97th Congress (1981-1983) ``` r require(scales) library(plotly) gg <- dat %>% ggplot(aes(x = nominate_dim1,y = nominate_dim2, text = bioname)) + geom_point() + labs(x = 'DW-Nominate Dimension 1', y = 'DW-Nominate Dimension 2') ``` --- # 97th Congress (1981-1983)
--- # Intuition Check -- - Can we see some clusters? - What do we think these are? -- - Let's try estimating `\(k\)`-means! -- - Function `kmeans(x,centers,iter.max,nstart)` -- - `x` is the data (only select the columns of interest!) - `centers` is the number of centroids - `iter.max` maximum amount of "steps" - `nstart` how many times to re-estimate --- # Clustering on Ideology - First, some light wrangling (convert numeric party code to character) ``` r datClust <- dat %>% mutate(party = ifelse(party_code == 200,'R', ifelse(party_code == 100,'D','I'))) %>% mutate(nameParty = paste0(bioname,' (',party,')')) %>% select(nominate_dim1,nominate_dim2,nameParty) %>% drop_na() ``` --- # Clustering on Ideology - Second, estimate `kmeans()` function ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 2) m ``` ``` ## K-means clustering with 2 clusters of sizes 214, 231 ## ## Cluster means: ## nominate_dim1 nominate_dim2 ## 1 0.2607991 -0.2443271 ## 2 -0.3019524 0.1529177 ## ## Clustering vector: ## [1] 1 1 1 2 2 2 2 1 1 1 2 2 2 1 2 2 1 1 2 2 1 2 2 2 1 2 1 ## [28] 2 2 1 1 2 1 1 2 2 2 2 1 2 1 2 2 1 2 2 1 1 1 2 1 1 1 1 ## [55] 1 2 1 1 2 1 2 1 2 2 1 1 2 1 1 2 1 2 2 1 2 2 2 2 2 2 1 ## [82] 1 2 2 2 2 1 1 2 2 2 2 1 2 2 2 2 1 2 2 2 1 1 1 1 2 2 2 ## [109] 1 1 2 1 1 1 1 1 2 1 2 2 2 1 1 1 1 2 1 2 1 1 1 2 2 1 2 ## [136] 1 1 1 2 2 1 1 1 1 1 1 2 1 1 1 2 2 1 2 2 1 1 2 2 2 1 2 ## [163] 1 2 1 1 1 2 1 1 2 2 1 2 2 2 2 1 2 1 2 2 1 2 2 2 2 2 1 ## [190] 2 2 2 1 2 2 2 2 2 1 1 1 2 1 2 2 1 2 1 1 1 2 2 1 1 2 1 ## [217] 2 2 2 1 1 2 2 1 1 1 2 2 2 2 1 1 1 2 1 1 1 2 2 1 2 2 2 ## [244] 2 1 1 1 2 2 1 1 2 2 1 1 1 1 2 2 2 1 2 1 1 2 2 2 1 1 1 ## [271] 2 2 1 1 2 2 2 2 2 2 2 2 2 2 1 1 2 1 1 1 1 1 1 1 2 1 2 ## [298] 1 2 2 1 2 2 2 2 1 1 2 1 1 1 1 1 1 2 2 1 1 2 1 1 1 2 2 ## [325] 2 2 1 2 1 2 1 1 1 2 2 1 2 2 2 1 1 1 2 1 2 1 2 1 2 1 1 ## [352] 1 2 2 1 1 2 1 2 1 1 2 1 1 2 2 1 2 1 2 1 1 2 2 1 1 2 2 ## [379] 1 1 1 2 1 2 2 2 2 2 2 2 2 2 2 2 1 1 2 2 1 2 2 2 2 2 2 ## [406] 1 2 1 2 2 2 1 1 1 2 2 1 1 1 1 1 1 1 1 2 1 2 2 2 2 1 2 ## [433] 2 1 1 2 2 2 2 2 1 1 1 1 1 ## ## Within cluster sum of squares by cluster: ## [1] 33.36394 48.70122 ## (between_SS / total_SS = 39.1 %) ## ## Available components: ## ## [1] "cluster" "centers" "totss" ## [4] "withinss" "tot.withinss" "betweenss" ## [7] "size" "iter" "ifault" ``` --- # Clustering on Ideology - Easier to see output with the help of `tidymodels` package ``` r require(tidymodels) tidy(m) ``` ``` ## # A tibble: 2 × 5 ## nominate_dim1 nominate_dim2 size withinss cluster ## <dbl> <dbl> <int> <dbl> <fct> ## 1 0.261 -0.244 214 33.4 1 ## 2 -0.302 0.153 231 48.7 2 ``` -- - First two columns are the **locations** of the centroids - `size` is the number of observations associated with each group - `withinss` is the **errors** each centroid makes --- # Clustering on Ideology - Third, plot points and color by cluster ``` r ggClust <- datClust %>% mutate(cluster = m$cluster) %>% # Add cluster to data ggplot(aes(x = nominate_dim1, y = nominate_dim2, color = factor(cluster), text=nameParty)) + geom_point() + labs(x = 'DW-Nominate Dimension 1', y = 'DW-Nominate Dimension 2', title="97th Congress Ideology", color = "Cluster") ``` --- # Clustering on Ideology ``` r ggplotly(ggClust,tooltip = 'text') ```
--- # More Clusters ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 3) ```
--- # More Clusters ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 4) ```
--- # More Clusters ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 5) ```
--- # How many clusters? -- - Recall from regression that we are interested in **errors** -- - What are "errors" in the context of clustering? -- <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-17-1.png" style="display: block; margin: auto;" /> --- # How many clusters? - Recall from regression that we are interested in **errors** - What are "errors" in the context of clustering? <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-18-1.png" style="display: block; margin: auto;" /> --- # How many clusters? - Recall from regression that we are interested in **errors** - What are "errors" in the context of clustering? - Just the sum of each observation's distance from its centroid! -- - Within Sum of Squares (**WSS**) ``` r tidy(m) ``` ``` ## # A tibble: 2 × 5 ## nominate_dim1 nominate_dim2 size withinss cluster ## <dbl> <dbl> <int> <dbl> <fct> ## 1 -0.216 0.370 166 23.7 1 ## 2 0.0783 -0.281 279 58.0 2 ``` --- # So...how many?! - Want to choose a number of clusters that reduces the total **WSS** -- ``` r m.cluster <- datClust %>% select(-nameParty) %>% # Same as selecting two dimensions kmeans(centers = 3) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-21-1.png" style="display: block; margin: auto;" /> --- # So...how many?! - Want to choose a number of clusters that reduces the total **WSS** ``` r m.cluster <- datClust %>% select(-nameParty) %>% kmeans(centers = 4) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-23-1.png" style="display: block; margin: auto;" /> --- # So...how many?! - Want to choose a number of clusters that reduces the total **WSS** ``` r m.cluster <- datClust %>% select(-nameParty) %>% kmeans(centers = 5) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-25-1.png" style="display: block; margin: auto;" /> --- # So...how many?! - Want to choose a number of clusters that reduces the total **WSS** ``` r m.cluster <- datClust %>% select(-nameParty) %>% kmeans(centers = 10) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-27-1.png" style="display: block; margin: auto;" /> --- # So...how many?! - Want to choose a number of clusters that reduces the total **WSS** ``` r m.cluster <- datClust %>% select(-nameParty) %>% kmeans(centers = 30) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-29-1.png" style="display: block; margin: auto;" /> --- # So...how many?! - But there's a trade-off! -- - Accuracy versus **parsimony** -- - Simple rule: look for the "elbow" ``` r totWSS <- NULL for(k in 1:10) { m.cluster <- datClust %>% select(-nameParty) %>% kmeans(centers = k,nstart = 25) totWSS <- data.frame(totWSS = m.cluster$tot.withinss, k = k) %>% bind_rows(totWSS) } ``` --- # Looking for the "elbow" ``` r totWSS %>% ggplot(aes(x = k,y = totWSS)) + geom_line() + geom_point() + labs(x = 'Number of Clusters',y = 'Total WSS') + scale_x_continuous(breaks = 1:10) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-31-1.png" style="display: block; margin: auto;" /> --- # Clustering on Ideology - Note that we need to `set.seed()`! Centroid starting points are **random**! ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 2) ```
--- # Clustering on Ideology - Note that we need to `set.seed()`! Centroid starting points are **random**! ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 2) ```
--- # Clustering on Ideology - Note that we need to `set.seed()`! Centroid starting points are **random**! ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 2) ```
--- # Clustering on Ideology - Note that we need to `set.seed()`! Centroid starting points are **random**! ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 2) ```
--- # Clustering Randomness - Can overcome with `nstart` -- - Attempts multiple initial centroids and chooses the "best" ``` r set.seed(42) c1 <- kmeans(datClust %>% select(-nameParty),centers = 2,nstart = 25) set.seed(123) c2 <- kmeans(datClust %>% select(-nameParty),centers = 2,nstart = 25) table(c1$cluster,c2$cluster) ``` ``` ## ## 1 2 ## 1 166 0 ## 2 0 279 ``` ``` r table(c1$cluster) ``` ``` ## ## 1 2 ## 166 279 ``` ``` r table(c2$cluster) ``` ``` ## ## 1 2 ## 166 279 ``` --- # Is Polarization Increasing? - Compare 97th Congress (1981-1983) to 117th Congress (2021-2023) ``` r dat <- read_csv('../Data/H117_members.csv') datClust <- dat %>% mutate(party = ifelse(party_code == 200,'R', ifelse(party_code == 100,'D','I'))) %>% mutate(nameParty = paste0(bioname,' (',party,')')) %>% # combine name + party select(nominate_dim1,nominate_dim2,nameParty) %>% drop_na() ``` - Check for the "elbow" ``` r totWSS <- NULL for(k in 1:10) { m.cluster <- datClust %>% select(-nameParty) %>% kmeans(centers = k,nstart = 25) totWSS <- data.frame(totWSS = m.cluster$tot.withinss,k = k) %>% bind_rows(totWSS) } ``` --- # Check for the "elbow" ``` r totWSS %>% ggplot(aes(x = k,y = totWSS)) + geom_line() + geom_point() + labs(x = 'Number of Clusters',y = 'Total WSS') + scale_x_continuous(breaks = 1:10) ``` <img src="14b_ClusteringPart1_files/figure-html/unnamed-chunk-43-1.png" style="display: block; margin: auto;" /> --- # Growing polarization? ``` r m <- kmeans(x = datClust %>% select(nominate_dim1,nominate_dim2), centers = 2) ```
--- # Conclusion -- - Clustering is part of a third camp of data science -- 1. Theory Testing 2. Prediction 3. **Learning**