diff --git a/.gitignore b/.gitignore index 9f16f77..e50eda4 100644 --- a/.gitignore +++ b/.gitignore @@ -63,3 +63,5 @@ Prog/Temp/ # Other *.bat Thumbs.db +.Rproj.user +.Rhistory diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas new file mode 100644 index 0000000..87f215d --- /dev/null +++ b/Prog/2019/Internet Access.sas @@ -0,0 +1,177 @@ +/************************************************************************** + Program: Internet Access.sas + Library: Requests + Project: NeighborhoodInfo DC + Author: Yipeng Su + Created: 3/13/19 + Version: SAS 9.4 + Environment: Local Windows session + + Description: + +**************************************************************************/ + +%include "L:\SAS\Inc\StdLocal.sas"; + +** Define libraries **; +%DCData_lib( ACS ); +%DCData_lib (RegHsg); + +%let year= 2013_17; + +proc format; + value Jurisdiction + 0= "Total" + 1= "DC" + 2= "Charles County" + 3= "Frederick County " + 4="Montgomery County" + 5="Prince Georges " + 6="Arlington" + 7="Fairfax, Fairfax city and Falls Church" + 8="Loudoun" + 9="Prince William, Manassas and Manassas Park" + 10="Alexandria" + ; +run; + +data ACSall; +set acs.Acs_&year._va_sum_tr_tr10 acs.Acs_&year._dc_sum_tr_tr10 acs.Acs_&year._md_sum_tr_tr10 acs.Acs_&year._wv_sum_tr_tr10; + keep geo2010 geoid totpop_&year. medhhincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. + Numdialup_&year. Numbroadbandall_&year. Numcellular_&year. Numcellularonly_&year. Numbroadband_&year. Numbroadbandonly_&year. Numsatellite_&year. + Numsatelliteonly_&year. Numotheronly_&year. Numaccesswosub_&year. Numnointernet_&year. Numwithinternet_&year. + county Jurisdiction hshldinc100000plus_&year. hshldincunder15000_&year. hshldinc15000to34999_&year. hshldinc35000to49999_&year. + hshldinc50000to74999_&year. hshldinc75000to99999_&year. Numwithinternet_&year. Numhhdefined_&year. numpopbroadbanda_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year. + numpopbroadbandiom_&year. NumPopdialupA_&year. NumPopbroadbandA_&year. NumPopnointernetA_&year. NumPopnocomputerA_&year. + NumPopdialupB_&year. NumPopbroadbandB_&year. NumPopnointernetB_&year. NumPopnocomputerB_&year. + NumPopdialupH_&year. NumPopbroadbandH_&year. NumPopnointernetH_&year. NumPopnocomputerH_&year. + NumPopdialupW_&year. NumPopbroadbandW_&year. NumPopnointernetW_&year. NumPopnocomputerW_&year. + NumPopdialupIOM_&year. NumPopbroadbandIOM_&year. NumPopnointernetIOM_&year. NumPopnocomputerIOM_&year.; + + county= substr(geo2010, 1,5); + ucounty=county; + geoid= geo2010; + +%ucounty_jurisdiction + format Jurisdiction Jurisdiction. ; +run; + + +data InternetAcccess ; + set ACSall; + metro15 = put( county, $ctym15f. ); + + percent100Kplus= hshldinc100000plus_&year./Numhhdefined_&year.; + percentunder15K= hshldincunder15000_&year./Numhhdefined_&year.; + percent15to50K= (hshldinc15000to34999_&year.+ hshldinc35000to49999_&year.)/Numhhdefined_&year.; + percent50to75K= hshldinc50000to74999_&year./Numhhdefined_&year.; + percent75Kto100K= hshldinc75000to99999_&year./Numhhdefined_&year.; + internetdenom= Numhhdefined_&year.; + pctinternetsub= Numwithinternet_&year. /internetdenom; + pctinternetwosub= Numaccesswosub_&year. /internetdenom; + pctnointernet= Numnointernet_&year./internetdenom; + +run; + +proc export data= InternetAcccess + outfile="&_dcdata_default_path\Requests\Prog\2019\Internet_access_tract.csv" + dbms=csv + replace; +run; + +data BroadbandAcccess ; + set ACSall; + + metro15 = put( county, $ctym15f. ); + pctbroadband= Numbroadband_&year./Numhhdefined_&year. ; + pctbroadbanda= numpopbroadbanda_&year./(NumPopdialupA_&year. + NumPopbroadbandA_&year. + NumPopnointernetA_&year. + NumPopnocomputerA_&year.); + pctbroadbandb= numpopbroadbandb_&year./(NumPopdialupB_&year. + NumPopbroadbandB_&year. + NumPopnointernetB_&year. + NumPopnocomputerB_&year.); + pctbroadbandh= numpopbroadbandh_&year. /(NumPopdialupH_&year. + NumPopbroadbandH_&year. + NumPopnointernetH_&year. + NumPopnocomputerH_&year.); + pctbroadbandw= numpopbroadbandw_&year. /(NumPopdialupW_&year. + NumPopbroadbandW_&year. + NumPopnointernetW_&year. + NumPopnocomputerW_&year.); + pctbroadbandiom= numpopbroadbandiom_&year./(NumPopdialupIOM_&year. + NumPopbroadbandIOM_&year. + NumPopnointernetIOM_&year. + NumPopnocomputerIOM_&year.); + + percent100Kplus= hshldinc100000plus_&year./Numhhdefined_&year.; + percentunder15K= hshldincunder15000_&year./Numhhdefined_&year.; + percent15to50K= (hshldinc15000to34999_&year.+ hshldinc35000to49999_&year.)/Numhhdefined_&year.; + percent50to75K= hshldinc50000to74999_&year./Numhhdefined_&year.; + percent75Kto100K= hshldinc75000to99999_&year./Numhhdefined_&year.; + pctinternetsub= Numwithinternet_&year. /Numhhdefined_&year.; + pctinternetwosub= Numaccesswosub_&year. /Numhhdefined_&year.; + pctnointernet= Numnointernet_&year./Numhhdefined_&year.; + + +run; + +proc export data= BroadbandAcccess + outfile="&_dcdata_default_path\Requests\Prog\2019\Broadband_access_tract.csv" + dbms=csv + replace; +run; + + +proc sort data= BroadbandAcccess ; +by metro15;run; + +proc summary data = BroadbandAcccess; + var Numhhdefined_&year. medhhincm_&year. NumPopdialupA_&year. NumPopbroadbandA_&year. NumPopnointernetA_&year. NumPopnocomputerA_&year. + NumPopdialupB_&year. NumPopbroadbandB_&year. NumPopnointernetB_&year. NumPopnocomputerB_&year. NumPopdialupH_&year. NumPopbroadbandH_&year. NumPopnointernetH_&year. NumPopnocomputerH_&year. + NumPopdialupW_&year. NumPopbroadbandW_&year. NumPopnointernetW_&year. NumPopnocomputerW_&year. NumPopdialupIOM_&year. NumPopbroadbandIOM_&year. NumPopnointernetIOM_&year. NumPopnocomputerIOM_&year. Numbroadband_&year. + numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year. + hshldinc100000plus_&year. hshldincunder15000_&year. hshldinc15000to34999_&year. hshldinc35000to49999_&year. + hshldinc50000to74999_&year. hshldinc75000to99999_&year.; + by metro15; + output out = AccessinDMV sum = ; +run; +proc sort data= BroadbandAcccess; +by Jurisdiction;run; +proc summary data = BroadbandAcccess (where=(metro15= "47900")); + var Numhhdefined_&year. medhhincm_&year. Numbroadband_&year. + numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year. + hshldinc100000plus_&year. hshldincunder15000_&year. hshldinc15000to34999_&year. hshldinc35000to49999_&year. + hshldinc50000to74999_&year. hshldinc75000to99999_&year.; + by Jurisdiction; + output out = Accessbycounty sum = ; +run; +data accessbycounty2; +set Accessbycounty; + percent100Kplus= hshldinc100000plus_&year./Numhhdefined_&year.; + percentunder15K= hshldincunder15000_&year./Numhhdefined_&year.; + percent15to50K= (hshldinc15000to34999_&year.+ hshldinc35000to49999_&year.)/Numhhdefined_&year.; + percent50to75K= hshldinc50000to74999_&year./Numhhdefined_&year.; + percent75Kto100K= hshldinc75000to99999_&year./Numhhdefined_&year.; + pctbroadband= Numbroadband_&year./Numhhdefined_&year. ; + +run; + +proc sort data=BroadbandAcccess; +by geo2010;run; + +proc summary data = BroadbandAcccess (where=(metro15= "47900")); + var Numbroadband_&year. medhhincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. + numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year. + hshldinc100000plus_&year. hshldincunder15000_&year. hshldinc15000to34999_&year. hshldinc35000to49999_&year. + hshldinc50000to74999_&year. hshldinc75000to99999_&year. Numhhdefined_&year. Numwithinternet_&year. Numaccesswosub_&year. Numnointernet_&year. ; + by geo2010; + output out = Accessbytract_DMV sum = ; +run; + +data Accessbytract2_DMV; +set Accessbytract_DMV; + + percent100Kplus= hshldinc100000plus_&year./Numhhdefined_&year.; + percentunder15K= hshldincunder15000_&year./Numhhdefined_&year.; + percent15to50K= (hshldinc15000to34999_&year.+ hshldinc35000to49999_&year.)/Numhhdefined_&year.; + percent50to75K= hshldinc50000to74999_&year./Numhhdefined_&year.; + percent75Kto100K= hshldinc75000to99999_&year./Numhhdefined_&year.; + broadbandaccess= Numbroadband_&year./Numhhdefined_&year.; + pctinternetsub= Numwithinternet_&year. /Numhhdefined_&year.; + pctinternetwosub= Numaccesswosub_&year. /Numhhdefined_&year.; + pctnointernet= Numnointernet_&year./Numhhdefined_&year.; + +run; + +proc export data= Accessbytract2_DMV + outfile="&_dcdata_default_path\Requests\Prog\2019\Internetbroadband_access_DMVtract.csv" + dbms=csv + replace; +run; diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd new file mode 100644 index 0000000..0f994fa --- /dev/null +++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd @@ -0,0 +1,436 @@ +--- +title: "Blog ideas" +subtitle: +author: "Yipeng Su" +output: + html_document: + number_sections: FALSE + self_contained: TRUE + code_folding: show + toc: TRUE + toc_float: TRUE + css: ../www/web_report.css + editor_options: + chunk_output_type: console +--- + + + +Library: Request + +Project: blog + +Author: Yipeng Su + +Version: R 3.5.1, RStudio 1.1.423 + +Last updated `r format(Sys.time(), '%B %d, %Y')` + +Environment: Local Windows session (desktop) + +```{r rmarkdown-setup, echo = FALSE} +knitr::opts_chunk$set(warning = FALSE) +knitr::opts_chunk$set(message = FALSE) +# knitr::opts_chunk$set(eval = FALSE) +``` + +## Internet/Broadband Access by geography and demographics + +The first idea is internet and broadband access very by geography. As the maps of the DMV area suggests, the overall internet access is pretty high, the median access to internet rate for all tracts is 90% and the median access to broadband is 82%. + +```{r setup} +library(tidyverse) +library(urbnthemes) +library(sf) + +set_urbn_defaults("print") + +library(tidyverse) +library(DescTools) +library(purrr) +library(colorspace) +library(ggplot2) + +#### Create directory for data exports on local computer + +if (!dir.exists("../Data")) { + dir.create("../Data") +} + +jdir <- "D:/DCData/Libraries/Requests/Prog/2019/" + +library(dplyr) + +#### Load in region shapefile +library(rgdal) + +library(sf) +shp= "L:/Libraries/General/Maps/DCMetroArea2015_tr10.shp" +Metro_sf <- read_sf(dsn=shp,layer= basename(strsplit(shp, "\\.")[[1]])[1]) + +countyshp= "L:/Libraries/General/Maps/DMVCounties.shp" + +county_sf <- read_sf(dsn= countyshp, layer= "DMVCounties") + + +# load in typology dataset output from SAS program + +InternetAccess <- read.csv(paste0(jdir,"Internet_access_tract.csv")) + +Access_df <- InternetAccess %>% + mutate(GEOID=as.character(geoid)) %>% + filter(TotPop_2013_17 >= 100 ) + + +BroadbandAccess <- read.csv(paste0(jdir,"Broadband_access_tract.csv")) + +Broadband_df <- BroadbandAccess %>% + mutate(GEOID=as.character(geoid)) %>% + filter(TotPop_2013_17 >= 100 ) + + +#spatial join +InternetAccessmap <- left_join (Metro_sf, Access_df, by = c("GEOID"="GEOID")) +BroadbandAccessmap <- left_join (Metro_sf, Broadband_df, by = c("GEOID"="GEOID")) + +#You need to install these if the library after these don't exist' +#install.packages("colorspace") +#install.packages("devtools") +#devtools::install_github("UI-Research/urbnthemes") + + +boundary <- ggplot()+ + geom_sf(county_sf, mapping=aes(), fill=NA, color="#0a4c6a", size=0.5)+ + theme_urbn_map() + + coord_sf(crs = 4269, datum = NA) + +WV <- InternetAccessmap %>% + filter(STATEFP=="54") + +DC <- InternetAccessmap %>% + filter(STATEFP=="11") + +``` + +Map the overall internet access. Note the categories in the internet access table are not mutually exclusive and causing the Internet access percentage to be more than 1 in some cases. + +```{r make-map, echo=FALSE} +#question: how to change color scale for urban style? + +ggplot() + + geom_sf(BroadbandAccessmap,mapping = aes(), + fill = NA, color = "red", size = .1) + + geom_sf(BroadbandAccessmap, mapping=aes(fill=pctbroadband)) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,1), low= "#fdbf11", high= "#1696d2", midpoint = 0.82, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "Percent broadband access", color = NULL) + + labs(title = "Percentage of Households with Broadband Subscription") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + +``` + +Instead of using the continuous internet access, put the numbers in quantile and recreate the map + +```{r make-quantile map, echo=FALSE} +BraodbandAccessmap_quantile <- BroadbandAccessmap %>% + mutate(broadband_quantile= ntile(pctbroadband, 4), + internet_quantile= ntile(pctinternetsub,4)) + +ggplot() + + geom_sf(BraodbandAccessmap_quantile,mapping = aes(), + fill = NA, color = "red", size = .1) + + geom_sf(BraodbandAccessmap_quantile, mapping=aes(fill=broadband_quantile)) + + theme_urbn_map() + + scale_fill_gradient2(low= "#fdbf11", high= "#1696d2", na.value ="grey50", aesthetics = "fill")+ + labs(fill = "quantile of broadband access", color = NULL) + + labs(title = "Households with Broadband Subscription by tract") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + +``` +But there are also areas of DMV that have a relatively low rate of internet access, such as Census Tract 74.01 in DC, with more than 54% households without internet access. And areas that have more than 20% households having access to internet without subscription. + +```{r access by region, echo=FALSE} + +ggplot() + + geom_sf(BroadbandAccessmap,mapping = aes(), + fill = NA, color = "red", size = .1) + + geom_sf(BroadbandAccessmap, mapping=aes(fill=pctinternetwosub)) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,0.21), low= "#78c26d", high= "#e54096", midpoint = 0.028, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "Percent internet access without subscription", color = NULL) + + labs(title = "Percentage population with internet access without subscription") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + + +ggplot() + + geom_sf(BroadbandAccessmap,mapping = aes(), + fill = NA, color = "red", size = .1) + + geom_sf(BroadbandAccessmap, mapping=aes(fill=pctnointernet)) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,0.21), low= "#78c26d", high= "#e54096", midpoint = 0.021, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "Percent internet access without subscription", color = NULL) + + labs(title = "Percentage population with no internet access") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + + +``` + +The different levels of internet access is also reflected in county level comparisons. The county with lowest broadband access is Rappahannock and Clarke in VA. + +```{r county comparison} + +BroadbandAccessmap2 <- BroadbandAccessmap %>% + group_by(county) %>% + summarize(medianbroadband= median(pctbroadband, na.rm=TRUE), + medianinternet= median(pctinternetsub, na.rm=TRUE), + medianinternetwosub= median(pctinternetwosub, na.rm=TRUE)) %>% + ungroup() %>% + transform(county= reorder(county, -medianbroadband)) + +ggplot(data=BroadbandAccessmap2, mapping= aes(as.factor(county), medianbroadband))+ geom_col() + + xlab("County")+ + ylab("Median Access to broadband rate")+ + labs(title = "Median percentage of hh that have access to broadband") + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +BroadbandAccessmap2 <- BroadbandAccessmap2 %>% + transform(county= reorder(county, -medianinternetwosub)) + +ggplot(data=BroadbandAccessmap2, mapping= aes(as.factor(county), medianinternetwosub))+ geom_col() + + xlab("County")+ + ylab("Median percent hh have internet without subscription")+ + labs(title = "Median percentage of hh that have access to internet without subscription") + + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + +fairfax <- BraodbandAccessmap_quantile %>% + filter(county== "51059") + +ggplot(data=fairfax, mapping= aes(x=broadband_quantile))+ + geom_histogram() + +p <- BraodbandAccessmap_quantile + +ggplot(data= BraodbandAccessmap_quantile, mapping = aes(x= factor(county), + y= (..count..), + fill= factor(broadband_quantile)))+ + geom_bar(position="fill")+ + scale_y_continuous(expand = c(0, 0),labels = scales::percent) + + xlab("county")+ + ylab("count")+ + labs("")+ + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +ggplot(data= BraodbandAccessmap_quantile, mapping = aes(x= factor(county), + y= (..count..), + fill= factor(broadband_quantile)))+ + geom_bar(position="dodge")+ + scale_y_continuous(expand = c(0, 0),limits=c(100), labels = scales::comma) + + xlab("county")+ + ylab("count")+ + labs("")+ + theme(axis.text.x = element_text(angle = 45, hjust = 1)) + + +``` + + +Variation in access to Internet also exist in each county/state. +```{r by state} + +Broadband_long <- BroadbandAccessmap %>% + mutate(pctwhite= PopAloneW_2013_17/TotPop_2013_17) %>% + select(GEOID, Jurisdiction, metro15, geometry, pctbroadband, pctinternetsub, percent100Kplus, pctwhite) %>% + gather(key, value, -GEOID, -Jurisdiction, -metro15, -geometry) + + +Broadband_state <- BroadbandAccessmap %>% + mutate(pctwhite= PopAloneW_2013_17/TotPop_2013_17) %>% + mutate(state= str_sub(geoid, 1,2 )) %>% + select(state, Jurisdiction, metro15, geometry, pctbroadband, pctinternetsub, percent100Kplus, pctwhite) + + +DC <- Broadband_state %>% + filter(state== "11") + +DCmedian <- DC %>% + mutate(median= median(pctbroadband)) + + +MD <- Broadband_state %>% + filter(state== "24") + +MDmedian <- MD %>% + mutate(median= median(pctbroadband)) + +VA <- Broadband_state %>% + filter(state== "51") + +VAmedian <- VA %>% + mutate(median= median(pctbroadband)) + +WV <- Broadband_state %>% + filter(state== "54") + +WVmedian <- WV %>% + mutate(median= median(pctbroadband)) + + +``` + +```{r braodband by state, echo=FALSE} + +ggplot() + + geom_sf(DC, mapping=aes(fill=(1-pctbroadband)), size = .05) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,1), low= "#73bfe2", high= "#ca5800", midpoint=0.73, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "No Access to broadband Internet", color = NULL) + + labs(title = "Percentage of population that don't have access to broadband internet") + + theme(legend.position ="right", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA)+ + ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_DC.pdf", device = cairo_pdf) + +ggplot() + + geom_sf(MD, mapping=aes(fill=(1-pctbroadband)), size = .05) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,1), low= "#73bfe2", high= "#ca5800", midpoint=0.8,na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "No Access to broadband Internet", color = NULL) + + labs(title = "Percentage of population that don't have access to broadband internet") + + theme(legend.position ="right", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA)+ + ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_MD.pdf", device = cairo_pdf) + +ggplot() + + geom_sf(VA, mapping=aes(fill=(1-pctbroadband)), size = .05) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,1), low= "#73bfe2", high= "#ca5800", midpoint=0.87,na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "No Access to broadband Internet", color = NULL) + + labs(title = "Percentage of population that don't have access to broadband internet") + + theme(legend.position ="right", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA)+ + ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_VA.pdf", device = cairo_pdf) + +ggplot() + + geom_sf(WV, mapping=aes(fill=(1-pctbroadband)), size = .05) + + theme_urbn_map() + + scale_fill_gradient2(limits=c(0,1), low= "#73bfe2", high= "#ca5800", midpoint=0.71,na.value = "grey50", labels = scales::percent, aesthetics = "fill")+ + labs(fill = "No Access to broadband Internet", color = NULL) + + labs(title = "Percentage of population that don't have access to broadband internet") + + theme(legend.position ="right", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA)+ + ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_WV.pdf", device = cairo_pdf) + +``` + +Access to internet reflects the distribution of socioeconomic distributions. +1. Broadband access increases with income +2. Broadband access increases with percent white residents + + +```{r scatter, echo=FALSE} + +ggplot(data=BroadbandAccessmap, mapping= aes(y= pctbroadband, x= percentunder15K))+ geom_point(alpha=3/10)+ + labs(title = "Internet Access Increase with Income", + subtitle = "Percent population earning less than 15K and percent having broadband internet access", + caption = "Urban Institute", + x = "Percent population with earning under 15K", + y = "Percent population with access to broadband internet" + ) + +ggplot(data=BroadbandAccessmap, mapping= aes(y= pctbroadband, x= MedHHIncm_2013_17))+ geom_point(alpha=3/10)+ + labs(title = "Internet Access Increase with Income", + subtitle = "Median income and percent having broadband internet access", + caption = "Urban Institute", + x = "Median Household Income", + y = "Percent population with access to broadband internet" + ) + +ggplot(data=BroadbandAccessmap, mapping= aes(y= pctbroadband, x=((TotPop_2013_17-PopAloneW_2013_17)/TotPop_2013_17) , size = TotPop_2013_17))+ geom_point(alpha=5/10)+ + scale_size_continuous(range = c(.1, 10)) + + labs(title = "Internet Access Decrease with percent non white", + subtitle = "Community of color tend to be more likely to have lower access of internet", + caption = "Urban Institute", + x = "Percent population that is non white", + y = "Percent household with access to internet" + ) + +BroadbandAccessmap <- BroadbandAccessmap %>% + mutate(pctwhite=PopAloneW_2013_17/TotPop_2013_17) %>% + mutate(quartile=ntile(pctwhite,4), + incquartile= ntile(percentunder15K,4)) %>% + mutate(racegroup= case_when(quartile==1~"pct white 1", + quartile==2~"pct white 2", + quartile==3~"pct white 3", + quartile==4~"pct white 4")) %>% + mutate(incgroup = case_when(incquartile==1 ~ "incgroup 1", + incquartile==2 ~ "incgroup 2", + incquartile==3 ~ "incgroup 3", + incquartile==4 ~ "incgroup 4")) + + +BroadbandAccessmap3 <- BroadbandAccessmap %>% + group_by(incgroup) %>% + summarize(medianbroadband= median(pctbroadband), + medianinternet= median(pctinternetsub)) %>% + ungroup() + +``` + +The distribution of access to broadband follow similar trends by different levels of income and diversity in the region: skewed to the higher end of X axis but groups with more income and more white are more skewed towards the higher end. + +```{r barchart for broadband} +ggplot(data=BroadbandAccessmap, mapping= aes(x=pctbroadband))+ geom_freqpoly(mapping= aes(color= racegroup), binwidth= 0.1)+ + labs(title = "Broadband Access distribution by race", + caption = "Urban Institute", + x = "count", + y = "Percent population with access to broadband internet" + ) + +ggplot(data=BroadbandAccessmap, mapping= aes(x=pctbroadband))+ geom_freqpoly(mapping= aes(color= incgroup), binwidth= 0.1) + labs(title = "Broadband Access distribution by income", + caption = "Urban Institute", + x = "Count", + y = "Percent population with access to broadband internet" + ) + +ggplot(data=BroadbandAccessmap3, mapping= aes(incgroup, medianbroadband))+ geom_col() + +``` + +Internet access trend is very similar to broadband trends, but overall higher than broadband access rate. + +```{r barchart for internet} +ggplot(data=BroadbandAccessmap, mapping= aes(x=pctinternetsub))+ geom_freqpoly(mapping= aes(color= racegroup), binwidth= 0.1)+ + labs(title = "Internet Access distribution by race", + caption = "Urban Institute", + x = "count", + y = "Percent household with access to internet" + ) + +ggplot(data=BroadbandAccessmap, mapping= aes(x=pctinternetsub))+ geom_freqpoly(mapping= aes(color= incgroup), binwidth= 0.1) + labs(title = "Broadband Access distribution by income", + caption = "Urban Institute", + x = "Count", + y = "Percent household with access to internet" + ) + +ggplot(data=BroadbandAccessmap3, mapping= aes(incgroup, medianinternet))+ geom_col() + +``` +## Distribution of demographics and broadband + +A frequency chart for demograohic, income and internet access shows how they interact with each other: compared to income and racial diversity in the region, most households in the region have access to broadband, at least internet access. But there are certain counties and neighborhoods that need targeted programs, especially when access to broadband has become a very important foundation for economic and community success. + +```{r broadband and demographics} + +ggplot(data=Broadband_long, mapping= aes(x=value))+ geom_freqpoly(mapping= aes(color= key), binwidth= 0.1) + + +``` + + diff --git a/Prog/2019/InternetAccess/InternetAccess.Rproj b/Prog/2019/InternetAccess/InternetAccess.Rproj new file mode 100644 index 0000000..8e3c2eb --- /dev/null +++ b/Prog/2019/InternetAccess/InternetAccess.Rproj @@ -0,0 +1,13 @@ +Version: 1.0 + +RestoreWorkspace: Default +SaveWorkspace: Default +AlwaysSaveHistory: Default + +EnableCodeIndexing: Yes +UseSpacesForTab: Yes +NumSpacesForTab: 2 +Encoding: UTF-8 + +RnwWeave: Sweave +LaTeX: pdfLaTeX diff --git a/Prog/2019/InternetAccess/mapping internet access.R b/Prog/2019/InternetAccess/mapping internet access.R new file mode 100644 index 0000000..5be2f8e --- /dev/null +++ b/Prog/2019/InternetAccess/mapping internet access.R @@ -0,0 +1,214 @@ +## Set-up +#### Load libraries and functions + +library(tidyverse) +library(DescTools) +library(purrr) + + +#### Create directory for data exports on local computer + +if (!dir.exists("../Data")) { + dir.create("../Data") +} + +jdir <- "D:/DCData/Libraries/Requests/Prog/2019/" + +library(dplyr) + +#### Load in region shapefile +library(rgdal) + +library(sf) +shp= "L:/Libraries/General/Maps/DCMetroArea2015_tr10.shp" +Metro_sf <- read_sf(dsn=shp,layer= basename(strsplit(shp, "\\.")[[1]])[1]) + +countyshp= "L:/Libraries/General/Maps/DMVCounties.shp" + +county_sf <- read_sf(dsn= countyshp, layer= "DMVCounties") + + +# load in typology dataset output from SAS program + +InternetAccess <- read.csv(paste0(jdir,"Internet_access_tract.csv")) + +Access_df <- InternetAccess %>% + mutate(GEOID=as.character(geoid)) + +BroadbandAccess <- read.csv(paste0(jdir,"Broadband_access_tract.csv")) + +Broadband_df <- BroadbandAccess %>% + mutate(GEOID=as.character(geoid)) + + +#spatial join +InternetAccessmap <- left_join (Metro_sf, Access_df, by = c("GEOID"="GEOID")) +BroadbandAccessmap <- left_join (Metro_sf, Broadband_df, by = c("GEOID"="GEOID")) + +# Typologymap$neighborhoodtypeHH[Typologymap$neighborhoodtypeHH==""] <- "NA" +# Typologymap$neighborhoodtypeFAM[Typologymap$neighborhoodtypeFAM==""] <- "NA" +# Typologymap$neighborhoodtypeHH[Typologymap$neighborhoodtypeHHcode==""] <- "NA" +# Typologymap$neighborhoodtypeFAM[Typologymap$neighborhoodtypeFAMcode==""] <- "NA" + +#You need to install these if the library after these don't exist' +#install.packages("colorspace") +#install.packages("devtools") +#devtools::install_github("UI-Research/urbnthemes") + +library(colorspace) +library(ggplot2) +library(urbnthemes) + +boundary <- ggplot()+ + geom_sf(county_sf, mapping=aes(), fill=NA, color="#0a4c6a", size=0.5)+ + theme_urbn_map() + + coord_sf(crs = 4269, datum = NA) + +WV <- InternetAccessmap %>% + filter(STATEFP=="54") + +DC <- InternetAccessmap %>% + filter(STATEFP=="11") + +#overall internet access +ggplot() + + geom_sf(InternetAccessmap ,mapping = aes(), + fill = NA, color = "red", size = .1) + + geom_sf(InternetAccessmap, mapping=aes(fill=pctnointernet)) + + theme_urbn_map() + + scale_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+ + scale_fill_gradientn(labels = scales::percent) + + labs(fill = "Percent no internet access", color = NULL) + + labs(title = "Percentage household that don't have access to internet") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + +#broadband access +ggplot() + + geom_sf(BroadbandAccessmap ,mapping = aes(), + fill = NA, color = "red", size = .1) + + geom_sf(InternetAccessmap, mapping=aes(fill=pctnointernet)) + + theme_urbn_map() + + scale_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+ + scale_fill_gradientn(labels = scales::percent) + + labs(fill = "Percent no internet access", color = NULL) + + labs(title = "Percentage household that don't have access to internet") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + +library(tidyverse) +library(urbnthemes) + +set_urbn_defaults("print") + +ggplot(data=InternetAccessmap, mapping= aes(y= pctinternet, x= percentunder15K))+ geom_point(alpha=3/10)+ + labs(title = "Internet Access Increase with Income", + subtitle = "Percent population earning less than 15K and percent having internet access", + caption = "Urban Institute", + x = "Percent population with earning under 15K", + y = "Percent household with access to internet" + ) + +ggplot(data=InternetAccessmap, mapping= aes(y= pctinternet, x=((TotPop_2013_17-PopAloneW_2013_17)/TotPop_2013_17) , size = TotPop_2013_17))+ geom_point(alpha=5/10)+ + scale_size_continuous(range = c(.1, 10)) + + labs(title = "Internet Access Decrease with percent non white", + subtitle = "Community of color tend to be more likely to have lower access of internet", + caption = "Urban Institute", + x = "Percent population that is non white", + y = "Percent household with access to internet" + ) + + +#overall internet access +ggplot() + + geom_sf(Accessmap, mapping = aes(), + fill = NA, color = "white", size = .05) + + geom_sf(Accessmap, mapping=aes(fill=pctbroadband, size = .05)) + + theme_urbn_map() + + scale_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+ + scale_fill_gradientn(labels = scales::percent) + + labs(fill = "Access to Internet and broadband", color = NULL) + + labs(title = "Percentage have access to broadband internet") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA) + +# geom_sf(COGcounty_sf, mapping=aes(), fill=NA, color="#12719e", size=0.3, alpha=0.5)+ +# coord_sf(crs = 4269, datum = NA) + + +#internet access by race +ggplot() + + geom_sf(Accessmap, mapping = aes(), + fill = NA, color = "white", size = .01) + + geom_sf(Accessmap, mapping=aes(fill=pctbroadbandw), size = .05) + + theme_urbn_map() + + scale_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+ + scale_fill_gradientn(labels = scales::percent) + + labs(fill = "Access to Internet and broadband", color = NULL) + + labs(title = "Percentage of white population have access to broadband internet") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA)+ + ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_white.pdf", device = cairo_pdf) + +ggplot() + + geom_sf(Accessmap, mapping = aes(), + fill = NA, color = "white", size = .01) + + geom_sf(Accessmap, mapping=aes(fill=pctbroadbandb), size = .05) + + theme_urbn_map() + + scale_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+ + scale_fill_gradientn(labels = scales::percent) + + labs(fill = "Access to Internet and broadband", color = NULL) + + labs(title = "Percentage of black population have access to broadband internet") + + theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) + + coord_sf(crs = 4269, datum = NA)+ + ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_black.pdf", device = cairo_pdf) + + +Accessmap_long <- BroadbandAccessmap %>% + select(GEOID, Jurisdiction, metro15, geometry, pctbroadband, pctbroadbanda, + pctbroadbandb, pctbroadbandh, pctbroadbandw, pctbroadbandiom) %>% + gather(key, value, -GEOID, -Jurisdiction, -metro15, -geometry) + +Broadband_long <- BroadbandAccessmap %>% + mutate(pctwhite= PopAloneW_2013_17/TotPop_2013_17) %>% + select(GEOID, Jurisdiction, metro15, geometry, pctbroadband, pctinternet, percent100Kplus, pctwhite) %>% + gather(key, value, -GEOID, -Jurisdiction, -metro15, -geometry) + +#facet by race +ggplot() + + geom_sf(Accessmap_long, mapping=aes(fill=value), size = .05) + + scale_fill_gradientn(labels = scales::percent) + + coord_sf(crs = 4269, datum = NA)+ + facet_wrap(~key) + +ggplot(data=Broadband_long, mapping= aes(x=value))+ geom_freqpoly(mapping= aes(color= key), binwidth= 0.1) + # labs(title = "Internet Access Decrease with percent non white", + # subtitle = "Community of color tend to be more likely to have lower access of internet", + # caption = "Urban Institute", + # x = "Percent population that is non white", + # y = "Percent household with access to internet" + # ) + + +Broadband_state <- BroadbandAccessmap %>% + mutate(pctwhite= PopAloneW_2013_17/TotPop_2013_17) %>% + mutate(state= str_sub(geoid, 1,2 )) %>% + select(state, Jurisdiction, metro15, geometry, pctbroadband, pctinternet, percent100Kplus, pctwhite) + +ggplot() + + geom_sf(Broadband_state, mapping=aes(fill=pctbroadband), size = .05) + + scale_fill_gradientn(labels = scales::percent) + + coord_sf(crs = 4269, datum = NA)+ + facet_wrap(~state) + +DC <- Broadband_state %>% + filter(state== "11") + +DC <- Broadband_state %>% + filter(state== "24") + +DC <- Broadband_state %>% + filter(state== "51") + +DC <- Broadband_state %>% + filter(state== "54") diff --git a/Prog/2019/__MACOSX/www/._images b/Prog/2019/__MACOSX/www/._images new file mode 100644 index 0000000..cfda601 Binary files /dev/null and b/Prog/2019/__MACOSX/www/._images differ diff --git a/Prog/2019/__MACOSX/www/._web_report.css b/Prog/2019/__MACOSX/www/._web_report.css new file mode 100644 index 0000000..7573844 Binary files /dev/null and b/Prog/2019/__MACOSX/www/._web_report.css differ diff --git a/Prog/2019/__MACOSX/www/images/._Thumbs.db b/Prog/2019/__MACOSX/www/images/._Thumbs.db new file mode 100644 index 0000000..b63a88c Binary files /dev/null and b/Prog/2019/__MACOSX/www/images/._Thumbs.db differ diff --git a/Prog/2019/www/web_report.css b/Prog/2019/www/web_report.css new file mode 100644 index 0000000..efb69e2 --- /dev/null +++ b/Prog/2019/www/web_report.css @@ -0,0 +1,62 @@ +.container-fluid { + font-family: Lato; +} + +/* make titles blue */ +h1 { + color: #1696d2; +} + +.navbar { + background-color: #1696d2; + color: #ffffff; + font-weight: bold; +} + +.navbar-default .navbar-brand { + color: #FFFFFF; +} + +.navbar-default .navbar-nav>li>a { + color: #FFFFFF; +} + +.navbar-default .navbar-nav>.active>a, .navbar-default .navbar-nav>.active>a:focus, .navbar-default .navbar-nav>.active>a:hover { + color: #1696d2; + background-color: #FFFFFF; +} + +/* Global Formats */ +.main-container { + font-family: Lato; +} + +/* Hyper-links */ +.a { + color: #1696d2; +} + +/* Header image formatting */ +#header { + padding-top: 12px; +} + +/* Legend Formatting */ +.list-group-item.active { + background-color: #1696d2; + border-color: #1696d2; +} + +.list-group-item.active:hover { + background-color: #000000; + border-color: #000000; +} + +.tocify { + border-radius: 0; +} + +/* Button Formatting */ +.btn { + border-radius: 0; +}