Transit-Oriented Development in San Francisco, CA - MUSA508 HW2
Rui Jiang
2022-09-21
Policy Brief for San Francisco Council Representatives
## Thanks for the helps and supports from Professor Michael Fichman, Jingyi Cai, Chenxi Zhu, Tiffany Luo, and Teresa Chang.Motivation
The exciting, quickly expanding trend of transit-oriented development helps to build thriving, livable, and sustainable communities. It is developing dense, walkable, pedestrian-oriented, mixed-use towns built on first-rate train networks, also known as TOD. Because of this, it is feasible to live a less stressful life without entirely relying on an automobile for transportation and survival.
Transit-oriented development combines regional planning, urban redevelopment, suburban rejuvenation, and walkable community development. This Policy Brief will evaluate how households value transit-rich neighborhoods in San Francisco, CA.
The Farallon Islands of northern California are one of the world’s great biodiversity hotspots. They are off limits to humans. Even though they’re included in census tracts of San Francisco, they will not be considered in this evaluation.
1. Data Wrangling
1.1 Load Packages and Functions
# Load Libraries
library(tidyverse)
library(tidycensus)
library(sf)
library(kableExtra)
library(geojsonio)
options(scipen=999)
options(tigris_class = "sf")
source("https://raw.githubusercontent.com/urbanSpatial/Public-Policy-Analytics-Landing/master/functions.r")
mapTheme2 <- function(base_size = 20, title_size = 16) {
theme(
text = element_text( color = "black"),
plot.title = element_text(size = title_size,colour = "black"),
plot.subtitle=element_text(face="italic"),
plot.caption=element_text(hjust=0),
axis.ticks = element_blank(),
panel.background = element_blank(),axis.title = element_blank(),
axis.text = element_blank(),
axis.title.x = element_blank(),
axis.title.y = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
strip.text.x = element_text(size = 14))
}
palette5 <- c("#f0f9e8","#bae4bc","#7bccc4","#43a2ca","#0868ac")
palette_purple <- c("#54278f","#756bb1","#9e9ac8","#cbc9e2","#f2f0f7")
palette_green <- c("006d2c","31a354","74c476","bae4b3","edf8e9")
census_api_key("2f748668ad5407296cc1ffdff1a4ab3b2aa98a84", overwrite = TRUE, install = TRUE)1.2 Wrangling 2009 Census Data
tracts09 <-
get_acs(geography = "tract",
variables = c("B25026_001E","B02001_002E",
"B15001_050E","B15001_009E",
"B19013_001E", "B25058_001E",
"B06012_002E"),
year=2009, state= "CA", #06
county="San Francisco", geometry=TRUE) %>% #075
st_transform('EPSG:2229')
totalPop09 <-
tracts09 %>%
filter(variable == "B25026_001")
totalPop09 <-
totalPop09%>%
filter(GEOID != "06075060400")
tracts09 <-
tracts09 %>%
dplyr::select( -NAME, -moe) %>%
spread(key = variable, value = estimate) %>%
rename(TotalPop = B25026_001,
Whites = B02001_002,
FemaleBachelors = B15001_050,
MaleBachelors = B15001_009,
MedHHInc = B19013_001,
MedRent = B25058_001,
TotalPoverty = B06012_002)
# Let's create new rate variables using mutate
tracts09 <-
tracts09 %>%
mutate(pctWhite = ifelse(TotalPop > 0, Whites / TotalPop, 0),
pctBachelors = ifelse(TotalPop > 0, ((FemaleBachelors + MaleBachelors) / TotalPop), 0),
pctPoverty = ifelse(TotalPop > 0, TotalPoverty / TotalPop, 0),
year = "2009") %>%
dplyr::select(-Whites,-FemaleBachelors,-MaleBachelors,-TotalPoverty) %>%
filter(GEOID != "06075060400")1.3 Wrangling 2020 Census Data and Combine into the Same Data Frame
tracts20 <-
get_acs(geography = "tract",
variables = c("B25026_001E","B02001_002E",
"B15001_050E","B15001_009E",
"B19013_001E","B25058_001E",
"B06012_002E"),
year=2020, state=06, county=075,
geometry=TRUE, output="wide") %>%
st_transform('EPSG:2229') %>%
rename(TotalPop = B25026_001E,
Whites = B02001_002E,
FemaleBachelors = B15001_050E,
MaleBachelors = B15001_009E,
MedHHInc = B19013_001E,
MedRent = B25058_001E,
TotalPoverty = B06012_002E) %>%
dplyr::select(-NAME, -starts_with("B")) %>%
mutate(pctWhite = ifelse(TotalPop > 0, Whites / TotalPop,0),
pctBachelors = ifelse(TotalPop > 0, ((FemaleBachelors + MaleBachelors) / TotalPop),0),
pctPoverty = ifelse(TotalPop > 0, TotalPoverty / TotalPop, 0),
year = "2020") %>%
dplyr::select(-Whites, -FemaleBachelors, -MaleBachelors, -TotalPoverty) %>%
filter(GEOID != "06075060400" & GEOID != "06075980401")
allTracts <- rbind(tracts09,tracts20)1.4 Wrangling Transit Open Data
bartStops <-
st_read("/Users/rui/Documents/GitHub/MUSA_508/BART_Station/BART_Station_0.shp") %>%
dplyr::select(Name, City) %>%
filter(City=="San Francisco") %>%
st_transform("EPSG:2229")
# view bart stops
#ggplot() +
#geom_sf(data=st_union(allTracts)) +
#geom_sf(data=bartStops,
#show.legend = "point", size= 0.5) +
#scale_colour_manual(values = c("orange","blue")) +
#labs(title="Bart Stops",
#subtitle="San Francisco, CA",
#caption="Figure 2.5") +
#mapTheme()1.5 Buffer the BART Stops
bartBuffers <-
rbind(
st_buffer(bartStops, 2640) %>% # 0.25mile = 1320 ft is an acceptable walking distance
mutate(Legend = "Buffer") %>%
dplyr::select(Legend),
st_union(st_buffer(bartStops, 2640)) %>%
st_sf() %>%
mutate(Legend = "Unioned Buffer"))
buffer <- filter(bartBuffers, Legend=="Unioned Buffer")2. Comparison of Four Selected Census Variables across 2009 to 2020 and TOD vs. non-TOD.
allTracts.group <-
rbind(
st_centroid(allTracts)[buffer,] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "TOD"),
st_centroid(allTracts)[buffer, op = st_disjoint] %>%
st_drop_geometry() %>%
left_join(allTracts) %>%
st_sf() %>%
mutate(TOD = "Non-TOD")) %>%
mutate(MedRent.inf = ifelse(year == "2009", MedRent * 1.14, MedRent))
allTracts.Summary <-
st_drop_geometry(allTracts.group) %>%
group_by(year, TOD) %>%
summarize(Rent = mean(MedRent, na.rm = T),
Population = mean(TotalPop, na.rm = T),
Percent_White = mean(pctWhite, na.rm = T),
Percent_Bach = mean(pctBachelors, na.rm = T),
Percent_Poverty = mean(pctPoverty, na.rm = T))
selectCentroids <-
st_centroid(tracts09)[buffer,] %>%
st_drop_geometry() %>%
left_join(., dplyr::select(tracts09, GEOID), by = "GEOID") %>%
st_sf() %>%
dplyr::select(TotalPop) %>%
mutate(Selection_Type = "Select by Centroids")
ggplot(allTracts.group)+
#geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = TotalPop),size = 0.1) +
labs(title = "Figure 2.1 Comparison of Total Population",
subtitle = "across 2009 to 2020 and TOD (red line) vs. non-TOD in San Francisco") +
geom_sf(data = st_union(selectCentroids), fill = "transparent", color = "red", size = 0.3)+
facet_wrap(~year)+
scale_fill_viridis_c() +
mapTheme2() +
theme(plot.title = element_text(size=22))
ggplot(allTracts.group)+
#geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = pctBachelors),size = 0.1) +
labs(title = "Figure 2.2 Comparison of Percent Bachelor",
subtitle = "across 2009 to 2020 and TOD (red line) vs. non-TOD in San Francisco") +
geom_sf(data = st_union(selectCentroids), fill = "transparent", color = "red", size = 0.3)+
facet_wrap(~year)+
scale_fill_viridis_c() +
mapTheme() +
theme(plot.title = element_text(size=22))
ggplot(allTracts.group)+
#geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = pctPoverty),size = 0.1) +
labs(title = "Figure 2.3 Comparison of Percent Poverty",
subtitle = "across 2009 to 2020 and TOD (red line) vs. non-TOD in San Francisco") +
geom_sf(data = st_union(selectCentroids), fill = "transparent", color = "red", size = 0.3)+
facet_wrap(~year)+
scale_fill_viridis_c() +
mapTheme() +
theme(plot.title = element_text(size=22))
ggplot(allTracts.group)+
#geom_sf(data = st_union(tracts09))+
geom_sf(aes(fill = MedRent),size = 0.1) +
labs(title = "Figure 2.4 Comparison of Rent",
subtitle = "across 2009 to 2020 and TOD (red line) vs. non-TOD in San Francisco") +
geom_sf(data = st_union(selectCentroids), fill = "transparent", color = "red", size = 0.3)+
facet_wrap(~year)+
scale_fill_viridis_c() +
mapTheme() +
theme(plot.title = element_text(size=22))
3.TOD Indicator Plots
allTracts.Summary %>%
gather(Variable, Value, -year, -TOD) %>%
ggplot(aes(year, Value, fill = TOD)) +
geom_bar(stat = "identity", position = "dodge") +
facet_wrap(~Variable, scales = "free", ncol=5) +
scale_fill_manual(values = c("#bae4bc", "#0868ac")) +
labs(title = "Figure 3.1 Comparison of Census variables",
subtitle = "across 2009 to 2020 and TOD vs. non-TOD in San Francisco") +
plotTheme() + theme(legend.position="bottom")
4. Table Comparison across Time and Space
allTracts.Summary %>%
unite(year.TOD, year, TOD, sep = ": ", remove = T) %>%
gather(Variable, Value, -year.TOD) %>%
mutate(Value = round(Value, 2)) %>%
spread(year.TOD, Value) %>%
kable() %>%
kable_styling() %>%
footnote(general_title = "\n",
general = "Table 4.1 Comparison of Census variables across 2009 to 2020 and TOD vs. non-TOD")| Variable | 2009: Non-TOD | 2009: TOD | 2020: Non-TOD | 2020: TOD |
|---|---|---|---|---|
| Percent_Bach | 0.02 | 0.01 | 0.03 | 0.03 |
| Percent_Poverty | 0.11 | 0.17 | 0.10 | 0.16 |
| Percent_White | 0.57 | 0.57 | 0.48 | 0.42 |
| Population | 4404.28 | 4641.86 | 3625.85 | 3116.75 |
| Rent | 1333.05 | 1028.75 | 2069.04 | 1657.93 |
|
|
||||
| Table 4.1 Comparison of Census variables across 2009 to 2020 and TOD vs. non-TOD |
From Figure 2.1 - 2.4, 3.1, & Table 4.1
- There is an overall increase in education levels in 2020 compared to
2009, but the impact of TOD cannot be directly analyzed.
- Poverty levels in 2020 are one percentage point lower than in 2009 in
both TOD and non-TOD areas overall, with TOD areas having higher poverty
levels than non-TOD areas in both 2009 and 2020.
- The proportion of whites in TOD areas has fallen more than in non-TOD
areas.
- The total population decreased from 2009 to 2020, TOD areas decreased
more than Non-TOD areas.
- There is an overall increase in rent price in 2020 compared to 2009.
TOD areas in 2020 had lower average rent prices than Non-TOD areas.
5. Graduated Symbol Maps of Population and Rent within 0.5 mile of each Transit Station.
# Generate point centers
bart_Buffers <-
rbind(
st_buffer(bartStops, 2640) %>% # 0.25mile = 1320 ft is an acceptable walking distance
mutate(Legend = "Buffer") %>%
dplyr::select(Legend,Name))
buffer_info09 <-
st_intersection(bart_Buffers, tracts09) %>%
dplyr::select(TotalPop,MedRent,Name) %>%
mutate(year = 2009)
buffer_info20 <-
st_intersection(bart_Buffers, tracts20) %>%
dplyr::select(TotalPop,MedRent,Name) %>%
mutate(year = 2020)
buffer_info <- rbind(buffer_info09, buffer_info20)
buffer_final <- buffer_info %>%
group_by(Name,year) %>%
summarize("MedRent" = mean(MedRent,na.rm = TRUE),
"TotalPop" = sum(TotalPop))
centers <- st_centroid(buffer_final)
# Set size parameter and the size range for population
ggplot() +
geom_sf(data = tracts09, fill = "white") +
geom_sf(data = tracts20, fill = "white") +
geom_sf(data = centers, aes(size = TotalPop,fill = TotalPop,alpha = 1),shape = 21,
show.legend = "point") +
labs(title = "Graduated Symbol Maps of Population within 0.5 Mile of Each Transit Station",
subtitle = "San Francisco, CA",
caption="Figure 5.1") +
guides(alpha = FALSE)+
guides(size = FALSE)+
scale_fill_viridis_c() +
facet_wrap(~year)+
geom_sf(data = bartStops, size = 0.4) +
scale_size_continuous(range = c(0.1, 15))
Sum of the population has no meaning which will lead to overpopulation in these maps. These maps try to show the population related to each transit station.
# Set size parameter and the size range for rent
ggplot() +
geom_sf(data = tracts09, fill = "white") +
geom_sf(data = tracts20, fill = "white") +
geom_sf(data = centers, aes(size = MedRent,fill = MedRent,alpha = 1), shape = 21,
show.legend = "point") +
labs(title = "Graduated Symbol Maps of Rent within 0.5 Mile of Each Transit Station",
subtitle = "San Francisco, CA",
caption="Figure 5.2") +
guides(alpha = FALSE)+
guides(size = FALSE)+
scale_fill_viridis_c() +
facet_wrap(~year)+
geom_sf(data = bartStops, size= 0.4) +
scale_size_continuous(range = c(0.5, 15))
6. Mean Rent as a Function of Distance to BART Transit Stations
allTracts <- rbind(tracts20,tracts09)
bart_MRB <- multipleRingBuffer(st_union(bartStops), 47520, 2640)
allTracts.rings <-
st_join(st_centroid(dplyr::select(allTracts, GEOID, year)),
bart_MRB) %>%
st_drop_geometry() %>%
left_join(dplyr::select(allTracts, GEOID, MedRent, year),
by=c("GEOID"="GEOID", "year"="year")) %>%
st_sf() %>%
mutate(distance = distance / 5280) #convert to miles
tract.group <- allTracts.rings %>%
group_by(distance,year) %>%
summarize("AveRent" = mean(MedRent,na.rm = TRUE))
ggplot(data=tract.group, aes(distance,AveRent, colour=year)) +
geom_line(size = 2) +
labs(title = "Average Rent of Different Distance to BART Transit Stations",
subtitle = "San Francisco, CA",
caption="Figure 6.1") 
Both Figure 5.2 and Figure 6.1 indicate the rent price dramatically increased from 2009 to 2020.
7. Conlcusion
Even though it seems that people in San Francisco are not willing to pay a premium to live in transit-rich areas, not enough has been done to terminate this conclusion fully. Households in San Francisco might be willing to pay more for transit amenities, but they also pay more for other amenities in neighborhoods that happen to be less transit-rich. For example, households may value locations inside or near parks (or other green facilities).
Rent prices dramatically increased from 2009 to 2020. There should be factors for residents to consider when they purchase or rent living places. These results in this study suggest a more thorough study is needed to learn more about how renters value transit.