URP 5363 - Project: Phase 1
Adrian Gallegos
2024-10-30
Research Questions:
What percentage of people in Boulder, Colorado, use alternative means of transportation – walk, bike, public transportation – compared with driving alone to work?
In Boulder specifically, is there a notable percentage of people who commute by alternative means of transportation from further away from the city center?
Does an overall increase in the number of commuters to work lead to an increase in the percentage of people who walk to work?
Does the rate of poverty across Boulder affect the number of people who commute to work through alternative means?
QUESTION TWO:
library(tidycensus)
census_api_key("4156b3413d433f2f6803ff4b60faa2a8bb579da2",overwrite ="TRUE")## To install your API key for use in future sessions, run this function with `install = TRUE`.var <- c(Means_of_Transportation_Work='B08301_001E',
Means_of_Transportation_WALK='B08301_019E',
Means_of_Transportation_BIKE='B08301_018E',
Means_of_Transportation_CAR_ALONE='B08301_003E',
Means_of_Transportation_BUS='B08301_011E',
poptotal='B03002_001E',
poptotal2='B17017_001E',
poverty='B17017_002E')
BOULDER <- get_acs(geography = "tract", variables = var, count= "Boulder",
state = "CO" ,output="wide", year = 2021, geometry = TRUE)## Getting data from the 2017-2021 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% | |=== | 5% | |===== | 7% | |====== | 8% | |======= | 10% | |======== | 11% | |========= | 13% | |========== | 14% | |=========== | 15% | |============ | 17% | |============= | 18% | |============= | 19% | |============== | 20% | |=============== | 22% | |================ | 22% | |================ | 23% | |================= | 25% | |================== | 26% | |=================== | 27% | |==================== | 28% | |===================== | 31% | |======================= | 33% | |======================== | 35% | |========================= | 36% | |=========================== | 38% | |=========================== | 39% | |============================ | 40% | |============================== | 42% | |=============================== | 44% | |================================ | 46% | |================================= | 47% | |================================== | 48% | |=================================== | 50% | |==================================== | 52% | |===================================== | 53% | |====================================== | 54% | |======================================= | 55% | |======================================== | 58% | |========================================= | 58% | |========================================== | 60% | |=========================================== | 62% | |============================================== | 65% | |============================================== | 66% | |================================================ | 69% | |================================================= | 70% | |================================================== | 72% | |=================================================== | 73% | |==================================================== | 74% | |===================================================== | 75% | |====================================================== | 77% | |======================================================= | 79% | |======================================================== | 80% | |========================================================= | 82% | |========================================================== | 83% | |=========================================================== | 85% | |============================================================ | 86% | |============================================================= | 87% | |============================================================== | 89% | |=============================================================== | 91% | |================================================================= | 93% | |================================================================== | 94% | |==================================================================== | 97% | |===================================================================== | 99% | |======================================================================| 100%BOULDER$B08301_001M<- NULL
BOULDER$B08301_019M<- NULL
BOULDER$B08301_018M<- NULL
BOULDER$B08301_003M<- NULL
BOULDER$B08301_011M<- NULL
BOULDER$B03002_001M<- NULL
BOULDER$B17017_001M<- NULL
BOULDER$B17017_002M<- NULLQUESTION THREE:
mean_Trans_WORK <- mean(BOULDER$Means_of_Transportation_Work)
mean_Trans_WALK <- mean(BOULDER$Means_of_Transportation_WALK)
mean_Trans_BIKE <- mean(BOULDER$Means_of_Transportation_BIKE)
mean_Trans_CAR_ALONE <- mean(BOULDER$Means_of_Transportation_CAR_ALONE)
mean_Trans_BUS <- mean(BOULDER$Means_of_Transportation_BUS)
mean_POPTOTAL <- mean(BOULDER$poptotal)
mean_PopTotal2 <- mean(BOULDER$poptotal2)
mean_Poverty <- mean(BOULDER$poverty)
median_Trans_WORK <- median(BOULDER$Means_of_Transportation_Work)
median_Trans_WALK <- median(BOULDER$Means_of_Transportation_WALK)
median_Trans_BIKE <- median(BOULDER$Means_of_Transportation_BIKE)
median_Trans_CAR_ALONE <- median(BOULDER$Means_of_Transportation_CAR_ALONE)
median_Trans_BUS <- median(BOULDER$Means_of_Transportation_BUS)
median_POPTOTAL <- median(BOULDER$poptotal)
median_PopTotal2 <- median(BOULDER$poptotal2)
median_Poverty <- median(BOULDER$poverty)
max_Trans_WORK <- max(BOULDER$Means_of_Transportation_Work)
max_Trans_WALK <- max(BOULDER$Means_of_Transportation_WALK)
max_Trans_BIKE <- max(BOULDER$Means_of_Transportation_BIKE)
max_Trans_CAR_ALONE <- max(BOULDER$Means_of_Transportation_CAR_ALONE)
max_Trans_BUS <- max(BOULDER$Means_of_Transportation_BUS)
max_POPTOTAL <- max(BOULDER$poptotal)
max_PopTotal2 <- max(BOULDER$poptotal2)
max_Poverty <- max(BOULDER$poverty)
min_Trans_WORK <- min(BOULDER$Means_of_Transportation_Work)
min_Trans_WALK <- min(BOULDER$Means_of_Transportation_WALK)
min_Trans_BIKE <- min(BOULDER$Means_of_Transportation_BIKE)
min_Trans_CAR_ALONE <- min(BOULDER$Means_of_Transportation_CAR_ALONE)
min_Trans_BUS <- min(BOULDER$Means_of_Transportation_BUS)
min_POPTOTAL <- min(BOULDER$poptotal)
min_PopTotal2 <- min(BOULDER$poptotal2)
min_Poverty <- min(BOULDER$poverty)QUESTION FOUR:
library(ggplot2)
library(plotly)##
## Attaching package: 'plotly'## The following object is masked from 'package:ggplot2':
##
## last_plot## The following object is masked from 'package:stats':
##
## filter## The following object is masked from 'package:graphics':
##
## layoutBOULDER$WALK_pct <- BOULDER$Means_of_Transportation_WALK/BOULDER$Means_of_Transportation_Work
BOULDER$BIKE_pct <- BOULDER$Means_of_Transportation_BIKE/BOULDER$Means_of_Transportation_Work
BOULDER$CAR_ALONE_pct <- BOULDER$Means_of_Transportation_CAR_ALONE/BOULDER$Means_of_Transportation_Work
BOULDER$BUS_pct <- BOULDER$Means_of_Transportation_BUS/BOULDER$Means_of_Transportation_Work
BOULDER$ALL_MODES_pct <- BOULDER$Means_of_Transportation_Work/BOULDER$poptotal
BOULDER$POVERTY_pct <- BOULDER$poverty /BOULDER$poptotal2
mean_Trans_WALK_pct <- mean(BOULDER$WALK_pct)
mean_Trans_BIKE_pct <- mean(BOULDER$BIKE_pct)
mean_Trans_BUS_pct <- mean(BOULDER$BUS_pct)
mean_Trans_CAR_ALONE_pct <- mean(BOULDER$CAR_ALONE_pct)
transportation <- c("WALK_pct", "BIKE_pct", "BUS_pct", "CAR_pct")
pct <- c(mean_Trans_WALK_pct, mean_Trans_BIKE_pct, mean_Trans_BUS_pct,mean_Trans_CAR_ALONE_pct)
df<- data.frame(mode_of_trans=transportation, percentage=pct)
ggplot(df, aes(x=mode_of_trans, y=percentage , fill=mode_of_trans)) +
geom_col()
ggplot(BOULDER, aes( x = CAR_ALONE_pct)) +
geom_histogram(binwidth = .1)
ggplot(BOULDER, aes(x=Means_of_Transportation_CAR_ALONE, y= Means_of_Transportation_Work)) +
geom_point()
ggplot(BOULDER, aes(x=WALK_pct, y= Means_of_Transportation_Work)) +
geom_point()
ggplot(BOULDER, aes(x= BIKE_pct, y= Means_of_Transportation_Work)) +
geom_point()
ggplot(BOULDER, aes(x= BUS_pct, y= Means_of_Transportation_Work)) +
geom_point()
ggplot(BOULDER, aes(x= WALK_pct, y= POVERTY_pct)) +
geom_point()
ggplot(BOULDER, aes(x= BIKE_pct, y= POVERTY_pct)) +
geom_point()
ggplot(BOULDER, aes(x=BUS_pct, y= POVERTY_pct)) +
geom_point()
ggplot(BOULDER, aes(x= CAR_ALONE_pct, y= POVERTY_pct)) +
geom_point()
QUESTION FIVE:
BOULDER$Poor <- ifelse(BOULDER$POVERTY_pct > 0.3, "Poor", "Nonpoor")
ggplot(BOULDER, aes(x = POVERTY_pct, fill=Poor)) +
geom_density(alpha = 0.5)+
labs(fill = "Poverty Status")
ggplot(BOULDER, aes(x = WALK_pct, fill = Poor))+
geom_density(alpha = 0.5)+
labs(fill = "Poverty Status") 
ggplot(BOULDER, aes(x = CAR_ALONE_pct, fill = Poor))+
geom_density(alpha = 0.5)+
labs(fill = "Poverty Status")
ggplot(BOULDER, aes(x = CAR_ALONE_pct, color = Poor)) +
stat_ecdf()
QUESTION SIX:
x <- c(2010,2011,2012,2013,2014,2015,2016,2017,2018,2019, 2020, 2021, 2022, 2023, 2024)
y <- c(295.1, 300, 304.7, 309.5, 312.5, 318.4, 321.8, 323, 325.4, 326, 330.9, 327.1, 327.5, 326.8, 326.3)
plot(x, y, pch=19, xlab='x', ylab='y')
poly.lm1 <- lm(y ~ poly(x, 1))
new.x <- c(2025, 2026, 2027, 2028, 2029, 2030)
new.df <- data.frame(x=new.x)
new.y <- predict(poly.lm1, newdata=new.df)
print(new.y)## 1 2 3 4 5 6
## 336.5505 338.8276 341.1048 343.3819 345.6590 347.9362x_axis <- seq(2010, 2030, length=10)
lines(x_axis, predict(poly.lm1, data.frame(x=x_axis)), col='red')
QUESTION SEVEN:
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 plotly::filter(), stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsBOULDER %>%
lm(WALK_pct ~ POVERTY_pct + poptotal, data = .) %>%
summary()##
## Call:
## lm(formula = WALK_pct ~ POVERTY_pct + poptotal, data = .)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.188496 -0.016821 -0.000288 0.012209 0.149391
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.129e-02 1.480e-02 -0.763 0.448
## POVERTY_pct 4.256e-01 4.330e-02 9.829 4.01e-15 ***
## poptotal 8.243e-07 2.979e-06 0.277 0.783
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04377 on 75 degrees of freedom
## Multiple R-squared: 0.564, Adjusted R-squared: 0.5524
## F-statistic: 48.51 on 2 and 75 DF, p-value: 3.028e-14result <- lm(WALK_pct ~ POVERTY_pct + poptotal, data = BOULDER)
summary(result)##
## Call:
## lm(formula = WALK_pct ~ POVERTY_pct + poptotal, data = BOULDER)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.188496 -0.016821 -0.000288 0.012209 0.149391
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -1.129e-02 1.480e-02 -0.763 0.448
## POVERTY_pct 4.256e-01 4.330e-02 9.829 4.01e-15 ***
## poptotal 8.243e-07 2.979e-06 0.277 0.783
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.04377 on 75 degrees of freedom
## Multiple R-squared: 0.564, Adjusted R-squared: 0.5524
## F-statistic: 48.51 on 2 and 75 DF, p-value: 3.028e-14BOULDER %>%
ggplot(aes(x = POVERTY_pct, y = WALK_pct)) +
geom_point() +
geom_smooth(method = "lm", col = "blue") +
ggtitle("Percentage in Poverty vs. Percentage Who Walk to Work")+
labs(x = "Percentage in Poverty", y = "Percentage Who Walk to Work")## `geom_smooth()` using formula = 'y ~ x'
BOULDER %>%
ggplot(aes(x = POVERTY_pct, y = BIKE_pct)) +
geom_point() +
geom_smooth(method = "lm", col = "blue") +
ggtitle("Percentage in Poverty vs. Percentage Who Bike to Work")+
labs(x = "Percentage in Poverty", y = "Percentage Who Bike to Work")## `geom_smooth()` using formula = 'y ~ x'
BOULDER %>%
ggplot(aes(x = POVERTY_pct, y = BUS_pct)) +
geom_point() +
geom_smooth(method = "lm", col = "blue") +
ggtitle("Percentage in Poverty vs. Percentage Who Bus to Work")+
labs(x = "Percentage in Poverty", y = "Percentage Who Bus to Work")## `geom_smooth()` using formula = 'y ~ x'
BOULDER %>%
ggplot(aes(x = POVERTY_pct, y = CAR_ALONE_pct)) +
geom_point() +
geom_smooth(method = "lm", col = "blue") +
ggtitle("Percentage in Poverty vs. Percentage Who Drive Alone to Work")+
labs(x = "Percentage in Poverty", y = "Percentage Who Drive Alone to Work")## `geom_smooth()` using formula = 'y ~ x'
QUESTION EIGHT:
library(plotly)
ggplot(BOULDER, aes(x = POVERTY_pct, y = WALK_pct)) +
geom_point() +
labs(x = "Poor", y = "Walk") 
ggplotly()BOULDER %>%
ggplot(aes(x = POVERTY_pct, y = CAR_ALONE_pct)) +
geom_point() +
geom_smooth(method = "lm", col = "blue") +
ggtitle("Percentage in Poverty vs. Percentage Who Drive Alone to Work")+
labs(x = "Percentage in Poverty", y = "Percentage Who Drive Alone to Work")## `geom_smooth()` using formula = 'y ~ x'
ggplotly()## `geom_smooth()` using formula = 'y ~ x'library(sf)## Linking to GEOS 3.12.1, GDAL 3.8.4, PROJ 9.3.1; sf_use_s2() is TRUElibrary(tigris)## To enable caching of data, set `options(tigris_use_cache = TRUE)`
## in your R script or .Rprofile.library(tmap)## Breaking News: tmap 3.x is retiring. Please test v4, e.g. with
## remotes::install_github('r-tmap/tmap')tm_shape(BOULDER) +
tm_polygons(col = "WALK_pct") +
tm_layout(frame.lwd = 3) +
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(BOULDER) +
tm_polygons(col = "BIKE_pct") +
tm_layout(frame.lwd = 3) +
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(BOULDER) +
tm_polygons(col = "BUS_pct") +
tm_layout(frame.lwd = 3) +
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(BOULDER) +
tm_polygons(col = "CAR_ALONE_pct") +
tm_layout(frame.lwd = 3) +
tmap_mode("view")## tmap mode set to interactive viewingtm_shape(BOULDER) +
tm_polygons(col = "POVERTY_pct") +
tm_layout(frame.lwd = 3) +
tmap_mode("view")## tmap mode set to interactive viewingFINDINGS:
People driving alone to work in Boulder, Colorado, made up 58.7 percent of all commuters compared with those who used alternative means - walk, bike, or public transit.
Though the number of commuters and the number of people who drive alone to work increase proportionally, the number of people who took alternative means – walk, bike, bus – was not drastically affected by an increase in the overall number of people who commuted to work.
The cumulative density function chart from QUESTION FIVE shows that tracts categorized as poor have a lower percentage of people who drive by themselves to work.
As the rate of poverty increased, the percentage of people who commuted to work through alternative means increased. Conversely, the higher the rate of poverty is, the lower the percentage of people who drive to work. This is most evident in ouur OLS regression analysis and corresponding charts from QUESTION SEVEN.
The population of Boulder peaked at the outset of the pandemic (2020) and then decreased. This may be due to the combination of job losses and cost of living. The population has since steadied and is projected to increase as is shown in QUESTION SIX.
A shown by the maps in QUESTION EIGHT, people who traveled to work through aternative means, most notably by walking or biking, tended to live closer to the city center. This also corresponded with the area of Boulder with the highest rate of poverty.