#load packages
library(tidycensus, quietly=T)
library(sf, quietly=T)Linking to GEOS 3.9.3, GDAL 3.5.2, PROJ 8.2.1; sf_use_s2() is TRUElibrary(dplyr, quietly=T)
Attaching package: 'dplyr'The following objects are masked from 'package:stats':
filter, lagThe following objects are masked from 'package:base':
intersect, setdiff, setequal, union#ready in Bexar county tracts
sa_acs<-get_acs(geography = "tract",
state="TX",
county = c("Bexar"),
year = 2019,
variables=c( "DP05_0001E",
"DP03_0119PE") ,
geometry = T, output = "wide")Getting data from the 2015-2019 5-year ACSDownloading 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%
|
|== | 2%
|
|== | 3%
|
|=== | 4%
|
|==== | 5%
|
|==== | 6%
|
|===== | 7%
|
|===== | 8%
|
|====== | 8%
|
|====== | 9%
|
|======= | 9%
|
|======= | 10%
|
|======= | 11%
|
|======== | 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%
|
|============================= | 42%
|
|============================== | 42%
|
|============================== | 43%
|
|=============================== | 44%
|
|================================ | 45%
|
|================================ | 46%
|
|================================= | 47%
|
|================================= | 48%
|
|================================== | 48%
|
|================================== | 49%
|
|=================================== | 50%
|
|==================================== | 51%
|
|==================================== | 52%
|
|===================================== | 52%
|
|===================================== | 53%
|
|===================================== | 54%
|
|====================================== | 54%
|
|======================================= | 55%
|
|======================================= | 56%
|
|======================================== | 57%
|
|======================================== | 58%
|
|========================================= | 59%
|
|========================================== | 60%
|
|=========================================== | 61%
|
|=========================================== | 62%
|
|============================================ | 63%
|
|============================================= | 64%
|
|============================================== | 65%
|
|============================================== | 66%
|
|=============================================== | 67%
|
|=============================================== | 68%
|
|================================================ | 68%
|
|================================================ | 69%
|
|================================================= | 69%
|
|================================================= | 70%
|
|================================================== | 71%
|
|=================================================== | 72%
|
|=================================================== | 73%
|
|==================================================== | 74%
|
|==================================================== | 75%
|
|===================================================== | 76%
|
|====================================================== | 77%
|
|======================================================= | 78%
|
|======================================================= | 79%
|
|======================================================== | 80%
|
|======================================================== | 81%
|
|========================================================= | 81%
|
|========================================================== | 82%
|
|========================================================== | 83%
|
|=========================================================== | 84%
|
|=========================================================== | 85%
|
|============================================================ | 86%
|
|============================================================= | 87%
|
|============================================================== | 88%
|
|============================================================== | 89%
|
|=============================================================== | 90%
|
|================================================================ | 91%
|
|================================================================= | 92%
|
|================================================================= | 93%
|
|================================================================== | 94%
|
|================================================================== | 95%
|
|=================================================================== | 96%
|
|==================================================================== | 97%
|
|==================================================================== | 98%
|
|===================================================================== | 98%
|
|===================================================================== | 99%
|
|======================================================================| 99%
|
|======================================================================| 100%#note: don't need the variables, only geometry=T#create a county FIPS code - 5 digit
sa_acs$county<-substr(sa_acs$GEOID, 1, 5)
#rename variables and filter missing cases
sa_acs2<-sa_acs%>%
mutate(totpop= DP05_0001E, ppov=DP03_0119PE) %>%
# st_transform(crs = 102740)%>%
na.omit()#identify coordinate system
st_crs(sa_acs2)Coordinate Reference System:
User input: NAD83
wkt:
GEOGCRS["NAD83",
DATUM["North American Datum 1983",
ELLIPSOID["GRS 1980",6378137,298.257222101,
LENGTHUNIT["metre",1]]],
PRIMEM["Greenwich",0,
ANGLEUNIT["degree",0.0174532925199433]],
CS[ellipsoidal,2],
AXIS["latitude",north,
ORDER[1],
ANGLEUNIT["degree",0.0174532925199433]],
AXIS["longitude",east,
ORDER[2],
ANGLEUNIT["degree",0.0174532925199433]],
ID["EPSG",4269]]library(tmap)
library(tmaptools)
tm_shape(sa_acs2)+
tm_polygons("ppov", title="% in Poverty",
palette="Blues",
style="quantile",
n=5 )+
tm_format("World",
main.title="San Antonio Poverty Estimates (2019) - Quintile Breaks",
main.title.position=c('center','top'),
main.title.size=1.5,
title="Author: R.Luttinen \nSource: ACS 2019",
legend.title.size=1.7,
legend.outside=T,
legend.text.size=1.2)+
tm_scale_bar(position = c("left","bottom"))+
tm_compass()
#NAD83
#Extract two tracts
twtr<-sa_acs2%>%
filter(GEOID %in% c(48029181820, 48029110600))
# get centroid coordinates for two tracts (these two tracts are where UTSA Main and Downtown Campuses are)
tr_co1<-st_centroid(twtr)Warning in st_centroid.sf(twtr): st_centroid assumes attributes are constant
over geometries of xhead(tr_co1)Simple feature collection with 2 features and 9 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: -98.61502 ymin: 29.43017 xmax: -98.50751 ymax: 29.57909
Geodetic CRS: NAD83
GEOID NAME DP05_0001E DP05_0001M
1 48029181820 Census Tract 1818.20, Bexar County, Texas 8305 833
2 48029110600 Census Tract 1106, Bexar County, Texas 5293 423
DP03_0119PE DP03_0119PM geometry county totpop ppov
1 15.2 9.1 POINT (-98.61502 29.57909) 48029 8305 15.2
2 37.8 15.2 POINT (-98.50751 29.43017) 48029 5293 37.8st_distance(tr_co1)Units: [m]
[,1] [,2]
[1,] 0.00 19555.86
[2,] 19555.86 0.00#get distance in miles
19555.86/1609[1] 12.15405#Re-Project map into "Texas Centric Albers Equal Area" Projection
new_sa<-st_transform(sa_acs2, crs = 3083)
#Extract two tracts
twtr<-new_sa%>%
filter(GEOID %in% c(48029181820, 48029110600))
# get centroid coordinates for two tracts (these two tracts are where UTSA Main and Downtown Campuses are)
tr_co<-st_centroid(twtr)Warning in st_centroid.sf(twtr): st_centroid assumes attributes are constant
over geometries of xhead(tr_co)Simple feature collection with 2 features and 9 fields
Geometry type: POINT
Dimension: XY
Bounding box: xmin: 1633963 ymin: 7257682 xmax: 1644584 ymax: 7274079
Projected CRS: NAD83 / Texas Centric Albers Equal Area
GEOID NAME DP05_0001E DP05_0001M
1 48029181820 Census Tract 1818.20, Bexar County, Texas 8305 833
2 48029110600 Census Tract 1106, Bexar County, Texas 5293 423
DP03_0119PE DP03_0119PM geometry county totpop ppov
1 15.2 9.1 POINT (1633963 7274079) 48029 8305 15.2
2 37.8 15.2 POINT (1644584 7257682) 48029 5293 37.8st_distance(tr_co)Units: [m]
1 2
1 0.00 19536.16
2 19536.16 0.00#measure distance in in ft
st_distance(tr_co)Units: [m]
1 2
1 0.00 19536.16
2 19536.16 0.00#convert to miles
19536.16/1609[1] 12.1418#The difference between NAD83 and NAD83 Texas Centric Albers Equal Area yield slightly different but close results in distance. (12.14 vs. 12.15)
#It is important to have an accurate system of projection because inaccurate projections affect the size and shape of the map you’re trying to produce and can also give you the wrong distances between coordinates.