East Bay's Transited Oriented Developments (2009 & 2019)
Alex Nelms
10/5/2021
The East Bay & Transit Oriented Developments
A Study of the Bay Area Rapid Transit and the Major Cities in the Eastern part of the San Francisco Bay Area
The San Francisco Bay Area’s East Bay Housing Crisis is the resulting clash of strict land-use regulations, racial housing discrimination, and missing regional government with the explosive growth of the technology industry. This mismatch has led to increasing rent, homelessness, and ‘gentrification’ on a crisis-level scale.
Even though the Bay Area’s economy has grew to become the 18th largest economy in the world in 2017, the housing market has not. Also ratified in 2017 was the region’s Plan Bay Area 2040 — which had bay area cities set 2040 housing targets. Two cities at the heart of the plan, Oakland and Berkeley, are already forecasted to meet their 2040 targets far beyond 2070.
“Every single county is over-performing its job forecast, some by massive amounts, and every single county is under-performing its housing forecast, almost all by a wide margin,”
— MTC director Steve Heminger in his report to the Association of Bay Area Governments executive board
The East Bay has been at the center of this mismatch, especially for the urban corridor [Figure 1] of Oakland, Berkeley, and immediate surrounding cities: Alameda, Piedmont, Albany, & Emeryville. The urban East Bay, between the 2009 and 2019 American Community Surveys, added 62,869 residents (10% increase) but could only add 799 occupied housing units (.003% increase). This mismatch of added population without a real increase in units suggests two questions to follow throughout the study:
+ Where are new residents locating? Are they living in new or old units?
+ What variables describe the change in new or old residents between 2009 and 2019?
library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.4 v dplyr 1.0.7
## v tidyr 1.1.3 v stringr 1.4.0
## v readr 2.0.1 v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
library(lubridate)
##
## Attaching package: 'lubridate'
## The following objects are masked from 'package:base':
##
## date, intersect, setdiff, union
library(RColorBrewer)
library(patchwork)
library(scales)
##
## Attaching package: 'scales'
## The following object is masked from 'package:purrr':
##
## discard
## The following object is masked from 'package:readr':
##
## col_factor
library(kableExtra)
##
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
library(tidycensus)
library(sf)
## Linking to GEOS 3.9.0, GDAL 3.2.1, PROJ 7.2.1
library(sp)
library(tmap)
library(ggrepel)
library(tigris)
## To enable
## caching of data, set `options(tigris_use_cache = TRUE)` in your R script or .Rprofile.
# tracts.all %>% group_by(year) %>%
# summarize(
# units = sum(tot_units),
# pop = sum(tot_pop)
# )
mile = 5280
sqmile = 27878400
set.seed(717)
mapTheme <- function(base_size = 12) {
theme(
text = element_text( color = "black"),
plot.title = element_text(size = 16,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))
}
plotTheme <- function(base_size = 12) {
theme(
text = element_text( color = "black"),
plot.title = element_text(size = 16,colour = "black"),
plot.subtitle = element_text(face="italic"),
plot.caption = element_text(hjust=0),
axis.ticks = element_blank(),
panel.background = element_blank(),
panel.grid.major = element_line("grey80", size = 0.1),
panel.grid.minor = element_blank(),
panel.border = element_rect(colour = "black", fill=NA, size=2),
strip.background = element_rect(fill = "grey80", color = "white"),
strip.text = element_text(size=12),
axis.title = element_text(size=12),
axis.text = element_text(size=10),
plot.background = element_blank(),
legend.background = element_blank(),
legend.title = element_text(colour = "black", face = "italic"),
legend.text = element_text(colour = "black", face = "italic"),
strip.text.x = element_text(size = 14)
)
}
key_file = "C:/Users/nelms/OneDrive/Code/census_api_key.txt"
census_key = readChar(key_file, file.info(key_file)$size)
census_api_key(census_key, overwrite = TRUE)
## To install your API key for use in future sessions, run this function with `install = TRUE`.
# PULL CITY BOUNDARIES FROM REGIONAL MTC OPEN DATA
#city_path = 'https://services3.arcgis.com/i2dkYWmb4wHvYPda/arcgis/rest/services/region_jurisdiction_clp/FeatureServer/0/query?where=1%3D1&outFields=jurname,fipco&outSR=2227&f=geojson'
city_path = 'C:/Users/nelms/OneDrive/Penn/MUSA-508/Files/EastBay_cities.geojson'
EB.cities = st_read(city_path)
## Reading layer `EastBay_cities' from data source
## `C:\Users\nelms\OneDrive\Penn\MUSA-508\Files\EastBay_cities.geojson'
## using driver `GeoJSON'
## Simple feature collection with 109 features and 2 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: 5696728 ymin: 1785314 xmax: 6355025 ymax: 2507172
## Projected CRS: NAD83 / California zone 3 (ftUS)
# NARROW AREAS TO MAJOR & MINOR CITIES
major_EB = c('Berkeley', 'Oakland')
minor_EB = c('Alameda', 'Albany', 'Emeryville', 'Piedmont')
is_EB = c(minor_EB, major_EB)
EB.cities = EB.cities[match(is_EB, EB.cities$jurname), ] %>%
select( -fipco) %>%
rename(
city = jurname
) %>%
st_transform(., 2227)
# Projection is (NAD83) California State Plan, Zone 3 (in FEET)
# EPSG:2226
CA_crs = st_crs(EB.cities)
EB.cities$size = 'minor'
EB.cities[EB.cities$city %in% major_EB, 'size'] = 'major'
# CREATE CITY LABELS
EB.labels =
EB.cities %>%
st_centroid(EB.cities) %>%
rename(
label = city
) %>%
mutate(
lon = map_dbl(geometry, ~st_centroid(.x)[[1]]),
lat = map_dbl(geometry, ~st_centroid(.x)[[2]])
)
plot_limits = function(
poly.geometry = EB.cities$geometry,
# buffer between plot's limits and the geometry
# (in unit of geometry column)
buffer = 0
){
# creates bounding box
poly.bbox =
poly.geometry %>% st_union() %>%
# buffers the geometry so the ultimate plot has margins
st_buffer(buffer) %>%
st_bbox()
return(
# returns the 'coord_sf' function which you can add to any plot
coord_sf(
xlim = c(poly.bbox['xmin'], poly.bbox['xmax']),
ylim = c(poly.bbox['ymin'], poly.bbox['ymax']),
crs = st_crs(poly.geometry)
))}
ggplot() +
# cities
geom_sf(data=EB.cities, aes(fill=city),
color=alpha('grey50',.5),
lwd=1, linetype = "dashed") +
# labels
geom_label(
data=EB.labels,
size = 2, fontface='bold', color='grey20', label.size = NA,
box.padding = 0.5, fill=alpha('white',.5),
aes(x=lon,y=lat, label=label)) +
labs(
title = 'East Bay Urban Corridor',
subtitle = 'Oakland, Berkeley, & surrounding cities') +
mapTheme() + plot_limits()
(#fig:setup_EB)East Bay Cities
The following study examines some of the surface level indicators of the housing crisis and its resulting displacement. The study will focus on Transit Oriented Developments around Bay Area Rapid Transit stations — specifically, to understand if TOD housing is relieving the housing crisis or exacerbating the displacement of local residents. The study will: (Section 1) establish the variables and parameters; (Section 2) spatially compare five American Community Survey (ACS) variables between 2009 and 2019; (Section 3 & Section 4) make overall comparisions of TOD and non-TOD areas; (Section 5) utilize graduated symbol maps to evaluate specific station TOD areas; (Section 6) compare the distance to BART to both Mean Rent and the Amount of Homeless Encampment complaints; and, finally, (Section 7) evaluate all of the study components to give a picture of the East Bay housing crisis.
1 Variables & Parameters
This study is bringing in three primary data sources: (1.1) the San Francisco Bay Area’s hybrid subway-commuter rail, the Bay Area Rapid Transit (BART), to find TOD areas; (1.2) American Community Survey (ACS) Variables & Census Tracts to get core information; and (1.3) bring in Homeless Encampment complaints from the City of Oakland’s 311 citizen hotline.
1.1 Transit Routes & Stops
This study’s use of BART allows a focus on both urban centers and their immediate suburbs. The data was sourced from the regional Metropolitan Transportation Commission.
#stop_path = "https://services3.arcgis.com/i2dkYWmb4wHvYPda/arcgis/rest/services/transitstops_existing_planned_2021/FeatureServer/0/query?where=1%3D1&outFields=*&outSR=2227&f=geojson"
stop_path = 'C:/Users/nelms/OneDrive/Penn/MUSA-508/Files/SF-Bay_Transit-Stops-Major_2021.geojson'
#route_path = "https://services3.arcgis.com/i2dkYWmb4wHvYPda/arcgis/rest/services/transitroutes_01_2020/FeatureServer/0/query?where=1%3D1&outFields=*&outSR=2227&f=geojson"
route_path = 'C:/Users/nelms/OneDrive/Penn/MUSA-508/Files/BART_routes.geojson'
BART.stops =
# from the MTC API, who sourced it from BART
st_read(stop_path) %>%
# only look at BART & weekday routes
filter(agency_id == "BA", route_s_nm!="Blue-Sun", route_s_nm!='Beige') %>%
mutate(
route_s_nm = ifelse(
route_s_nm=="Blue-Wkd/Sat", "Blue",
route_s_nm)
) %>%
st_transform(., 2227)
## Reading layer `Transit_Stops_-_Major_(2021)' from data source
## `C:\Users\nelms\OneDrive\Penn\MUSA-508\Files\SF-Bay_Transit-Stops-Major_2021.geojson'
## using driver `GeoJSON'
## Simple feature collection with 5115 features and 18 fields
## Geometry type: POINT
## Dimension: XY
## Bounding box: xmin: -122.8172 ymin: 37.00348 xmax: -121.5661 ymax: 38.54765
## Geodetic CRS: WGS 84
# Projection is (NAD83) California State Plan, Zone 2 (in FEET)
# EPSG:2226
CA_crs = st_crs(BART.stops)
#cat(CA_crs$input, ', EPSG:', CA_crs$epsg)
BART.routes =
st_read(route_path) %>%
filter(agency_id == "BA", route_s_nm!="Blue-Sun") %>%
mutate(
route_s_nm = ifelse(
route_s_nm=="Blue-Wkd/Sat", "Blue",
route_s_nm)
) %>%
st_transform(., CA_crs)
## Reading layer `BART_routes' from data source
## `C:\Users\nelms\OneDrive\Penn\MUSA-508\Files\BART_routes.geojson'
## using driver `GeoJSON'
## Simple feature collection with 2000 features and 8 fields
## Geometry type: MULTILINESTRING
## Dimension: XY
## Bounding box: xmin: 5908167 ymin: 1815066 xmax: 6277273 ymax: 2407672
## Projected CRS: NAD83 / California zone 3 (ftUS)
# NARROW STOPS TO .5 MILE OUTSIDE THESE CITIES
BART.stops =
BART.stops %>%
# .5 mile buffer + 1 foot
st_filter(., st_buffer(st_union(EB.cities), dist=5280*.5+1)) %>%
group_by(stop_nm,stop_id) %>%
st_drop_geometry(.) %>%
summarise(
route_count = n_distinct(route_s_nm), # get routes used
routes = list(unique(route_s_nm))
) %>%
merge(., BART.stops[,'stop_id'], by='stop_id') %>%
distinct() %>% # remove duplicates
st_as_sf()
# NARROW STOPS TO THESE CITIES
BART.routes = st_intersection(BART.routes, st_buffer(st_union(EB.cities),5280*.5))The BART stations will serve as the center of TOD areas — with the ultimate area being tracts mostly within a ½ mile buffer of BART. See Figure 1.1 & 1.2 in Section 1.2, for a graphical understanding of this selection.
buffer_distance = .5
min_point_distances = function(
input.geoms,
input.ids,
compare.geoms,
compare.ids
){
# GET DISTANCES OF TRANSIT STOPS AND THE FOCUS AREA BOUNDARY
distances_matrix =
outer(input.geoms,
compare.geoms,
FUN=Vectorize(st_distance, USE.NAMES = FALSE))
# CREATE MATRIX COLUMN & ROW NAMES
rownames(distances_matrix) = input.ids
colnames(distances_matrix) = compare.ids
get_col = function(rowname, find_num){
return(colnames(distances_matrix)[distances_matrix[rowname, ] == find_num])
}
get_col = Vectorize(get_col)
distances_df =
apply(distances_matrix, 1, min) %>% as.data.frame() %>%
rename('distance'=1) %>%
rownames_to_column('ID') %>%
mutate(closest=get_col(ID, distance))
return(distances_df)
}
EB.coords = EB.cities %>%
st_convex_hull() %>%
st_cast(., "MULTIPOINT") %>%
st_union() %>%
st_cast(., "POINT")
BARTstop_EBboundary_distances = min_point_distances(
input.geoms = EB.coords,
input.ids = seq(from=1,to=length(EB.coords)),
compare.geoms = BART.stops$geometry,
compare.ids = BART.stops$stop_id
)
# GET LARGEST CLOSEST DISTANCE (MILES) BETWEEN STOPS AND BOUNDARY
max_min_BART_EB_dist =
max(BARTstop_EBboundary_distances$distance)/mile
# MINIMUM DISTANCE NEEDED TO BUFFER FROM TRANSIT STOPS AND COVER ALL FOCUS AREAS
# ASSUMES IN 1/2 or 1 MILE INTERVALS
buffer_max_distance = ceiling(max_min_BART_EB_dist)
# FUNCTION CREATING MULTIPLE RING BUFFERS FOR TRANSIT STOPS
# CYCLES THROUGH EACH DISTANCE ROW TO BUFFER & UNION
multiringbuffers_byrow = function(
input.points, # BART Stops or any point
buffer_distance=.5,
buffer_max=5,
# default fields & info for union
union_default = data.frame(
stop_id=c('ALL'),stop_nm=c('UNION'),
route_count=c(0),routes=c(''))
){
mile=5280
# SEQUENCE VECTOR OF BUFFER RING LENGTHS
buffer_distances =
seq(from=buffer_distance,
to=buffer_max, by=buffer_distance)
# CYCLE THROUGH DISTANCES TO BUFFER EACH POINT
# USE ST_DIFFERENCE TO CREATE RINGS
# CREATE UNION ROW OF EACH DISTANCE
for (current_buffer_distance in buffer_distances) {
# GEOM OF SMALLER DISTANCE TO CREATE RING
buffer.difference =
input.points %>%
st_buffer(
(current_buffer_distance-buffer_distance)*mile
) %>% st_union() %>% st_sfc()
# SF BUFFER OF EACH STOP
buffer.new =
input.points %>%
st_buffer(., current_buffer_distance*mile) %>%
st_difference(., buffer.difference) %>%
mutate(distance = current_buffer_distance)
# SF BUFFER UNION FOR NEW ROW
buffer.union =
buffer.new %>%
st_union() %>%
st_difference(., buffer.difference) %>%
st_sfc() %>%
# cbind default union fields
cbind(
., union_default %>%
mutate(distance=current_buffer_distance)
) %>% st_as_sf() %>%
# reorder columns for rbind
subset(., select=colnames(buffer.new))
# rbind to all buffers
if (current_buffer_distance==buffer_distance) {
buffer.temp =
st_as_sf(rbind(
buffer.union,
buffer.new))}
else
buffer.temp =
st_as_sf(rbind(
buffer.temp,
buffer.union,
buffer.new))
}
# reset index
row.names(buffer.temp) <- NULL
return(buffer.temp)
}
buffer_distance = .5
BART.buffers =
multiringbuffers_byrow(
BART.stops, buffer_distance=buffer_distance,
buffer_max=buffer_max_distance)
buffer_distances =
seq(from=buffer_distance, to=buffer_max_distance, by=buffer_distance)
buffer_breaks = c(0,buffer_distances)
buffer_labels =
c(gsub("0.", ".", buffer_breaks))
#buffer_breaks = c(buffer_distances,buffer_max_distance+buffer_distance)1.2 American Community Survey Census Tracts
This study is using Census Tracts & Transit stations in the urban area of the Eastern San Francisco Bay Area “East Bay”: Oakland, Berkeley, and the immediate suburban cities of Alameda, Albany, Emeryville, and Albany.
The census tracts are for the ACS years of 2009 and 2019 – which allows us to have a 10-year comparision. There are 6 primary variables that are pulled from the ACS, which can all be seen in Sections 3 & 4, or listed below: + Total Population (5.1), + Median Gross Rent (includes Utilities costs) (2.2 & 5.2), + People per Occupied Housing Unit (2.1); + Percent of Income Spent on Rent (2.3); + Percent of Residents between the ages of 22 and 34 (2.4); and + Percent of Residents Employed in the Information industry (e.g. Software, Technology, Media) (2.5).
#View(load_variables(2009, "acs5", cache = TRUE))
# ACS VARIABLES TO FOCUS ON
acs_var = c(
"B01001_001", # total pop
# HOUSING
"B19013_001", # median household income
#"B25001_001", # housing units # SOMETHING WRONG
#"B25008_001", # occupied housing units
'B25002_003', # vacant housing units
"B25058_001", # Median Contract rent
"B25064_001", # Median gross rent
"B25071_001", # median rent as percent of household income
"B07003_001", # total
"B07003_004", # total same house 1 year
# TRAVEL
"B08135_001", # aggregate time to work
"B08135_010", # aggregate time to work over 60 mins
# DEMOGRAPHIC
"B01001_010", # Male Age 22 to 24
"B01001_011", # Male Age 25 to 29
"B01001_012", # Male Age 30 to 34
"B01001_034", # Female Age 22 to 24
"B01001_035", # Female Age 25 to 29
"B01001_036" # Female Age 30 to 34
# THIS SECTION OF MY CODE IS DEDICATED TO THE VARIABLES THAT COULD HAVE BEEN STUDIED IF TIDY CENSUS DIDNT HAVE ERRORS WITH THESE TABLES
# Rest In Pieces
## "B08201_001", # household size
## "B08201_002", # households with not vehicle
## "B24114_001", # total occupations
## "B24114_068" # total software developers
)
# preparing dummy housing fields
B07013_002 = 0
B07013_003 = 0
B25008_002 = 0
B25008_003 = 0
# FUNCTION TO PULL EACH ACS YEAR'S CENSUS TRACTS
get_acs_year <- function(acs_year) {
# TIDY CENSUS PULL
# add in housing variables per year (same fields but differing variable name/id)
acs_var = c(acs_var,
ifelse(acs_year==2019,
c(
"B07013_002", # 2019 owner lived in units
"B07013_003" # 2019 renter lived in units
), c(
"B25008_002", # 2009 owner lived in units
"B25008_003" # 2009 renter lived in units
)))
tracts.acs =
get_acs(
geography = "tract",
variables = acs_var,
year=acs_year, state='CA', county='Alameda',
geometry=T) %>%
st_transform(CA_crs)
# directory = 'C:/Users/nelms/OneDrive/Penn/MUSA-508/Files'
# filename = gsub(" ","",paste('census', acs_year, '_tracts.geojson'))
# tract_path = file.path(directory, filename)
#
# tracts.acs = st_read(tract_path)
tracts.acs =
tracts.acs %>%
dplyr::select( -NAME, -moe) %>%
spread(variable, estimate)
# GROUP BY GEOID TO FIX MULTIPOLYGON ISSUE
tracts.acs =
tracts.acs %>%
group_by(GEOID) %>%
summarise(
year = acs_year,
tot_pop = first(B01001_001),
med_HH_inc = first(B19013_001),
med_rent = first(B25058_001),
med_rent_util = first(B25064_001),
tot_units = ifelse(acs_year==2019,
first(B07013_002)+first(B07013_003),
first(B25008_002)+first(B25008_003)), #+ first(B25002_003),
pct_60m_commute = first(B08135_010) / first(B08135_001),
tot_22_34yo = first(B01001_010) + first(B01001_011) + first(B01001_012)
+ first(B01001_034) + first(B01001_035) + first(B01001_036),
pct_22_34yo = tot_22_34yo/first(B01001_001),
tot_moved = first(B07003_001) - first(B07003_004),
pct_moved = tot_moved/first(B07003_001),
pct_med_rent = first(B25071_001),
geometry = st_union(geometry), # turn to multipoly
# median contract rent (just rent) adjusted by 2019 inflation
med_rent_inf =
ifelse(acs_year == 2009, med_rent * 1.19, med_rent),
# median gross rent (rent + utilities) adjusted for inflation
med_rent_util_inf =
ifelse(acs_year == 2009, med_rent_util * 1.19, med_rent_util),
# median rent (in 2009) adjusted by 2019 inflation
med_HH_inc_inf =
ifelse(acs_year == 2009, med_HH_inc * 1.19, med_HH_inc)
)
# REMOVE RAW ACS FIELDS
non_raw_cols =
colnames(tracts.acs)[!startsWith(colnames(tracts.acs), "B")]
tracts.acs = tracts.acs[non_raw_cols]
return (tracts.acs)
}
# ADD ACS EMPLOYMENT FIELDS THAT TIDYCENSUS WOULDN'T IMPORT
get_acs_subinfo = function(acs_year){
# local csv
directory = 'C:/Users/nelms/OneDrive/Penn/MUSA-508/Files'
filename = gsub(" ","",paste('census', acs_year, '_employment.csv'))
focus_year = read.csv(file=file.path(directory, filename))
focus_year$GEOID = sapply(focus_year$GEOID, function(g) paste('0', as.character(g), sep=''))
focus_year =
focus_year[focus_year$GEOID != '0NA',]
return(focus_year)
}
tracts.all = rbind(
get_acs_year(2009),
get_acs_year(2019)
) %>% st_as_sf()
## Getting data from the 2005-2009 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%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|======= | 10%
|
|======== | 11%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|======================= | 33%
|
|======================== | 34%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 79%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%
## Getting data from the 2015-2019 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%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================= | 65%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%
tracts.info =
rbind(
get_acs_subinfo(2009),
get_acs_subinfo(2019))
tracts.all = merge(
tracts.all,
tracts.info,
by = c('GEOID','year'),
all.x = TRUE) %>%
st_as_sf()Figure 1.1 highlights (1) the Easy Bay cities in comparison to BART stations, (2) the ½ mile buffers that extend out of those stations, and (3) the closest station to each census tract’s centroid.
# CREATE ERASE FUNCTION
st_erase <- function(x, y) {
st_difference(x, st_union(y))}
# ERASE WATER AREAS FROM CENSUS TRACTS
EB.water =
area_water("CA", "Alameda", class = "sf") %>%
st_transform(., CA_crs)
##
|
| | 0%
|
|===== | 8%
|
|============ | 17%
|
|===================== | 31%
|
|=========================== | 38%
|
|=================================== | 50%
|
|=========================================== | 62%
|
|========================================================= | 81%
|
|================================================================= | 93%
|
|======================================================================| 100%
tracts.all <- st_erase(tracts.all, EB.water)
# GET CENTROIDS IN EAST BAY
tracts.all.centroid =
tracts.all[c('GEOID','geometry')] %>%
# centroid with largest poly to avoid water in city shapes
st_centroid(tracts.all, of_largest_polygon = TRUE) %>%
st_join(., EB.cities, left=TRUE) %>%
distinct(GEOID, .keep_all = TRUE)
tracts.all.centroid =
tracts.all.centroid[tracts.all.centroid$city %in% is_EB,]
# SELECT TRACTS BY EAST BAY
center_geoms = tracts.all.centroid$GEOID
tracts.all = tracts.all[tracts.all$GEOID %in% center_geoms,]
# ERASE CITIES BY WATER
EB.cities <- st_erase(EB.cities, EB.water)
min_BART_dist_find = function(tract.pt){
dists_bart = sapply(
BART.stops$geometry, function(BART_pt)
st_distance(BART_pt, tract.pt))
return(min(dists_bart))
}
tract_bart_distances = min_point_distances(
tracts.all.centroid$geometry, tracts.all.centroid$GEOID,
BART.stops$geometry, BART.stops$stop_id) %>%
rename(GEOID=ID, dist_BART=distance, closest_BART=closest)
tracts.all.centroid =
tracts.all.centroid %>%
merge(
.,
tract_bart_distances,
by='GEOID', all.x = TRUE
)
# CALCULATE NEW COLUMNS BY WEIGHTING & LQ
tracts.all =
tracts.all %>%
merge(
.,
tracts.all.centroid %>% as.data.frame() %>%
select(GEOID, city, dist_BART, closest_BART) %>%
rename(dist_BART_feet=dist_BART) %>%
distinct(.),
by='GEOID', all.x = TRUE) %>%
mutate(
# distance to BART by miles
dist_BART_miles=dist_BART_feet/mile,
# area of tract that's not water
land_area = st_area(geometry),
# total population over housing units
pop_units = ifelse(tot_units==0, NA,
tot_pop / tot_units),
# get percent of employees in information industry
pct_emp_info = (tot_emp_info / tot_emp)*100
)
attributes(tracts.all$land_area) = NULL
# population per sq mile
tracts.all$dens_pop = tracts.all$tot_pop/(tracts.all$land_area/sqmile)
# housing units per sq mile
tracts.all$dens_units = tracts.all$tot_units /(tracts.all$land_area/sqmile)
selects = c("06001401900","06001402000","06001402200", "06001981900", "06001982000")
tracts.all[tracts.all$GEOID %in% selects,]
## Simple feature collection with 6 features and 28 fields
## Geometry type: POLYGON
## Dimension: XY
## Bounding box: xmin: 6029469 ymin: 2116347 xmax: 6047505 ymax: 2124940
## Projected CRS: NAD83 / California zone 3 (ftUS)
## GEOID year tot_pop med_HH_inc med_rent med_rent_util tot_units
## 37 06001401900 2009 678 48750 1292 1552 349
## 38 06001402000 2009 87 6845 NA NA 42
## 40 06001402200 2009 1729 28355 912 957 388
## 41 06001402200 2019 2477 68606 1500 1593 672
## 337 06001981900 2019 58 171563 2750 2750 0
## 338 06001982000 2019 63 128750 NA NA 63
## pct_60m_commute tot_22_34yo pct_22_34yo tot_moved pct_moved pct_med_rent
## 37 NA 261 0.3849558 0 0.00000000 42.7
## 38 NA 21 0.2413793 0 0.00000000 NA
## 40 NA 550 0.3181029 511 0.30764600 42.3
## 41 0.3254692 653 0.2636254 313 0.12677197 32.7
## 337 NA 42 0.7241379 4 0.06896552 18.4
## 338 NA 8 0.1269841 10 0.15873016 NA
## med_rent_inf med_rent_util_inf med_HH_inc_inf X tot_emp tot_emp_info
## 37 1537.48 1846.88 58012.50 19 19 0
## 38 NA NA 8145.55 20 9 0
## 40 1085.28 1138.83 33742.45 22 978 29
## 41 1500.00 1593.00 68606.00 19 1391 58
## 337 2750.00 2750.00 171563.00 358 54 15
## 338 NA NA 128750.00 359 37 0
## city dist_BART_feet closest_BART geometry
## 37 Oakland 4847.395 WOAK POLYGON ((6031967 2122517, ...
## 38 Oakland 2794.864 WOAK POLYGON ((6038026 2117129, ...
## 40 Oakland 1613.874 WOAK POLYGON ((6043541 2122923, ...
## 41 Oakland 1613.874 WOAK POLYGON ((6040996 2121368, ...
## 337 Oakland 5669.837 WOAK POLYGON ((6029469 2121022, ...
## 338 Oakland 2906.838 WOAK POLYGON ((6046297 2116779, ...
## dist_BART_miles land_area pop_units pct_emp_info dens_pop dens_units
## 37 0.9180672 42641085 1.942693 0.000000 443.27097 228.17341
## 38 0.5293304 14738646 2.071429 0.000000 164.56198 79.44371
## 40 0.3056580 2565075 4.456186 2.965235 18791.56004 4216.96084
## 41 0.3056580 7464138 3.686012 4.169662 9251.54346 2509.90602
## 337 1.0738328 40926240 NA 27.777778 39.50881 0.00000
## 338 0.5505375 13458590 1.000000 0.000000 130.49949 130.49949
BART.stops =
BART.stops %>%
mutate(
lon = map_dbl(geometry, ~st_centroid(.x)[[1]]),
lat = map_dbl(geometry, ~st_centroid(.x)[[2]]),
stop_nm = gsub("St. Oakland.*", "St", stop_nm)
)
buff_plot =
ggplot() +
geom_sf(
data=EB.cities, fill='grey90') +
geom_sf(
data=BART.routes, color='grey20',
alpha=.5, lwd=1.5) +
geom_sf(
data=BART.buffers[BART.buffers$stop_id=='ALL',],
fill='transparent', aes(color=distance), lwd=.75) +
geom_sf(
data=BART.stops, fill='white',
color='grey30', shape=21) +
scale_color_stepsn(
#labels = buffer_labels,
breaks = buffer_breaks,
colors=brewer.pal(length(buffer_breaks),
name='Spectral'), guide='none') +
labs(subtitle='½ Mile Buffer from Stations') +
mapTheme() + plot_limits()
tracts_tracks =
ggplot() +
# base tracts
geom_sf(data=tracts.all, size=.5,
color='grey80', fill='grey90') +
# cities
geom_sf(data=EB.cities, fill='transparent',
color=alpha('grey50',.5),
lwd=1, linetype = "dashed") +
# centroids
# geom_sf(data=tracts.all.centroid, color='grey50', size=.5) +
# BART routes
geom_sf(data=BART.routes, color=BART.routes$route_s_nm, lwd=1.5) +
# BART stops
geom_sf(data=BART.stops, fill='white',
color='grey30', shape=21) +
# labels
geom_label(
data=EB.labels,
size = 2, fontface='bold', color='grey20', label.size = NA,
box.padding = 0.5, fill=alpha('white',.5),
aes(x=lon,y=lat, label=label)) +
labs(subtitle = 'Cities, Tracts & Routes') +
mapTheme() + plot_limits()
nearest_stop =
ggplot() +
# base tracts
geom_sf(data=tracts.all, size=.5,
color='grey80', fill='grey90') +
# Tracts BART
geom_sf(
data=tracts.all[tracts.all$year==2019,], color=alpha('black',.1),
aes(
fill=tracts.all[tracts.all$year==2019,]$closest_BART,
alpha=tracts.all[tracts.all$year==2019,]$dist_BART_miles)) +
# BART stops
geom_sf(data=BART.stops,
color='black', shape=19, size=1) +
# labels
geom_label_repel(
data=BART.stops,
size = 2, fontface=2, color='grey20', label.size = NA,
fill=alpha('white',.5),
aes(x=lon,y=lat, label=stop_nm)) +
scale_fill_discrete(name="Closest BART", guide='none') +
labs(subtitle = 'Closest Station to each Tract') +
scale_alpha_continuous(breaks=c(.5,1,1.5,2), name="Distance", range=c(1,0), guide='none') +
mapTheme() + plot_limits()
tracts_tracks + buff_plot + nearest_stop + plot_annotation(title='East Bay Census Tracts & BART')
Figure 1.1: East Bay Cities, BART Station .5 mile Buffers, & Closest Station to Census Tracts
The TOD census tracts need to meet at least one of the two following requirements: (1) at least 50% of the tract’s land area is within the ½ mile BART station buffers, or (2) at least 25% of the land area is within the ½ mile buffer (but that tract’s buffer area is above .075 square miles). The second requirement accommodates TOD tracts that show the direct impacts from their transit proximity – but have a geometry that is large enough to prevent them from being a majority within the ½ mile buffer.
Figure 1.2 highlights the 3 methods to narrow down TOD tracts — with the selected tracts being highlighted with black outlines.
#tracts.all = st_as_sf(at)
# .5 MILE BUFFERS OF BART STOPS
BART.buffers.TOD =
BART.buffers[
BART.buffers$distance == buffer_distance &
BART.buffers$stop_id == 'ALL'
,]
# CLIP TRACTS BY BUFFER
clip =
st_intersection(tracts.all, BART.buffers.TOD) %>%
select(GEOID, year, land_area) %>%
group_by(GEOID, year) %>%
summarize(
geometry = st_union(geometry),
land_area = sum(land_area)
) %>%
mutate(
# find area that is in the buffer
clip_area = as.vector(st_area(geometry)),
# percent of buffer area to total
pct_in_tod = as.vector(clip_area / land_area),
Selection_Type = "Clip")
## `summarise()` has grouped output by 'GEOID'. You can override using the `.groups` argument.
clipped = clip[c("GEOID", "year", "pct_in_tod","clip_area")]
clipped$geometry = NULL
# GET TOTAL & PERCENT LAND IN CLIP
tracts.all =
merge(tracts.all,
clip %>% st_drop_geometry() %>% select(GEOID, year, pct_in_tod, clip_area),
by = c("GEOID","year"), all.x = TRUE)
tracts.all[is.na(tracts.all$clip_area), 'clip_area'] = 0
tracts.all[is.na(tracts.all$pct_in_tod), 'pct_in_tod'] = 0
# GET OTHER SELECTIONS FOR COMPARING
selection =
tracts.all[BART.buffers.TOD,] %>%
dplyr::select(GEOID, pct_in_tod) %>%
mutate(
Selection_Type = "Spatial Selection")
selectCentroids =
tracts.all.centroid[BART.buffers.TOD,] %>%
st_drop_geometry() %>%
left_join(dplyr::select(tracts.all, GEOID, pct_in_tod)) %>%
st_sf() %>%
mutate(Selection_Type = "Centroid Selection")
## Joining, by = "GEOID"
# NARROW DOWN TOD TRACTS BASED ON CLIPPED STOPS BUFFER AREA (% and TOT)
tracts.all = tracts.all %>%
mutate(
TOD = if_else(
# select tracts that had 50% of their land in .5mi stops buffer
((
tracts.all$pct_in_tod>=.5
) |
# select tracts that had:
( ### at least 20% of their land in the buffer, and
(tracts.all$pct_in_tod>.25) &
### at least .01 sq.miles (278,784 )
(tracts.all$clip_area>sqmile*.075)
) | (tracts.all$GEOID %in% selects)),
'TOD',
'Non-TOD'
))
tracts.TOD = tracts.all[tracts.all$TOD=='TOD',]
ggplot() +
geom_sf(
data=EB.cities %>% st_union(), fill='grey90') +
geom_sf(data=clip, aes(fill=pct_in_tod)) +
geom_sf(data=selection, aes(fill=pct_in_tod)) +
geom_sf(data=selectCentroids, aes(fill=pct_in_tod)) +
geom_sf(data=BART.buffers.TOD, fill='transparent', color='red', lwd=1) +
geom_sf(data=tracts.TOD %>% filter(year==2019) %>% st_union(),
fill='transparent', aes(color='Black'), lwd=1)+
geom_sf(
data=BART.stops, fill='white',
color='grey30', shape=21) +
scale_fill_steps2(
low = "red",
mid = "white",
midpoint=.5,
high = "blue",
name='% of land area\nwithin ½ Mile Station Buffer',
labels = percent, limits = c(0,1)
) +
scale_color_identity(guide = "legend", name='TOD Tracts', labels=c('Primarily within ½ Mile Buffer*')) +
facet_wrap(~Selection_Type) +
labs(title='Selecting Transit Oriented Development Census Tracts',
subtitle = "TOD Tracts have 50% of their Total Area within the ½ Mile Station Buffer\nor 25% of their Total Area (when the Buffer Area is at least .075 square miles)", caption="* Either the Tract's Buffer Area is 50% of Total Area or 25% of Total Area, if the Buffer Area is greater than .075 square miles")+
mapTheme() + plot_limits(poly.geometry = BART.buffers.TOD, buffer=mile*.25)
Figure 1.2: East Bay Cities, BART Station .5 mile Buffers, & Closest Station to Census Tracts
1.3 Homeless Encampment Complaints
The final part of the study (Section 6) is to focus on just the City of Oakland (for 2009, 2014, 2019) — with a special focus on the rise of homelessness in the city.
library(zoo)
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
OAK.311.path = "C:/Users/nelms/OneDrive/Penn/MUSA-508/Files/OAK_311.csv"
OAK.311 = read.csv(OAK.311.path) %>%
rename(
id = REQUESTID,
date_in = DATETIMEINIT,
description = DESCRIPTION,
category = REQCATEGORY,
geom = REQADDRESS,
address = PROBADDRESS,
lat = SRY,
long = SRX
) %>%
mutate(
datetime = mdy_hms(date_in, quiet=TRUE, tz = "America/Los_Angeles"),
date = datetime %>% as.Date(),
year_qtr = date %>% as.yearqtr(),
year = format(date, "%Y"),
cat = sub("\\_.*", "", category),
description = sub(" in | on | � | – |\\\\|/| [(]", " - ", description) %>%
sub("TE ", "Traffic ", .) %>% sub("Oakland Police - Abandoned Auto", "Abandoned Auto", .) %>% str_trim(.),
desc = sub("\\-.*", "", description) %>%
gsub("(Traffic).*", "\\1", .) %>% gsub("(Recycling).*", "\\1", .) %>%
gsub("(Oakland Police).*", "\\1", .) %>% gsub("(Trash).*", "\\1", .) %>%
str_trim(.)
) %>%
filter(
desc %in% c("Illegal Dumping", "Homeless Encampment"),
!is.na(lat) & !is.na(long),
(lat>0) & is.numeric(lat),
(long>0) & is.numeric(long),
(is.POSIXct(datetime))
) %>%
select(id, datetime, date, year, year_qtr, desc, lat, long) %>%
st_as_sf(., coords = c('long','lat'), crs=CA_crs) %>% arrange(datetime)
OAK.311[OAK.311$year_qtr %in% c(unique(OAK.311$year_qtr)[3], unique(OAK.311$year_qtr)[3]), "year"] = "2009"
OAK.311 = OAK.311 %>% filter(year %in% c("2009","2014", "2019"))
OAK.311 =
st_join(OAK.311, EB.cities[EB.cities$city=='Oakland',],
join=st_intersects) %>% filter(city=="Oakland") %>% select(-size)
OAK.311.desc =
OAK.311 %>% st_drop_geometry() %>%
group_by(year) %>% count(desc) %>%
spread(desc, n)
OAK.311.desc
## # A tibble: 3 x 3
## # Groups: year [3]
## year `Homeless Encampment` `Illegal Dumping`
## <chr> <int> <int>
## 1 2009 94 9920
## 2 2014 748 19219
## 3 2019 3217 31470Since it is difficult to quantify a direct, spatial count of homelessness, a placeholder variable will be used: the amount of complaints about homeless encampments made by citizens to the City of Oakland’s 311 citizen outreach. This data will be visualized in the graduated symbol maps of Section ??.
get_base_tracts = function(
acs_year,
acs_var_base=c("B25064_001")
){
tracts.acs =
get_acs(
geography = "tract",
variables = acs_var_base,
year=acs_year, state='CA', county='Alameda',
geometry=T) %>%
st_transform(CA_crs)
tracts.acs =
tracts.acs %>%
dplyr::select( -NAME, -moe) %>%
spread(variable, estimate)
tracts.acs =
tracts.acs %>%
rename(med_rent = B25064_001) %>%
mutate(
med_rent_inf =
med_rent * ifelse(acs_year == 2009, 1.19,
ifelse(acs_year == 2014, 1.08,
1)),
year = acs_year %>% as.character())
return(tracts.acs)}
tracts.OAK = rbind(
get_base_tracts(2009),
get_base_tracts(2014),
get_base_tracts(2019)
) %>% st_as_sf()
## Getting data from the 2005-2009 5-year ACS
## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
## Getting data from the 2010-2014 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%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 13%
|
|========== | 14%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|======================= | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================= | 46%
|
|================================= | 47%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 59%
|
|========================================== | 60%
|
|========================================== | 61%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================== | 79%
|
|======================================================== | 80%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 83%
|
|========================================================== | 84%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================= | 88%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================= | 94%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%
## Getting data from the 2015-2019 5-year ACS
## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.
EB.OAK = EB.cities[EB.cities$city=='Oakland', ] %>% st_buffer(.,500) %>%
st_erase(., EB.cities[EB.cities$city!='Oakland', ])
tracts.OAK.c =
tracts.OAK %>% st_centroid(., of_largest_polygon=TRUE) %>%
st_join(., EB.OAK,
join=st_intersects) %>% filter(city=="Oakland") %>% select(-size)
tracts.OAK.c$GEOID_year = paste(tracts.OAK.c$GEOID, tracts.OAK.c$year)
OAK_bart_distances = min_point_distances(
tracts.OAK.c$geometry, tracts.OAK.c$GEOID_year,
BART.stops$geometry, BART.stops$stop_id) %>%
rename(GEOID_year=ID, dist_BART=distance, closest_BART=closest) %>%
mutate(GEOID = sub("\\ .*", "", GEOID_year), year = sub(".* ", "", GEOID_year))
tracts.OAK =
tracts.OAK %>%
merge(
.,
OAK_bart_distances,
by=c('GEOID', 'year'),
)
tracts.OAK = st_erase(tracts.OAK, EB.water) %>%
st_erase(., EB.cities[EB.cities$city!='Oakland', ])
#EB.OAK = st_erase(EB.OAK, EB.water)
select_choice = function(focus.year, focus.desc, tract.geometry){
focus.311 = OAK.311[(OAK.311$year==focus.year)&(OAK.311$desc==focus.desc),]
count_focus = lengths(st_intersects(tract.geometry, focus.311))
return(count_focus)}
select_choice = Vectorize(select_choice)
tracts.OAK =
tracts.OAK %>%
mutate(
Illegal_Dumping = select_choice(year, 'Illegal Dumping', geometry),
Homeless_Encampment = select_choice(year, 'Homeless Encampment', geometry)
)2 Five Time & Space Maps
Comparing TOD & non-TOD Tracts between 2009 & 2019
These five maps paint a primer of the housing and demographic change between 2009 and 2019 in the East Bay.
2.1 People per Unit
Total Population per Occupied Housing Units
Figure 2.1 is the first variable that highlights the overall building and housing conditions of the East Bay. Both the 2009 and 2019 maps highlight the general characteristics of the building density and housing stock: there is more multiple family housing (4+ people per unit) in the areas closer to BART stations and more single family housing farther away from the stations. Of note is the extremely high residents per unit (20+ people) in Berkeley to the university’s student housing. Another important note is the extremely low density, un-changing hills of East Berkeley and Oakland – where the high elevation, large stock of single-family housing, and aging residents makes it difficult to add density.
Between 2009 and 2019, we don’t see too much of a change in location – just a general increase in residents per housing unit. At the same time, West Berkeley, Emeryville, and Far-South Oakland all see an increase from 1.5 people per unit to almost 4 people per unit; this is likely the result of many industrial buildings being converted to apartments.
options(scipen=999)
get_labels = function(
cut_breaks, round_digit = 0, bucket_diff=1, first_start_range=0, last_end_range=TRUE, input_end_range='', bucket_suffix='', bucket_prefix=''
){
labels =
cut_breaks %>% gsub(",", " to ", .) %>%
str_sub(., 2, -2) %>% unique(.)
list_str = function(l, remove=0){
format(round(as.numeric(l), digit=round_digit)-remove, big.mark=",")}
for (i in seq(from=1,to=length(labels))){
bucket_range = labels[i] %>% str_split(., " to ")
start_range = paste(bucket_prefix, list_str(bucket_range[[1]][1]))
end_range = paste(list_str(bucket_range[[1]][2], remove=bucket_diff), bucket_suffix)
if (i == 1 & first_start_range != ''){
start_range = paste(bucket_prefix, list_str(first_start_range))}
if (i == length(labels) & input_end_range!=''){
end_range=paste(list_str(input_end_range), bucket_suffix)
last_end_range=TRUE
}
if (i == length(labels) & last_end_range==FALSE){end_range='+'}
bucket = paste(
start_range,
'to',
end_range) %>% str_trim()
labels[i] = bucket}
return(labels)
}
plot_vari = function(
focus_sf = tracts.all,
variable = "dens_pop",
qbreaks = qBr(tracts.all, variable),
bucket_diff = 1,
title = "Population Density",
subtitle = "2009-2019 East Bay with ½ mile station buffers",
legend_nm = variable,
caption = "",
brewer_colors = 'Spectral',
round_digit = 0,
last_end_range = TRUE,
input_end_range = '',
bucket_suffix = '',
bucket_prefix = '',
buff_col = 'red',
col_rev = FALSE,
first_start_range = 0,
leg_xspace = .025
){
cutting_field = function(var_field, var_breaks){return(var_field %>% cut(., breaks = var_breaks, dig.lab=10, include.lowest = TRUE))}
focus_sf$cut_field = cutting_field(focus_sf[[variable]], qbreaks)
cut_breaks = sapply(focus_sf$cut_field, function(brk) brk %>% levels())
labels = get_labels(
cut_breaks,
round_digit = round_digit, bucket_diff=bucket_diff,
last_end_range=last_end_range, first_start_range=first_start_range,
input_end_range=input_end_range, bucket_suffix=bucket_suffix, bucket_prefix=bucket_prefix)
breaks_amount = length(qbreaks)-1
col_vals = brewer.pal(breaks_amount, name=brewer_colors)
if (col_rev==TRUE){col_vals=rev(col_vals)}
return(
ggplot()+
# geom_sf(data = EB.all, fill=alpha('grey50', .5), color=alpha('grey50', .5)) +
# geom_sf(data = EB.back_water, fill=alpha('cornflowerblue', .5), color='transparent') +
geom_sf(data = EB.cities, fill='grey90')+
geom_sf(data = focus_sf, aes(fill = cut_field), color='grey50') +
scale_fill_manual(
values=col_vals,
labels = labels, name=legend_nm) +
geom_sf(data=BART.buffers.TOD, fill='transparent', color=alpha(buff_col, alpha=.75), lwd=.75) +
geom_sf(
data=BART.stops, fill='white',
color='grey30', shape=21) +
# geom_text(
# data=EB.labels, check_overlap=TRUE,
# size = 3.5, fontface='bold', color='black',
# aes(x=lon,y=lat, label=label)) +
labs(title = title, subtitle = subtitle,
caption=caption) +
guides(fill = guide_legend(title.position="top",
#reverse=T,
title.hjust = 0.5, title.vjust = 0)) +
theme(legend.position = "bottom",
legend.spacing.x = unit(leg_xspace, 'in'),
legend.text = element_text(
margin = margin(r = .1, unit = 'in')),
legend.margin=margin(0,0,0,0),
legend.box.margin=margin(-5,-5,-5,-5)) +
facet_wrap(~year)+
mapTheme() + plot_limits()
)}
variable = "pop_units"
filt_sf = tracts.all[!is.na(tracts.all[[variable]]) &
!is.infinite(tracts.all[[variable]])
,]
mx = max(filt_sf[[variable]])
breaks = c(0,1.5,2,2.5,4,20, mx)
#breaks = seq(0, mx, length.out = 4)
plot_vari(
focus_sf = filt_sf,
variable = variable,
qbreaks = breaks,
title = "People per Housing Unit",
brewer_colors = 'BuPu',
legend_nm = "Total Residents per Occupied Housing Unit",
bucket_suffix = '',
input_end_range = '50',
last_end_range = FALSE,
round_digit=2,
bucket_diff=.1,
first_start_range=1,
leg_xspace = .2
)
Figure 2.1: People per Unit
#hist(filt_sf[['pop_units']], breaks=500, xlim=c(1,4))
#filt_sf$pop_units<502.2 Rent
Household Median Rent & Utilities Cost (Adjusted to 2019 inflation)
The East Bay’s median gross rent reveals a dramatic jump in rent in a 10 year period — even adjusting for the 2019 inflation. A dramatic change is the areas of lower income rent – Downtown Oakland, Fruitvale, Emeryville, and West Berkeley – all seeing a $500 to $1,000 increase in rent. West Berkeley & Emeryville’s dramatic increase in rent and people per unit suggest a drastic change. Most of the immediate TOD tracts have increases, but not unique to the overal increase; so is there a demand for non-TOD housing in the West?.
variable = "med_rent_inf"
filt_sf = tracts.all[!is.na(tracts.all[[variable]]) &
!is.infinite(tracts.all[[variable]])
,]
mx = max(filt_sf[[variable]])
#breaks = seq(0, mx, length.out = 6)
#breaks = c(0, 10000,20000,30000, mx)
breaks = c(0, 1000, 1500, 2000, mx)
plot_vari(
focus_sf = filt_sf,
variable = variable,
qbreaks = breaks,
title = "Median Gross Rent",
caption = "",
brewer_colors = 'Greens',
legend_nm = "Household Median Rent + Utilities (Adjusted to 2019 Inflation)",
input_end_range="3500",
bucket_prefix = '$',
first_start_range=500,
buff_col='blue'
)
Figure 2.2: Median Rent
variable = 'med_rent_util_inf'
brewer_colors = 'Greens'
2.3 Income spent on Rent
Percent of Median Household Income spent on Rent
This map of the percent of income spent on rent suggests a large change in personal finances and/or population in many areas of the city. The noticeable change is the actual decrease in the percent of income spent on rent – especially West Berkeley, Emeryville, West Oakland, and South Oakland.
Even though it initially appears optimistic that more residents are affording rent, it starts to turn pessimistic when recalling the sharp rise in rent in Figure 2.2. For West Berkeley, Emeryville, and West Oakland, the large increase in rent combined with less income going towards rent suggests the introduction of new units and wealthier residents. One tract in particular on the farthest tip of West Oakland goes from 43% of income going towards rent to only 19% – with a rise of median rent going from $1,552 to $2,750 in that same period.
variable = "pct_med_rent"
filt_sf = tracts.all[!is.na(tracts.all[[variable]]) & !is.infinite(tracts.all[[variable]]),]
mx = max(filt_sf[[variable]])
#breaks = seq(0, mx, length.out = 6)
#breaks = c(0, 10000,20000,30000, mx)
breaks = c(0, 10,20,30,40, mx)
plot_vari(
focus_sf = filt_sf,
variable = variable,
qbreaks = breaks,
title = "Percent of Income Spent on Rent",
brewer_colors = 'RdYlGn',
legend_nm = "% of Median Income Spent on Rent + Utilities",
input_end_range='50',
bucket_suffix='%',
col_rev=TRUE,
buff_col='blue'
)
Figure 2.3: Income on Rent
2.4 Young Adults
Percent of People between the ages of 22 and 34 compared to total people
The percent of young adults (Figure 2.4) highlights concentrations of young adults (above 30%). At the same time, the aging Oakland/Berkeley Hills population and the low-income families of South Oakland & Fruitvale retain the same age composition in this period. This map locates the ‘young urban professionals’ who have money, fewer responsibilities, and an ability to move to their location of choice. Northern TOD tracts and West Berkeley seem to receive the largest growth in young adults. The underlying complication of this map is remembering the East Bay’s .003% increase in units for the 10% increase of population during this period.
variable = "pct_22_34yo"
filt_sf = tracts.all %>%
transform(., pct_moved=as.numeric(pct_moved)) %>%
filter(!is.na(tracts.all[[variable]]) &
!is.infinite(tracts.all[[variable]]))
filt_sf[[variable]] = filt_sf[[variable]] * 100
mx = max(filt_sf[[variable]])
#breaks = seq(0, mx, length.out = 5)
breaks = c(0, 15, 30, 45, mx)
filt_sf$cut_field =
filt_sf[[variable]] %>%
cut(.,
breaks = breaks, dig.lab=10, include.lowest = FALSE)
plot_vari(
focus_sf = filt_sf,
variable = variable,
qbreaks = breaks,
bucket_diff=1,
round_digit=0,
title = "Percent of Young Adults (22-34)",
caption = "",
brewer_colors = 'PuRd',
legend_nm = "% of Residents between the ages of 22 and 34",
input_end_range='75',
bucket_suffix='%',
col_rev=FALSE
)
Figure 2.4: Young Adults
2.5 Employees of Tech & Software companies
Percent of Employed People in the Information Industry (e.g. Technology, Software, Media) compared to Total Employed People
This map of the employees of the technology, software and media (Figure 2.5) strikes at the heart of the Bay Area’s booming economy, pricing-out, and ‘gentrification’. There is an increase of tech employees in the previously mentioned young and wealthy areas: Northern TOD tracts, West Berkeley, West Oakland, and Emeryville. At the same time, tech employees start to encroach on the neighborhoods of the typically low-income households: Fruitvale, Downtown Oakland, and West Oakland.
variable = "pct_emp_info"
filt_sf = tracts.all %>%
mutate(pct_22_34yo = pct_22_34yo * 100) %>%
filter(!is.na(tracts.all[[variable]]) &
!is.infinite(tracts.all[[variable]]))
mx = max(filt_sf[[variable]])
# Break reasons: min, right below mean/median (3.7%, 3.5%), above 3rd quantile, odd spike around 9-10%, max
breaks = c(0, 3, 6, 9, mx)
plot_vari(
focus_sf = filt_sf,
variable = variable,
qbreaks = breaks,
bucket_diff=1,
round_digit=0,
title = "Percent of Employed Residents in the Information Industry 2009-2019",
brewer_colors = 'OrRd',
legend_nm = "% of Information Industry Employees (e.g. Technology, Software, Media)\nout of all Employed Residents",
input_end_range='25',
bucket_suffix='%',
buff_col='Black'
)
Figure 2.5: Technology Employees
3 Bar Plot
One grouped bar plot making these same comparisons
The Bar Plots (Figure 3.1) highlight that there is a completely different narrative for TOD and non-TOD tracts. To start, population has been practically stagnant for non-TOD tracts – with an addition of 36,029 residents (a 0.07% increase); meanwhile, there was an increase of 26,840 TOD residents (a 24% increase). In a similar pattern, TOD tracts received relative jumps in the amount of young adults and tech employees, while the non-TOD tracts lied dormant. Overall, both TOD and non-TOD saw increases in rent and people per unit.
tracts.summary =
tracts.all %>% st_drop_geometry() %>%
mutate(
year = as.character(year),
pct_moved = pct_moved*100 ) %>%
group_by(year, TOD) %>%
summarize(
# Variable B Population
Population = sum(tot_pop, na.rm=T),
# Variable A Rent (Inflation)
y_Median_Rent = mean(med_rent_util_inf, na.rm = T),
# Variable 1 Popultion per Unit
yy_Pop_per_Unit = sum(tot_pop, na.rm=T)/sum(tot_units, na.rm=T),
#mean(ifelse(pop_units>50, NA, pop_units), na.rm = T),
# Variable 2 % Income Spent on Rent
z_Income_Rent_per = mean(pct_med_rent, na.rm = T),
# Variable 3 % Moved in Last Year
zz_Young_Adult_per = (sum(tot_22_34yo, na.rm=T)/sum(tot_pop, na.rm=T))*100,
# Variable 4
zzz_Info_per = (sum(tot_emp_info, na.rm=T)/sum(tot_emp, na.rm=T))*100)
## `summarise()` has grouped output by 'year'. You can override using the `.groups` argument.
plot_names = list(
'Population' = "Population",
'y_Median_Rent' = "Median Rent\n& Utilities",
'yy_Pop_per_Unit'= "Population\nper Housing Unit*",
'z_Income_Rent_per'="% of Income\n Spent on Rent",
'zz_Young_Adult_per' = "% of Pop between\n22 & 34 years old*",
'zzz_Info_per' = "% Information\nEmployees*"
)
plot_labeller <- function(variable, value){return(plot_names[value])}
col_labeller <- function(Variable, value){return(as.character(plot_names[value]))}
tot_levels = c('Population', 'z_Median_Rent', 'zz_Pop_per_Unit')
per_levels = c('Income_Rent_per', 'Moved_per', 'Info_per')
all_levels = c(tot_levels, per_levels)
total_bars =
tracts.summary %>%
select(-z_Income_Rent_per, -zz_Young_Adult_per, -zzz_Info_per) %>%
gather(Variable, Value, -year, -TOD) %>%
ggplot() +
geom_bar(stat = "identity", position = "dodge",
aes(year, Value, fill = TOD)) +
facet_wrap(Variable ~ .,
scales = "free", ncol=3,
labeller=plot_labeller,
) +
scale_fill_manual(values = c("#bae4bc", "#0868ac"), guide='none') +
labs(x=NULL, y=NULL) +
theme(panel.spacing = unit(1, "lines")) +
plotTheme()
percent_bars =
tracts.summary %>%
select(-Population, -y_Median_Rent, -yy_Pop_per_Unit) %>%
gather(Variable, Value, -year, -TOD) %>%
#mutate(Variable=factor(Variable, levels=per_levels)) %>%
ggplot() +
geom_bar(stat = "identity", position = "dodge",
aes(year, Value, fill = TOD)) +
facet_wrap(~Variable,
#~reorder(Variable, all_levels, first),
#~factor(Variable, levels = per_levels),
scales = "free", ncol=3,
labeller=plot_labeller
) +
scale_fill_manual(values = c("#bae4bc", "#0868ac")) +
labs(x=NULL, y=NULL) +
theme(panel.spacing = unit(1, "lines")) +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
plotTheme() + theme(legend.position="bottom")
total_bars / percent_bars +
plot_annotation(title = "Difference Between TOD Tracts",
subtitle = "variables with * were summed before adding percentages") + plotTheme() 
Figure 3.1: Bar Plot
4 Table
One table making these same comparisons
The table adds in the numbers previously discussed in the last section.
plot_names = list(
'Population' = "Population",
'y_Median_Rent' = "Median Rent & Utilities(Adjusted)",
'yy_Pop_per_Unit'= "Population per Housing Unit",
'z_Income_Rent_per'="% of Income Spent on Rent",
'zz_Young_Adult_per' = "% of Population between the ages of 22 and 34",
'zzz_Info_per' = "% of Population in the Information Industry"
)
col_labeller = function(value){return(as.character(plot_names[value]))}
rounder = function(value, colname){return(paste(
ifelse(str_sub(colname,1,4)=='z_Median_Rent', '$ ', ''),
format(round(value, digit = ifelse(value>31,0,2)),drop0trailing=TRUE, big.mark=","),
ifelse(str_sub(colname,-4,-1)=='_per', ' %', ''), sep=''))}
tracts.table =
tracts.summary %>%
unite(year.TOD, year, TOD, sep = ": ", remove = T) %>%
gather(Variable, Value, -year.TOD) %>%
mutate(Value = rounder(Value,Variable)) %>%
spread(year.TOD, Value) %>%
arrange(., Variable) %>%
mutate(Variable=col_labeller(Variable)) %>%
# mutate(Variable = factor(Variable, levels =c("Population","Median Rent & Utilities(Adjusted)","Population per Housing Unit","% of Income Spent on Rent","% of Population that Moved this Year","% of Population in the Information Industry"))) %>%
kable(., col.names = c("Mean Variables","non-TOD","TOD","non-TOD","TOD"), align="lrrrr") %>%
kable_styling() %>%
footnote(general_title = "\n", general = "Table 1.3") %>%
add_header_above(., header = c(" "=1, "2009" = 2, "2019" = 2))
#col.names = c("","2009","2009","2019","2019")
tracts.table| Mean Variables | non-TOD | TOD | non-TOD | TOD |
|---|---|---|---|---|
| Population | 491,334 | 113,921 | 527,363 | 140,761 |
| Median Rent & Utilities(Adjusted) | 1,426 | 1,181 | 1,746 | 1,565 |
| Population per Housing Unit | 1.96 | 2.92 | 2.13 | 3.33 |
| % of Income Spent on Rent | 33 % | 35 % | 30.88 % | 30.81 % |
| % of Population between the ages of 22 and 34 | 20.2 % | 26.4 % | 21.52 % | 28.32 % |
| % of Population in the Information Industry | 3.41 % | 3.58 % | 3.76 % | 4.72 % |
|
|
||||
| Table 1.3 |
5 Graduated Symbol Maps
Two Graduated Symbol Maps within 0.5 miles transit stations
The graduate symbols maps highlight the specific TOD trends for Berkeley and Oakland.
5.1 Map of Population within ½ Mile of BART Stations
The population graduated symbols (Figure 5.1) highlight the lack of lack of real population growth and the higher amount of population that is closer to TOD in North Oakland and Berkeley. Downtown Oakland, West Oakland, and the South Oakland stations don’t have as much population – likely due to the large amount of commercial and industrial space next to the stations.
variable = 'pop'
brewer_colors = 'Purples'
stops.TOD =
tracts.all[tracts.all$TOD=='TOD',] %>% st_drop_geometry() %>%
group_by(closest_BART, year) %>%
summarize(
rent = mean(med_rent_inf, na.rm=TRUE),
pop=sum(tot_pop, na.rm=TRUE)) %>% rename(stop_id = closest_BART) %>%
merge(.,
BART.stops %>% select(stop_id),
by='stop_id', left=TRUE)%>% st_as_sf()
## `summarise()` has grouped output by 'closest_BART'. You can override using the `.groups` argument.
plot_title = "Total Population within ½ Mile of BART Stations"
legend_title = "Total Population"
subtitle = "East Bay Census Tracts & BART Stations"
caption = "Map 5.A"
filt_sf = stops.TOD[!is.na(stops.TOD[[variable]]) &
!is.infinite(stops.TOD[[variable]])
,]
mx = max(filt_sf[[variable]])
qbreaks = c(0, 5000, 10000, 15000, 25000)
#qbreaks = seq(0, mx, length.out = 5)
cutting_field = function(var_field, var_breaks){return(var_field %>% cut(., breaks = var_breaks, dig.lab=10, include.lowest = TRUE))}
filt_sf$cut_field = cutting_field(filt_sf[[variable]], qbreaks)
cut_breaks = sapply(filt_sf$cut_field, function(brk) brk %>% levels())
labels = get_labels(
cut_breaks,
round_digit = 0,
bucket_diff = 1,
last_end_range = TRUE,
first_start_range = '',
input_end_range = '25000',
bucket_suffix = '')
breaks_amount = length(qbreaks)-1
col_vals = brewer.pal(breaks_amount, name=brewer_colors)
ggplot()+
#POLYGON
geom_sf(data = tracts.all, fill = "white",color = "grey75")+
geom_sf(
data=BART.buffers.TOD,
fill='transparent', color='red', lwd=1) +
geom_sf(
data=tracts.TOD %>% filter(year==2019) %>% st_union(),
fill='transparent', color='Black', lwd=1)+
geom_sf(
data=BART.stops, fill='white',
color='grey30', shape=21) +
# POINT
geom_sf(data = filt_sf,
shape = 21, color='grey10',
aes(size = cut_field, fill = cut_field)) +
scale_size_manual(
values = seq(4, 10, length.out = breaks_amount),
labels = labels,
name=legend_title)+
scale_fill_manual(
values = col_vals,
labels = labels,
name='Total Population', guide='none') +
labs(title = 'Total Population of TOD Tracts',
subtitle = 'grouped by BART Stations (sum)',
caption = '') +
guides(size =
guide_legend(override.aes = list(fill = col_vals))) +
theme(axis.title=element_blank(),axis.text=element_blank(),
axis.ticks=element_blank(), panel.background = element_rect(fill='gray')) +
facet_wrap(~year)+
mapTheme() + plot_limits(tracts.TOD %>% filter(year==2019), buffer=mile*.5)
Figure 5.1: Population Graduated Symbol
5.2 Map of Rent within ½ Mile of BART Stations
Overall, the rent increases in all of the station areas (in Figure 5.2). This shows both the increased demand to rent housing units and in TOD area.
variable = 'rent'
brewer_colors = 'Greens'
plot_title = "Median Gross Rent within ½ Mile of BART Stations"
legend_title = "Median Rent + Utilities\n(Adjusted to 2019 Inflation)"
subtitle = "East Bay Census Tracts & BART Stations"
caption = ""
filt_sf = stops.TOD[!is.na(stops.TOD[[variable]]) &
!is.infinite(stops.TOD[[variable]])
,]
mx = max(filt_sf[[variable]])
qbreaks = c(500,1000, 1400, 1900)
#qbreaks = seq(min(filt_sf[[variable]]), mx, length.out = 4)
cutting_field = function(var_field, var_breaks){return(var_field %>% cut(., breaks = var_breaks, dig.lab=10, include.lowest = TRUE))}
filt_sf$cut_field = cutting_field(filt_sf[[variable]], qbreaks)
cut_breaks = sapply(filt_sf$cut_field, function(brk) brk %>% levels())
labels = get_labels(
cut_breaks,
round_digit = 0,
bucket_diff = 1,
last_end_range = TRUE,
first_start_range = '500',
input_end_range = '1900',
bucket_suffix = '')
breaks_amount = length(qbreaks)-1
col_vals = brewer.pal(breaks_amount, name=brewer_colors)
ggplot()+
#POLYGON
geom_sf(data = tracts.all, fill = "white",color = "grey75")+
geom_sf(
data=BART.buffers.TOD,
fill='transparent', color='red', lwd=1) +
geom_sf(
data=tracts.TOD %>% filter(year==2019) %>% st_union(),
fill='transparent', color='Black', lwd=1)+
geom_sf(
data=BART.stops, fill='white',
color='grey30', shape=21) +
# POINT
geom_sf(data = filt_sf %>% st_centroid(),
shape = 21, color='grey10',
aes(size = cut_field, fill = cut_field)) +
scale_size_manual(
values = seq(4, 10, length.out = breaks_amount),
labels = labels,
name=legend_title)+
scale_fill_manual(
values = col_vals,
labels = labels,
name='Median Rent + Utilities\n averaged by BART Stop', guide='none') +
labs(title = 'Median Rent of TOD Tracts',
subtitle = 'grouped by BART Stations (mean)',
caption = '') +
guides(size =
guide_legend(override.aes = list(fill = col_vals))) +
theme(axis.title=element_blank(),axis.text=element_blank(),
axis.ticks=element_blank(), panel.background = element_rect(fill='gray')) +
facet_wrap(~year)+
mapTheme() + plot_limits(tracts.TOD %>% filter(year==2019), buffer=mile*.5)
Figure 5.2: Rent Graduated Symbol
6 Rent, Homelessness, & Distance to BART
In the following plots, the study’s focus will temporarily narrow down to the City of Oakland and the years of 2009, 2014, and 2019. The scope allows the use of the City of Oakland’s 311 citizen request service – specifically looking at requests to remove homeless encampments. Homelessness in the Bay Area has increased tremendously in the past 20 years – with rising rents being a considerable cause.
In Figure 6.1, both the rent and amount of homeless encampment requests are compared to the distance of BART. Specifically, there is a significant rise in rent and requests to remove homeless encampments over the last 10 years. For rent and distance to BART, rent increases with distance to BART – likely due to the larger house sizes in the Oakland Hills, the small amount of tracts that are over 2.5 miles from BART, and the small amount of units for rent father from BART. The increase in rent between 2014 and 2019 is very noticeable, regardless of distance to BART.
buff_breaks = seq(0,5,by=.5)
tracts.OAK$BART_dist = cut(
tracts.OAK$dist_BART/mile, breaks = buff_breaks,
dig.lab=10, include.lowest = TRUE,
labels = seq(.5,5,by=.5))
tracts.OAK.mile =
tracts.OAK %>% st_drop_geometry() %>%
group_by(year, BART_dist) %>%
summarize(
tracts = n(),
mean_rent = mean(med_rent_inf, na.rm=TRUE),
Homeless_Encampment = sum(Homeless_Encampment),
Illegal_Dumping = sum(Illegal_Dumping)
) %>% ungroup(.) %>%
mutate(
BART_dist = as.numeric(as.character(BART_dist)),
year = as.character(year)
)
## `summarise()` has grouped output by 'year'. You can override using the `.groups` argument.
rent_breaks = c(1000,1500,2000,2500,3000)
rent_labels = c("$ 1,000","","$ 2,000","","$ 3,000")
rent =
ggplot(data=tracts.OAK.mile,
aes(x=BART_dist,
y=mean_rent, color=year)) +
geom_line(lwd=1.5)+
geom_point(size=2)+
labs(
title = "Distance to BART from Oakland Census Tracts",
subtitle="Mean Rent & Utilities (adjusted to 2019 inflation)") +
scale_color_brewer(palette="Greens") +
scale_y_continuous(
breaks = rent_breaks,
labels = rent_labels,
name = "Mean Rent (adj)") +
theme(axis.title.x=element_blank()) +
scale_color_manual(
name = "Years",
values=brewer.pal(6, name="Greens")[c(2,4,6)]) + plotTheme()
## Scale for 'colour' is already present. Adding another scale for 'colour',
## which will replace the existing scale.
home_breaks = c(0,250,500,750,1000)
home_labels = c("0","250","500","750","1,000")
homeless =
ggplot(data=tracts.OAK.mile,
aes(x=BART_dist,
y=Homeless_Encampment, color=year)) +
geom_line(lwd=1.5)+
geom_point(size=2)+
scale_y_continuous(
breaks = home_breaks,
labels = home_labels,
name = "Requests to Rem0ve") +
scale_x_continuous(
name = "Distance to BART (miles)") +
labs(
subtitle="Requests to Remove Homeless Encampments") +
scale_color_manual(
name = "Years",
values=brewer.pal(6, name="Purples")[c(2,4,6)]) + plotTheme()
library(cowplot)
##
## Attaching package: 'cowplot'
## The following object is masked from 'package:patchwork':
##
## align_plots
## The following object is masked from 'package:lubridate':
##
## stamp
plot_grid(rent, homeless, align='v', ncol=1) +
labs(title = "Rent, Homelessness, BART Distances")
Figure 6.1: Rent, Homeless, & Distance to BART
For requests to remove homeless encampments, it is noticeably higher closer to BART. This is likely due to the larger amount of open space, transportation options, and resources closer to Downtown and the bay. Like rent, there is a noticeable jump in homelessness requests from 2014 to 2019.
Taking in all 311 requests (e.g. Illegal Dumping, Littering, Abandoned cars) into account, the homeless encampment requests’ increase went far beyond the all requests – with all requests increasing by 83% from 2014 to 2019, but homeless requests increasing by 330%.
Looking at Figure 6.2, the homeless encampments locate themselves on the bay shores and along the BART routes. This likely is to maximize the open land (compared to the low density of the hills) and the amount of resources close to higher density transit areas.
plot_vari_spec = function(
focus_sf = tracts.all,
variable = "dens_pop",
qbreaks = qBr(tracts.all, variable),
bucket_diff = 1,
title = "Population Density 2009-2019",
subtitle = "East Bay with ½ mile buffer from BART stations",
legend_nm = variable,
caption = "",
brewer_colors = 'Spectral',
round_digit = 0,
last_end_range = TRUE,
input_end_range = '',
bucket_suffix = '',
buff_col = 'red',
col_rev = FALSE,
first_start_range = 0
){
cutting_field = function(var_field, var_breaks){return(var_field %>% cut(., breaks = var_breaks, dig.lab=10, include.lowest = TRUE))}
focus_sf$cut_field = cutting_field(focus_sf[[variable]], qbreaks)
cut_breaks = sapply(focus_sf$cut_field, function(brk) brk %>% levels())
labels = get_labels(
cut_breaks,
round_digit = round_digit, bucket_diff=bucket_diff,
last_end_range=last_end_range, first_start_range=first_start_range,
input_end_range=input_end_range, bucket_suffix=bucket_suffix)
breaks_amount = length(qbreaks)-1
col_vals = brewer.pal(breaks_amount, name=brewer_colors)
if (col_rev==TRUE){col_vals=rev(col_vals)}
return(
ggplot()+
# geom_sf(data = EB.all, fill=alpha('grey50', .5), color=alpha('grey50', .5)) +
# geom_sf(data = EB.back_water, fill=alpha('cornflowerblue', .5), color='transparent') +
geom_sf(data = EB.cities, fill='grey90')+
geom_sf(data = focus_sf, aes(fill = cut_field), color='grey50') +
scale_fill_manual(
values=col_vals,
labels = labels, name=legend_nm) +
geom_sf(data=BART.buffers.TOD, fill='transparent', color=alpha(buff_col, alpha=.75), lwd=.75) +
geom_sf(
data=BART.stops, fill='white',
color='grey30', shape=21) +
# geom_text(
# data=EB.labels, check_overlap=TRUE,
# size = 3.5, fontface='bold', color='black',
# aes(x=lon,y=lat, label=label)) +
labs(title = title, subtitle = subtitle,
caption=caption) +
guides(fill = guide_legend(title.position="bottom",
title.hjust = 0.5, title.vjust = 0)) +
theme(legend.position = "bottom",
legend.spacing.x = unit(.1, 'in')) +
facet_wrap(~year)+
mapTheme() + plot_limits()
)}
################
variable = "Homeless_Encampment"
filt_sf = tracts.OAK[!is.na(tracts.OAK[[variable]]) &
!is.infinite(tracts.OAK[[variable]])
,]
mx = max(filt_sf[[variable]])
breaks = c(0,25,50,100, 150, mx)
#breaks = seq(0, mx, length.out = 4)
plot_vari_spec(
focus_sf = filt_sf,
variable = variable,
qbreaks = breaks,
title = "Homeless Encampments",
subtitle = "Amount of Citizen Requests to the City of Oakland to Remove Homeless Encampments",
caption = "",
brewer_colors = 'OrRd',
legend_nm = "Encampment Requests per Tract",
bucket_suffix = ' ',
input_end_range = '200',
last_end_range = FALSE,
round_digit=0,
bucket_diff=1,
first_start_range=0
)
Figure 6.2: Homeless Map
### how much homeless compares to other7 Policy Brief
The study’s examination of the East Bay’s Housing Crisis suggest the lack of housing units allow higher income, younger tech employees to out price the local residents. The five variable maps in Section 2 suggest this narrative. The table of Section 4 and the population/units maps of Section 5 highlight that the non-TOD tracts have been stagnant on their housing production – leading to higher competition and prices of the smaller housing stock. The BART stations themselves are a magnet to density and general interests – suggesting that there should be an evaluation to expand BART and TOD.