# Load Libraries
library(sf)
## Warning: package 'sf' was built under R version 4.0.2
## Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.0.2
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.0.2
library(classInt)
## Warning: package 'classInt' was built under R version 4.0.2
# Question 1
library <- st_read("Shelby.gdb", layer="Library_Shelby")
## Reading layer `Library_Shelby' from data source `C:\Users\mwtro\OneDrive\Documents\r spatial\data\Shelby.gdb' using driver `OpenFileGDB'
## Simple feature collection with 22 features and 16 fields
## geometry type: POINT
## dimension: XY
## bbox: xmin: 752812.9 ymin: 272549.6 xmax: 875503.7 ymax: 390129.8
## projected CRS: NAD83 / Tennessee (ftUS)
schools <- st_read("Shelby.gdb", layer="School_shelby")
## Reading layer `School_shelby' from data source `C:\Users\mwtro\OneDrive\Documents\r spatial\data\Shelby.gdb' using driver `OpenFileGDB'
## Simple feature collection with 391 features and 17 fields
## geometry type: POINT
## dimension: XY
## bbox: xmin: 734398 ymin: 263306.1 xmax: 876914 ymax: 397840.4
## projected CRS: NAD83 / Tennessee (ftUS)
buffer <- st_buffer(library, 6561) #convert to km
head(buffer)
## Simple feature collection with 6 features and 16 fields
## geometry type: POLYGON
## dimension: XY
## bbox: xmin: 777923.5 ymin: 275114.8 xmax: 882064.7 ymax: 377221.2
## projected CRS: NAD83 / Tennessee (ftUS)
## Status Score Match_type Side Match_addr
## 1 M 100 A L 11968 WALKER ST, 38002
## 2 M 100 A L 5884 STAGE RD, 38134
## 3 M 63 A R 499 POPLAR VIEW PKWY, 38017
## 4 M 100 A L 1925 EXETER RD, 38138
## 5 M 100 A L 3030 POPLAR AVE, 38111
## 6 M 81 A L 3300 SHARPE AVE, 38111
## ARC_Street ARC_Zone Library_Na
## 1 11968 Walker St 38002 Sam T Wilson Public Library
## 2 5884 Stage Road 38134 Bartlett Library
## 3 501 Poplar View Parkway 38017 The collierville Library
## 4 1925 Exeter Road 38138 The Germantown Library
## 5 3030 Poplar Ave 38111 Benjamin L. Hooks Central Library
## 6 3300 Sharpe 38111 Cherokee Branch Library
## Address City State County Zip ARC_City ARC_State
## 1 11968 Walker St Arlington TN 38002
## 2 5884 Stage Road Bartlett TN 38134
## 3 501 Poplar View Parkway Collierville TN 38017
## 4 1925 Exeter Road Germantown TN 38138
## 5 3030 Poplar Ave Memphis TN 38111
## 6 3300 Sharpe Memphis TN 38111
## ARC_ZIP Shape
## 1 POLYGON ((882064.7 370660.2...
## 2 POLYGON ((820113.3 339887.2...
## 3 POLYGON ((867660.1 281675.8...
## 4 POLYGON ((837921.4 300104.3...
## 5 POLYGON ((791045.5 314819.7...
## 6 POLYGON ((792552 298118.4, ...
intersectionschools <- st_intersection(buffer, schools)
## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries
relations <- intersectionschools %>%
group_by(Library_Na)
summed <- summarize(relations, NumSchools = n(), Library_Na = unique(Library_Na))
## `summarise()` ungrouping output (override with `.groups` argument)
ordered <- summed[order(summed$NumSchools), c(1,2)]
topfive <- tail(ordered)
# Final Answer
topfive
## Simple feature collection with 6 features and 2 fields
## geometry type: MULTIPOINT
## dimension: XY
## bbox: xmin: 750390.5 ymin: 300350.1 xmax: 807441.6 ymax: 329737.9
## projected CRS: NAD83 / Tennessee (ftUS)
## # A tibble: 6 x 3
## Library_Na NumSchools Shape
## <chr> <int> <MULTIPOINT [US_survey_foot]>
## 1 South Library Branch 9 ((750754.9 302709.1), (751050.4 303184), (752~
## 2 Poplar White Statio~ 10 ((798720.7 309226.4), (800709.8 308824), (801~
## 3 North Branch Library 11 ((762900.2 326318), (763058.3 325328.8), (763~
## 4 Randolph Branch Lib~ 11 ((787640 326204.7), (788289.8 321280.7), (789~
## 5 Cornelia Crenshaw B~ 12 ((757511.5 321188.3), (757738.8 317564), (758~
## 6 Gaston Park Branch ~ 12 ((750390.5 309804.1), (752022.2 306007.4), (7~
# Question 2
demos <- read.csv("fips_demographics.txt")
head(demos)
## OBJECTID STATE_FIPS BLKGRP FIPS POP2010 POP2013 WHITE BLACK MALES
## 1 1 47 1 471570106201 999 1007 75 871 456
## 2 2 47 4 471570082004 698 683 68 318 357
## 3 3 47 1 471570110101 1203 1063 116 1035 531
## 4 4 47 1 471579804001 293 293 80 213 40
## 5 5 47 2 471570211222 862 859 520 186 414
## 6 6 47 5 471570211125 1101 1135 674 210 570
## FEMALES MED_AGE AVE_FAM_SZ HSE_UNITS OWNER_OCC RENTER_OCC
## 1 543 28.0 3.67 345 189 118
## 2 341 26.9 3.76 247 60 145
## 3 672 31.6 3.46 445 298 102
## 4 253 30.4 2.00 9 8 1
## 5 448 35.5 3.29 337 230 71
## 6 531 30.0 3.42 377 270 87
## GlobalID Shape__Area Shape__Length
## 1 {cda740af-7a58-47b5-af2a-dbf0bf310394} 3508259 7506.588
## 2 {a638ccf1-3a22-4b44-b5e0-4c317cabbd84} 2730128 6954.234
## 3 {0b7ea9ab-aa8d-496e-b806-58505992614e} 8463532 11881.001
## 4 {9deda4f1-0861-4935-99a2-0480773c0030} 195869343 62238.963
## 5 {3b16c7e2-5b9a-48d9-b9e3-c12d0a9d2346} 6086786 10940.180
## 6 {81d58b86-2954-4ff2-b932-c42e9932773d} 13593616 21332.252
shape <- sf::st_read("Memphis_Demographics_GCS.shp")
## Reading layer `Memphis_Demographics_GCS' from data source `C:\Users\mwtro\OneDrive\Documents\r spatial\data\Memphis_Demographics_GCS.shp' using driver `ESRI Shapefile'
## Simple feature collection with 503 features and 4 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -90.31029 ymin: 34.99417 xmax: -89.73822 ymax: 35.26718
## geographic CRS: NAD83
merged <- merge(shape, demos, by.x="FIPS", by.y="FIPS")
st_crs(merged)
## 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]]
merged$difference <- (merged$POP2013-merged$POP2010/merged$POP2010)
head(merged)
## Simple feature collection with 6 features and 22 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -90.0668 ymin: 35.15312 xmax: -90.01795 ymax: 35.19356
## geographic CRS: NAD83
## FIPS OBJECTID.x STATE_FIPS.x BLKGRP.x OBJECTID.y STATE_FIPS.y
## 1 471570001001 374 47 1 374 47
## 2 471570001002 366 47 2 366 47
## 3 471570001003 318 47 3 318 47
## 4 471570002001 464 47 1 464 47
## 5 471570003001 334 47 1 334 47
## 6 471570003002 296 47 2 296 47
## BLKGRP.y POP2010 POP2013 WHITE BLACK MALES FEMALES MED_AGE AVE_FAM_SZ
## 1 1 1545 1543 939 382 692 853 28.3 2.46
## 2 2 2280 2245 1440 322 1151 1129 30.6 2.54
## 3 3 1569 1788 1277 145 776 793 36.6 2.46
## 4 1 1033 1042 18 982 494 539 26.7 3.67
## 5 1 708 680 7 697 343 365 34.9 3.77
## 6 2 352 319 0 351 181 171 37.3 3.41
## HSE_UNITS OWNER_OCC RENTER_OCC GlobalID
## 1 1090 100 827 {a9db01d7-d5c1-49a5-91c5-ee519297fc4d}
## 2 1317 626 623 {e91c9bca-7092-4295-95ce-ac4f85448eb5}
## 3 971 454 424 {3e3cbeb6-8333-45f5-92f0-9392863b5134}
## 4 578 91 265 {01a00ab6-f983-4293-8c47-50b8b55990a0}
## 5 341 106 143 {ff90f732-2bb2-40ff-9033-0ae27ce2b01b}
## 6 177 57 74 {3a35b8c5-95bb-4498-9816-080fa5077ae2}
## Shape__Area Shape__Length geometry difference
## 1 29860219 28921.058 MULTIPOLYGON (((-90.03523 3... 1542
## 2 19321032 20748.769 MULTIPOLYGON (((-90.05732 3... 2244
## 3 27131689 21609.754 MULTIPOLYGON (((-90.04811 3... 1787
## 4 12154296 17240.530 MULTIPOLYGON (((-90.03612 3... 1041
## 5 26394606 27006.397 MULTIPOLYGON (((-90.01795 3... 679
## 6 4275271 9388.243 MULTIPOLYGON (((-90.03196 3... 318
breaks_qt <- classIntervals(c(min(merged$difference)-0.00001,
merged$difference), n = 7, style = "quantile")
## Warning in classIntervals(c(min(merged$difference) - 1e-05,
## merged$difference), : var has missing values, omitted in finding classes
breaks_qt
## style: quantile
## [2,781) [781,979.8571) [979.8571,1129.857) [1129.857,1303.429)
## 72 71 72 71
## [1303.429,1525.429) [1525.429,1886.857) [1886.857,4087]
## 72 71 72
popchange <- mutate(merged, difference_cat = cut(difference, breaks_qt$brks))
ggplot(popchange)+
geom_sf(aes(fill=difference_cat))+
scale_fill_brewer(palette = "Oranges")
