Rendered at 01:23 PM, May. 13, 2021
Edited by Ryan Thornburg (ryan.thornburg@unc.edu)
Original reporting and analysis done by Christian Avy, Rachel Crumpler, Dominick Ferrara and Jamie Krantz, students at the University of North Carolina at Chapel Hill Hussman School of Journalism and Media working on a class project during the Fall 2020 Advanced Data Reporting class.
# Load files, environment variables, libraries, etc. here
library(tidyverse)
library(apstyle)
library(DT)
library(gsheet)
library(aptheme)
library(tigris)
library(leaflet)
library(scales)
library(viridis)
Overview
This project tracks expenditures for local health departments in North Carolina and discusses what they can tell us about each county’s preparedness for COVID-19 and other epidemic or pandemic level threats.
Starting in September, UNC students requested annual expenditure data from 1999 to the present from all 85 local health departments in the state, which serve each of the state’s 100 counties, in an effort to understand local public health spending in North Carolina. They received data from 51 local health departments, and there was some variance in the years each health department was able to provide.
After the publication of the original story in The News & Observer in January 2021, reporters from around the state, organized by the N.C. Local News Workshop at Elon University, gathered additional data. The collection now includes at least three years from 58 local health departments representing 65 counties.
Our analysis of local health department spending records represents over half of the total departments in the state. These health departments serve nearly 80% of North Carolina’s population.
Main Findings
From 2010 - 2018, nationwide spending for state public health departments has dropped by 16% per capita. The drop has been nearly twice as steep in North Carolina.
At the state level, North Carolina spent about $72 per person on public health in 2018, which is less than all but 13 other states. For every dollar spent per person on state-level public health nationally in 2010, North Carolina spent 90 cents. By 2018, North Carolina spent only 77 cents per dollar spent nationally.
Based on our analysis of 52 health departments in North Carolina, county-level spending on public health dropped 22% from 2010-2018 when adjusted for inflation, compounding the 27% spending drop at the state level over the same period. At least 46 health departments serving saw a decline in inflation-adjusted public health spending from 2010-2018.
Because the state does not keep individual health departments’ annual expenditures in one centralized location, the data in this story is the most current and complete picture about spending on local public health in the nation’s ninth most populated state.
Loading Data
This story was inspired by reporting done by the Kaiser Health News service and begins by using the data they collected and cleaned.
khn_state_public_health_agencies <- read_csv("https://raw.githubusercontent.com/khnews/2020-underfunded-under-threat-data/master/data/01-state-public-health-agencies.csv")
State Level Spending
Changes From 2010-2018
Spending on public health at the state level in North Carolina dropped by more than 27%. This is spending per capita, adjusted for inflation, between 2010 and 2018.
khn_state_public_health_agencies %>%
filter(state_code =="NC", year %in% c(2010, 2018)) %>%
select(year, expenditures_infl_per_capita) %>%
pivot_wider(names_from = "year", values_from = "expenditures_infl_per_capita", names_prefix="year") %>%
mutate(pct_change = (year2018 - year2010) / year2010)
Raw expenditures dropped about 6%.
khn_state_public_health_agencies %>%
filter(state_code =="NC", year %in% c(2010, 2018)) %>%
select(year, expenditures) %>%
pivot_wider(names_from = "year", values_from = "expenditures", names_prefix="year") %>%
mutate(pct_change = (year2018 - year2010) / year2010)
But when you adjust those raw numbers for the state’s population increase during that time, the decline goes to 13%.
khn_state_public_health_agencies %>%
filter(state_code =="NC", year %in% c(2010, 2018)) %>%
select(year, expenditures_per_capita) %>%
pivot_wider(names_from = "year", values_from = "expenditures_per_capita", names_prefix="year") %>%
mutate(pct_change = (year2018 - year2010) / year2010)
Compared to Other States
The national decline in state-level public health spending of 16%.
khn_state_public_health_agencies %>%
filter(year %in% c(2010, 2018)) %>%
#KHN excluded Missouri, Michigan, Texas and Wyoming
filter(!(state_code %in% c("MO","MI","TX","WY"))) %>%
group_by(year) %>%
summarise(total_expenditures = sum(expenditures_infl), total_pop = sum(population)) %>%
mutate(national_expenditures_infl_per_capita = total_expenditures / total_pop) %>%
select(year, national_expenditures_infl_per_capita) %>%
pivot_wider(names_from = "year", values_from = "national_expenditures_infl_per_capita", names_prefix="year") %>%
mutate(pct_change = (year2018 - year2010) / year2010)
North Carolina’s per-person spending on state-level public health declined at a higher rate than all but six states – Texas, South Carolina, Nevada, Kentucky, Arkansas and Alabama.
khn_state_public_health_agencies %>%
filter(year %in% c(2010, 2018)) %>%
select(state_code, year, expenditures_infl_per_capita) %>%
pivot_wider(names_from = "year", values_from = "expenditures_infl_per_capita", names_prefix="year") %>%
mutate(pct_change = (year2018 - year2010) / year2010) %>%
arrange(pct_change) %>%
datatable()
North Carolina state government spent about $72 per person on public health in 2018, which is less than all but 13 other states.
khn_state_public_health_agencies %>%
filter(!(state_code %in% c("MO", "MI", "TX", "WY"))) %>%
#KHN excluded Missouri, Michigan, Texas and Wyoming
filter(year == 2018) %>%
select(state_code, expenditures_infl_per_capita) %>%
arrange(expenditures_infl_per_capita)%>%
datatable(options = list(pageLength = 15))
Ten years ago, North Carolina spent just over $100 per person and ranked 12 places higher compared to other states.
khn_state_public_health_agencies %>%
filter(!(state_code %in% c("MO", "MI", "TX", "WY"))) %>%
#KHN excluded Missouri, Michigan, Texas and Wyoming
filter(year == 2010) %>%
select(state_code, expenditures_infl_per_capita) %>%
arrange(expenditures_infl_per_capita)%>%
datatable(options = list(pageLength = 50))
Local Health Department Spending in N.C.
In the fall of 2020, UNC students requested expenditures from all 85 local health department in North Carolina. They entered the data in a spreadsheet that matches the format of the Kaiser Health News expenditure data.
The definition of expenditures on public health differ from year to year and from county to county. For example, some counties include veterans services in their public health budget while others do not. For this reporting, we used whatever definition each county used either in its budget or financial statements posted online or in their response to our request for public health expenditures.
Local expenditures on public health here include not just funding that comes directly from county governments. It also includes funding that comes from federal and state sources that are administered by local health departments. Including all these sources is standard practice nationally.
If there was any question about which spending to include or exclude, we used the Financial Statement Template for Districts of Health provided by the N.C. state Treasurer at https://www.nctreasurer.com/state-and-local-government-finance-division/local-government-commission/other-units-financial-statement-resources to guide us.
CompiledLHDExpenditures <- gsheet2tbl("https://docs.google.com/spreadsheets/d/1Zc10pam92Y1218F90eXn9ri7-a4GQI1vhzING33nNSI/edit#gid=0") %>%
select(1:5)
The UNC students received data from 51 local health departments representing 56 counties, and there was some variance in the years each health department was able to provide.
After the publication of the original story in The News & Observer in January 2021, reporters from around the state, organized by the N.C. Local News Workshop at Elon University, gathered additional data. The collection now includes at least three years from 58 local health departments representing 65 counties
CompiledLHDExpenditures %>%
group_by(lhd_name, county_name) %>%
summarize(years_provided = n()) %>%
arrange(lhd_name) %>%
datatable()
The students originally collected 46 health departments that provided full data spanning from 2010-2018. The collection now contains 52 health departments that provided data for every year from 2010-2018.
CompiledLHDExpenditures %>% filter(year >=2010, year<=2018) %>%
pivot_wider(id_cols = lhd_name, names_from = year, values_from = expenditures, names_prefix = "year") %>%
filter(!is.na(year2010),
!is.na(year2011),
!is.na(year2012),
!is.na(year2013),
!is.na(year2014),
!is.na(year2015),
!is.na(year2016),
!is.na(year2017),
!is.na(year2018)) %>%
arrange(lhd_name) %>%
datatable()
Annual opulation estimates for each county comes from the website of the State Demographer. Most recent year is 2018.
county_pop <- read_delim("https://linc.osbm.nc.gov/explore/dataset/census-population-and-housing-linc/download/?format=csv&disjunctive.area_name=true&disjunctive.year=true&disjunctive.variable=true&refine.area_type=County&refine.variable=Population+Estimate+(BEA+per+Capita+Denominator)&timezone=America/New_York&lang=en&use_labels_for_header=true&csv_separator=%3B",
";", escape_double = FALSE, col_types = cols_only(`Area Name` = col_character(),
Year = col_double(), Value = col_double()),
trim_ws = TRUE) %>%
rename(county_name = `Area Name`, year = `Year`)
county_pop$county_name <- str_sub(county_pop$county_name, end = -8)
county_pop<- county_pop %>%
filter(county_name %in% c("Granville","Vance")) %>%
group_by(year) %>%
summarise(Value=sum(Value)) %>%
mutate(county_name = "Granville & Vance") %>%
select(county_name, year, Value) %>%
union_all(county_pop)
county_pop<- county_pop %>%
filter(county_name %in% c("Avery", "Mitchell", "Yancey")) %>%
group_by(year) %>%
summarise(Value=sum(Value)) %>%
mutate(county_name = "Avery, Mitchell & Yancey") %>%
select(county_name, year, Value) %>%
union_all(county_pop)
county_pop<- county_pop %>%
filter(county_name %in% c("Martin", "Tyrrell", "Washington")) %>%
group_by(year) %>%
summarise(Value=sum(Value)) %>%
mutate(county_name = "Martin, Tyrrell & Washington") %>%
select(county_name, year, Value) %>%
union_all(county_pop)
county_pop<- county_pop %>%
filter(county_name %in% c("Camden", "Chowan", "Currituck", "Bertie", "Gates", "Hertford","Pasquotank", "Perquimans")) %>%
group_by(year) %>%
summarise(Value=sum(Value)) %>%
mutate(county_name = "Camden, Chowan, Currituck, Bertie, Gates, Hertford,Pasquotank, Perquimans") %>%
select(county_name, year, Value) %>%
union_all(county_pop)
county_pop<- county_pop %>%
filter(county_name %in% c("Alleghany", "Ashe", "Watauga")) %>%
group_by(year) %>%
summarise(Value=sum(Value)) %>%
mutate(county_name = "Alleghany, Ashe, Watauga") %>%
select(county_name, year, Value) %>%
union_all(county_pop)
county_pop<- county_pop %>%
filter(county_name %in% c("Rutherford", "Polk", "McDowell")) %>%
group_by(year) %>%
summarise(Value=sum(Value)) %>%
mutate(county_name = "Rutherford, Polk, McDowell") %>%
select(county_name, year, Value) %>%
union_all(county_pop)%>%
rename(population=Value)
CompiledLHDExpenditures<- left_join(CompiledLHDExpenditures, county_pop, c("county_name" = "county_name", "year" = "year"))
These health departments serve about 80% of North Carolina’s population.
CompiledLHDExpenditures %>%
filter(year==2018) %>%
select(population) %>%
summarize(pct_total_pop = sum(population) / 10389148) #2018 pop. from State Demographer
LHD Per Capita Spending
CompiledLHDExpenditures <-
CompiledLHDExpenditures %>%
filter(!is.na(population), !is.na(expenditures)) %>%
mutate(expenditures_per_capita = expenditures / population)
CompiledLHDExpenditures %>%
select(year, lhd_name, county_name, expenditures_per_capita) %>%
datatable()
Inflation rates
In its reporting, Kaiser Health News inflation-adjusted all financial data to 2019 using the Bureau of Economic Analysis’ “Government consumption expenditures and gross investment: State and local - implicit price deflator.”
Because this index itself is adjusted periodically, we simply reverse engineered inflation rates from the KHN data so that the data in our story could be used to make apples-to-apples comparisons with the original KHN data.
infl_rates <-
khn_state_public_health_agencies %>%
filter(!is.na(expenditures), !is.na(expenditures_infl),) %>%
group_by(year) %>%
summarize(total_raw = max(expenditures, na.rm=TRUE), total_infl = max(expenditures_infl, na.rm=TRUE)) %>%
mutate(multiplier2019 = total_infl/ total_raw)
#Ugh. Have to hand-code two years
infl_rates <- infl_rates %>%
add_row(year = 2012, multiplier2019 = 114.969 / 100) %>%
add_row(year = 2013, multiplier2019 = 114.969 / 103.279)
infl_rates %>%
select(year, multiplier2019) %>%
arrange(year)
Using the infl_rates data to create a new dataframe of all LHD expenditures, adjusted for inflation.
CompiledLHDExpenditures <-
left_join(CompiledLHDExpenditures, infl_rates, by=c("year"="year")) %>%
mutate(expenditures_infl = expenditures * multiplier2019,
expenditures_infl_per_capita = expenditures_infl / population) %>%
select(year, lhd_name, lhd_area_type, county_name, population, expenditures, expenditures_infl, expenditures_per_capita, expenditures_infl_per_capita)
infl_nc_county_by_year <- CompiledLHDExpenditures %>%
filter(year >=2010, year<=2018) %>%
pivot_wider(id_cols = county_name, names_from = year, values_from = expenditures_infl_per_capita, names_prefix = "year") %>%
arrange(county_name)
infl_nc_county_by_year %>% datatable()
plotly::ggplotly(
ggplot(filter(CompiledLHDExpenditures,year>=2010, year<=2019),
aes(x=year,
y=expenditures_infl_per_capita,
group=lhd_name,
color=lhd_name)) +
geom_line() +
scale_y_continuous()+
scale_fill_viridis(discrete = TRUE) +
theme(legend.position="none") +
ggtitle("Trends in Per Capita Local Health Department Expenditures") +
theme_ap() +
theme(
legend.position="none",
panel.spacing = unit(0.1, "lines"),
strip.text.x = element_text(size = 8),
plot.title = element_text(size=14)
)
)
County-level spending on public health dropped 22% from 2010-2018 when adjusted for inflation and population increase.
CompiledLHDExpenditures %>%
filter(year %in% c(2010,2018)) %>%
group_by(year) %>%
summarise(annual_lhd_total_capita = sum(expenditures_infl) / sum(population)) %>%
pivot_wider(names_from = "year", values_from = "annual_lhd_total_capita", names_prefix="year") %>%
mutate(pct_change = (year2018 - year2010) / year2010)
At least 46 health departments saw a decline in public health spending from 2010-2018 when adjusted for inflation and population increase.
CompiledLHDExpenditures%>%
filter(year %in% c('2010', '2018')) %>%
pivot_wider(id_cols = 1:4, names_from = year, values_from = expenditures_infl_per_capita, names_prefix = "year") %>%
mutate(pct_change = ((year2018 - year2010)) / year2010) %>%
select(lhd_name, year2010, year2018, pct_change)%>%
filter(pct_change < 0) %>%
arrange(pct_change)
Local Health Department Staffing in N.C.
Data comes via Kaiser Health News compilation of data in "Local Health Department Staffing and Services Summary Fiscal Year 2016–2017, published by the N.C. Department of Health and Human Services’s State Center for Health Statistics. This is the most recent year available for the report, which has been conducted since 1984. It is typically conducted every two years.
From 2009-2017, 62 of the 85 local health departments’ reported to the state DHHS that their full-time staff decreased.
khn_nc_lhd_fte <- read_csv("https://raw.githubusercontent.com/khnews/2020-underfunded-under-threat-data/master/data/05-local-health-departments-detail.csv",
col_types = cols(fips_place = col_character(),
fips_counties = col_character(),
lhd_note = col_character())) %>%
filter(state_code=="NC")
khn_nc_lhd_fte %>%
filter(year %in% c('2009', '2017')) %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = ((fte2017 - fte2009)) / fte2009) %>%
select(lhd_name, fte2009, fte2017, pct_change)%>%
arrange(pct_change)
The average change in staff across all 85 departments was a decrease of nearly 15%.
khn_nc_lhd_fte %>%
filter(year %in% c('2009', '2017')) %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = ((fte2017 - fte2009)) / fte2009) %>%
summarize(mean(pct_change))
Thirteen health departments reported to the state DHHS that their staffing drop by more than a third over the time period.
khn_nc_lhd_fte %>%
filter(year %in% c('2009', '2017')) %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = ((fte2017 - fte2009)) / fte2009) %>%
select(lhd_name, fte2009, fte2017, pct_change)%>%
filter(pct_change < -0.34) %>%
arrange(pct_change)
Wake County divested its mental health programs, leading to a 25% reduction in full-time equivalent staff between 2011 and 2013.
khn_nc_lhd_fte %>%
filter(year %in% c('2011', '2013'), county_name=="Wake County") %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = ((fte2013 - fte2011)) / fte2011) %>%
select(lhd_name, fte2011, fte2013, pct_change)
Data from 2017 shows that Wake County had returned to 95% of its 2011 staffing.
khn_nc_lhd_fte %>%
filter(year %in% c('2011', '2017'), county_name=="Wake County") %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_of_2011 = fte2017/fte2011) %>%
select(lhd_name, fte2011, fte2017, pct_of_2011)
Toe River Health District sold its home health program in 2015, leading to nearly a 62% drop in full-time equivalent employees between 2013 and 2017.
khn_nc_lhd_fte %>%
filter(year %in% c('2013', '2017'), lhd_name=="Toe River District") %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = ((fte2017 - fte2013)) / fte2013) %>%
select(lhd_name, fte2013, fte2017, pct_change)
Hyde County sold its home health program in 2016, causing it to lose 30% of its full-time equivalent employees.
khn_nc_lhd_fte %>%
filter(year %in% c('2013', '2017'), county_name=="Hyde County") %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = ((fte2017 - fte2013)) / fte2013) %>%
select(lhd_name, fte2013, fte2017, pct_change)
Data Viz
infl_nc_county_by_year %>%
filter(!is.na(year2010)) %>%
mutate(pct_change = (year2018 - year2010) / year2010) %>%
ggplot(
aes(x=pct_change, y=fct_reorder(county_name, pct_change))) +
geom_segment(
aes(x=0,
y=fct_reorder(county_name,pct_change),
xend= pct_change,
yend=fct_reorder(county_name, pct_change)),
color="gray50")+
geom_point(color="#1d91c0")+
labs(x="Percent Change in Per Capita Spending", y="County Health Department",
title = "Percent Change in Per Capita Spending from 2010-2018",
caption = "Data Source: County Finance Records (Did not receive data from 34 health departments)") +
theme_minimal()+
theme(panel.border = element_blank(),
panel.grid.minor = element_blank()
)
khn_nc_lhd_fte %>%
filter(year %in% c('2009', '2017')) %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = (fte2017 - fte2009) / fte2009) %>%
ggplot(
aes(x=pct_change, y=fct_reorder(lhd_name, pct_change))) +
geom_segment(
aes(x=0,
y=fct_reorder(lhd_name,pct_change),
xend= pct_change,
yend=fct_reorder(lhd_name, pct_change)),
color="gray50")+
geom_point(color="#1d91c0")+
labs(x="Percent Change in FTEs", y="County Health Department",
title = "Percent Change in Number of FTEs from 2007-2017",
caption = "Data Source: KHN FTE Dataset") +
scale_x_continuous(labels = scales::percent) +
theme_minimal()+
theme(panel.border = element_blank(),
panel.grid.minor = element_blank(),
plot.title = element_text(hjust = 3)
)
Map
Change in Per-Capita Spending, Adjusted for Inflation
Click on one of the health districts to see additional information – the change in population, change in inflation-adjusted expenditures and changes in FTE.
#Downloading shapefile of NC counties
options(tigris_use_cache = TRUE)
nc_counties <- counties("NC")
##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 22%
|
|================ | 23%
|
|================ | 24%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|============================== | 44%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 49%
|
|=================================== | 50%
|
|=================================== | 51%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|=================================================== | 74%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%
#First, pivot the infl_CompiledLHDExpenditures on multiple columns ...
change_infl_CompiledLHDExpenditures <-
#Add populations for counties that didn't have them before ...
left_join(county_pop, CompiledLHDExpenditures, c("county_name" = "county_name", "year" = "year")) %>%
#get just the years we want ...
filter(year %in% c(2010, 2018)) %>%
#... and just the columns we want to deal with. (I'm actually taking more than I need in case I want to calculate percent change for these other columns later.)
dplyr::select(year,
county_name,
population = population.x,
expenditures,
expenditures_infl,
expenditures_per_capita,
expenditures_infl_per_capita) %>%
pivot_wider(
#This next line says make every row a unique county.
id_cols = county_name,
#this next line looks normal, but it just becomes *part* of the column names when we combine it with...
names_from = year,
#multiple column names in the values_from variable. Each of the new columns will be a combination of the "year" and then each of these variable names...
values_from =c(population, expenditures,
expenditures_infl,
expenditures_per_capita,
expenditures_infl_per_capita)
)
#Now we calculate the percentage changes...
change_infl_CompiledLHDExpenditures<- change_infl_CompiledLHDExpenditures %>%
mutate(
pct_change_expenditures_infl = (expenditures_infl_2018 - expenditures_infl_2010)/ expenditures_infl_2010,
pct_population_change = (population_2018 - population_2010) / population_2010,
pct_change_expenditures_capita_infl = (expenditures_infl_per_capita_2018 - expenditures_infl_per_capita_2010) / expenditures_infl_per_capita_2010
)
nc_fte_change<- khn_nc_lhd_fte %>%
filter(year %in% c('2009', '2017')) %>%
pivot_wider(id_cols = -c(fte_per_100000, population), names_from = year, values_from = fte, names_prefix = "fte") %>%
mutate(pct_change = (fte2017 - fte2009) / fte2009) %>%
select(1:6,8:9,15:17)
nc_fte_change$county_name <- str_sub(nc_fte_change$county_name, end = -8)
nc_fte_change <- nc_fte_change %>% mutate(multi_county_name = case_when(
lhd_name == "Albemarle Regional Health Services" ~ "Camden, Chowan, Currituck, Bertie, Gates, Hertford,Pasquotank, Perquimans",
lhd_name == "Appalachian District Health Department" ~ "Alleghany, Ashe, Watauga",
lhd_name == "Toe River District" ~ "Avery, Mitchell & Yancey",
lhd_name == "Martin Tyrrell Washington District" ~ "Martin, Tyrrell & Washington",
lhd_name == "Granville-Vance District Health Department" ~ "Granville & Vance",
lhd_name == "Rutherford-Polk-McDowell District" ~ "Rutherford, Polk, McDowell",
TRUE ~ county_name)
)
#Next, join the two dataframes. Each row is unique by year and county, so we need to use both fields to join. The "nc" dataframe needs to be on the left because it is the only one of the two that has all counties.
a_MappingData<- left_join(nc_fte_change, change_infl_CompiledLHDExpenditures, by=c("multi_county_name" = "county_name"))
#Let's clean up some column names
a_MappingData<- a_MappingData %>%
rename (fte_pct_change = pct_change
) %>%
#and just reorder some columns rather than delete them.
select(county_name,
lhd_name,
multi_county_name,
fte_pct_change,
#Note: Unlike the lollipop charts, these changes are not per capita. Instead we note the population change separately.
pct_change_expenditures_infl,
pct_population_change,
everything())
new_lhd_polygons <- nc_counties %>% mutate(multi_county_name = case_when(
NAME %in% c("Camden","Pasquotank", "Perquimans", "Chowan", "Currituck", "Bertie", "Gates", "Hertford") ~ "Camden, Chowan, Currituck, Bertie, Gates, Hertford,Pasquotank, Perquimans",
NAME %in% c("Alleghany", "Ashe", "Watauga") ~ "Alleghany, Ashe, Watauga",
NAME %in% c("Avery", "Mitchell", "Yancey") ~ "Avery, Mitchell & Yancey",
NAME %in% c("Martin", "Tyrrell", "Washington") ~"Martin, Tyrrell & Washington",
NAME %in% c("Granville", "Vance") ~ "Granville & Vance",
NAME %in% c("Rutherford", "Polk", "McDowell") ~ "Rutherford, Polk, McDowell",
TRUE ~ NAME)
) %>%
group_by(multi_county_name) %>%
summarize()
new_lhd_polygons <- left_join(new_lhd_polygons, a_MappingData, by="multi_county_name")
#Leaflet map where health districts get filled in
# Creating a color palette based on the number range in the pct_change column
pal <- colorNumeric("YlGnBu", domain = (new_lhd_polygons$pct_change_expenditures_capita_infl * 100))
# Setting up the pop up text
popup_pctchange <- paste0(
"The population served by the <strong>", new_lhd_polygons$lhd_name,
"</strong> changed ", as.character(
percent(new_lhd_polygons$pct_population_change, accuracy = 1)
),
" while the inflation-adjusted expenditures changed ",
as.character(
percent(new_lhd_polygons$pct_change_expenditures_infl, accuracy = 1)
),
" and the number of FTEs changed ",
as.character(
percent(new_lhd_polygons$fte_pct_change, accuracy = 1)
)
)
leaflet() %>%
addProviderTiles("CartoDB.Positron") %>%
setView(lng=-79.177556, lat=35.481333, zoom = 6) %>%
addPolygons(data = new_lhd_polygons,
fillColor = ~pal(new_lhd_polygons$pct_change_expenditures_capita_infl *100),
fillOpacity = 0.9,
weight = 0.2,
smoothFactor = 0.2,
highlight = highlightOptions(
weight = 5,
color = "#666",
fillOpacity = 0.7,
bringToFront = TRUE),
popup = ~ popup_pctchange) %>%
addLegend(pal = colorNumeric("YlGnBu", domain = (new_lhd_polygons$pct_change_expenditures_capita_infl * 100), reverse =TRUE) ,
opacity = 0.9,
values = new_lhd_polygons$pct_change_expenditures_capita_infl * 100,
position = "bottomleft",
title = "$ per capita",
labFormat = labelFormat(suffix = "%", transform = function(x) sort(x, decreasing = TRUE)),
na.label = "No Data")
#Saving map as html file
#-> final_map
#library("htmlwidgets")
#saveWidget(final_map, file="final_map.html")
References
# Leave this block of code at the end of the file
# If a test fails it will stop the Rmd document from knitting
# Run tests like so:
# source("tests/etl_test.R")