DEM 7093 GIS HW4
Daniel Mamani
2/16/2021
Libraries
library(tidycensus)
library(tidyverse)## -- Attaching packages ------------------------------------------------ tidyverse 1.3.0 --## v ggplot2 3.3.3 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.3
## v tidyr 1.1.1 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## -- Conflicts --------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(sf)## Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1library(tmap)v10_Profile <- load_variables(2010, "acs5/profile", cache = TRUE) #demographic profile tables
v19_Profile <- load_variables(2019, "acs5/profile", cache = TRUE) #demographic
#Search for variables by using grep()
v10_Profile[grep(x = v10_Profile$label, "VACANT HOUSING UNITS", ignore.case = TRUE), c("name", "label")]## # A tibble: 2 x 2
## name label
## <chr> <chr>
## 1 DP04_0003 Estimate!!HOUSING OCCUPANCY!!Vacant housing units
## 2 DP04_0003P Percent!!HOUSING OCCUPANCY!!Vacant housing unitsv19_Profile[grep(x = v10_Profile$label, "VACANT HOUSING UNITS", ignore.case = TRUE), c("name", "label")]## # A tibble: 2 x 2
## name label
## <chr> <chr>
## 1 DP03_0132 Estimate!!PERCENTAGE OF FAMILIES AND PEOPLE WHOSE INCOME IN THE PA~
## 2 DP03_0132P Percent!!PERCENTAGE OF FAMILIES AND PEOPLE WHOSE INCOME IN THE PAS~Extracting, renaming, and filtering ACS 2010 data
vac10<-get_acs(geography = "tract",
state="TX",
county = "Bexar",
year = 2010,
variables="DP04_0003P" ,
geometry = T,
output = "wide")## Getting data from the 2006-2010 5-year ACS## Downloading feature geometry from the Census website. To cache shapefiles for use in future sessions, set `options(tigris_use_cache = TRUE)`.## Using the ACS Data Profile##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|====== | 8%
|
|======= | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 16%
|
|============ | 17%
|
|============ | 18%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 26%
|
|=================== | 27%
|
|=================== | 28%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 29%
|
|===================== | 30%
|
|===================== | 31%
|
|====================== | 31%
|
|======================= | 32%
|
|======================= | 33%
|
|======================= | 34%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|========================== | 38%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|=============================== | 45%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 53%
|
|====================================== | 54%
|
|====================================== | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================= | 71%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|=================================================== | 74%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|====================================================== | 78%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|=============================================================== | 91%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 100%#rename variables and filter missing cases
vac10 <- vac10%>%
mutate(pvac = DP04_0003PE,
pvac_er = DP04_0003PM/1.645,
pvac_cv =100* (pvac_er/pvac)) %>%
filter(complete.cases(pvac), is.finite(pvac_cv)==T)
head(vac10)## Simple feature collection with 6 features and 7 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -98.5152 ymin: 29.40677 xmax: -98.456 ymax: 29.58043
## geographic CRS: NAD83
## GEOID NAME DP04_0003PE DP04_0003PM
## 1 48029110100 Census Tract 1101, Bexar County, Texas 30.8 8.2
## 2 48029110300 Census Tract 1103, Bexar County, Texas 7.2 5.1
## 3 48029110500 Census Tract 1105, Bexar County, Texas 4.3 5.2
## 4 48029120300 Census Tract 1203, Bexar County, Texas 16.2 4.4
## 5 48029120702 Census Tract 1207.02, Bexar County, Texas 16.1 6.2
## 6 48029121108 Census Tract 1211.08, Bexar County, Texas 7.3 4.4
## geometry pvac pvac_er pvac_cv
## 1 MULTIPOLYGON (((-98.49928 2... 30.8 4.984802 16.18442
## 2 MULTIPOLYGON (((-98.48687 2... 7.2 3.100304 43.05978
## 3 MULTIPOLYGON (((-98.51411 2... 4.3 3.161094 73.51382
## 4 MULTIPOLYGON (((-98.45928 2... 16.2 2.674772 16.51094
## 5 MULTIPOLYGON (((-98.48187 2... 16.1 3.768997 23.40992
## 6 MULTIPOLYGON (((-98.47468 2... 7.3 2.674772 36.64071Mapping Coefficient of Variation in quantile breaks
p1<-tm_shape(vac10)+
tm_polygons(c("pvac"), title=c("% Vacant Housing"), palette="Greens", style="quantile", n=5)+
#tm_format("World", legend.outside=T, title.size =4)+
tm_scale_bar()+
tm_layout(title="San Antonio Vacant Housing Rate Estimates", title.size =1.5, legend.frame = TRUE, title.position = c('right', 'top'))+
tm_compass()
p2<-tm_shape(vac10)+
tm_polygons(c("pvac_cv"), title=c("CV Vacant Housing"), palette="Greens", style="quantile", n=5)+
#tm_format("World", title="San Antonio Vacant Housing Rate CV", legend.outside=T)+
tm_layout(title="San Antonio Vacant Housing Rate CV", title.size =1.5, legend.frame = TRUE, title.position = c('right', 'top'))+
tm_scale_bar()+
tm_compass()
tmap_arrange(p1, p2)
plot(vac10$pvac, vac10$pvac_cv)
Comparing vacancy rates over time
# get the 2019 estimates
vac19<-get_acs(geography = "tract",
state="TX",
county = "Bexar",
year = 2019,
variables="DP04_0003P" ,
geometry = T,
output = "wide")## 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)`.## Using the ACS Data Profile##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 3%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 10%
|
|======== | 11%
|
|======== | 12%
|
|========= | 12%
|
|========= | 13%
|
|========= | 14%
|
|========== | 14%
|
|========== | 15%
|
|=========== | 15%
|
|=========== | 16%
|
|============ | 17%
|
|============= | 18%
|
|============= | 19%
|
|============== | 20%
|
|============== | 21%
|
|=============== | 21%
|
|=============== | 22%
|
|================ | 23%
|
|================= | 24%
|
|================= | 25%
|
|================== | 25%
|
|================== | 26%
|
|=================== | 27%
|
|==================== | 28%
|
|==================== | 29%
|
|===================== | 30%
|
|====================== | 31%
|
|====================== | 32%
|
|======================= | 33%
|
|======================== | 34%
|
|======================== | 35%
|
|========================= | 36%
|
|========================== | 37%
|
|=========================== | 38%
|
|=========================== | 39%
|
|============================ | 40%
|
|============================ | 41%
|
|============================= | 41%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|================================================== | 72%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|===================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================= | 82%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================ | 92%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%#rename variables and filter missing cases
vac19<- vac19%>%
mutate(pvac19 = DP04_0003PE,
pvac19_er = DP04_0003PM/1.645,
pvac19_cv =100* (pvac19_er/pvac19)) %>%
filter(complete.cases(pvac19), is.finite(pvac19_cv)==T)
head(vac19)## Simple feature collection with 6 features and 7 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -98.56606 ymin: 29.36662 xmax: -98.44832 ymax: 29.54044
## geographic CRS: NAD83
## GEOID NAME DP04_0003PE DP04_0003PM
## 1 48029190601 Census Tract 1906.01, Bexar County, Texas 10.1 6.1
## 2 48029181100 Census Tract 1811, Bexar County, Texas 5.6 4.9
## 3 48029140700 Census Tract 1407, Bexar County, Texas 6.5 4.0
## 4 48029180602 Census Tract 1806.02, Bexar County, Texas 7.0 5.3
## 5 48029140800 Census Tract 1408, Bexar County, Texas 10.2 4.8
## 6 48029170200 Census Tract 1702, Bexar County, Texas 12.6 3.9
## geometry pvac19 pvac19_er pvac19_cv
## 1 MULTIPOLYGON (((-98.52602 2... 10.1 3.708207 36.71492
## 2 MULTIPOLYGON (((-98.56225 2... 5.6 2.978723 53.19149
## 3 MULTIPOLYGON (((-98.47348 2... 6.5 2.431611 37.40940
## 4 MULTIPOLYGON (((-98.56606 2... 7.0 3.221884 46.02692
## 5 MULTIPOLYGON (((-98.4778 29... 10.2 2.917933 28.60719
## 6 MULTIPOLYGON (((-98.5283 29... 12.6 2.370821 18.81604Merge both data sets
mdat<-tigris::geo_join(vac10, as.data.frame(vac19), by_sp="GEOID", by_df="GEOID")## Warning: `group_by_()` is deprecated as of dplyr 0.7.0.
## Please use `group_by()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.head(mdat)## Simple feature collection with 6 features and 14 fields
## Active geometry column: geometry.x
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -98.5152 ymin: 29.40677 xmax: -98.456 ymax: 29.58043
## geographic CRS: NAD83
## GEOID NAME.x DP04_0003PE.x
## 1 48029110100 Census Tract 1101, Bexar County, Texas 30.8
## 2 48029110300 Census Tract 1103, Bexar County, Texas 7.2
## 3 48029110500 Census Tract 1105, Bexar County, Texas 4.3
## 4 48029120300 Census Tract 1203, Bexar County, Texas 16.2
## 5 48029120702 Census Tract 1207.02, Bexar County, Texas 16.1
## 6 48029121108 Census Tract 1211.08, Bexar County, Texas 7.3
## DP04_0003PM.x pvac pvac_er pvac_cv
## 1 8.2 30.8 4.984802 16.18442
## 2 5.1 7.2 3.100304 43.05978
## 3 5.2 4.3 3.161094 73.51382
## 4 4.4 16.2 2.674772 16.51094
## 5 6.2 16.1 3.768997 23.40992
## 6 4.4 7.3 2.674772 36.64071
## NAME.y DP04_0003PE.y DP04_0003PM.y pvac19
## 1 Census Tract 1101, Bexar County, Texas 30.6 7.2 30.6
## 2 Census Tract 1103, Bexar County, Texas 14.0 6.4 14.0
## 3 Census Tract 1105, Bexar County, Texas 12.2 5.5 12.2
## 4 Census Tract 1203, Bexar County, Texas 15.1 4.6 15.1
## 5 Census Tract 1207.02, Bexar County, Texas 14.7 6.0 14.7
## 6 Census Tract 1211.08, Bexar County, Texas 2.7 2.4 2.7
## pvac19_er pvac19_cv rank geometry.x
## 1 4.376900 14.30359 1 MULTIPOLYGON (((-98.49928 2...
## 2 3.890578 27.78984 1 MULTIPOLYGON (((-98.48687 2...
## 3 3.343465 27.40545 1 MULTIPOLYGON (((-98.51411 2...
## 4 2.796353 18.51889 1 MULTIPOLYGON (((-98.45928 2...
## 5 3.647416 24.81236 1 MULTIPOLYGON (((-98.48187 2...
## 6 1.458967 54.03580 1 MULTIPOLYGON (((-98.47468 2...
## geometry.y
## 1 MULTIPOLYGON (((-98.50172 2...
## 2 MULTIPOLYGON (((-98.48895 2...
## 3 MULTIPOLYGON (((-98.51479 2...
## 4 MULTIPOLYGON (((-98.48187 2...
## 5 MULTIPOLYGON (((-98.48215 2...
## 6 MULTIPOLYGON (((-98.48235 2...Creating a function that implements the Census testing procedure
acstest<-function(names,geoid, est1, err1, est2, err2, alpha, yr1, yr2, span){
se1<-err1/qnorm(.90)
se2<-err2/qnorm(.90)
yrs1<-seq(yr1, to=yr1-span)
yrs2<-seq(yr2, to=yr2-span)
C<-mean(yrs2%in%yrs1)
diff<- (est1-est2)
test<-(est1-est2) / (sqrt(1-C)*sqrt((se1^2+se2^2)))
crit<-qnorm(1-alpha/2)
pval<-2*pnorm(abs(test),lower.tail=F)
result<-NULL
result[pval > alpha]<-"insignificant change"
result[pval < alpha & test < 0]<- "significant increase"
result[pval < alpha & test > 0]<-"significant decrease"
data.frame(name=names,geoid=geoid, est1=est1, est2=est2, se1=se1, se2=se2,difference=diff, test=test, result=result, pval=pval)
}Using the function to compare both data sets
diff1019<-acstest(names = mdat$NAME.x, geoid = mdat$GEOID, est1 = mdat$pvac, est2 = mdat$pvac19, err1 = mdat$pvac_er, err2=mdat$pvac19_er,alpha = .1, yr1 = 2010, yr2=2019, span = 5)
head(diff1019)## name geoid est1 est2 se1
## 1 Census Tract 1101, Bexar County, Texas 48029110100 30.8 30.6 3.889662
## 2 Census Tract 1103, Bexar County, Texas 48029110300 7.2 14.0 2.419180
## 3 Census Tract 1105, Bexar County, Texas 48029110500 4.3 12.2 2.466615
## 4 Census Tract 1203, Bexar County, Texas 48029120300 16.2 15.1 2.087136
## 5 Census Tract 1207.02, Bexar County, Texas 48029120702 16.1 14.7 2.940964
## 6 Census Tract 1211.08, Bexar County, Texas 48029121108 7.3 2.7 2.087136
## se2 difference test result pval
## 1 3.415313 0.2 0.03863782 insignificant change 0.96917915
## 2 3.035834 -6.8 -1.75174445 significant increase 0.07981776
## 3 2.608920 -7.9 -2.20033936 significant increase 0.02778283
## 4 2.182006 1.1 0.36430066 insignificant change 0.71563351
## 5 2.846094 1.4 0.34207934 insignificant change 0.73229119
## 6 1.138438 4.6 1.93486203 significant decrease 0.05300723table(diff1019$result)##
## insignificant change significant decrease significant increase
## 249 63 32acs_merge<-left_join(mdat, diff1019, by=c("GEOID"="geoid"))
tmap_mode("plot")## tmap mode set to plottingMapping the change in vacant housing
p1<-tm_shape(acs_merge)+
tm_polygons(c("pvac"), title=c("% Vacant Housing 2010"), palette="Greens", style="quantile", n=5)+
#tm_format("World", legend.outside=T, title.size =4)+
tm_scale_bar()+
tm_layout(title="San Antonio Vacant Housing Estimates 2010", title.size =1.5, legend.frame = TRUE, title.position = c('right', 'top'))+
tm_compass()
p2<-tm_shape(acs_merge)+
tm_polygons(c("pvac19"), title=c("% Vacant Housing 2019"), palette="Greens", style="quantile", n=5)+
#tm_format("World", title="San Antonio Poverty Rate CV", legend.outside=T)+
tm_layout(title="San Antonio Vacant Housing Rate Estimate 2019", title.size =1.5, legend.frame = TRUE, title.position = c('right', 'top'))+
tm_scale_bar()+
tm_compass()
p3 <- tm_shape(acs_merge)+
tm_polygons(c("result"), title=c("Changes"), palette = "Dark2")+
#tm_format("World", title="San Antonio Poverty Rate CV", legend.outside=T)+
tm_layout(title="San Antonio Vacant Housing Rate Estimate Changes", title.size =1.5, legend.frame = TRUE, title.position = c('right', 'top'))+
tm_scale_bar()+
tm_compass()
tmap_arrange(p1, p2, p3)