class: center middle main-title section-title-1 # .huge[.kjh-lblue[Basic] .kjh-yellow[Maps]] --- class: right bottom main-title section-title-1 ## .huge.right.bottom.squish4[.kjh-yellow[Maps as] .kjh-lblue[polygons]] --- layout: true class: title title-1 --- # Packages ```r library(here) # manage file paths library(socviz) # data and some useful functions library(tidyverse) # your friend and mine library(maps) # Some basic maps library(ggforce) # ggplot extensions ``` --- # Take a look at this data ```r ## This is from the map library # library(maps) us_states <- map_data("state") dim(us_states) ``` ``` ## [1] 15537 6 ``` ```r ## Making it a tibble prevents crashes ## in the slide rendering later on us_states <- as_tibble(us_states) us_states ``` ``` ## # A tibble: 15,537 × 6 ## long lat group order region subregion ## <dbl> <dbl> <dbl> <int> <chr> <chr> ## 1 -87.5 30.4 1 1 alabama <NA> ## 2 -87.5 30.4 1 2 alabama <NA> ## 3 -87.5 30.4 1 3 alabama <NA> ## 4 -87.5 30.3 1 4 alabama <NA> ## 5 -87.6 30.3 1 5 alabama <NA> ## 6 -87.6 30.3 1 6 alabama <NA> ## 7 -87.6 30.3 1 7 alabama <NA> ## 8 -87.6 30.3 1 8 alabama <NA> ## 9 -87.7 30.3 1 9 alabama <NA> ## 10 -87.8 30.3 1 10 alabama <NA> ## # … with 15,527 more rows ``` --- # What is this, at root? ```r us_states ``` ``` ## # A tibble: 15,537 × 6 ## long lat group order region subregion ## <dbl> <dbl> <dbl> <int> <chr> <chr> ## 1 -87.5 30.4 1 1 alabama <NA> ## 2 -87.5 30.4 1 2 alabama <NA> ## 3 -87.5 30.4 1 3 alabama <NA> ## 4 -87.5 30.3 1 4 alabama <NA> ## 5 -87.6 30.3 1 5 alabama <NA> ## 6 -87.6 30.3 1 6 alabama <NA> ## 7 -87.6 30.3 1 7 alabama <NA> ## 8 -87.6 30.3 1 8 alabama <NA> ## 9 -87.7 30.3 1 9 alabama <NA> ## 10 -87.8 30.3 1 10 alabama <NA> ## # … with 15,527 more rows ``` - It's a series of rows defining `x` and `y` coordinatates on a plane. - If we join those points up as lines while respecting their `group` (i.e. so `ggplot` knows when to "lift the pen", as with the `gapminder` line plot), we will get an outline map of states in the U.S. --- # Like this, with .kjh-green[`geom_polygon()`] .pull-left.w35[ ```r us_states |> ggplot(mapping = aes(x = long, y = lat, group = group)) + geom_polygon(fill = "white", color = "black") + labs(title = "This looks horrible") ``` ] -- .pull-right.w65[ <img src="09-slides_files/figure-html/codefig-poly1-1.png" width="576" style="display: block; margin: auto;" /> ] --- # We can represent a .kjh-orange[`fill`], too, like any geom .pull-left.w35[ ```r us_states |> ggplot(mapping = aes(x = long, y = lat, * fill = region, group = group)) + geom_polygon(color = "black") + * guides(fill = "none") + labs(title = "Still looks horrible", caption = "Set fill = none to stop ggplot from producing a key with 50 entries") ``` ] -- .pull-right.w65[ <img src="09-slides_files/figure-html/codefig-poly2-1.png" width="576" style="display: block; margin: auto;" /> ] --- layout: true class: title title-1 --- # We need to do two things ### .center.middle.huge[1: Fix the .kjh-lblue[map projection]] ### .center.middle.huge[2: .kjh-orange[Add some data] to fill with.] --- # For now, we'll do it the direct way - .middle.large[To make explicit what's happening, and to emphasize how .kjh-pink[_it's all just points and lines made from tables_] we'll first do it at the level of the .kjh-lblue[`ggplot`] grammar with a geom that just draws shapes, .kjh-green[`geom_polygon()`]. After that, we'll introduce a new package, .kjh-lblue[`sf`] and a new geom, .kjh-green[`geom_sf()`] that will handle this for us, and more.] --- layout: true class: title title-1 --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r *us_states <- as_tibble(map_data("state")) ``` ] .panel2-reveal-coord-auto[ ] --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r us_states <- as_tibble(map_data("state")) *us_states ``` ] .panel2-reveal-coord-auto[ ``` ## # A tibble: 15,537 × 6 ## long lat group order region subregion ## <dbl> <dbl> <dbl> <int> <chr> <chr> ## 1 -87.5 30.4 1 1 alabama <NA> ## 2 -87.5 30.4 1 2 alabama <NA> ## 3 -87.5 30.4 1 3 alabama <NA> ## 4 -87.5 30.3 1 4 alabama <NA> ## 5 -87.6 30.3 1 5 alabama <NA> ## 6 -87.6 30.3 1 6 alabama <NA> ## 7 -87.6 30.3 1 7 alabama <NA> ## 8 -87.6 30.3 1 8 alabama <NA> ## 9 -87.7 30.3 1 9 alabama <NA> ## 10 -87.8 30.3 1 10 alabama <NA> ## # … with 15,527 more rows ``` ] --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r us_states <- as_tibble(map_data("state")) us_states |> * ggplot(mapping = aes(x = long, * y = lat, * fill = region, * group = group)) ``` ] .panel2-reveal-coord-auto[ <img src="09-slides_files/figure-html/reveal-coord_auto_03_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r us_states <- as_tibble(map_data("state")) us_states |> ggplot(mapping = aes(x = long, y = lat, fill = region, group = group)) + * geom_polygon(color = "black") ``` ] .panel2-reveal-coord-auto[ <img src="09-slides_files/figure-html/reveal-coord_auto_04_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r us_states <- as_tibble(map_data("state")) us_states |> ggplot(mapping = aes(x = long, y = lat, fill = region, group = group)) + geom_polygon(color = "black") + * guides(fill = "none") ``` ] .panel2-reveal-coord-auto[ <img src="09-slides_files/figure-html/reveal-coord_auto_05_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r us_states <- as_tibble(map_data("state")) us_states |> ggplot(mapping = aes(x = long, y = lat, fill = region, group = group)) + geom_polygon(color = "black") + guides(fill = "none") + * coord_map(projection = "albers", * lat0 = 39, * lat1 = 45) ``` ] .panel2-reveal-coord-auto[ <img src="09-slides_files/figure-html/reveal-coord_auto_06_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Fix the projection .panel1-reveal-coord-auto[ ```r us_states <- as_tibble(map_data("state")) us_states |> ggplot(mapping = aes(x = long, y = lat, fill = region, group = group)) + geom_polygon(color = "black") + guides(fill = "none") + coord_map(projection = "albers", lat0 = 39, lat1 = 45) ## A coordinate transformation! ``` ] .panel2-reveal-coord-auto[ <img src="09-slides_files/figure-html/reveal-coord_auto_07_output-1.png" width="504" style="display: block; margin: auto;" /> ] <style> .panel1-reveal-coord-auto { color: black; width: 39.2%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel2-reveal-coord-auto { color: black; width: 58.8%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel3-reveal-coord-auto { color: black; width: NA%; hight: 33%; float: left; padding-left: 1%; font-size: 80% } </style> --- layout: true class: title title-1 --- # U.S. Map Projections .center[] --- # U.S. Map Projections .center[] --- layout: false <img src="09-slides_files/figure-html/07-make-maps-10-1.png" width="1080" style="display: block; margin: auto;" /> .right.w90.small[Our U.S. Map again, now transformed] --- layout: true class: title title-1 --- # Next, some data .small[- We can merge our state-level `election` data with the `us_states` table, but we need to do a little work.] .pull-left.w45[ ```r us_states ``` ``` ## # A tibble: 15,537 × 6 ## long lat group order region subregion ## <dbl> <dbl> <dbl> <int> <chr> <chr> ## 1 -87.5 30.4 1 1 alabama <NA> ## 2 -87.5 30.4 1 2 alabama <NA> ## 3 -87.5 30.4 1 3 alabama <NA> ## 4 -87.5 30.3 1 4 alabama <NA> ## 5 -87.6 30.3 1 5 alabama <NA> ## 6 -87.6 30.3 1 6 alabama <NA> ## 7 -87.6 30.3 1 7 alabama <NA> ## 8 -87.6 30.3 1 8 alabama <NA> ## 9 -87.7 30.3 1 9 alabama <NA> ## 10 -87.8 30.3 1 10 alabama <NA> ## # … with 15,527 more rows ``` ] .pull-right.w45[ ```r election ``` ``` ## # A tibble: 51 × 22 ## state st fips total…¹ vote_…² winner party pct_m…³ r_poi…⁴ d_poi…⁵ ## <chr> <chr> <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> ## 1 Alabama AL 1 2.12e6 588708 Trump Repu… 0.277 27.7 -27.7 ## 2 Alaska AK 2 3.19e5 46933 Trump Repu… 0.147 14.7 -14.7 ## 3 Arizona AZ 4 2.60e6 91234 Trump Repu… 0.035 3.5 -3.5 ## 4 Arkansas AR 5 1.13e6 304378 Trump Repu… 0.269 26.9 -26.9 ## 5 California CA 6 1.42e7 4269978 Clint… Demo… 0.300 -30.0 30.0 ## 6 Colorado CO 8 2.78e6 136386 Clint… Demo… 0.0491 -4.91 4.91 ## 7 Connecticut CT 9 1.64e6 224357 Clint… Demo… 0.136 -13.6 13.6 ## 8 Delaware DE 10 4.44e5 50476 Clint… Demo… 0.114 -11.4 11.4 ## 9 District of… DC 11 3.11e5 270107 Clint… Demo… 0.868 -86.8 86.8 ## 10 Florida FL 12 9.50e6 112911 Trump Repu… 0.0119 1.19 -1.19 ## # … with 41 more rows, 12 more variables: pct_clinton <dbl>, pct_trump <dbl>, ## # pct_johnson <dbl>, pct_other <dbl>, clinton_vote <dbl>, trump_vote <dbl>, ## # johnson_vote <dbl>, other_vote <dbl>, ev_dem <dbl>, ev_rep <dbl>, ## # ev_oth <dbl>, census <chr>, and abbreviated variable names ¹total_vote, ## # ²vote_margin, ³pct_margin, ⁴r_points, ⁵d_points ``` ] -- .center[To merge, or .kjh-pink[_join_] these tables, they need to have a column in common to act as a key.] --- # Recode to make a key ```r election <- election |> mutate(region = tolower(state)) |> relocate(region) election ``` ``` ## # A tibble: 51 × 23 ## region state st fips total…¹ vote_…² winner party pct_m…³ r_poi…⁴ d_poi…⁵ ## <chr> <chr> <chr> <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> ## 1 alaba… Alab… AL 1 2.12e6 588708 Trump Repu… 0.277 27.7 -27.7 ## 2 alaska Alas… AK 2 3.19e5 46933 Trump Repu… 0.147 14.7 -14.7 ## 3 arizo… Ariz… AZ 4 2.60e6 91234 Trump Repu… 0.035 3.5 -3.5 ## 4 arkan… Arka… AR 5 1.13e6 304378 Trump Repu… 0.269 26.9 -26.9 ## 5 calif… Cali… CA 6 1.42e7 4269978 Clint… Demo… 0.300 -30.0 30.0 ## 6 color… Colo… CO 8 2.78e6 136386 Clint… Demo… 0.0491 -4.91 4.91 ## 7 conne… Conn… CT 9 1.64e6 224357 Clint… Demo… 0.136 -13.6 13.6 ## 8 delaw… Dela… DE 10 4.44e5 50476 Clint… Demo… 0.114 -11.4 11.4 ## 9 distr… Dist… DC 11 3.11e5 270107 Clint… Demo… 0.868 -86.8 86.8 ## 10 flori… Flor… FL 12 9.50e6 112911 Trump Repu… 0.0119 1.19 -1.19 ## # … with 41 more rows, 12 more variables: pct_clinton <dbl>, pct_trump <dbl>, ## # pct_johnson <dbl>, pct_other <dbl>, clinton_vote <dbl>, trump_vote <dbl>, ## # johnson_vote <dbl>, other_vote <dbl>, ev_dem <dbl>, ev_rep <dbl>, ## # ev_oth <dbl>, census <chr>, and abbreviated variable names ¹total_vote, ## # ²vote_margin, ³pct_margin, ⁴r_points, ⁵d_points ``` --- # Now we can join them .pull-left.w45[ ```r us_states ``` ``` ## # A tibble: 15,537 × 6 ## long lat group order region subregion ## <dbl> <dbl> <dbl> <int> <chr> <chr> ## 1 -87.5 30.4 1 1 alabama <NA> ## 2 -87.5 30.4 1 2 alabama <NA> ## 3 -87.5 30.4 1 3 alabama <NA> ## 4 -87.5 30.3 1 4 alabama <NA> ## 5 -87.6 30.3 1 5 alabama <NA> ## 6 -87.6 30.3 1 6 alabama <NA> ## 7 -87.6 30.3 1 7 alabama <NA> ## 8 -87.6 30.3 1 8 alabama <NA> ## 9 -87.7 30.3 1 9 alabama <NA> ## 10 -87.8 30.3 1 10 alabama <NA> ## # … with 15,527 more rows ``` ] .pull-right.w45[ ```r election ``` ``` ## # A tibble: 51 × 23 ## region state st fips total…¹ vote_…² winner party pct_m…³ r_poi…⁴ d_poi…⁵ ## <chr> <chr> <chr> <dbl> <dbl> <dbl> <chr> <chr> <dbl> <dbl> <dbl> ## 1 alaba… Alab… AL 1 2.12e6 588708 Trump Repu… 0.277 27.7 -27.7 ## 2 alaska Alas… AK 2 3.19e5 46933 Trump Repu… 0.147 14.7 -14.7 ## 3 arizo… Ariz… AZ 4 2.60e6 91234 Trump Repu… 0.035 3.5 -3.5 ## 4 arkan… Arka… AR 5 1.13e6 304378 Trump Repu… 0.269 26.9 -26.9 ## 5 calif… Cali… CA 6 1.42e7 4269978 Clint… Demo… 0.300 -30.0 30.0 ## 6 color… Colo… CO 8 2.78e6 136386 Clint… Demo… 0.0491 -4.91 4.91 ## 7 conne… Conn… CT 9 1.64e6 224357 Clint… Demo… 0.136 -13.6 13.6 ## 8 delaw… Dela… DE 10 4.44e5 50476 Clint… Demo… 0.114 -11.4 11.4 ## 9 distr… Dist… DC 11 3.11e5 270107 Clint… Demo… 0.868 -86.8 86.8 ## 10 flori… Flor… FL 12 9.50e6 112911 Trump Repu… 0.0119 1.19 -1.19 ## # … with 41 more rows, 12 more variables: pct_clinton <dbl>, pct_trump <dbl>, ## # pct_johnson <dbl>, pct_other <dbl>, clinton_vote <dbl>, trump_vote <dbl>, ## # johnson_vote <dbl>, other_vote <dbl>, ev_dem <dbl>, ev_rep <dbl>, ## # ev_oth <dbl>, census <chr>, and abbreviated variable names ¹total_vote, ## # ²vote_margin, ³pct_margin, ⁴r_points, ⁵d_points ``` ] --- # This is a .kjh-pink[_left join_] ```r us_states_elec <- left_join(us_states, election, by = "region") us_states_elec ``` ``` ## # A tibble: 15,537 × 28 ## long lat group order region subregion state st fips total…¹ vote_…² ## <dbl> <dbl> <dbl> <int> <chr> <chr> <chr> <chr> <dbl> <dbl> <dbl> ## 1 -87.5 30.4 1 1 alabama <NA> Alabama AL 1 2123372 588708 ## 2 -87.5 30.4 1 2 alabama <NA> Alabama AL 1 2123372 588708 ## 3 -87.5 30.4 1 3 alabama <NA> Alabama AL 1 2123372 588708 ## 4 -87.5 30.3 1 4 alabama <NA> Alabama AL 1 2123372 588708 ## 5 -87.6 30.3 1 5 alabama <NA> Alabama AL 1 2123372 588708 ## 6 -87.6 30.3 1 6 alabama <NA> Alabama AL 1 2123372 588708 ## 7 -87.6 30.3 1 7 alabama <NA> Alabama AL 1 2123372 588708 ## 8 -87.6 30.3 1 8 alabama <NA> Alabama AL 1 2123372 588708 ## 9 -87.7 30.3 1 9 alabama <NA> Alabama AL 1 2123372 588708 ## 10 -87.8 30.3 1 10 alabama <NA> Alabama AL 1 2123372 588708 ## # … with 15,527 more rows, 17 more variables: winner <chr>, party <chr>, ## # pct_margin <dbl>, r_points <dbl>, d_points <dbl>, pct_clinton <dbl>, ## # pct_trump <dbl>, pct_johnson <dbl>, pct_other <dbl>, clinton_vote <dbl>, ## # trump_vote <dbl>, johnson_vote <dbl>, other_vote <dbl>, ev_dem <dbl>, ## # ev_rep <dbl>, ev_oth <dbl>, census <chr>, and abbreviated variable names ## # ¹total_vote, ²vote_margin ``` -- .center[Now our `us_states_elec` table has both the line-drawing information and (very redundantly) the election data merged in, with rows repeated as necessary.] --- layout: true class: title title-1 --- # Now we can start drawing choropleths .pull-left.w45[ ```r us_states_elec |> ggplot(mapping = aes(x = long, y = lat, * fill = party, group = group)) + geom_polygon(color = "gray90", size = 0.1) + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + guides(fill = "none") ``` ] .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-choroparty-1.png" width="460" style="display: block; margin: auto;" /> ] --- # Let's turn off the gridlines This is a .kjh-pink[_theme function_]. ```r theme_map <- function(base_size=9, base_family="") { require(grid) theme_bw(base_size=base_size, base_family=base_family) %+replace% theme(axis.line=element_blank(), axis.text=element_blank(), axis.ticks=element_blank(), axis.title=element_blank(), panel.background=element_blank(), panel.border=element_blank(), panel.grid=element_blank(), panel.spacing=unit(0, "lines"), plot.background=element_blank(), legend.justification = c(0,0), legend.position = c(0,0) ) } ``` --- # Add the theme function at the end .pull-left.w45[ ```r us_states_elec |> ggplot(mapping = aes(x = long, y = lat, * fill = party, group = group)) + geom_polygon(color = "gray90", size = 0.1) + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + theme_map() ``` ] .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-choropartytheme-1.png" width="460" style="display: block; margin: auto;" /> ] --- # Fix the Party Colors .pull-left.w45[ ```r ## Hex color codes for Democratic Blue and Republican Red party_colors <- c("#2E74C0", "#CB454A") us_states_elec |> ggplot(mapping = aes(x = long, y = lat, * fill = party, group = group)) + geom_polygon(color = "gray90", size = 0.1) + scale_fill_manual(values = party_colors) + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + theme_map() ``` ] -- .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-choropartycolors-1.png" width="460" style="display: block; margin: auto;" /> ] --- # On maps, continuous measures are _gradients_ .pull-left.w45[ ```r us_states_elec |> ggplot(mapping = aes(x = long, y = lat, * fill = pct_trump, group = group)) + geom_polygon(color = "gray90", size = 0.1) + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + labs(title = "Trump vote", fill = "Percent") + theme_map() ``` ] -- .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-gradient1-1.png" width="460" style="display: block; margin: auto;" /> ] --- # Fix the gradient scale with its .kjh-orange[scale function] .pull-left.w45[ ```r us_states_elec |> ggplot(mapping = aes(x = long, y = lat, fill = pct_trump, group = group)) + geom_polygon(color = "gray90", size = 0.1) + * scale_fill_gradient(low = "white", * high = "#CB454A") + labs(title = "Trump vote") + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + labs(title = "Trump vote", fill = "Percent") + theme_map() ``` ] -- .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-gradient2-1.png" width="460" style="display: block; margin: auto;" /> ] --- # Some gradients are .kjh-yellow[_diverging_] .pull-left.w45[ ```r us_states_elec |> ggplot(mapping = aes(x = long, y = lat, * fill = d_points, group = group)) + geom_polygon(color = "gray90", size = 0.1) + * scale_fill_gradient2() + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + labs(title = "Winning Margins", fill = "Percent") + theme_map() ``` ] -- .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-diverging1-1.png" width="460" style="display: block; margin: auto;" /> ] --- # Purple America Map .pull-left.w45[ ```r us_states_elec |> ggplot(mapping = aes(x = long, y = lat, * fill = d_points, group = group)) + geom_polygon(color = "gray90", size = 0.1) + * scale_fill_gradient2(low = "red", * mid = scales::muted("purple"), * high = "blue", * breaks = c(-25, 0, 25, * 50, 75)) + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + labs(title = "Winning Margins", fill = "Percent") + theme_map() ``` ] -- .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-purpleamerica-1.png" width="460" style="display: block; margin: auto;" /> ] --- layout: false <img src="09-slides_files/figure-html/07-make-maps-25-1.png" width="864" style="display: block; margin: auto;" /> .right.w90.small[Take a closer look at this, though.] --- layout: false .center[] .right.w90.small[Washington, DC] --- layout: true class: title title-1 --- # Purple America Map, without DC .pull-left.w45[ ```r us_states_elec |> * filter(region %nin% "district of columbia") |> ggplot(mapping = aes(x = long, y = lat, fill = d_points, group = group)) + geom_polygon(color = "gray90", size = 0.1) + scale_fill_gradient2(low = "red", mid = scales::muted("purple"), high = "blue") + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + labs(title = "Winning Margins", fill = "Percent") + theme_map() ``` ] -- .pull-right.w55[ <img src="09-slides_files/figure-html/codefig-purpleamerica2-1.png" width="460" style="display: block; margin: auto;" /> ] --- layout: false <img src="09-slides_files/figure-html/07-make-maps-27-1.png" width="864" style="display: block; margin: auto;" /> .right.w90.small[More balanced.] --- class: right bottom main-title section-title-1 ## .huge.right.bottom.squish4[.kjh-yellow[America's]<br />.kjh-lblue[Ur-Choropleths]] --- layout: true class: title title-1 --- # County-level choropleths - Conceptually identical to state ones. The tables are just bigger, because there are way more lines to draw. ```r county_map <- as_tibble(county_map) county_map ``` ``` ## # A tibble: 191,382 × 7 ## long lat order hole piece group id ## <dbl> <dbl> <int> <lgl> <fct> <fct> <chr> ## 1 1225889. -1275020. 1 FALSE 1 0500000US01001.1 01001 ## 2 1235324. -1274008. 2 FALSE 1 0500000US01001.1 01001 ## 3 1244873. -1272331. 3 FALSE 1 0500000US01001.1 01001 ## 4 1244129. -1267515. 4 FALSE 1 0500000US01001.1 01001 ## 5 1272010. -1262889. 5 FALSE 1 0500000US01001.1 01001 ## 6 1276797. -1295514. 6 FALSE 1 0500000US01001.1 01001 ## 7 1273832. -1297124. 7 FALSE 1 0500000US01001.1 01001 ## 8 1272727. -1296631. 8 FALSE 1 0500000US01001.1 01001 ## 9 1272513. -1299771. 9 FALSE 1 0500000US01001.1 01001 ## 10 1269950. -1302038. 10 FALSE 1 0500000US01001.1 01001 ## # … with 191,372 more rows ``` - 191,000 or so rows - `id` here is the county FIPS code. --- # County-level choropleths ```r county_data <- as_tibble(county_data) county_data ``` ``` ## # A tibble: 3,195 × 32 ## id name state censu…¹ pop_d…² pop_d…³ pop_d…⁴ pct_b…⁵ pop female white ## <chr> <chr> <fct> <fct> <fct> <fct> <fct> <fct> <int> <dbl> <dbl> ## 1 0 <NA> <NA> <NA> [ 50… [ 45, … [ 82, … [10.0,… 3.19e8 50.8 77.7 ## 2 01000 1 AL South [ 50… [ 45, … [ 82, … [25.0,… 4.85e6 51.5 69.8 ## 3 01001 Auta… AL South [ 50… [ 45, … [ 82, … [15.0,… 5.54e4 51.5 78.1 ## 4 01003 Bald… AL South [ 100… [118,7… [ 82, … [ 5.0,… 2.00e5 51.2 87.3 ## 5 01005 Barb… AL South [ 10… [ 17, … [ 25, … [25.0,… 2.69e4 46.5 50.2 ## 6 01007 Bibb… AL South [ 10… [ 17, … [ 25, … [15.0,… 2.25e4 46 76.3 ## 7 01009 Blou… AL South [ 50… [ 45, … [ 82, … [ 0.0,… 5.77e4 50.6 96 ## 8 01011 Bull… AL South [ 10… [ 17, … [ 9, … [50.0,… 1.08e4 45.2 27.2 ## 9 01013 Butl… AL South [ 10… [ 17, … [ 25, … [25.0,… 2.03e4 53.4 54.3 ## 10 01015 Calh… AL South [ 100… [118,7… [ 82, … [15.0,… 1.16e5 51.7 76 ## # … with 3,185 more rows, 21 more variables: black <dbl>, travel_time <dbl>, ## # land_area <dbl>, hh_income <int>, su_gun4 <fct>, su_gun6 <fct>, fips <dbl>, ## # votes_dem_2016 <int>, votes_gop_2016 <int>, total_votes_2016 <int>, ## # per_dem_2016 <dbl>, per_gop_2016 <dbl>, diff_2016 <int>, ## # per_dem_2012 <dbl>, per_gop_2012 <dbl>, diff_2012 <int>, winner <chr>, ## # partywinner16 <chr>, winner12 <chr>, partywinner12 <chr>, flipped <chr>, ## # and abbreviated variable names ¹census_region, ²pop_dens, ³pop_dens4, … ``` --- # County-level choropleths - 3,195 entities, including states (FIPS `id` ends in four zeros) - And the US as a whole (FIPS `id` of `0`) - Sample a few rows, with specific columns: ```r county_data |> select(id, name, state, pop_dens, pct_black) |> sample_n(10) ``` ``` ## # A tibble: 10 × 5 ## id name state pop_dens pct_black ## <chr> <chr> <fct> <fct> <fct> ## 1 21071 Floyd County KY [ 50, 100) [ 0.0, 2.0) ## 2 12105 Polk County FL [ 100, 500) [15.0,25.0) ## 3 17013 Calhoun County IL [ 10, 50) [ 0.0, 2.0) ## 4 24000 21 MD [ 500, 1000) [25.0,50.0) ## 5 36101 Steuben County NY [ 50, 100) [ 0.0, 2.0) ## 6 35017 Grant County NM [ 0, 10) [ 0.0, 2.0) ## 7 48437 Swisher County TX [ 0, 10) [ 5.0,10.0) ## 8 51660 Harrisonburg city VA [ 1000, 5000) [ 5.0,10.0) ## 9 55019 Clark County WI [ 10, 50) [ 0.0, 2.0) ## 10 24001 Allegany County MD [ 100, 500) [ 5.0,10.0) ``` --- layout: true class: title title-1 --- # Joined table ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full ``` ``` ## # A tibble: 191,382 × 38 ## long lat order hole piece group id name state censu…¹ pop_d…² ## <dbl> <dbl> <int> <lgl> <fct> <fct> <chr> <chr> <fct> <fct> <fct> ## 1 1225889. -1275020. 1 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 2 1235324. -1274008. 2 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 3 1244873. -1272331. 3 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 4 1244129. -1267515. 4 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 5 1272010. -1262889. 5 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 6 1276797. -1295514. 6 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 7 1273832. -1297124. 7 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 8 1272727. -1296631. 8 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 9 1272513. -1299771. 9 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 10 1269950. -1302038. 10 FALSE 1 05000… 01001 Auta… AL South [ 50… ## # … with 191,372 more rows, 27 more variables: pop_dens4 <fct>, ## # pop_dens6 <fct>, pct_black <fct>, pop <int>, female <dbl>, white <dbl>, ## # black <dbl>, travel_time <dbl>, land_area <dbl>, hh_income <int>, ## # su_gun4 <fct>, su_gun6 <fct>, fips <dbl>, votes_dem_2016 <int>, ## # votes_gop_2016 <int>, total_votes_2016 <int>, per_dem_2016 <dbl>, ## # per_gop_2016 <dbl>, diff_2016 <int>, per_dem_2012 <dbl>, ## # per_gop_2012 <dbl>, diff_2012 <int>, winner <chr>, partywinner16 <chr>, … ``` --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r *county_full <- as_tibble(left_join(county_map, county_data, by = "id")) ``` ] .panel2-reveal-countypop-auto[ ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) *county_full ``` ] .panel2-reveal-countypop-auto[ ``` ## # A tibble: 191,382 × 38 ## long lat order hole piece group id name state censu…¹ pop_d…² ## <dbl> <dbl> <int> <lgl> <fct> <fct> <chr> <chr> <fct> <fct> <fct> ## 1 1225889. -1275020. 1 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 2 1235324. -1274008. 2 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 3 1244873. -1272331. 3 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 4 1244129. -1267515. 4 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 5 1272010. -1262889. 5 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 6 1276797. -1295514. 6 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 7 1273832. -1297124. 7 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 8 1272727. -1296631. 8 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 9 1272513. -1299771. 9 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 10 1269950. -1302038. 10 FALSE 1 05000… 01001 Auta… AL South [ 50… ## # … with 191,372 more rows, 27 more variables: pop_dens4 <fct>, ## # pop_dens6 <fct>, pct_black <fct>, pop <int>, female <dbl>, white <dbl>, ## # black <dbl>, travel_time <dbl>, land_area <dbl>, hh_income <int>, ## # su_gun4 <fct>, su_gun6 <fct>, fips <dbl>, votes_dem_2016 <int>, ## # votes_gop_2016 <int>, total_votes_2016 <int>, per_dem_2016 <dbl>, ## # per_gop_2016 <dbl>, diff_2016 <int>, per_dem_2012 <dbl>, ## # per_gop_2012 <dbl>, diff_2012 <int>, winner <chr>, partywinner16 <chr>, … ``` ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> * ggplot(mapping = aes(x = long, y = lat, * fill = pop_dens, * group = group)) ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_03_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + * geom_polygon(color = "gray70", * size = 0.1) ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_04_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + geom_polygon(color = "gray70", size = 0.1) + * coord_fixed() ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_05_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + * scale_fill_brewer(palette="Blues", * labels = c("0-10", "10-50", "50-100", * "100-500", "500-1,000", * "1,000-5,000", ">5,000")) ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_06_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Blues", labels = c("0-10", "10-50", "50-100", "100-500", "500-1,000", "1,000-5,000", ">5,000")) + * labs(fill = "Population per\nsquare mile") ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_07_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Blues", labels = c("0-10", "10-50", "50-100", "100-500", "500-1,000", "1,000-5,000", ">5,000")) + labs(fill = "Population per\nsquare mile") + * kjhslides::kjh_theme_map() ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_08_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Blues", labels = c("0-10", "10-50", "50-100", "100-500", "500-1,000", "1,000-5,000", ">5,000")) + labs(fill = "Population per\nsquare mile") + kjhslides::kjh_theme_map() + * guides(fill = guide_legend(nrow = 1)) ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_09_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # County Population Density .panel1-reveal-countypop-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pop_dens, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Blues", labels = c("0-10", "10-50", "50-100", "100-500", "500-1,000", "1,000-5,000", ">5,000")) + labs(fill = "Population per\nsquare mile") + kjhslides::kjh_theme_map() + guides(fill = guide_legend(nrow = 1)) + * theme(legend.position = "bottom") ``` ] .panel2-reveal-countypop-auto[ <img src="09-slides_files/figure-html/reveal-countypop_auto_10_output-1.png" width="504" style="display: block; margin: auto;" /> ] <style> .panel1-reveal-countypop-auto { color: black; width: 39.2%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel2-reveal-countypop-auto { color: black; width: 58.8%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel3-reveal-countypop-auto { color: black; width: NA%; hight: 33%; float: left; padding-left: 1%; font-size: 80% } </style> --- layout: false <img src="09-slides_files/figure-html/07-make-maps-32-1.png" width="864" style="display: block; margin: auto;" /> .right.w90.small[Population Density by County, binned] --- layout: true class: title title-1 --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r *county_full <- as_tibble(left_join(county_map, county_data, by = "id")) ``` ] .panel2-reveal-choroblack-auto[ ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) *county_full ``` ] .panel2-reveal-choroblack-auto[ ``` ## # A tibble: 191,382 × 38 ## long lat order hole piece group id name state censu…¹ pop_d…² ## <dbl> <dbl> <int> <lgl> <fct> <fct> <chr> <chr> <fct> <fct> <fct> ## 1 1225889. -1275020. 1 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 2 1235324. -1274008. 2 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 3 1244873. -1272331. 3 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 4 1244129. -1267515. 4 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 5 1272010. -1262889. 5 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 6 1276797. -1295514. 6 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 7 1273832. -1297124. 7 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 8 1272727. -1296631. 8 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 9 1272513. -1299771. 9 FALSE 1 05000… 01001 Auta… AL South [ 50… ## 10 1269950. -1302038. 10 FALSE 1 05000… 01001 Auta… AL South [ 50… ## # … with 191,372 more rows, 27 more variables: pop_dens4 <fct>, ## # pop_dens6 <fct>, pct_black <fct>, pop <int>, female <dbl>, white <dbl>, ## # black <dbl>, travel_time <dbl>, land_area <dbl>, hh_income <int>, ## # su_gun4 <fct>, su_gun6 <fct>, fips <dbl>, votes_dem_2016 <int>, ## # votes_gop_2016 <int>, total_votes_2016 <int>, per_dem_2016 <dbl>, ## # per_gop_2016 <dbl>, diff_2016 <int>, per_dem_2012 <dbl>, ## # per_gop_2012 <dbl>, diff_2012 <int>, winner <chr>, partywinner16 <chr>, … ``` ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> * ggplot(mapping = aes(x = long, y = lat, * fill = pct_black, * group = group)) ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_03_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + * geom_polygon(color = "gray70", * size = 0.1) ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_04_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + geom_polygon(color = "gray70", size = 0.1) + * coord_fixed() ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_05_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + * scale_fill_brewer(palette="Greens", * labels = c("0-2%", "2-5%", "5-10%", * "10-15%", "15-25%", * "25-50%", ">50%")) ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_06_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Greens", labels = c("0-2%", "2-5%", "5-10%", "10-15%", "15-25%", "25-50%", ">50%")) + * labs(fill = "US Population, percent Black") ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_07_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Greens", labels = c("0-2%", "2-5%", "5-10%", "10-15%", "15-25%", "25-50%", ">50%")) + labs(fill = "US Population, percent Black") + * kjhslides::kjh_theme_map() ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_08_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Greens", labels = c("0-2%", "2-5%", "5-10%", "10-15%", "15-25%", "25-50%", ">50%")) + labs(fill = "US Population, percent Black") + kjhslides::kjh_theme_map() + * guides(fill = guide_legend(nrow = 1)) ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_09_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Same again for Percent Black .panel1-reveal-choroblack-auto[ ```r county_full <- as_tibble(left_join(county_map, county_data, by = "id")) county_full |> ggplot(mapping = aes(x = long, y = lat, fill = pct_black, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + scale_fill_brewer(palette="Greens", labels = c("0-2%", "2-5%", "5-10%", "10-15%", "15-25%", "25-50%", ">50%")) + labs(fill = "US Population, percent Black") + kjhslides::kjh_theme_map() + guides(fill = guide_legend(nrow = 1)) + * theme(legend.position = "bottom") ``` ] .panel2-reveal-choroblack-auto[ <img src="09-slides_files/figure-html/reveal-choroblack_auto_10_output-1.png" width="504" style="display: block; margin: auto;" /> ] <style> .panel1-reveal-choroblack-auto { color: black; width: 39.2%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel2-reveal-choroblack-auto { color: black; width: 58.8%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel3-reveal-choroblack-auto { color: black; width: NA%; hight: 33%; float: left; padding-left: 1%; font-size: 80% } </style> --- layout: false <img src="09-slides_files/figure-html/07-make-maps-33-1.png" width="864" style="display: block; margin: auto;" /> .right.w90.small[Percent Black, by County, binned] --- class: right bottom main-title section-title-1 ## .huge.right.bottom.squish4[.kjh-yellow[Big counties, small populations,] .kjh-lblue[rare events]] --- layout: true class: title title-1 --- # Example: Reverse coding .pull-left.w45[ ```r orange_pal <- RColorBrewer::brewer.pal(n = 6, name = "Oranges") orange_pal ``` ``` ## [1] "#FEEDDE" "#FDD0A2" "#FDAE6B" "#FD8D3C" "#E6550D" "#A63603" ``` <img src="09-slides_files/figure-html/07-make-maps-35-1.png" width="360" style="display: block; margin: auto;" /> ] -- .pull-right.w45[ ```r # Just reverse it orange_rev <- rev(orange_pal) orange_rev ``` ``` ## [1] "#A63603" "#E6550D" "#FD8D3C" "#FDAE6B" "#FDD0A2" "#FEEDDE" ``` <img src="09-slides_files/figure-html/07-make-maps-37-1.png" width="360" style="display: block; margin: auto;" /> ] --- # Build a plot ```r p_g1 <- county_full |> ggplot(mapping = aes(x = long, y = lat, * fill = su_gun6, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + * scale_fill_manual(values = orange_pal) + labs(title = "Gun-Related Suicides, 1999-2015", fill = "Rate per 100,000 pop.") + theme_map() + guides(fill = guide_legend(nrow = 1)) + theme(legend.position = "bottom") ``` --- layout: false class: middle <img src="09-slides_files/figure-html/07-make-maps-39-1.png" width="864" style="display: block; margin: auto;" /> .right.w90.small[Regular palette] --- layout: true class: title title-1 --- # And another ```r p_g2 <- county_full |> ggplot(mapping = aes(x = long, y = lat, * fill = pop_dens6, group = group)) + geom_polygon(color = "gray70", size = 0.1) + coord_fixed() + * scale_fill_manual(values = orange_rev) + labs(title = "Reverse-coded Population Density", fill = "Persons per square mile") + theme_map() + guides(fill = guide_legend(nrow = 1)) + theme(legend.position = "bottom") ``` --- layout: false class: middle <img src="09-slides_files/figure-html/07-make-maps-41-1.png" width="864" style="display: block; margin: auto;" /> .right.w90.small[Reverse-coded density] --- layout: false class: middle .pull-left[ <img src="09-slides_files/figure-html/07-make-maps-42-1.png" width="576" style="display: block; margin: auto;" /> ] .pull-right[ <img src="09-slides_files/figure-html/07-make-maps-43-1.png" width="576" style="display: block; margin: auto;" /> ] .right.w90.small[Comparing the plots] --- class: right bottom main-title section-title-1 ## .huge.right.bottom.squish4[.kjh-yellow[Small multiples] .kjh-lblue[for maps]] --- layout: true class: title title-1 --- # Opiate-related Mortality, 1999-2014 ```r opiates ``` ``` ## # A tibble: 800 × 11 ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 1999 Alabama 1 37 4.43e6 0.8 0.8 0.1 South AL East S… ## 2 1999 Alaska 2 27 6.25e5 4.3 4 0.8 West AK Pacific ## 3 1999 Arizona 4 229 5.02e6 4.6 4.7 0.3 West AZ Mounta… ## 4 1999 Arkans… 5 28 2.65e6 1.1 1.1 0.2 South AR West S… ## 5 1999 Califo… 6 1474 3.35e7 4.4 4.5 0.1 West CA Pacific ## 6 1999 Colora… 8 164 4.23e6 3.9 3.7 0.3 West CO Mounta… ## 7 1999 Connec… 9 151 3.39e6 4.5 4.4 0.4 North… CT New En… ## 8 1999 Delawa… 10 32 7.75e5 4.1 4.1 0.7 South DE South … ## 9 1999 Distri… 11 28 5.70e5 4.9 4.9 0.9 South DC <NA> ## 10 1999 Florida 12 402 1.58e7 2.6 2.6 0.1 South FL South … ## # … with 790 more rows, and abbreviated variable names ¹population, ²adjusted, ## # ³adjusted_se, ⁴division_name ``` ```r opiates$state <- tolower(opiates$state) us_states$state <- us_states$region opiates_map <- left_join(us_states, opiates, by = "state") ``` --- ```r p_out <- opiates_map |> ggplot(mapping = aes(x = long, y = lat, group = group, fill = cut_interval(adjusted, n = 5))) + geom_polygon(color = "lightblue", size = 0.2) + coord_map(projection = "albers", lat0 = 39, lat1 = 45) + scale_fill_brewer(type = "seq", palette = "Oranges") + kjhslides::kjh_theme_map() + facet_wrap(~ year, ncol = 4) + guides(fill = guide_legend(nrow = 1)) + theme(legend.position = "bottom", strip.background = element_blank()) + labs(fill = "Death rate per 100,000 population", title = "Opiate-Related Deaths by State, 1999-2014") ``` --- layout: false class: middle <img src="09-slides_files/figure-html/07-make-maps-46-1.png" width="1152" style="display: block; margin: auto;" /> .right.w90.small[Faceting works just as it would for any other kind of plot.] --- --- class: right bottom main-title section-title-1 ## .huge.right.bottom.squish4[.kjh-yellow[Is your data<br/ >] .kjh-lblue[really spatial?]] --- layout: true class: title title-1 --- count: false # The two leading states in each region in 2014 .panel1-reveal-maxstates-auto[ ```r ## Put this in an object called `st_top` *opiates ``` ] .panel2-reveal-maxstates-auto[ ``` ## # A tibble: 800 × 11 ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 1999 Alabama 1 37 4.43e6 0.8 0.8 0.1 South AL East S… ## 2 1999 Alaska 2 27 6.25e5 4.3 4 0.8 West AK Pacific ## 3 1999 Arizona 4 229 5.02e6 4.6 4.7 0.3 West AZ Mounta… ## 4 1999 Arkans… 5 28 2.65e6 1.1 1.1 0.2 South AR West S… ## 5 1999 Califo… 6 1474 3.35e7 4.4 4.5 0.1 West CA Pacific ## 6 1999 Colora… 8 164 4.23e6 3.9 3.7 0.3 West CO Mounta… ## 7 1999 Connec… 9 151 3.39e6 4.5 4.4 0.4 North… CT New En… ## 8 1999 Delawa… 10 32 7.75e5 4.1 4.1 0.7 South DE South … ## 9 1999 Distri… 11 28 5.70e5 4.9 4.9 0.9 South DC <NA> ## 10 1999 Florida 12 402 1.58e7 2.6 2.6 0.1 South FL South … ## # … with 790 more rows, and abbreviated variable names ¹population, ²adjusted, ## # ³adjusted_se, ⁴division_name ``` ] --- count: false # The two leading states in each region in 2014 .panel1-reveal-maxstates-auto[ ```r ## Put this in an object called `st_top` opiates |> * filter(year == max(year), * abbr != "DC") ``` ] .panel2-reveal-maxstates-auto[ ``` ## # A tibble: 50 × 11 ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 2014 Alabama 1 270 4.85e6 5.6 5.6 0.3 South AL East S… ## 2 2014 Alaska 2 76 7.37e5 10.3 10.6 1.2 West AK Pacific ## 3 2014 Arizona 4 589 6.73e6 8.7 8.8 0.4 West AZ Mounta… ## 4 2014 Arkans… 5 173 2.97e6 5.8 6.3 0.5 South AR West S… ## 5 2014 Califo… 6 2024 3.88e7 5.2 5 0.1 West CA Pacific ## 6 2014 Colora… 8 517 5.36e6 9.7 9.4 0.4 West CO Mounta… ## 7 2014 Connec… 9 525 3.60e6 14.6 15.2 0.7 North… CT New En… ## 8 2014 Delawa… 10 124 9.36e5 13.3 13.9 1.3 South DE South … ## 9 2014 Florida 12 1399 1.99e7 7 7.2 0.2 South FL South … ## 10 2014 Georgia 13 710 1.01e7 7 7 0.3 South GA South … ## # … with 40 more rows, and abbreviated variable names ¹population, ²adjusted, ## # ³adjusted_se, ⁴division_name ``` ] --- count: false # The two leading states in each region in 2014 .panel1-reveal-maxstates-auto[ ```r ## Put this in an object called `st_top` opiates |> filter(year == max(year), abbr != "DC") |> * group_by(region) ``` ] .panel2-reveal-maxstates-auto[ ``` ## # A tibble: 50 × 11 ## # Groups: region [4] ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 2014 Alabama 1 270 4.85e6 5.6 5.6 0.3 South AL East S… ## 2 2014 Alaska 2 76 7.37e5 10.3 10.6 1.2 West AK Pacific ## 3 2014 Arizona 4 589 6.73e6 8.7 8.8 0.4 West AZ Mounta… ## 4 2014 Arkans… 5 173 2.97e6 5.8 6.3 0.5 South AR West S… ## 5 2014 Califo… 6 2024 3.88e7 5.2 5 0.1 West CA Pacific ## 6 2014 Colora… 8 517 5.36e6 9.7 9.4 0.4 West CO Mounta… ## 7 2014 Connec… 9 525 3.60e6 14.6 15.2 0.7 North… CT New En… ## 8 2014 Delawa… 10 124 9.36e5 13.3 13.9 1.3 South DE South … ## 9 2014 Florida 12 1399 1.99e7 7 7.2 0.2 South FL South … ## 10 2014 Georgia 13 710 1.01e7 7 7 0.3 South GA South … ## # … with 40 more rows, and abbreviated variable names ¹population, ²adjusted, ## # ³adjusted_se, ⁴division_name ``` ] --- count: false # The two leading states in each region in 2014 .panel1-reveal-maxstates-auto[ ```r ## Put this in an object called `st_top` opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> * slice_max(order_by = adjusted, * n = 2) ``` ] .panel2-reveal-maxstates-auto[ ``` ## # A tibble: 8 × 11 ## # Groups: region [4] ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 2014 New Ham… 33 297 1.33e6 22.4 23.4 1.4 North… NH New En… ## 2 2014 Rhode I… 44 205 1.06e6 19.4 19.8 1.4 North… RI New En… ## 3 2014 Ohio 39 2106 1.16e7 18.2 19.1 0.4 Midwe… OH East N… ## 4 2014 Missouri 29 696 6.06e6 11.5 12 0.5 Midwe… MO West N… ## 5 2014 New Mex… 35 402 2.09e6 19.3 20.2 1 West NM Mounta… ## 6 2014 Utah 49 455 2.94e6 15.5 16.8 0.8 West UT Mounta… ## 7 2014 West Vi… 54 554 1.85e6 29.9 31.6 1.4 South WV South … ## 8 2014 Kentucky 21 729 4.41e6 16.5 16.8 0.6 South KY East S… ## # … with abbreviated variable names ¹population, ²adjusted, ³adjusted_se, ## # ⁴division_name ``` ] --- count: false # The two leading states in each region in 2014 .panel1-reveal-maxstates-auto[ ```r ## Put this in an object called `st_top` opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) ``` ] .panel2-reveal-maxstates-auto[ ``` ## # A tibble: 8 × 11 ## # Groups: region [4] ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 2014 New Ham… 33 297 1.33e6 22.4 23.4 1.4 North… NH New En… ## 2 2014 Rhode I… 44 205 1.06e6 19.4 19.8 1.4 North… RI New En… ## 3 2014 Ohio 39 2106 1.16e7 18.2 19.1 0.4 Midwe… OH East N… ## 4 2014 Missouri 29 696 6.06e6 11.5 12 0.5 Midwe… MO West N… ## 5 2014 New Mex… 35 402 2.09e6 19.3 20.2 1 West NM Mounta… ## 6 2014 Utah 49 455 2.94e6 15.5 16.8 0.8 West UT Mounta… ## 7 2014 West Vi… 54 554 1.85e6 29.9 31.6 1.4 South WV South … ## 8 2014 Kentucky 21 729 4.41e6 16.5 16.8 0.6 South KY East S… ## # … with abbreviated variable names ¹population, ²adjusted, ³adjusted_se, ## # ⁴division_name ``` ] <style> .panel1-reveal-maxstates-auto { color: black; width: 39.2%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel2-reveal-maxstates-auto { color: black; width: 58.8%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel3-reveal-maxstates-auto { color: black; width: NA%; hight: 33%; float: left; padding-left: 1%; font-size: 80% } </style> --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r *st_top <- opiates |> filter(year == max(year), abbr != "DC") ``` ] .panel2-reveal-opiateline-auto[ ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> * group_by(region) ``` ] .panel2-reveal-opiateline-auto[ ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> * slice_max(order_by = adjusted, n = 2) ``` ] .panel2-reveal-opiateline-auto[ ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) *opiates ``` ] .panel2-reveal-opiateline-auto[ ``` ## # A tibble: 800 × 11 ## year state fips deaths popul…¹ crude adjus…² adjus…³ region abbr divis…⁴ ## <int> <chr> <int> <int> <int> <dbl> <dbl> <dbl> <ord> <chr> <chr> ## 1 1999 Alabama 1 37 4.43e6 0.8 0.8 0.1 South AL East S… ## 2 1999 Alaska 2 27 6.25e5 4.3 4 0.8 West AK Pacific ## 3 1999 Arizona 4 229 5.02e6 4.6 4.7 0.3 West AZ Mounta… ## 4 1999 Arkans… 5 28 2.65e6 1.1 1.1 0.2 South AR West S… ## 5 1999 Califo… 6 1474 3.35e7 4.4 4.5 0.1 West CA Pacific ## 6 1999 Colora… 8 164 4.23e6 3.9 3.7 0.3 West CO Mounta… ## 7 1999 Connec… 9 151 3.39e6 4.5 4.4 0.4 North… CT New En… ## 8 1999 Delawa… 10 32 7.75e5 4.1 4.1 0.7 South DE South … ## 9 1999 Distri… 11 28 5.70e5 4.9 4.9 0.9 South DC <NA> ## 10 1999 Florida 12 402 1.58e7 2.6 2.6 0.1 South FL South … ## # … with 790 more rows, and abbreviated variable names ¹population, ²adjusted, ## # ³adjusted_se, ⁴division_name ``` ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> * ggplot(aes(x = year, * y = adjusted)) ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_05_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + * geom_line(aes(group = state), * color = "gray50") ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_06_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + geom_line(aes(group = state), color = "gray50") + * geom_smooth(aes(group = region), * se = FALSE) ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_07_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + geom_line(aes(group = state), color = "gray50") + geom_smooth(aes(group = region), se = FALSE) + * ggrepel::geom_text_repel( * data = st_top, * mapping = aes(x = year, * y = adjusted, * label = abbr), * size = 3, * segment.color = NA, * nudge_x = 0.5) ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_08_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + geom_line(aes(group = state), color = "gray50") + geom_smooth(aes(group = region), se = FALSE) + ggrepel::geom_text_repel( data = st_top, mapping = aes(x = year, y = adjusted, label = abbr), size = 3, segment.color = NA, nudge_x = 0.5) + * coord_cartesian(c(min(opiates$year), * max(opiates$year) + 1)) ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_09_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + geom_line(aes(group = state), color = "gray50") + geom_smooth(aes(group = region), se = FALSE) + ggrepel::geom_text_repel( data = st_top, mapping = aes(x = year, y = adjusted, label = abbr), size = 3, segment.color = NA, nudge_x = 0.5) + coord_cartesian(c(min(opiates$year), max(opiates$year) + 1)) + * labs(x = NULL, * y = "Rate per 100,000 population", * title = "State-Level Opiate Death * Rates by Region, 1999-2014") ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_10_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + geom_line(aes(group = state), color = "gray50") + geom_smooth(aes(group = region), se = FALSE) + ggrepel::geom_text_repel( data = st_top, mapping = aes(x = year, y = adjusted, label = abbr), size = 3, segment.color = NA, nudge_x = 0.5) + coord_cartesian(c(min(opiates$year), max(opiates$year) + 1)) + labs(x = NULL, y = "Rate per 100,000 population", title = "State-Level Opiate Death Rates by Region, 1999-2014") + * facet_wrap(~ reorder(region, adjusted, * na.rm = TRUE), * nrow = 1) ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_11_output-1.png" width="504" style="display: block; margin: auto;" /> ] --- count: false # Opiates Time Series plot .panel1-reveal-opiateline-auto[ ```r st_top <- opiates |> filter(year == max(year), abbr != "DC") |> group_by(region) |> slice_max(order_by = adjusted, n = 2) opiates |> ggplot(aes(x = year, y = adjusted)) + geom_line(aes(group = state), color = "gray50") + geom_smooth(aes(group = region), se = FALSE) + ggrepel::geom_text_repel( data = st_top, mapping = aes(x = year, y = adjusted, label = abbr), size = 3, segment.color = NA, nudge_x = 0.5) + coord_cartesian(c(min(opiates$year), max(opiates$year) + 1)) + labs(x = NULL, y = "Rate per 100,000 population", title = "State-Level Opiate Death Rates by Region, 1999-2014") + facet_wrap(~ reorder(region, adjusted, na.rm = TRUE), nrow = 1) ``` ] .panel2-reveal-opiateline-auto[ <img src="09-slides_files/figure-html/reveal-opiateline_auto_12_output-1.png" width="504" style="display: block; margin: auto;" /> ] <style> .panel1-reveal-opiateline-auto { color: black; width: 39.2%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel2-reveal-opiateline-auto { color: black; width: 58.8%; hight: 32%; float: left; padding-left: 1%; font-size: 80% } .panel3-reveal-opiateline-auto { color: black; width: NA%; hight: 33%; float: left; padding-left: 1%; font-size: 80% } </style> --- layout: false <img src="09-slides_files/figure-html/07-make-maps-48-1.png" width="1080" style="display: block; margin: auto;" /> .right.w90.small[Regional trends in opiate-related mortality.]