Midterm Exam
Alex Sharp
10/1/2020
library(sf)## Linking to GEOS 3.8.0, GDAL 3.0.4, PROJ 6.3.1library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(dbplyr)##
## Attaching package: 'dbplyr'## The following objects are masked from 'package:dplyr':
##
## ident, sqllibrary(raster)## Loading required package: sp##
## Attaching package: 'raster'## The following object is masked from 'package:dplyr':
##
## selectlibrary(rgdal)## rgdal: version: 1.5-16, (SVN revision 1050)
## Geospatial Data Abstraction Library extensions to R successfully loaded
## Loaded GDAL runtime: GDAL 3.0.4, released 2020/01/28
## Path to GDAL shared files: C:/Users/asharp5/Desktop/R-4.0.2/library/rgdal/gdal
## GDAL binary built with GEOS: TRUE
## Loaded PROJ runtime: Rel. 6.3.1, February 10th, 2020, [PJ_VERSION: 631]
## Path to PROJ shared files: C:/Users/asharp5/Desktop/R-4.0.2/library/rgdal/proj
## Linking to sp version:1.4-2
## To mute warnings of possible GDAL/OSR exportToProj4() degradation,
## use options("rgdal_show_exportToProj4_warnings"="none") before loading rgdal.library(rgeos)## rgeos version: 0.5-5, (SVN revision 640)
## GEOS runtime version: 3.8.0-CAPI-1.13.1
## Linking to sp version: 1.4-2
## Polygon checking: TRUElibrary(magrittr)##
## Attaching package: 'magrittr'## The following object is masked from 'package:raster':
##
## extractlibrary(knitr)
library(rasterVis)## Loading required package: lattice## Loading required package: latticeExtralibrary(tidyverse)## -- Attaching packages ---------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v stringr 1.4.0
## v tidyr 1.1.2 v forcats 0.5.0
## v readr 1.3.1## -- Conflicts ------------------------------------------- tidyverse_conflicts() --
## x tidyr::extract() masks magrittr::extract(), raster::extract()
## x dplyr::filter() masks stats::filter()
## x dbplyr::ident() masks dplyr::ident()
## x dplyr::lag() masks stats::lag()
## x ggplot2::layer() masks latticeExtra::layer()
## x raster::select() masks dplyr::select()
## x purrr::set_names() masks magrittr::set_names()
## x dbplyr::sql() masks dplyr::sql()library(RColorBrewer)
library(ggplot2)
library(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinelibrary(classInt)
library(ggmap)## Google's Terms of Service: https://cloud.google.com/maps-platform/terms/.## Please cite ggmap if you use it! See citation("ggmap") for details.##
## Attaching package: 'ggmap'## The following object is masked from 'package:magrittr':
##
## insetlibrary(tmap)
library(leaflet)
library(ctv)#Problem 1
# reading database:
dsn <- sf::st_read(dsn = "data/Shelby.gdb")## Multiple layers are present in data source F:\Fall 2020\Seminar\Midterm\SharpAlex_Assign6\data\Shelby.gdb, reading layer `Community_Garden_shelby'.
## Use `st_layers' to list all layer names and their type in a data source.
## Set the `layer' argument in `st_read' to read a particular layer.## Warning in evalq((function (..., call. = TRUE, immediate. = FALSE, noBreaks. =
## FALSE, : automatically selected the first layer in a data source containing more
## than one.## Reading layer `Community_Garden_shelby' from data source `F:\Fall 2020\Seminar\Midterm\SharpAlex_Assign6\data\Shelby.gdb' using driver `OpenFileGDB'
## Simple feature collection with 33 features and 17 fields
## geometry type: POINT
## dimension: XY
## bbox: xmin: 756844.4 ymin: 298726.4 xmax: 794158.8 ymax: 341723.2
## projected CRS: NAD83 / Tennessee (ftUS)#Importing layers
libraries <- sf::st_read("data/Shelby.gdb", layer="Library_shelby")## Reading layer `Library_shelby' from data source `F:\Fall 2020\Seminar\Midterm\SharpAlex_Assign6\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 <- sf::st_read("data/Shelby.gdb", layer="School_shelby")## Reading layer `School_shelby' from data source `F:\Fall 2020\Seminar\Midterm\SharpAlex_Assign6\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)# creating a 2km buffer from the libraries to the schools:
libraries_buf <- st_buffer(libraries, 6561.68) # convert ft to km
# intersecting the library buffer with all of the schools:
libraries_buf_intersect <- st_intersection(libraries_buf, schools)## Warning: attribute variables are assumed to be spatially constant throughout all
## geometries# creating a table to find the top 5 libraries with the most schools nearby:
table(libraries_buf_intersect$Library_Na)##
## Bartlett Library Benjamin L. Hooks Central Library
## 3 7
## Cherokee Branch Library Cordova Branch Library
## 6 7
## Cornelia Crenshaw Branch Library Cossit Branch Library
## 12 9
## East Shelby Branch Library Frayser Branch Library
## 3 9
## Gaston Park Branch Library Hollywood Branch Library
## 12 4
## Levi Branch Library Millington Public Library
## 5 3
## North Branch Library Parkway villiage Branch Library
## 11 9
## Poplar White Station Branch Library Raleigh Branch Library
## 10 4
## Randolph Branch Library Sam T Wilson Public Library
## 11 1
## South Library Branch The collierville Library
## 9 2
## The Germantown Library Whitehaven Branch Library
## 6 8top.5 <- table(libraries_buf_intersect$Library_Na)
# creating a data frame containing the table:
table_df <- data.frame(top.5)
# puttinig table values in descending order:
table_df %>% arrange(desc(Freq))## Var1 Freq
## 1 Cornelia Crenshaw Branch Library 12
## 2 Gaston Park Branch Library 12
## 3 North Branch Library 11
## 4 Randolph Branch Library 11
## 5 Poplar White Station Branch Library 10
## 6 Cossit Branch Library 9
## 7 Frayser Branch Library 9
## 8 Parkway villiage Branch Library 9
## 9 South Library Branch 9
## 10 Whitehaven Branch Library 8
## 11 Benjamin L. Hooks Central Library 7
## 12 Cordova Branch Library 7
## 13 Cherokee Branch Library 6
## 14 The Germantown Library 6
## 15 Levi Branch Library 5
## 16 Hollywood Branch Library 4
## 17 Raleigh Branch Library 4
## 18 Bartlett Library 3
## 19 East Shelby Branch Library 3
## 20 Millington Public Library 3
## 21 The collierville Library 2
## 22 Sam T Wilson Public Library 1the top 5 libraries are Cornelia Crenshaw Branch Library, Gaston Park Branch Library , Randolph Branch Library, North Branch Library, Poplar White Station Branch Library.
#Problem 2
# reading in data
demographics <- read_sf("data/Memphis_demographics_GCS.shp")
fips_demographics <- read.csv("data/fips_demographics.txt")
str(fips_demographics)## 'data.frame': 503 obs. of 18 variables:
## $ OBJECTID : int 1 2 3 4 5 6 7 8 9 10 ...
## $ STATE_FIPS : int 47 47 47 47 47 47 47 47 47 47 ...
## $ BLKGRP : int 1 4 1 1 2 5 4 1 3 2 ...
## $ FIPS : num 4.72e+11 4.72e+11 4.72e+11 4.72e+11 4.72e+11 ...
## $ POP2010 : int 999 698 1203 293 862 1101 1400 3968 1350 3182 ...
## $ POP2013 : int 1007 683 1063 293 859 1135 1414 4088 1318 3187 ...
## $ WHITE : int 75 68 116 80 520 674 1352 1383 17 1875 ...
## $ BLACK : int 871 318 1035 213 186 210 27 2181 1305 1004 ...
## $ MALES : int 456 357 531 40 414 570 657 1861 595 1523 ...
## $ FEMALES : int 543 341 672 253 448 531 743 2107 755 1659 ...
## $ MED_AGE : num 28 26.9 31.6 30.4 35.5 30 46.6 35.3 21.7 38.4 ...
## $ AVE_FAM_SZ : num 3.67 3.76 3.46 2 3.29 3.42 2.83 2.87 3.58 3.19 ...
## $ HSE_UNITS : int 345 247 445 9 337 377 658 2141 533 1184 ...
## $ OWNER_OCC : int 189 60 298 8 230 270 537 536 96 1011 ...
## $ RENTER_OCC : int 118 145 102 1 71 87 89 1385 378 107 ...
## $ GlobalID : chr "{cda740af-7a58-47b5-af2a-dbf0bf310394}" "{a638ccf1-3a22-4b44-b5e0-4c317cabbd84}" "{0b7ea9ab-aa8d-496e-b806-58505992614e}" "{9deda4f1-0861-4935-99a2-0480773c0030}" ...
## $ Shape__Area : num 3.51e+06 2.73e+06 8.46e+06 1.96e+08 6.09e+06 ...
## $ Shape__Length: num 7507 6954 11881 62239 10940 ...fips_dem_13 <- fips_demographics$POP2013
fips_dem_10 <- fips_demographics$POP2010
# calculating population growth rate
growth_rate <- (fips_dem_13 - fips_dem_10)/fips_dem_10
# Joining the 2 data sets
fips_dem_merge <- merge(demographics, fips_demographics, by.x="FIPS", by.y="FIPS")
# checking coordinates
st_crs(fips_dem_merge) ==st_crs(schools) ## [1] FALSE# the coordinates are not the same
# reprojecting fips_dem_merge into NAD83 Tennessee and assign to new object
fips_dem_TN <- st_transform(fips_dem_merge, st_crs(schools))
# getting rid of NA values:
na.zero <- function(fips_dem_TN){fips_dem_TN[is.na(fips_dem_TN)] <- 0
return (fips_dem_TN)}
fips_dem_TN[is.na(fips_dem_TN)] <- 0
plot(fips_dem_TN)## Warning: plotting the first 9 out of 21 attributes; use max.plot = 21 to plot
## all
# creating data frame containing both objects:
fips_dem_TN_bind <- cbind.data.frame(fips_dem_TN, growth_rate)
# creating a spatial feature class:
fips_dem_bind_sf <- st_as_sf(fips_dem_TN_bind)
plot(st_geometry(fips_dem_bind_sf))
# #Choropleth Map#
#1st making sure basic code is working:
ggplot(fips_dem_bind_sf)+geom_sf(aes(fill=growth_rate)) 
# this is not truly choropleth map because it is a single colorBreaking up the population growth rate into quantiles & adding a categorical variable to the object that assigns each value to a bracket.
#using classIntervals to determine breaks,
# and adding .00001 offset to catch the lowest value:
breaks_qt_f_d <- classIntervals(c(min(fips_dem_bind_sf$growth_rate) - 0.00001,
fips_dem_bind_sf$growth_rate), n=7,
style= "quantile")## Warning in classIntervals(c(min(fips_dem_bind_sf$growth_rate) - 1e-05,
## fips_dem_bind_sf$growth_rate), : var has missing values, omitted in finding
## classes# using breaks$brks to retrieve the breaks and creating a new data.frame with
# the added column:
fips_dem_bind_sf_cat <- fips_dem_bind_sf %>%
mutate(growth_cat= cut(growth_rate, breaks_qt_f_d$brks)) #mutating as a factorReplotting
a <- ggplot(fips_dem_bind_sf_cat) + geom_sf(aes(fill = growth_cat)) +
scale_fill_brewer(palette = "OrRd")
a
# creating thematic map
tm_shape(fips_dem_bind_sf_cat) +
tm_polygons("growth_cat",
style="quantile",
title="Shelby County Population Growth Rate")
# creating a manual class break to replace the other:
manual <- c(-0.2,-0.05,-0.03,-0.008,0.002,0.02,0.04,0.3)
# recreating the new data.frame with the added column:
fips_dem_bind_sf_cat2 <- fips_dem_bind_sf %>%
mutate(growth_cat= cut(growth_rate, manual))
## Replotting with the manual class break:
b <- ggplot(fips_dem_bind_sf_cat2) + geom_sf(aes(fill = growth_cat)) +
scale_fill_brewer(palette = "YlGnBu")
b