# Loading
library(ggplot2)
library(sf)
## Linking to GEOS 3.12.1, GDAL 3.8.4, PROJ 9.3.1; sf_use_s2() is TRUE
library(tigris)
## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.
library(leaflet)
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.2 ✔ tidyr 1.3.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(tmap)
## Breaking News: tmap 3.x is retiring. Please test v4, e.g. with
## remotes::install_github('r-tmap/tmap')
# Load the data
data(kcwDisabled)
## Warning in data(kcwDisabled): data set 'kcwDisabled' not found
kcwDisabled<-read.csv("C:/Users/dejmo/OneDrive/Documents/URP Cert/URP 5363- Planning Methods I/Project 1/Data/disability characteristics - data2.csv")
kwc_tracts <- tracts(state = "WA", county = "King", cb = TRUE, class = "sf")
## Retrieving data for the year 2022
## | | | 0% | |= | 1% | |==== | 5% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======== | 12% | |=========== | 16% | |================== | 26% | |==================== | 28% | |======================== | 34% | |======================================================================| 100%
# 1. The US Census Bureau’s 2022 ACS 5-Year estimates the percentage of disabled residents in King County, WA residents is 10% . Per this Census data, 225,134 out of 2,240,808 King County, WA residents have a disability; 107,934 are males and 117,200 are females. Using the Census 2022 ACS Disability Characteristic data, the following questions are posed:
var <- c(poptotal='S1810_C01_001E',
dis_poptotal='S1810_C02_001E',
dis_poptotal_male='S1810_C02_002E',
dis_poptotal_female='S1810_C02_003E',
dis_poptotal_vision='S1810_C02_029E',
dis_poptotal_ambulatory='S1810_C02_047E')
#S1810_C01_001E Estimate!!Total!!Total civilian noninstitutionalized population
#'S1810_C02_001E Estimate!!With a disability!!Total civilian noninstitutionalized population'
#'S1810_C02_002E Estimate!!With a disability!!Total civilian noninstitutionalized population!!SEX!!Male'
#'S1810_C02_003E Estimate!!With a disability!!Total civilian noninstitutionalized population!!SEX!!Female'
#'S1810_C02_029E Estimate!!With a disability!!Total civilian noninstitutionalized population!!DISABILITY TYPE BY DETAILED AGE!!With a vision difficulty'
#'S1810_C02_047E Estimate!!With a disability!!Total civilian noninstitutionalized population!!DISABILITY TYPE BY DETAILED AGE!!With an ambulatory difficulty
names(kcwDisabled)[3] <- "All_Pop"
kcwDisabled$S1810_C01_001E <- NULL
names(kcwDisabled)[141] <- "Dis_Pop"
kcwDisabled$S1810_C02_001E <- NULL
# a. What is King County, WA’s median number of disabled residents based on census tract?
median_Dis_Pop <- median(kcwDisabled$Dis_Pop)
# b. What census tract has the highest disabled population?
max_Dis_Pop <- max(kcwDisabled$Dis_Pop)
# c. What census tract has the lowest disabled population?
min_Dis_Pop <- min(kcwDisabled$Dis_Pop)
# d. What is King County, WA’s mean number of disabled male residents based on census tract?
names(kcwDisabled)[143] <- "Dis_Pop_Male"
kcwDisabled$S1810_C02_002E <- NULL
mean_Dis_Pop_Male <- mean(kcwDisabled$Dis_Pop_Male)
# e. What is King County, WA’s mean number of disabled female residents based on census tract?
names(kcwDisabled)[145] <- "Dis_Pop_Female"
kcwDisabled$S1810_C02_003E <- NULL
mean_Dis_Pop_Female <- mean(kcwDisabled$Dis_Pop_Female)
# 2. The US Census categorizes disabilities into the following difficulty types: hearing, vision, cognitive, ambulatory, self-care, and independent living. For the intents of this project, the focus will be on vision and ambulatory difficulties as these two disability types experience the most mobility challenges due to natural and built physical barriers. Per the US Census Bureau’s 2022 ACS 5-Year estimates the number of vision disabled residents in King County, WA residents is 37,152 and 100,007 residents have an ambulatory disability. Using the Census 2022 ACS Disability Characteristic data, the following questions are posed:
#Vision Disability
names(kcwDisabled)[197] <- "Dis_Pop_Vis"
kcwDisabled$S1810_C02_029E <- NULL
# a. What is King County, WA’s median number of vision disabled residents based on census tract?
median_Dis_Pop_Vis <- median(kcwDisabled$Dis_Pop_Vis)
# b. What census tract has the highest vision disabled population?
max_Dis_Pop_Vis <- max(kcwDisabled$Dis_Pop_Vis)
# c. What census tract has the lowest vision disabled population?
min_Dis_Pop_Vis <- min(kcwDisabled$Dis_Pop_Vis)
#Ambulatory Disability
names(kcwDisabled)[233] <- "Dis_Pop_Amb"
kcwDisabled$S1810_C02_047E <- NULL
# d.. What is King County, WA’s median number of ambulatory disabled residents based on census tract?
median_Dis_Pop_Amb <- median(kcwDisabled$Dis_Pop_Amb)
# e. What census tract has the highest ambulatory disabled population?
max_Dis_Pop_Amb <- max(kcwDisabled$Dis_Pop_Amb)
# f. What census tract has the lowest ambulatory disabled population?
min_Dis_Pop_Amb <- min(kcwDisabled$Dis_Pop_Amb)
#======================================================================
# Select relevant columns from kcwDisabled
df_kcwDisabled <- kcwDisabled[, c(1,2,3,141,143,145,197,233)]
#======================================================================
# Basic scatter plot
ggplot(df_kcwDisabled, aes(x = Dis_Pop, y =All_Pop )) +
geom_point()
#======================================================================
# Basic box plot from data frame
ggplot(df_kcwDisabled, aes(x = Dis_Pop, y =)) +
geom_boxplot()
#======================================================================
#basic histogram from data frame
ggplot(df_kcwDisabled, aes(x = Dis_Pop, )) +
geom_histogram()
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
#======================================================================
#basic density plot from data frame
ggplot(df_kcwDisabled, aes(x = Dis_Pop)) +
geom_density()
#=====================================================================
# Cumulative density plot (ECDF) for King County, WA disabled population
ggplot(df_kcwDisabled, aes(x = Dis_Pop, color = All_Pop)) +
stat_ecdf(geom = "step")
## Warning: The following aesthetics were dropped during statistical transformation:
## colour.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
ggplot(df_kcwDisabled, aes(x = Dis_Pop_Vis, y = Dis_Pop_Amb)) +
geom_point()+
labs(x = "Total Vision Disabled", y = "Total Ambulatory Disabled")
#======================================================================
# What is King County, WA's disabled population prediction between 2025 and 2030?
x <- c(2014,2015,2016,2017,2018,2019,2020,2021,2022,2023) #year
y <- c(208, 196, 207, 210, 211, 215,216,216,235,238) #thousand persons
#create a scatterplot of x vs. y
plot(x, y, pch=19, xlab='x', ylab='y')
#fit a linear model
poly.lm1 <- lm(y ~ poly(x, 1))
poly.lm2 <- lm(y ~ poly(x, 2))
poly.lm3 <- lm(y ~ poly(x, 3))
# To predict y for new x-values, make a data.frame:
new.x <- c(2024,2025,2026,2027,2028,2029,2030)
new.df <- data.frame(x=new.x)
new.y <- predict(poly.lm1, newdata=new.df)
new.y <- predict(poly.lm2, newdata=new.df)
new.y <- predict(poly.lm3, newdata=new.df)
#add curve of each model to plot
x_axis <- seq(2014, 2023, length=50)
lines(x_axis, predict(poly.lm1, data.frame(x=x_axis)), col='green')
lines(x_axis, predict(poly.lm2, data.frame(x=x_axis)), col='red')
lines(x_axis, predict(poly.lm3, data.frame(x=x_axis)), col='purple')
#======================================================================
#OLS Regression
# Fit an OLS regression model using tidyverse's pipeline
df_kcwDisabled %>%
lm(Dis_Pop ~ Dis_Pop_Vis + Dis_Pop_Amb, data = .) %>%
summary()
##
## Call:
## lm(formula = Dis_Pop ~ Dis_Pop_Vis + Dis_Pop_Amb, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -330.00 -67.20 -11.69 52.08 473.73
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 135.63373 8.59267 15.79 <2e-16 ***
## Dis_Pop_Vis 0.90768 0.07671 11.83 <2e-16 ***
## Dis_Pop_Amb 1.24264 0.04072 30.52 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 103 on 492 degrees of freedom
## Multiple R-squared: 0.7985, Adjusted R-squared: 0.7977
## F-statistic: 975.1 on 2 and 492 DF, p-value: < 2.2e-16
# Visualize the relationship between variables using ggplot2
df_kcwDisabled %>%
ggplot(aes(x = Dis_Pop_Vis, y = Dis_Pop)) +
geom_point() +
geom_smooth(method = "lm", col = "blue") +
ggtitle("Vision Difficulty vs. Total Disabled Population with Regression Line")
## `geom_smooth()` using formula = 'y ~ x'
df_kcwDisabled %>%
ggplot(aes(x = Dis_Pop_Amb, y = Dis_Pop)) +
geom_point() +
geom_smooth(method = "lm", col = "red") +
ggtitle("Ambulatory Difficulty vs. Total Disabled Population with Regression Line")
## `geom_smooth()` using formula = 'y ~ x'
#=======================================================================
# Per census tract, what percentage of disabled residents in King County, WA live in poverty and how does this compare to overall poverty concentration of all King County, WA residents?
library(tidycensus)
census_var <- load_variables(2022, 'acs5', cache = TRUE)
king_tracts<- tracts(state = "WA", county = "King")
## Retrieving data for the year 2022
## | | | 0% | |= | 1% | |== | 2% | |=== | 5% | |===== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |======= | 9% | |======= | 11% | |======== | 11% | |=============== | 21% | |================= | 24% | |================= | 25% | |================== | 25% | |=================== | 27% | |==================== | 28% | |===================== | 31% | |====================== | 32% | |======================= | 33% | |======================== | 35% | |=========================== | 38% | |============================= | 41% | |============================== | 42% | |==================================== | 52% | |====================================== | 54% | |======================================= | 56% | |========================================= | 58% | |=========================================== | 61% | |============================================ | 63% | |============================================== | 66% | |================================================= | 70% | |=================================================== | 73% | |===================================================== | 75% | |========================================================== | 82% | |============================================================== | 89% | |================================================================ | 92% | |================================================================== | 94% | |==================================================================== | 97% | |======================================================================| 100%
tm_shape(king_tracts) +
tm_borders("gray60", lwd = 0.8) + # Plot the county borders in gray
tm_layout(frame = FALSE) # Remove the frame around the map
# polygons
var <- c(poptotal='B01003_001',
disabled_poverty='B23024_001',
poverty='B17001_001')
#'B01003_001' Estimate!!Total Total Population
#'B23024_001 Estimate!!Total: Poverty Status in the Past 12 Months by Disability Status by
#'B17017_002 Estimate!!Total:!!Income in the past 12 months below poverty...Poverty Status in the Past 12 Months by Household Type by
cbg <- get_acs(geography = "block group", variables = var, county="King",
state = "WA",output="wide", year = 2022, geometry = TRUE)
## Getting data from the 2018-2022 5-year ACS
## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
## | | | 0% | |= | 1% | |== | 3% | |====== | 9% | |======== | 11% | |=========== | 16% | |============== | 20% | |=================== | 27% | |===================== | 31% | |========================= | 36% | |============================== | 43% | |======================================== | 58% | |=========================================== | 61% | |================================================= | 70% | |===================================================== | 76% | |======================================================== | 80% | |======================================================================| 100%
# Disabled Poverty Percentage calculation and Map
cbg <- cbg %>%
mutate(dis_poverty_pct = ifelse(poptotalE > 0, disabled_povertyE / poptotalE, NA))
head(cbg)
## Simple feature collection with 6 features and 9 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -122.5117 ymin: 47.44731 xmax: -122.1461 ymax: 47.73416
## Geodetic CRS: NAD83
## GEOID NAME
## 1 530330277014 Block Group 4; Census Tract 277.01; King County; Washington
## 2 530330005001 Block Group 1; Census Tract 5; King County; Washington
## 3 530330079011 Block Group 1; Census Tract 79.01; King County; Washington
## 4 530330236031 Block Group 1; Census Tract 236.03; King County; Washington
## 5 530330084021 Block Group 1; Census Tract 84.02; King County; Washington
## 6 530330220031 Block Group 1; Census Tract 220.03; King County; Washington
## poptotalE poptotalM disabled_povertyE disabled_povertyM povertyE povertyM
## 1 977 345 437 250 NA NA
## 2 2042 371 954 222 NA NA
## 3 1670 392 1373 330 NA NA
## 4 1397 382 835 245 NA NA
## 5 892 244 811 250 NA NA
## 6 1301 321 861 233 NA NA
## geometry dis_poverty_pct
## 1 MULTIPOLYGON (((-122.5117 4... 0.4472876
## 2 MULTIPOLYGON (((-122.3764 4... 0.4671890
## 3 MULTIPOLYGON (((-122.3128 4... 0.8221557
## 4 MULTIPOLYGON (((-122.1593 4... 0.5977094
## 5 MULTIPOLYGON (((-122.3268 4... 0.9091928
## 6 MULTIPOLYGON (((-122.2019 4... 0.6617986
# Remove empty geometries
cbg <- cbg[!st_is_empty(cbg), ]
# First map with thicker frame and legend on the left-bottom
tm_shape(cbg) +
tm_polygons(col = "dis_poverty_pct") + # Fill polygons based on the 'poverty_pct' variable
tm_layout(frame.lwd = 3, # Make the frame line width thicker
legend.position = c("left", "bottom")) # Position the legend in the bottom-left corner
tm_shape(cbg) +
tm_polygons(col = "dis_poverty_pct") + # Use the 'poverty_pct' variable for color
tm_layout(legend.position = c("center", "bottom"), # Center the legend at the bottom of the map
legend.outside = TRUE, # Place the legend outside the map boundaries
legend.outside.position = "right") + # Set the legend to appear on the right side outside the map
tm_layout(frame = FALSE)+ # Remove the frame around the map
tm_compass(type = "8star", position = c("right", "top"), size = 2)+ # Add a north arrow at the top left
tm_scale_bar(position = c("left", "bottom")) # Add a scale bar at the bottom left
# Switch to interactive mode for the maps
tmap_mode("view") # Enable interactive map visualization mode (zoom, pan, etc.)
## tmap mode set to interactive viewing
tm_shape(cbg) +
tm_polygons(col = "dis_poverty_pct") + # Visualize 'poverty_pct' data
tm_layout(legend.position = c("center", "bottom"), # Place the legend at the center-bottom
legend.outside = TRUE, # Legend placed outside the map
legend.outside.position = "right") # Right side outside the map
## legend.postion is used for plot mode. Use view.legend.position in tm_view to set the legend position in view mode.
# Summary: The original intent of my analysis was to determine if King County, WA is a livable community for disabled individuals, specifically if Seattle, WA is easy to navigate for those with vision and mobility difficulties. Through this first project, my focus was obtaining disabled demographic data and trying to understand the make up and concentration of King County, WA's disabled population. As part of this project, it was also important to determine how prevalent poverty exists within this group of people as this can pose mobility challenges and modes of transportation. Considering that the disabled population is projected to keep increasing, it is critical consider these individuals mobility and transportation needs plus promote inclusion in everyday living.
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this: