-
Notifications
You must be signed in to change notification settings - Fork 1
/
doc.Rmd
150 lines (135 loc) · 7.67 KB
/
doc.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
---
title: "Census 2020 by Municipality"
subtitle: ""
author: "Geoffrey Arnold"
date: " \nRan on: `r format(Sys.time(), '%a %B %d, %Y %I:%M %p', tz ='America/New_York')`"
output:
html_document:
toc: true
theme: flatly
toc_depth: 2
---
```{r setup, warning=FALSE, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, warning = FALSE, message = FALSE, fig.height = 9) # Switch this to FALSE to hide code to those who will be consuming your report
require(sf)
require(readr)
require(dplyr)
require(leaflet)
require(jsonlite)
require(tidyr)
bounds <- st_read("./tl_2020_42003_cousub20.shp")
comps_muni <- fromJSON("https://data.wprdc.org/datastore/odata3.0/fb2cb765-458c-4deb-8252-0a18d7ce9a78?$format=json")$value %>%
select(FIPS, NAME, everything()) %>%
mutate(across(contains("Percent_Change"), ~gsub("%", "", .)),
NAME = as.factor(NAME)) %>%
mutate_if(is.character, as.numeric)
race_delta <- comps_muni %>%
select(FIPS, starts_with("Percent_Change")) %>%
pivot_longer(-c(FIPS)) %>%
filter(name != "Percent_Change_2010_to_2020_Total_Population", !is.na(value))
race_grps <- race_delta %>%
group_by(FIPS) %>%
summarise(value = max(value)) %>%
left_join(race_delta) %>%
distinct(FIPS, .keep_all = TRUE) %>%
mutate(name = case_when(name == "Percent_Change_2010_to_2020_American_Indian_and_Alaska_Native_a" ~ "Native American, Alaskan Natives, Pacific Islander",
name == "Percent_Change_2010_to_2020_Hispanic_or_Latino_Population" ~ "Hispanic or Latino",
name == "Percent_Change_2010_to_2020_Asian_Alone_Population" ~ "Asian",
name == "Percent_Change_2010_to_2020_Black_Alone_Population" ~ "Black",
name == "Percent_Change_2010_to_2020_White_Alone_Population" ~ "White",
name == "Percent_Change_2010_to_2020_Population_two_or_more_races" ~ "Two or More Races",
name == "Percent_Change_2010_to_2020_Any_other_single_race_alone_Popualt" ~ "Any other single race",
name == "Percent_Change_2010_to_2020_Native_Hawaiian_and_Other_Pacific_I" ~ "Native Hawaiian and Other Pacific Islander")
) %>%
rename(MOST_GROWTH_RACE = name,
MOST_GROWTH_PERCENT = value)
final_munis <- comps_muni %>%
left_join(race_grps) %>%
mutate(FIPS = as.character(FIPS))
map <- bounds %>%
left_join(final_munis, by = c("GEOID20" = "FIPS")) %>%
mutate(`2020_Non_White` = `2020_Total_Population`- `2020_White_Alone_Population`,
`2010_Non_White` = `2010_Total_Population`- `2010_White_Alone_Population`,
Percent_Change_2020_Non_White = ((`2020_Non_White` - `2010_Non_White`) / `2010_Non_White`) * 100,
Percent_Change_2020_Non_White = na_if(Percent_Change_2020_Non_White, Inf)
)
```
## Total Population Change
```{r pop}
popChng <- colorNumeric("YlGnBu", domain = map$Percent_Change_2010_to_2020_Total_Population)
leaflet(map, width = "100%") %>%
addTiles() %>%
addPolygons(color = ~popChng(Percent_Change_2010_to_2020_Total_Population),
opacity = .75,
fillOpacity = .65,
popup = ~paste("<b>Municipality:</b>", NAME,
"<br><b>Percentage Change:</b>", Percent_Change_2010_to_2020_Total_Population, "%",
"<br><b>2020 Total Pop:</b>", prettyNum(`2020_Total_Population`, big.mark = ","),
"<br><b>2010 Total Pop:</b>", prettyNum(`2010_Total_Population`, big.mark = ","))) %>%
addLegend(pal = popChng,
values = ~Percent_Change_2010_to_2020_Total_Population,
opacity = 0.7,
title = 'Population <br>Change',
labFormat = labelFormat(suffix = "%"),
position = "bottomright")
```
## Non-White Population Change
```{r div}
divPal <- colorBin("BuPu",
bins = c(-20, 0, 40, 80, 160, 420, 840, 1300),
domain = map$Percent_Change_2020_Non_White,
)
leaflet(map, width = "100%") %>%
addTiles() %>%
addPolygons(color = ~divPal(Percent_Change_2020_Non_White),
opacity = .75,
fillOpacity = .65,
popup = ~paste("<b>Municipality:</b>", NAME,
"<br><b>2020 Total Pop:</b>", prettyNum(`2020_Total_Population`, big.mark = ","),
"<br><b>2020 Non-White Growth:</b>",round(`Percent_Change_2020_Non_White`, 2), "%",
"<br><b>2010 Non-White Pop:</b>", prettyNum(`2010_Non_White`, big.mark = ","),
"<br><b>2020 Non-White Pop:</b>", prettyNum(`2020_Non_White`, big.mark = ","),
"<ul><li>Any other single race:", prettyNum(`2020_Any_other_single_race_alone_Popualtion`, big.mark = ","),
"<li>Asian:", prettyNum(`2020_Asian_Alone_Population`, big.mark = ","),
"<li>Black:", prettyNum(`2020_Black_Alone_Population`, big.mark = ","),
"<li>Hispanic or Latino Pop:", prettyNum(`2020_Hispanic_or_Latino_Population`, big.mark = ","),
"<li>Native American, Alaskan Natives, Pacific Islander:", prettyNum(`2020_Native_Hawaiian_and_Other_Pacific_Islander_alone_Populatio`, big.mark = ","),
"<li>Native Hawaiian and Other Pacific Islander:", prettyNum(`2020_Native_Hawaiian_and_Other_Pacific_Islander_alone_Populatio`, big.mark = ","),
"<li>Two or more Races:", prettyNum(`2020_Population_two_or_more_races`, big.mark = ","),
"<li>White:", prettyNum(`2020_White_Alone_Population`, big.mark = ","),
"</ul")
) %>%
addLegend(pal = divPal,
values = ~Percent_Change_2020_Non_White,
opacity = 0.7,
title = 'Non-White Population',
labFormat = labelFormat(suffix = "%"),
position = "bottomright")
```
## Racial Group with Highest Growth Rate, by Muni
```{r race, echo=FALSE}
racialChng <- colorFactor("Set2", domain = map$MOST_GROWTH_RACE)
leaflet(map, width = "100%") %>%
addTiles() %>%
addPolygons(color = ~racialChng(MOST_GROWTH_RACE),
opacity = .75,
fillOpacity = .65,
popup = ~paste("<b>Municipality:</b>", NAME,
"<ul>",
"<li>Any other single race:", Percent_Change_2010_to_2020_Any_other_single_race_alone_Popualt, "%",
"<li>Asian", Percent_Change_2010_to_2020_Asian_Alone_Population, "%",
"<li>Black", Percent_Change_2010_to_2020_Black_Alone_Population, "%",
"<li>Hispanic or Latino", Percent_Change_2010_to_2020_Hispanic_or_Latino_Population, "%",
"<li>Native American, Alaskan Natives, Pacific Islander:", Percent_Change_2010_to_2020_American_Indian_and_Alaska_Native_a, "%",
"<li>Native Hawaiian and Other Pacific Islander:", Percent_Change_2010_to_2020_Native_Hawaiian_and_Other_Pacific_I, "%",
"<li>Two or More Races:", Percent_Change_2010_to_2020_Population_two_or_more_races, "%",
"<li>White:", Percent_Change_2010_to_2020_White_Alone_Population, "%",
"</ul>
<b>Percentage Total Change:</b>", Percent_Change_2010_to_2020_Total_Population, "%",
"<br><b>Total Pop:</b>", prettyNum(`2020_Total_Population`, big.mark = ","))) %>%
addLegend(pal = racialChng ,
values = ~MOST_GROWTH_RACE,
opacity = 0.7,
title = 'Largest Growth by Racial Group',
position = "bottomright")
```