Assignment 5
Senet Manandhar
11/12/2017
Instructions
Complete the problems below and submit your work as a knitted docx file.
Setup
# Get all of your required libraries.
library(tidycensus)
library(tidyverse)## Loading tidyverse: ggplot2
## Loading tidyverse: tibble
## Loading tidyverse: tidyr
## Loading tidyverse: readr
## Loading tidyverse: purrr
## Loading tidyverse: dplyr## Conflicts with tidy packages ----------------------------------------------## filter(): dplyr, stats
## lag(): dplyr, statslibrary(viridis)## Loading required package: viridisLitelibrary(sf)## Linking to GEOS 3.6.1, GDAL 2.2.0, proj.4 4.9.3library(stringr)
census_api_key("d0906976a239fcc6ccd33f082f1dde1df09e7da8")## To install your API key for use in future sessions, run this function with `install = TRUE`.#census_api_key("Place your key here")Problem 1
Select any geographical area in the US and any numerical variable that interests you. Use Kyle Walker’s choropleth method to create a choropleth based on your choices. Describe your choices.
v15 <- load_variables(2015, "acs5", cache = TRUE)
options(tigris_use_cache = TRUE)
county<-get_acs(state = "WA", geography = "county",
variables = "B06009_005", geometry = TRUE)
head(county)## Simple feature collection with 6 features and 5 fields
## geometry type: MULTIPOLYGON
## dimension: XY
## bbox: xmin: -124.7631 ymin: 45.83596 xmax: -117.8194 ymax: 48.55072
## epsg (SRID): 4269
## proj4string: +proj=longlat +datum=NAD83 +no_defs
## # A tibble: 6 x 6
## GEOID NAME variable estimate moe
## <chr> <chr> <chr> <dbl> <dbl>
## 1 53005 Benton County, Washington B06009_005 21723 1007
## 2 53007 Chelan County, Washington B06009_005 7531 555
## 3 53009 Clallam County, Washington B06009_005 8007 564
## 4 53015 Cowlitz County, Washington B06009_005 6857 571
## 5 53037 Kittitas County, Washington B06009_005 5695 480
## 6 53043 Lincoln County, Washington B06009_005 1118 137
## # ... with 1 more variables: geometry <simple_feature>county %>%
ggplot(aes(fill = estimate, color = estimate)) +
geom_sf() +
coord_sf(crs = 26911) +
scale_fill_viridis(option = "magma") +
scale_color_viridis(option = "magma")
##My choice was variables having Bachelor's degree in the county of washington state. The reason i choose this because i am graduating student this year and I would like to see the number of graduates in the county where i live as well as all the other counties in Washington State with the past data. Problem 2
Use the bubble map technique that I demonstrated in class with the same choices I made in Problem 1.
library(openintro)## Please visit openintro.org for free statistics materials##
## Attaching package: 'openintro'## The following object is masked _by_ '.GlobalEnv':
##
## county## The following object is masked from 'package:ggplot2':
##
## diamonds## The following objects are masked from 'package:datasets':
##
## cars, treeslibrary(readxl)
census1<-read_delim("C:/Users/senet/Desktop/CSC 463 Data Visualization Tools/R/Assignment 5/2015_Gaz_counties_national.txt","\t", escape_double = FALSE, col_types = cols(GEOID = col_character()),trim_ws = TRUE)
WA_CO<-filter(census1, USPS=="WA")
data("countyComplete")
str(countyComplete)## 'data.frame': 3143 obs. of 53 variables:
## $ state : Factor w/ 51 levels "Alabama","Alaska",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ name : Factor w/ 1877 levels "Abbeville County",..: 83 90 101 151 166 227 237 250 298 320 ...
## $ FIPS : num 1001 1003 1005 1007 1009 ...
## $ pop2010 : num 54571 182265 27457 22915 57322 ...
## $ pop2000 : num 43671 140415 29038 20826 51024 ...
## $ age_under_5 : num 6.6 6.1 6.2 6 6.3 6.8 6.5 6.1 5.7 5.3 ...
## $ age_under_18 : num 26.8 23 21.9 22.7 24.6 22.3 24.1 22.9 22.5 21.4 ...
## $ age_over_65 : num 12 16.8 14.2 12.7 14.7 13.5 16.7 14.3 16.7 17.9 ...
## $ female : num 51.3 51.1 46.9 46.3 50.5 45.8 53 51.8 52.2 50.4 ...
## $ white : num 78.5 85.7 48 75.8 92.6 23 54.4 74.9 58.8 92.7 ...
## $ black : num 17.7 9.4 46.9 22 1.3 70.2 43.4 20.6 38.7 4.6 ...
## $ native : num 0.4 0.7 0.4 0.3 0.5 0.2 0.3 0.5 0.2 0.5 ...
## $ asian : num 0.9 0.7 0.4 0.1 0.2 0.2 0.8 0.7 0.5 0.2 ...
## $ pac_isl : num NA NA NA NA NA NA 0 0.1 0 0 ...
## $ two_plus_races : num 1.6 1.5 0.9 0.9 1.2 0.8 0.8 1.7 1.1 1.5 ...
## $ hispanic : num 2.4 4.4 5.1 1.8 8.1 7.1 0.9 3.3 1.6 1.2 ...
## $ white_not_hispanic : num 77.2 83.5 46.8 75 88.9 21.9 54.1 73.6 58.1 92.1 ...
## $ no_move_in_one_plus_year : num 86.3 83 83 90.5 87.2 88.5 92.8 82.9 86.2 88.1 ...
## $ foreign_born : num 2 3.6 2.8 0.7 4.7 1.1 1.1 2.5 0.9 0.5 ...
## $ foreign_spoken_at_home : num 3.7 5.5 4.7 1.5 7.2 3.8 1.6 4.5 1.6 1.4 ...
## $ hs_grad : num 85.3 87.6 71.9 74.5 74.7 74.7 74.8 78.5 71.8 73.4 ...
## $ bachelors : num 21.7 26.8 13.5 10 12.5 12 11 16.1 10.8 10.5 ...
## $ veterans : num 5817 20396 2327 1883 4072 ...
## $ mean_work_travel : num 25.1 25.8 23.8 28.3 33.2 28.1 25.1 22.1 23.6 26.2 ...
## $ housing_units : num 22135 104061 11829 8981 23887 ...
## $ home_ownership : num 77.5 76.7 68 82.9 82 76.9 69 70.7 71.4 77.5 ...
## $ housing_multi_unit : num 7.2 22.6 11.1 6.6 3.7 9.9 13.7 14.3 8.7 4.3 ...
## $ median_val_owner_occupied : num 133900 177200 88200 81200 113700 ...
## $ households : num 19718 69476 9795 7441 20605 ...
## $ persons_per_household : num 2.7 2.5 2.52 3.02 2.73 2.85 2.58 2.46 2.51 2.22 ...
## $ per_capita_income : num 24568 26469 15875 19918 21070 ...
## $ median_household_income : num 53255 50147 33219 41770 45549 ...
## $ poverty : num 10.6 12.2 25 12.6 13.4 25.3 25 19.5 20.3 17.6 ...
## $ private_nonfarm_establishments : num 877 4812 522 318 749 ...
## $ private_nonfarm_employment : num 10628 52233 7990 2927 6968 ...
## $ percent_change_private_nonfarm_employment: num 16.6 17.4 -27 -14 -11.4 -18.5 2.1 -5.6 -45.8 5.4 ...
## $ nonemployment_establishments : num 2971 14175 1527 1192 3501 ...
## $ firms : num 4067 19035 1667 1385 4458 ...
## $ black_owned_firms : num 15.2 2.7 NA 14.9 NA NA NA 7.2 NA NA ...
## $ native_owned_firms : num NA 0.4 NA NA NA NA NA NA NA NA ...
## $ asian_owned_firms : num 1.3 1 NA NA NA NA 3.3 1.6 NA NA ...
## $ pac_isl_owned_firms : num NA NA NA NA NA NA NA NA NA NA ...
## $ hispanic_owned_firms : num 0.7 1.3 NA NA NA NA NA 0.5 NA NA ...
## $ women_owned_firms : num 31.7 27.3 27 NA 23.2 38.8 NA 24.7 29.3 14.5 ...
## $ manufacturer_shipments_2007 : num NA 1410273 NA 0 341544 ...
## $ mercent_whole_sales_2007 : num NA NA NA NA NA ...
## $ sales : num 598175 2966489 188337 124707 319700 ...
## $ sales_per_capita : num 12003 17166 6334 5804 5622 ...
## $ accommodation_food_service : num 88157 436955 NA 10757 20941 ...
## $ building_permits : num 191 696 10 8 18 1 3 107 10 6 ...
## $ fed_spending : num 331142 1119082 240308 163201 294114 ...
## $ area : num 594 1590 885 623 645 ...
## $ density : num 91.8 114.6 31 36.8 88.9 ...cc = countyComplete %>%
filter(state == "Washington") %>%
select(FIPS,pop2010) %>%
rename(GEOID = FIPS) %>%
mutate(GEOID = as.character(GEOID))
select(cc,GEOID,pop2010) %>% full_join(county)->z1## Joining, by = "GEOID" WA_CO%>%full_join(z1, by="GEOID")->y1
y1%>%ggplot(aes(x=INTPTLONG,y=INTPTLAT)) +
geom_sf() +
geom_point(aes(color=estimate,size=pop2010)) +
scale_color_viridis(option = "magma")
Problem 3
Use Jula Silge’s method to make a leaflet-based choropleth with the same choices.
Jula Silge’s Method:
library(ggmap)
library(leaflet)
library(sf)
library(geospatial)
library(stringr)
WA_ST <- get_acs(state = "WA", geography = "county",
variables = "B06009_005", geometry = TRUE)
str(WA_ST)## Classes 'sf', 'tbl_df', 'tbl' and 'data.frame': 39 obs. of 6 variables:
## $ GEOID : chr "53005" "53007" "53009" "53015" ...
## $ NAME : chr "Benton County, Washington" "Chelan County, Washington" "Clallam County, Washington" "Cowlitz County, Washington" ...
## $ variable: chr "B06009_005" "B06009_005" "B06009_005" "B06009_005" ...
## $ estimate: num 21723 7531 8007 6857 5695 ...
## $ moe : num 1007 555 564 571 480 ...
## $ geometry:sfc_MULTIPOLYGON of length 39; first list element: List of 1
## ..$ :List of 1
## .. ..$ : num [1:272, 1:2] -120 -120 -120 -120 -120 ...
## ..- attr(*, "class")= chr "XY" "MULTIPOLYGON" "sfg"
## - attr(*, "sf_column")= chr "geometry"
## - attr(*, "agr")= Factor w/ 3 levels "constant","aggregate",..: NA NA NA NA NA
## ..- attr(*, "names")= chr "GEOID" "NAME" "variable" "estimate" ...pal <- colorQuantile(palette = "viridis", domain = WA_ST$estimate, n = 10)
WA_ST %>%
st_transform(crs = "+init=epsg:4326") %>%
leaflet(width = "100%") %>%
addProviderTiles(provider = "CartoDB.Positron") %>%
addPolygons(popup = ~ str_extract(NAME, "^([^,]*)"),
stroke = FALSE,
smoothFactor = 0,
fillOpacity = 0.4,
color = ~ pal(estimate)) %>%
addLegend("bottomleft",
pal = pal,
values = ~ estimate,
title = "Bachelor's Degree",
opacity = 1)