From 0ec5a82f96489dee1782ef06f2484df409daf662 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 13 Mar 2019 18:39:39 -0400
Subject: [PATCH 01/19] initial setup

---
 Prog/2019/Internet Access.sas | 129 ++++++++++++++++++++++++++++++++++
 1 file changed, 129 insertions(+)
 create mode 100644 Prog/2019/Internet Access.sas

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
new file mode 100644
index 0000000..e1d311a
--- /dev/null
+++ b/Prog/2019/Internet Access.sas	
@@ -0,0 +1,129 @@
+/**************************************************************************
+ 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 InternetAcccess ;
+	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
+	      
+	  keep geo2010 totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
+	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
+           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 percent100Kplus percentunder15K percent15to50K percent50to75K  percent75Kto100K
+           county metro15 Jurisdiction;
+
+      county= substr(geo2010, 1,5);
+	  ucounty=county;
+
+%ucounty_jurisdiction
+
+	  metro15 = put( county, $ctym15f. );
+      numpopbroadbandtot= numpopbroadbanda_2013_17 + numpopbroadbandiom_2013_17+ numpopbroadbandb_2013_17+ numpopbroadbandh_2013_17+ numpopbroadbandw_2013_17;
+      tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
+           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
+      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
+	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
+	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
+	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
+      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+
+	  format Jurisdiction Jurisdiction. ;
+run;
+proc sort data=InternetAcccess;
+by metro15;run;
+
+proc summary data = InternetAcccess ;
+	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
+	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
+           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
+		   by metro15;
+	output out = AccessinDMV sum = ;
+run;
+proc sort data=InternetAcccess;
+by Jurisdiction;run;
+proc summary data = InternetAcccess (where=(metro15= "47900"));
+	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
+	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
+           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
+		   by Jurisdiction;
+	output out = Accessbycounty sum = ;
+run;
+data accessbycounty2;
+set Accessbycounty;
+tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
+           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
+      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
+	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
+	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
+	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
+      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+	  broadbandaccess= numpopbroadbandtot/totpop_&year.;
+
+run;
+
+
+proc sort data=InternetAcccess;
+by geo2010;run;
+
+proc summary data = InternetAcccess (where=(metro15= "47900"));
+	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
+	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
+           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
+		   by geo2010;
+	output out = Accessbytract sum = ;
+run;
+
+data Accessbytract2;
+set Accessbytract;
+tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
+           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
+      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
+	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
+	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
+	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
+      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+	  broadbandaccess= numpopbroadbandtot/totpop_&year.;
+
+run;
+
+
+proc export data=Accessbytract2
+   outfile='&_dcdata_default_path\Requests\Data\Internet_access_tract.csv'
+   dbms=csv
+   replace;
+run;

From 65c5c16053626c6dc31457aad63e9d08675e3a9d Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 13 Mar 2019 18:46:28 -0400
Subject: [PATCH 02/19] map

---
 Prog/2019/Internet Access.sas       |   3 +-
 Prog/2019/mapping internet access.R | 100 ++++++++++++++++++++++++++++
 2 files changed, 101 insertions(+), 2 deletions(-)
 create mode 100644 Prog/2019/mapping internet access.R

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index e1d311a..8afe7e6 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -121,9 +121,8 @@ tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc1500
 
 run;
 
-
 proc export data=Accessbytract2
-   outfile='&_dcdata_default_path\Requests\Data\Internet_access_tract.csv'
+   outfile='&_dcdata_default_path\Requests\Prog\2019\Internet_access_tract.csv'
    dbms=csv
    replace;
 run;
diff --git a/Prog/2019/mapping internet access.R b/Prog/2019/mapping internet access.R
new file mode 100644
index 0000000..4caf3d4
--- /dev/null
+++ b/Prog/2019/mapping internet access.R	
@@ -0,0 +1,100 @@
+## 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")
+}
+
+library(dplyr)
+#### Set FIPS code and filepath name
+
+currentfips <- "11001"
+filepath <- "DC"
+jdir <- paste0("L:/Libraries/RegHsg/Data/", filepath, "/")
+
+
+#### Load in CG region shapefile
+library(rgdal)
+
+library(sf)
+shp= "L:/Libraries/RegHsg/Maps/COG_region.shp"
+COGregion_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
+
+Typology <- read.csv(paste0(jdir,"Neighborhood typology for mapping.csv")) 
+
+Typology_df <- Typology  %>% 
+         mutate(GEOID=as.character(geoid))
+
+
+                #missing= ifelse(vulnerable=="", 1,0)) %>% 
+         #filter(missing==0)
+  
+
+#spatial join
+Typologymap <- left_join (Typology_df, COGregion_sf, 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(COGcounty_sf, mapping=aes(), fill=NA, color="#0a4c6a", size=0.5)+
+  theme_urbn_map() +
+  coord_sf(crs = 4269, datum = NA)
+
+
+#Typology by HH income 
+ggplot() +
+  geom_sf(COGcounty_sf, mapping=aes(), fill=NA, color="#98cf90", size=0.05)+
+  geom_sf(Typologymap,  mapping = aes(),
+          fill = NA, color = "white", size = .05) +
+  geom_sf(Typologymap, mapping=aes(fill=factor(neighborhoodtypeHHcode)), color= "#dcdbdb", size = .05)+
+  scale_fill_manual(values = c ("#cfe8f3", "#a2d4ec", "#73bfe2", "#46abdb", "#1696d2", "#12719e","#332d2f", "#9d9d9d" ),
+                    labels= c("Low-mod value, no demographic chg","Low-mod value, adj. to high value/apprec., no demographic chg", "Low-mod value but accelerating mkt., no demographic chg", "Low-mod value, adj. to high value/apprec., demographic chg", "Low-mod value but accelerating mkt., demographic chg", "High value, appreciated mkt., demographic chg", "High value, appreciated mkt., demographic chg., smaller vulnerable pop", "Less than 50 owner-occupied units in at least 1 reference period","Not at risk: High value, smaller vulnerable pop" )) +
+  theme_urbn_map() +
+  labs(fill = "Tract Gentrification and Displacement Risk for Vulnerable Populations", color = NULL) +
+  labs(title = "Neighborhood Gentrification Typology by HH") + 
+  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)
+
+
+#Typology by FAM income
+ggplot() +
+  geom_sf(COGcounty_sf,  mapping = aes(),
+          fill = NA, color = "#9d9d9d", size = .05) +
+  geom_sf(Typologymap, mapping=aes(fill=factor(neighborhoodtypeFAMcode)), color= "#dcdbdb", size = .05)+
+  scale_fill_manual(values = c ("#cfe8f3", "#a2d4ec", "#73bfe2", "#46abdb", "#1696d2", "#12719e","#332d2f", "#9d9d9d" ),
+                    labels= c("Low-mod value, no demographic chg","Low-mod value, adj. to high value/apprec., no demographic chg", "Low-mod value but accelerating mkt., no demographic chg", "Low-mod value, adj. to high value/apprec., demographic chg", "Low-mod value but accelerating mkt., demographic chg", "High value, appreciated mkt., demographic chg", "High value, appreciated mkt., demographic chg., smaller vulnerable pop", "Less than 50 owner-occupied units in at least 1 reference period","Not at risk: High value, smaller vulnerable pop" )) +
+  theme_urbn_map() +
+  labs(fill = "Tract Gentrification and Displacement Risk for Vulnerable Populations", color = NULL) +
+  labs(title = "Neighborhood Gentrification Typology by Family") + 
+  theme(legend.position ="bottom", legend.box = "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)

From 8bcdd91a8bd7cdd93c5214c9f92f3bbef827026d Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Tue, 26 Mar 2019 12:28:08 -0400
Subject: [PATCH 03/19] create program to make maps

---
 .gitignore                                    |   2 +
 Prog/2019/Internet Access.sas                 |  17 ++-
 Prog/2019/InternetAccess/InternetAccess.Rproj |  13 ++
 .../InternetAccess/mapping internet access.R  | 137 ++++++++++++++++++
 Prog/2019/mapping internet access.R           | 100 -------------
 5 files changed, 167 insertions(+), 102 deletions(-)
 create mode 100644 Prog/2019/InternetAccess/InternetAccess.Rproj
 create mode 100644 Prog/2019/InternetAccess/mapping internet access.R
 delete mode 100644 Prog/2019/mapping internet access.R

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
index 8afe7e6..4db57dc 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -38,19 +38,26 @@ run;
 data InternetAcccess ;
 	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
 	      
-	  keep geo2010 totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	  keep geo2010 geoid totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. numpopbroadbandtot
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
            hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 percent100Kplus percentunder15K percent15to50K percent50to75K  percent75Kto100K
-           county metro15 Jurisdiction;
+           pctbroadband pctbroadbanda pctbroadbandb pctbroadbandh pctbroadbandw pctbroadbandiom county metro15 Jurisdiction ;
 
       county= substr(geo2010, 1,5);
 	  ucounty=county;
+	  geoid= geo2010;
 
 %ucounty_jurisdiction
 
 	  metro15 = put( county, $ctym15f. );
       numpopbroadbandtot= numpopbroadbanda_2013_17 + numpopbroadbandiom_2013_17+ numpopbroadbandb_2013_17+ numpopbroadbandh_2013_17+ numpopbroadbandw_2013_17;
+      pctbroadband= numpopbroadbandtot/totpop_&year.;
+	  pctbroadbanda= numpopbroadbanda_&year./popalonea_&year.;
+	  pctbroadbandb= numpopbroadbandb_&year./popaloneb_&year.;
+      pctbroadbandh= numpopbroadbandh_&year. /popaloneh_&year.;
+      pctbroadbandw= numpopbroadbandw_&year. /popalonew_&year.;
+      pctbroadbandiom= numpopbroadbandiom_&year./popaloneaiom_&year.;
       tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
            hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
       percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
@@ -61,6 +68,12 @@ data InternetAcccess ;
 
 	  format Jurisdiction Jurisdiction. ;
 run;
+proc export data= InternetAcccess
+   outfile="&_dcdata_default_path\Requests\Prog\2019\Internet_access_tract.csv"
+   dbms=csv
+   replace;
+run;
+
 proc sort data=InternetAcccess;
 by metro15;run;
 
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..bdf07db
--- /dev/null
+++ b/Prog/2019/InternetAccess/mapping internet access.R	
@@ -0,0 +1,137 @@
+## 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))
+
+  
+
+#spatial join
+Accessmap <- left_join (Metro_sf, Access_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)
+
+
+#overall internet access
+ggplot() +
+  geom_sf(Accessmap,  mapping = aes(),
+          fill = NA, color = "white", size = .05) +
+  geom_sf(Accessmap, mapping=aes(fill=pctbroadband)) +
+  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)
+
+#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 <- Accessmap %>%
+  select(GEOID, Jurisdiction, metro15, geometry, pctbroadband, pctbroadbanda, 
+         pctbroadbandb, pctbroadbandh, pctbroadbandw, pctbroadbandiom) %>% 
+  gather(key, value, -GEOID, -Jurisdiction, -metro15, -geometry)
+
+#facet by race
+ggplot() +
+  geom_sf(Accessmap, mapping=aes(fill=value), size = .05) +
+  scale_fill_gradientn(labels = scales::percent) +
+  coord_sf(crs = 4269, datum = NA)+
+  facet_wrap(~ key) 
+
+
+
diff --git a/Prog/2019/mapping internet access.R b/Prog/2019/mapping internet access.R
deleted file mode 100644
index 4caf3d4..0000000
--- a/Prog/2019/mapping internet access.R	
+++ /dev/null
@@ -1,100 +0,0 @@
-## 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")
-}
-
-library(dplyr)
-#### Set FIPS code and filepath name
-
-currentfips <- "11001"
-filepath <- "DC"
-jdir <- paste0("L:/Libraries/RegHsg/Data/", filepath, "/")
-
-
-#### Load in CG region shapefile
-library(rgdal)
-
-library(sf)
-shp= "L:/Libraries/RegHsg/Maps/COG_region.shp"
-COGregion_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
-
-Typology <- read.csv(paste0(jdir,"Neighborhood typology for mapping.csv")) 
-
-Typology_df <- Typology  %>% 
-         mutate(GEOID=as.character(geoid))
-
-
-                #missing= ifelse(vulnerable=="", 1,0)) %>% 
-         #filter(missing==0)
-  
-
-#spatial join
-Typologymap <- left_join (Typology_df, COGregion_sf, 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(COGcounty_sf, mapping=aes(), fill=NA, color="#0a4c6a", size=0.5)+
-  theme_urbn_map() +
-  coord_sf(crs = 4269, datum = NA)
-
-
-#Typology by HH income 
-ggplot() +
-  geom_sf(COGcounty_sf, mapping=aes(), fill=NA, color="#98cf90", size=0.05)+
-  geom_sf(Typologymap,  mapping = aes(),
-          fill = NA, color = "white", size = .05) +
-  geom_sf(Typologymap, mapping=aes(fill=factor(neighborhoodtypeHHcode)), color= "#dcdbdb", size = .05)+
-  scale_fill_manual(values = c ("#cfe8f3", "#a2d4ec", "#73bfe2", "#46abdb", "#1696d2", "#12719e","#332d2f", "#9d9d9d" ),
-                    labels= c("Low-mod value, no demographic chg","Low-mod value, adj. to high value/apprec., no demographic chg", "Low-mod value but accelerating mkt., no demographic chg", "Low-mod value, adj. to high value/apprec., demographic chg", "Low-mod value but accelerating mkt., demographic chg", "High value, appreciated mkt., demographic chg", "High value, appreciated mkt., demographic chg., smaller vulnerable pop", "Less than 50 owner-occupied units in at least 1 reference period","Not at risk: High value, smaller vulnerable pop" )) +
-  theme_urbn_map() +
-  labs(fill = "Tract Gentrification and Displacement Risk for Vulnerable Populations", color = NULL) +
-  labs(title = "Neighborhood Gentrification Typology by HH") + 
-  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)
-
-
-#Typology by FAM income
-ggplot() +
-  geom_sf(COGcounty_sf,  mapping = aes(),
-          fill = NA, color = "#9d9d9d", size = .05) +
-  geom_sf(Typologymap, mapping=aes(fill=factor(neighborhoodtypeFAMcode)), color= "#dcdbdb", size = .05)+
-  scale_fill_manual(values = c ("#cfe8f3", "#a2d4ec", "#73bfe2", "#46abdb", "#1696d2", "#12719e","#332d2f", "#9d9d9d" ),
-                    labels= c("Low-mod value, no demographic chg","Low-mod value, adj. to high value/apprec., no demographic chg", "Low-mod value but accelerating mkt., no demographic chg", "Low-mod value, adj. to high value/apprec., demographic chg", "Low-mod value but accelerating mkt., demographic chg", "High value, appreciated mkt., demographic chg", "High value, appreciated mkt., demographic chg., smaller vulnerable pop", "Less than 50 owner-occupied units in at least 1 reference period","Not at risk: High value, smaller vulnerable pop" )) +
-  theme_urbn_map() +
-  labs(fill = "Tract Gentrification and Displacement Risk for Vulnerable Populations", color = NULL) +
-  labs(title = "Neighborhood Gentrification Typology by Family") + 
-  theme(legend.position ="bottom", legend.box = "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)

From 10a1ebb1d8107916dbe9c70fcb9613f12e42ea0a Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Tue, 26 Mar 2019 15:20:12 -0400
Subject: [PATCH 04/19] distinguish internet and broadband access

---
 Prog/2019/Internet Access.sas | 44 +++++++++++++++++++++++++++++++----
 1 file changed, 40 insertions(+), 4 deletions(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index 4db57dc..eebbaa1 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -38,6 +38,41 @@ run;
 data InternetAcccess ;
 	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
 	      
+	  keep geo2010 geoid totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. numpopbroadbandtot
+	       Numdialup_&year. Numbroadbandall_&year. Numcellular_&year. Numcellularonly_&year. Numbroadband_&year. Numbroadbandonly_&year. Numsatellite_&year.
+           Numsatelliteonly_&year. Numotheronly_&year. Numaccesswosub_&year. Numnointernet_&year. tothhdemom pctinternet percent100Kplus percentunder15K
+           percent15to50K percent50to75K percent75Kto100K county metro15 Jurisdiction hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
+           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 pctnointernet;
+
+      county= substr(geo2010, 1,5);
+	  ucounty=county;
+	  geoid= geo2010;
+
+%ucounty_jurisdiction
+
+	  metro15 = put( county, $ctym15f. );
+      pctinternet= (tothhdemom - Numnointernet_&year.)/tothhdemom;
+	  pctnointernet= Numnointernet_&year./tothhdemom;
+      tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
+           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
+      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
+	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
+	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
+	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
+      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+
+	  format Jurisdiction Jurisdiction. ;
+run;
+
+proc export data= InternetAcccess
+   outfile="&_dcdata_default_path\Requests\Prog\2019\Internet_access_tract.csv"
+   dbms=csv
+   replace;
+run;
+
+data BroadbandAcccess ;
+	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
+	      
 	  keep geo2010 geoid totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. numpopbroadbandtot
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
@@ -68,16 +103,17 @@ data InternetAcccess ;
 
 	  format Jurisdiction Jurisdiction. ;
 run;
-proc export data= InternetAcccess
-   outfile="&_dcdata_default_path\Requests\Prog\2019\Internet_access_tract.csv"
+
+proc export data= BroadbandAcccess 
+   outfile="&_dcdata_default_path\Requests\Prog\2019\Broadband_access_tract.csv"
    dbms=csv
    replace;
 run;
 
-proc sort data=InternetAcccess;
+proc sort data= BroadbandAcccess ;
 by metro15;run;
 
-proc summary data = InternetAcccess ;
+proc summary data = BroadbandAcccess;
 	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17

From 01d4a2f718ffcb22228108960821f757ac15c9bc Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Tue, 26 Mar 2019 18:22:02 -0400
Subject: [PATCH 05/19] incorporate code to Rmarkdown document

---
 .../Blog ideas_internet access.Rmd            | 231 ++++++++++++++++++
 .../InternetAccess/mapping internet access.R  | 107 ++++++--
 2 files changed, 323 insertions(+), 15 deletions(-)
 create mode 100644 Prog/2019/InternetAccess/Blog ideas_internet access.Rmd

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..c8a3edb
--- /dev/null
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -0,0 +1,231 @@
+---
+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
+---
+
+<link rel="stylesheet" href="//fonts.googleapis.com/css?family=Lato" />
+
+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, and also by demographics. 
+
+```{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))
+
+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")) 
+
+#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
+```{r make-map, echo=FALSE}
+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)
+
+```
+Since the region is large compared to DC, it is hard to see as a whole on the map. For illustrating the point, histogram and frequency plot works better in illustrating the relationship between 
+```{r scatter, echo=FALSE}
+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"
+  )
+
+```
+## Distribution of demographics and broadband
+```{r reshape}
+
+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)
+
+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) 
+
+
+DC <- Broadband_state %>% 
+  filter(state== "11")
+
+MD <- Broadband_state %>% 
+  filter(state== "24")
+
+VA <- Broadband_state %>% 
+  filter(state== "51")
+
+WV <- Broadband_state %>% 
+  filter(state== "54")
+
+```
+
+```{r broadband and demographics}
+
+ggplot(data=Broadband_long, mapping= aes(x=value))+ geom_freqpoly(mapping= aes(color= key), binwidth= 0.1)
+
+
+```
+## Urban Rural comparison
+
+By mapping broadband access by state, there really is not a strong case for lack of access in more rural counties in the region. DC actually have more tracts that lack access to broadband. 
+```{r braodband by state, echo=FALSE}
+
+ggplot() +
+    geom_sf(DC, mapping=aes(fill=(1-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(limits=c(0,1.5), labels = scales::percent) +
+    labs(fill = "No Access to Internet and broadband", 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_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+
+    scale_fill_gradientn(limits=c(0,1.5), labels = scales::percent) +
+    labs(fill = "No Access to Internet and broadband", 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_colour_gradient (limits=c(0,10), low = "red", high = "blue", na.value = "grey50", aesthetics = "colour")+
+    scale_fill_gradientn(limits=c(0,1), labels = scales::percent) +
+    labs(fill = "No Access to Internet and broadband", 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_gradientn(limits=c(0,1), labels = scales::percent) +
+    labs(fill = "No Access to Internet and broadband", 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)
+
+
+
+```
diff --git a/Prog/2019/InternetAccess/mapping internet access.R b/Prog/2019/InternetAccess/mapping internet access.R
index bdf07db..5be2f8e 100644
--- a/Prog/2019/InternetAccess/mapping internet access.R	
+++ b/Prog/2019/InternetAccess/mapping internet access.R	
@@ -35,15 +35,20 @@ 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
-Accessmap <- left_join (Metro_sf, Access_df, by = c("GEOID"="GEOID")) 
+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"
+# 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")
@@ -59,22 +64,60 @@ boundary <- ggplot()+
   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(Accessmap,  mapping = aes(),
-          fill = NA, color = "white", size = .05) +
-  geom_sf(Accessmap, mapping=aes(fill=pctbroadband)) +
+  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 = "Access to Internet and broadband", color = NULL) +
-  labs(title = "Percentage have access to broadband internet") + 
+  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)
 
-  # geom_sf(COGcounty_sf, mapping=aes(), fill=NA, color="#12719e", size=0.3, alpha=0.5)+
-  # 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() +
@@ -121,17 +164,51 @@ ggplot() +
   ggsave("D:/DCData/Libraries/Requests/Prog/2019/Broadbandaccess_black.pdf", device = cairo_pdf)
 
 
-Accessmap_long <- Accessmap %>%
+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, mapping=aes(fill=value), size = .05) +
+  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(~ key) 
+  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")

From 9911dd145482b91f15db5da89258fc743b3cc851 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 27 Mar 2019 13:44:57 -0400
Subject: [PATCH 06/19] add css for urban theme

---
 Prog/2019/Internet Access.sas             |  12 +++--
 Prog/2019/__MACOSX/www/._images           | Bin 0 -> 174 bytes
 Prog/2019/__MACOSX/www/._web_report.css   | Bin 0 -> 280 bytes
 Prog/2019/__MACOSX/www/images/._Thumbs.db | Bin 0 -> 174 bytes
 Prog/2019/www/web_report.css              |  62 ++++++++++++++++++++++
 5 files changed, 69 insertions(+), 5 deletions(-)
 create mode 100644 Prog/2019/__MACOSX/www/._images
 create mode 100644 Prog/2019/__MACOSX/www/._web_report.css
 create mode 100644 Prog/2019/__MACOSX/www/images/._Thumbs.db
 create mode 100644 Prog/2019/www/web_report.css

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index eebbaa1..195fbc5 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -51,15 +51,15 @@ data InternetAcccess ;
 %ucounty_jurisdiction
 
 	  metro15 = put( county, $ctym15f. );
-      pctinternet= (tothhdemom - Numnointernet_&year.)/tothhdemom;
-	  pctnointernet= Numnointernet_&year./tothhdemom;
       tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
-           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
+      hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17;
       percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
 	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
 	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
 	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
       percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+	  pctinternet= (tothhdemom - Numnointernet_&year.)/tothhdemom;
+	  pctnointernet= Numnointernet_&year./tothhdemom;
 
 	  format Jurisdiction Jurisdiction. ;
 run;
@@ -77,7 +77,7 @@ data BroadbandAcccess ;
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
            hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 percent100Kplus percentunder15K percent15to50K percent50to75K  percent75Kto100K
-           pctbroadband pctbroadbanda pctbroadbandb pctbroadbandh pctbroadbandw pctbroadbandiom county metro15 Jurisdiction ;
+           pctbroadband pctbroadbanda pctbroadbandb pctbroadbandh pctbroadbandw pctbroadbandiom  Numnointernet_&year. pctinternet pctnointernetcounty metro15 Jurisdiction ;
 
       county= substr(geo2010, 1,5);
 	  ucounty=county;
@@ -94,12 +94,14 @@ data BroadbandAcccess ;
       pctbroadbandw= numpopbroadbandw_&year. /popalonew_&year.;
       pctbroadbandiom= numpopbroadbandiom_&year./popaloneaiom_&year.;
       tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
-           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
+      hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
       percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
 	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
 	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
 	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
       percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+	  pctinternet= (tothhdemom - Numnointernet_&year.)/tothhdemom;
+	  pctnointernet= Numnointernet_&year./tothhdemom;
 
 	  format Jurisdiction Jurisdiction. ;
 run;
diff --git a/Prog/2019/__MACOSX/www/._images b/Prog/2019/__MACOSX/www/._images
new file mode 100644
index 0000000000000000000000000000000000000000..cfda60187ab41fb41c10c4c0534a93fa36553d81
GIT binary patch
literal 174
zcmZQz6=P>$Vqox1Ojhs@R)|o50+1L3ClDI}aSafI`0Id}2;dkJ5(HHS(lG;w#n7}d
tBE&_L^K<nQ3kq^l^$JT9ixTrnGV@Xy3iS;PER3uTpupNUF*C=S0RSO86*m9?

literal 0
HcmV?d00001

diff --git a/Prog/2019/__MACOSX/www/._web_report.css b/Prog/2019/__MACOSX/www/._web_report.css
new file mode 100644
index 0000000000000000000000000000000000000000..7573844639410bde3a25ba4a21a87ddabab064ed
GIT binary patch
literal 280
zcmZQz6=P>$Vqox1Ojhs@R)|o50+1L3ClDI}@iQO>@);$7G!eitBqRu;46Ne@knMn`
z4P-h<T#JFhG&w(4FR`E?Csi*uwInemu_Vz7C=?GCiqB2V%!$t|4oc0<FG+PQDM?Ju
z$W6^F0cvFgnIXo&Ad1jmSejUrm{*dSm&%Y-kds+lVqn0*0aOJ9jEoSP0Y*c)44j4f
X1_l;J)~3mpNtOl{me#&N8?6}tfwC>7

literal 0
HcmV?d00001

diff --git a/Prog/2019/__MACOSX/www/images/._Thumbs.db b/Prog/2019/__MACOSX/www/images/._Thumbs.db
new file mode 100644
index 0000000000000000000000000000000000000000..b63a88c8c02a127df2c29c9ef52d2207becfc042
GIT binary patch
literal 174
zcmZQz6=P>$Vqox1Ojhs@R)|o50+1L3ClDI}aSafI`0Id}2;dkJ5(HHS(lG;w#n7}d
yBE&_L^K<nQ3kq^l^$JT9ixTrnGV@Xy3iS;PER3v8lP!}h4J<6JeG@ZttQi0(5EaA#

literal 0
HcmV?d00001

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;
+}

From 760ef246919ec6e3795be614e1571a1868f24572 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Fri, 29 Mar 2019 12:15:10 -0400
Subject: [PATCH 07/19] update internet access

---
 Prog/2019/Internet Access.sas                 | 22 +++++++++++--------
 .../Blog ideas_internet access.Rmd            | 18 +++++++++++++--
 2 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index 195fbc5..a6c3d7f 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -38,11 +38,11 @@ run;
 data InternetAcccess ;
 	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
 	      
-	  keep geo2010 geoid totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. numpopbroadbandtot
+	  keep geo2010 geoid totpop_&year. medfamincm_&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. tothhdemom pctinternet percent100Kplus percentunder15K
            percent15to50K percent50to75K percent75Kto100K county metro15 Jurisdiction hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
-           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 pctnointernet;
+           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 pctinternet pctnointernet Numwithinternet_2013_17;
 
       county= substr(geo2010, 1,5);
 	  ucounty=county;
@@ -58,8 +58,10 @@ data InternetAcccess ;
 	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
 	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
       percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
-	  pctinternet= (tothhdemom - Numnointernet_&year.)/tothhdemom;
-	  pctnointernet= Numnointernet_&year./tothhdemom;
+	  internetdenom= Numdialup_&year. + Numbroadbandall_&year. + Numcellular_&year. + Numcellularonly_&year. + Numbroadband_&year. + Numbroadbandonly_&year. + Numsatellite_&year.+ 
+           Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
+	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
+	  pctnointernet= 1- pctinternet;
 
 	  format Jurisdiction Jurisdiction. ;
 run;
@@ -77,7 +79,7 @@ data BroadbandAcccess ;
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
            hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 percent100Kplus percentunder15K percent15to50K percent50to75K  percent75Kto100K
-           pctbroadband pctbroadbanda pctbroadbandb pctbroadbandh pctbroadbandw pctbroadbandiom  Numnointernet_&year. pctinternet pctnointernetcounty metro15 Jurisdiction ;
+           pctbroadband pctbroadbanda pctbroadbandb pctbroadbandh pctbroadbandw pctbroadbandiom  Numnointernet_2013_17 pctinternet pctnointernetcounty metro15 Jurisdiction Numbroadband_2013_17 Numhhdefined_2013_17;
 
       county= substr(geo2010, 1,5);
 	  ucounty=county;
@@ -86,8 +88,7 @@ data BroadbandAcccess ;
 %ucounty_jurisdiction
 
 	  metro15 = put( county, $ctym15f. );
-      numpopbroadbandtot= numpopbroadbanda_2013_17 + numpopbroadbandiom_2013_17+ numpopbroadbandb_2013_17+ numpopbroadbandh_2013_17+ numpopbroadbandw_2013_17;
-      pctbroadband= numpopbroadbandtot/totpop_&year.;
+      pctbroadband= Numbroadband_2013_17/totpop_2013_17;
 	  pctbroadbanda= numpopbroadbanda_&year./popalonea_&year.;
 	  pctbroadbandb= numpopbroadbandb_&year./popaloneb_&year.;
       pctbroadbandh= numpopbroadbandh_&year. /popaloneh_&year.;
@@ -100,8 +101,11 @@ data BroadbandAcccess ;
 	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
 	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
       percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
-	  pctinternet= (tothhdemom - Numnointernet_&year.)/tothhdemom;
-	  pctnointernet= Numnointernet_&year./tothhdemom;
+      internetdenom= Numdialup_&year. + Numbroadbandall_&year. + Numcellular_&year. + Numcellularonly_&year. + Numbroadband_&year. + Numbroadbandonly_&year. + Numsatellite_&year.+ 
+           Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
+	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
+	  pctnointernet= 1- pctinternet;
+
 
 	  format Jurisdiction Jurisdiction. ;
 run;
diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index c8a3edb..954faea 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -78,12 +78,15 @@ county_sf <- read_sf(dsn= countyshp, layer= "DMVCounties")
 InternetAccess <- read.csv(paste0(jdir,"Internet_access_tract.csv")) 
 
 Access_df <- InternetAccess  %>% 
-         mutate(GEOID=as.character(geoid))
+         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))
+  mutate(GEOID=as.character(geoid)) %>% 
+  filter(TotPop_2013_17 >= 100 )
   
 
 #spatial join
@@ -143,6 +146,17 @@ ggplot(data=InternetAccessmap, mapping= aes(y= pctinternet, x=((TotPop_2013_17-P
        y = "Percent household with access to internet"
   )
 
+InternetAccessmap <- InternetAccessmap %>% 
+  mutate(pctwhite=PopAloneW_2013_17/TotPop_2013_17 ) %>% 
+  mutate(quartile=ntile(pctwhite,4)) %>% 
+  mutate(group= case_when(quartile==1~"group 1",
+                          quartile==2~"group 2",
+                          quartile==3~"group 3",
+                          quartile==4~"group 4")) 
+
+
+ggplot(data=InternetAccessmap, mapping= aes(x=pctinternet))+ geom_freqpoly(mapping= aes(color= group), binwidth= 0.1)
+
 ```
 ## Distribution of demographics and broadband
 ```{r reshape}

From 38e6b185c38707fdeb16605d7cd5600321ae3abc Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Tue, 2 Apr 2019 11:45:07 -0400
Subject: [PATCH 08/19] blog

---
 .../Blog ideas_internet access.Rmd            | 131 +++++++++++++-----
 1 file changed, 99 insertions(+), 32 deletions(-)

diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index 954faea..f8d52b8 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -112,32 +112,35 @@ DC <- InternetAccessmap %>%
 
 ```
 
-Map the overall internet access
+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(InternetAccessmap ,mapping = aes(),
+  geom_sf(BroadbandAccessmap,mapping = aes(),
           fill = NA, color = "red", size = .1) +
-  geom_sf(InternetAccessmap, mapping=aes(fill=pctnointernet)) +
+  geom_sf(BroadbandAccessmap, mapping=aes(fill=pctbroadband)) +
   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") + 
+    scale_fill_gradient2(limits=c(0,.7), low= "#fdbf11", high= "#1696d2", midpoint = 0.3, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+  labs(fill = "Percent broadband access", color = NULL) +
+  labs(title = "Percentage population with braodband internet access") + 
   theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) +
   coord_sf(crs = 4269, datum = NA)
 
 ```
 Since the region is large compared to DC, it is hard to see as a whole on the map. For illustrating the point, histogram and frequency plot works better in illustrating the relationship between 
 ```{r scatter, echo=FALSE}
-ggplot(data=InternetAccessmap, mapping= aes(y= pctinternet, x= percentunder15K))+ geom_point(alpha=3/10)+
+
+
+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 internet access",
+       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 household with access to internet"
+       y = "Percent population with access to broadband 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)+
+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",
@@ -146,16 +149,67 @@ ggplot(data=InternetAccessmap, mapping= aes(y= pctinternet, x=((TotPop_2013_17-P
        y = "Percent household with access to internet"
   )
 
-InternetAccessmap <- InternetAccessmap %>% 
-  mutate(pctwhite=PopAloneW_2013_17/TotPop_2013_17 ) %>% 
-  mutate(quartile=ntile(pctwhite,4)) %>% 
-  mutate(group= case_when(quartile==1~"group 1",
-                          quartile==2~"group 2",
-                          quartile==3~"group 3",
-                          quartile==4~"group 4")) 
+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~"race group 1",
+                          quartile==2~"race group 2",
+                          quartile==3~"race group 3",
+                          quartile==4~"race group 4")) %>% 
+  mutate(incgroup = case_when(incquartile==1 ~ "incgroup 1",
+                             incquartile==2 ~ "incgroup 2",
+                             incquartile==3 ~ "incgroup 3",
+                             incquartile==4 ~ "incgroup 4"))
+
+
+BroadbandAccessmap2 <- BroadbandAccessmap %>% 
+  group_by(incgroup) %>% 
+  summarize(averagebroadband= mean(pctbroadband),
+            averageinternet= mean(pctinternet)) %>% 
+  ungroup() 
+
+```
+
+As the bar chart shows, there isn't much variation in broadband access by income and race. 
+
+```{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=InternetAccessmap, mapping= aes(x=pctinternet))+ geom_freqpoly(mapping= aes(color= group), binwidth= 0.1)
+ggplot(data=BroadbandAccessmap2, mapping= aes(incgroup, averagebroadband))+ geom_col()
+
+```
+
+Try plotting internet access as well
+
+```{r barchart for internet}
+ggplot(data=BroadbandAccessmap, mapping= aes(x=pctinternet))+ 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=pctinternet))+ 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=BroadbandAccessmap2, mapping= aes(incgroup, averageinternet))+ geom_col()
 
 ```
 ## Distribution of demographics and broadband
@@ -166,6 +220,7 @@ Broadband_long <- BroadbandAccessmap %>%
   select(GEOID, Jurisdiction, metro15, geometry, pctbroadband, pctinternet, 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 )) %>% 
@@ -173,36 +228,50 @@ Broadband_state <- BroadbandAccessmap %>%
 
 
 DC <- Broadband_state %>% 
-  filter(state== "11")
+  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 broadband and demographics}
 
+#note pctinternet exceeds 1 because the categories are not mutually exclusive 
 ggplot(data=Broadband_long, mapping= aes(x=value))+ geom_freqpoly(mapping= aes(color= key), binwidth= 0.1)
 
 
 ```
 ## Urban Rural comparison
 
-By mapping broadband access by state, there really is not a strong case for lack of access in more rural counties in the region. DC actually have more tracts that lack access to broadband. 
+By mapping broadband access by state, there really is not a strong case for lack of access in more rural counties in the region. DC actually have more tracts that lack access to broadband compared to DC median. 
 ```{r braodband by state, echo=FALSE}
 
 ggplot() +
     geom_sf(DC, mapping=aes(fill=(1-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(limits=c(0,1.5), labels = scales::percent) +
-    labs(fill = "No Access to Internet and broadband", color = NULL) +
+    scale_fill_gradient2(limits=c(0.4,1), low= "#73bfe2", high= "#ca5800", midpoint=0.72, 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)+
@@ -211,9 +280,8 @@ ggplot() +
 ggplot() +
     geom_sf(MD, mapping=aes(fill=(1-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(limits=c(0,1.5), labels = scales::percent) +
-    labs(fill = "No Access to Internet and broadband", color = NULL) +
+    scale_fill_gradient2(limits=c(0.4,1), low= "#73bfe2", high= "#ca5800", midpoint=0.72,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)+
@@ -222,9 +290,8 @@ ggplot() +
 ggplot() +
     geom_sf(VA, mapping=aes(fill=(1-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(limits=c(0,1), labels = scales::percent) +
-    labs(fill = "No Access to Internet and broadband", color = NULL) +
+    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)+
@@ -233,8 +300,8 @@ ggplot() +
 ggplot() +
     geom_sf(WV, mapping=aes(fill=(1-pctbroadband)), size = .05) +
     theme_urbn_map() +
-    scale_fill_gradientn(limits=c(0,1), labels = scales::percent) +
-    labs(fill = "No Access to Internet and broadband", color = NULL) +
+    scale_fill_gradient2(limits=c(0,1), low= "#73bfe2", high= "#ca5800", midpoint=0.74,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)+

From b01be1928e07ee6f9db7cf860ee0d5ea06f81419 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 3 Apr 2019 14:03:19 -0400
Subject: [PATCH 09/19] minor change

---
 Prog/2019/Internet Access.sas | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index a6c3d7f..1d694d9 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -59,7 +59,7 @@ data InternetAcccess ;
 	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
       percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
 	  internetdenom= Numdialup_&year. + Numbroadbandall_&year. + Numcellular_&year. + Numcellularonly_&year. + Numbroadband_&year. + Numbroadbandonly_&year. + Numsatellite_&year.+ 
-           Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
+                     Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
 	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
 	  pctnointernet= 1- pctinternet;
 

From 74e3557a6336f191244a42cf4403f13e0ef3b345 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Sat, 20 Apr 2019 18:29:25 -0400
Subject: [PATCH 10/19] update code

---
 Prog/2019/Internet Access.sas | 56 ++++++++++++++---------------------
 1 file changed, 23 insertions(+), 33 deletions(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index 1d694d9..bdbf96b 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -35,9 +35,8 @@ proc format;
   	;
 run; 
 
-data InternetAcccess ;
-	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
-	      
+data ACSall;
+set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
 	  keep geo2010 geoid totpop_&year. medfamincm_&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. tothhdemom pctinternet percent100Kplus percentunder15K
@@ -49,21 +48,24 @@ data InternetAcccess ;
 	  geoid= geo2010;
 
 %ucounty_jurisdiction
+	  format Jurisdiction Jurisdiction. ;
+run;
 
+
+data InternetAcccess ;
+	  set ACSall;
 	  metro15 = put( county, $ctym15f. );
-      tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
       hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17;
-      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
-	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
-	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
-	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
-      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
+      percent100Kplus= hshldinc100000plus_2013_17/Numhhdefined_2013_17;
+	  percentunder15K= hshldincunder15000_2013_17/Numhhdefined_2013_17;
+	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/Numhhdefined_2013_17;
+	  percent50to75K= hshldinc50000to74999_2013_17/Numhhdefined_2013_17;
+      percent75Kto100K= hshldinc75000to99999_2013_17/Numhhdefined_2013_17;
 	  internetdenom= Numdialup_&year. + Numbroadbandall_&year. + Numcellular_&year. + Numcellularonly_&year. + Numbroadband_&year. + Numbroadbandonly_&year. + Numsatellite_&year.+ 
                      Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
 	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
 	  pctnointernet= 1- pctinternet;
 
-	  format Jurisdiction Jurisdiction. ;
 run;
 
 proc export data= InternetAcccess
@@ -73,27 +75,15 @@ proc export data= InternetAcccess
 run;
 
 data BroadbandAcccess ;
-	  set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
+	  set ACSall;
 	      
-	  keep geo2010 geoid totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. numpopbroadbandtot
-	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
-	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
-           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 percent100Kplus percentunder15K percent15to50K percent50to75K  percent75Kto100K
-           pctbroadband pctbroadbanda pctbroadbandb pctbroadbandh pctbroadbandw pctbroadbandiom  Numnointernet_2013_17 pctinternet pctnointernetcounty metro15 Jurisdiction Numbroadband_2013_17 Numhhdefined_2013_17;
-
-      county= substr(geo2010, 1,5);
-	  ucounty=county;
-	  geoid= geo2010;
-
-%ucounty_jurisdiction
-
 	  metro15 = put( county, $ctym15f. );
-      pctbroadband= Numbroadband_2013_17/totpop_2013_17;
-	  pctbroadbanda= numpopbroadbanda_&year./popalonea_&year.;
-	  pctbroadbandb= numpopbroadbandb_&year./popaloneb_&year.;
-      pctbroadbandh= numpopbroadbandh_&year. /popaloneh_&year.;
-      pctbroadbandw= numpopbroadbandw_&year. /popalonew_&year.;
-      pctbroadbandiom= numpopbroadbandiom_&year./popaloneaiom_&year.;
+      pctbroadband= Numbroadband_2013_17/Numhhdefined_2013_17 ;
+	  pctbroadbanda= numpopbroadbanda_&year./(NumPopdialupA_2013_17 + NumPopbroadbandA_2013_17 + NumPopnointernetA_2013_17 + NumPopnocomputerA_2013_17);
+	  pctbroadbandb= numpopbroadbandb_&year./(NumPopdialupB_2013_17 + NumPopbroadbandB_2013_17 + NumPopnointernetB_2013_17 + NumPopnocomputerB_2013_17);
+      pctbroadbandh= numpopbroadbandh_&year. /(NumPopdialupH_2013_17 + NumPopbroadbandH_2013_17 + NumPopnointernetH_2013_17 + NumPopnocomputerH_2013_17);
+      pctbroadbandw= numpopbroadbandw_&year. /(NumPopdialupW_2013_17 + NumPopbroadbandW_2013_17 + NumPopnointernetW_2013_17 + NumPopnocomputerW_2013_17);
+      pctbroadbandiom= numpopbroadbandiom_&year./(NumPopdialupIOM_2013_17 + NumPopbroadbandIOM_2013_17 + NumPopnointernetIOM_2013_17 + NumPopnocomputerIOM_2013_17);
       tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
       hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
       percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
@@ -106,8 +96,6 @@ data BroadbandAcccess ;
 	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
 	  pctnointernet= 1- pctinternet;
 
-
-	  format Jurisdiction Jurisdiction. ;
 run;
 
 proc export data= BroadbandAcccess 
@@ -120,7 +108,9 @@ proc sort data= BroadbandAcccess ;
 by metro15;run;
 
 proc summary data = BroadbandAcccess;
-	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	var    tothhdemom Numhhdefined_2013_17 medfamincm_&year. NumPopdialupA_2013_17 NumPopbroadbandA_2013_17 NumPopnointernetA_2013_17 NumPopnocomputerA_2013_17
+	      NumPopdialupB_2013_17 NumPopbroadbandB_2013_17NumPopnointernetB_2013_17 NumPopnocomputerB_2013_17 NumPopdialupH_2013_17 + NumPopbroadbandH_2013_17 + NumPopnointernetH_2013_17 + NumPopnocomputerH_2013_17
+           NumPopdialupW_2013_17 + NumPopbroadbandW_2013_17 + NumPopnointernetW_2013_17 + NumPopnocomputerW_2013_17 NumPopdialupIOM_2013_17 + NumPopbroadbandIOM_2013_17 + NumPopnointernetIOM_2013_17 + NumPopnocomputerIOM_2013_17 numpopbroadbandtot
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
            hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
@@ -130,7 +120,7 @@ run;
 proc sort data=InternetAcccess;
 by Jurisdiction;run;
 proc summary data = InternetAcccess (where=(metro15= "47900"));
-	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+	var  Numhhdefined_2013_17 medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
 	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
            hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;

From 201d0241d2fa1ad90e3abe225605c33758a1fc44 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 24 Apr 2019 14:45:08 -0400
Subject: [PATCH 11/19] update code

---
 Prog/2019/Internet Access.sas | 140 +++++++++++++++++-----------------
 1 file changed, 72 insertions(+), 68 deletions(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index bdbf96b..f8441fb 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -17,7 +17,7 @@
 %DCData_lib( ACS )
 %DCData_lib (RegHsg);
 
-%let year= 2013_17;
+%let year= &year.;
 
 proc format;
   value Jurisdiction
@@ -36,12 +36,17 @@ proc format;
 run; 
 
 data ACSall;
-set acs.Acs_2013_17_va_sum_tr_tr10 acs.Acs_2013_17_dc_sum_tr_tr10 acs.Acs_2013_17_md_sum_tr_tr10 acs.Acs_2013_17_wv_sum_tr_tr10;
+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. medfamincm_&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. tothhdemom pctinternet percent100Kplus percentunder15K
-           percent15to50K percent50to75K percent75Kto100K county metro15 Jurisdiction hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
-           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17 pctinternet pctnointernet Numwithinternet_2013_17;
+           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;
@@ -55,16 +60,16 @@ run;
 data InternetAcccess ;
 	  set ACSall;
 	  metro15 = put( county, $ctym15f. );
-      hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17;
-      percent100Kplus= hshldinc100000plus_2013_17/Numhhdefined_2013_17;
-	  percentunder15K= hshldincunder15000_2013_17/Numhhdefined_2013_17;
-	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/Numhhdefined_2013_17;
-	  percent50to75K= hshldinc50000to74999_2013_17/Numhhdefined_2013_17;
-      percent75Kto100K= hshldinc75000to99999_2013_17/Numhhdefined_2013_17;
-	  internetdenom= Numdialup_&year. + Numbroadbandall_&year. + Numcellular_&year. + Numcellularonly_&year. + Numbroadband_&year. + Numbroadbandonly_&year. + Numsatellite_&year.+ 
-                     Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
-	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
-	  pctnointernet= 1- pctinternet;
+
+      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;
 
@@ -78,23 +83,22 @@ data BroadbandAcccess ;
 	  set ACSall;
 	      
 	  metro15 = put( county, $ctym15f. );
-      pctbroadband= Numbroadband_2013_17/Numhhdefined_2013_17 ;
-	  pctbroadbanda= numpopbroadbanda_&year./(NumPopdialupA_2013_17 + NumPopbroadbandA_2013_17 + NumPopnointernetA_2013_17 + NumPopnocomputerA_2013_17);
-	  pctbroadbandb= numpopbroadbandb_&year./(NumPopdialupB_2013_17 + NumPopbroadbandB_2013_17 + NumPopnointernetB_2013_17 + NumPopnocomputerB_2013_17);
-      pctbroadbandh= numpopbroadbandh_&year. /(NumPopdialupH_2013_17 + NumPopbroadbandH_2013_17 + NumPopnointernetH_2013_17 + NumPopnocomputerH_2013_17);
-      pctbroadbandw= numpopbroadbandw_&year. /(NumPopdialupW_2013_17 + NumPopbroadbandW_2013_17 + NumPopnointernetW_2013_17 + NumPopnocomputerW_2013_17);
-      pctbroadbandiom= numpopbroadbandiom_&year./(NumPopdialupIOM_2013_17 + NumPopbroadbandIOM_2013_17 + NumPopnointernetIOM_2013_17 + NumPopnocomputerIOM_2013_17);
-      tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
-      hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
-      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
-	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
-	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
-	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
-      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
-      internetdenom= Numdialup_&year. + Numbroadbandall_&year. + Numcellular_&year. + Numcellularonly_&year. + Numbroadband_&year. + Numbroadbandonly_&year. + Numsatellite_&year.+ 
-           Numsatelliteonly_&year. + Numotheronly_&year. + Numaccesswosub_&year. + Numnointernet_&year.;
-	  pctinternet= (internetdenom- Numnointernet_&year.)/internetdenom;
-	  pctnointernet= 1- pctinternet;
+      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;
 
@@ -108,66 +112,66 @@ proc sort data= BroadbandAcccess ;
 by metro15;run;
 
 proc summary data = BroadbandAcccess;
-	var    tothhdemom Numhhdefined_2013_17 medfamincm_&year. NumPopdialupA_2013_17 NumPopbroadbandA_2013_17 NumPopnointernetA_2013_17 NumPopnocomputerA_2013_17
-	      NumPopdialupB_2013_17 NumPopbroadbandB_2013_17NumPopnointernetB_2013_17 NumPopnocomputerB_2013_17 NumPopdialupH_2013_17 + NumPopbroadbandH_2013_17 + NumPopnointernetH_2013_17 + NumPopnocomputerH_2013_17
-           NumPopdialupW_2013_17 + NumPopbroadbandW_2013_17 + NumPopnointernetW_2013_17 + NumPopnocomputerW_2013_17 NumPopdialupIOM_2013_17 + NumPopbroadbandIOM_2013_17 + NumPopnointernetIOM_2013_17 + NumPopnocomputerIOM_2013_17 numpopbroadbandtot
+	var    Numhhdefined_&year. medfamincm_&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_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
-           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
+	       hshldinc100000plus_&year. hshldincunder15000_&year. hshldinc15000to34999_&year. hshldinc35000to49999_&year.
+           hshldinc50000to74999_&year. hshldinc75000to99999_&year.;
 		   by metro15;
 	output out = AccessinDMV sum = ;
 run;
-proc sort data=InternetAcccess;
+proc sort data= BroadbandAcccess;
 by Jurisdiction;run;
-proc summary data = InternetAcccess (where=(metro15= "47900"));
-	var  Numhhdefined_2013_17 medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+proc summary data = BroadbandAcccess (where=(metro15= "47900"));
+	var    Numhhdefined_&year. medfamincm_&year. Numbroadband_&year.
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
-	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
-           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
+	       hshldinc100000plus_&year. hshldincunder15000_&year. hshldinc15000to34999_&year. hshldinc35000to49999_&year.
+           hshldinc50000to74999_&year. hshldinc75000to99999_&year.;
 		   by Jurisdiction;
 	output out = Accessbycounty sum = ;
 run;
 data accessbycounty2;
 set Accessbycounty;
-tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
-           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
-      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
-	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
-	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
-	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
-      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
-	  broadbandaccess= numpopbroadbandtot/totpop_&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.;
+	  pctbroadband= Numbroadband_&year./Numhhdefined_&year. ;
 
 run;
 
 
-proc sort data=InternetAcccess;
+proc sort data=BroadbandAcccess;
 by geo2010;run;
 
-proc summary data = InternetAcccess (where=(metro15= "47900"));
-	var  totpop_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. numpopbroadbandtot
+proc summary data = BroadbandAcccess (where=(metro15= "47900"));
+	var  Numbroadband_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. 
 	       numpopbroadbanda_&year. numpopbroadbandiom_&year. numpopbroadbandb_&year. numpopbroadbandh_&year. numpopbroadbandw_&year.
-	       hshldinc100000plus_2013_17 hshldincunder15000_2013_17 hshldinc15000to34999_2013_17 hshldinc35000to49999_2013_17
-           hshldinc50000to74999_2013_17 hshldinc75000to99999_2013_17;
+	       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 sum = ;
+	output out = Accessbytract_DMV sum = ;
 run;
 
-data Accessbytract2;
-set Accessbytract;
-tothhdemom= hshldinc100000plus_2013_17+ hshldincunder15000_2013_17+ hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17+
-           hshldinc50000to74999_2013_17+ hshldinc75000to99999_2013_17 ;
-      percent100Kplus= hshldinc100000plus_2013_17/tothhdemom;
-	  percentunder15K= hshldincunder15000_2013_17/tothhdemom;
-	  percent15to50K= (hshldinc15000to34999_2013_17+ hshldinc35000to49999_2013_17)/tothhdemom;
-	  percent50to75K= hshldinc50000to74999_2013_17/tothhdemom;
-      percent75Kto100K= hshldinc75000to99999_2013_17/tothhdemom;
-	  broadbandaccess= numpopbroadbandtot/totpop_&year.;
+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
-   outfile='&_dcdata_default_path\Requests\Prog\2019\Internet_access_tract.csv'
+proc export data=Accessbytract2_DMV
+   outfile='&_dcdata_default_path\Requests\Prog\2019\Internetbroadband_access_DMVtract.csv'
    dbms=csv
    replace;
 run;

From 45b011a5a5046d33b53b6b14ab290a6c4c19e93b Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 24 Apr 2019 16:07:41 -0400
Subject: [PATCH 12/19] minor fix

---
 Prog/2019/Internet Access.sas | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index f8441fb..33c2c32 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -17,7 +17,7 @@
 %DCData_lib( ACS )
 %DCData_lib (RegHsg);
 
-%let year= &year.;
+%let year= 2013_17;
 
 proc format;
   value Jurisdiction

From 6b12567c7ad37a3ec47e2aa971a2c80d5b97cca5 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 24 Apr 2019 19:13:34 -0400
Subject: [PATCH 13/19] minor update

---
 Prog/2019/Internet Access.sas | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index 33c2c32..e0db579 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -108,6 +108,7 @@ proc export data= BroadbandAcccess
    replace;
 run;
 
+
 proc sort data= BroadbandAcccess ;
 by metro15;run;
 
@@ -170,8 +171,8 @@ set Accessbytract_DMV;
 
 run;
 
-proc export data=Accessbytract2_DMV
-   outfile='&_dcdata_default_path\Requests\Prog\2019\Internetbroadband_access_DMVtract.csv'
+proc export data= Accessbytract2_DMV
+   outfile="&_dcdata_default_path\Requests\Prog\2019\Internetbroadband_access_DMVtract.csv"
    dbms=csv
    replace;
 run;

From 53e5bb961f00a65abe3be5a151339db79d9b35ae Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Wed, 24 Apr 2019 19:37:26 -0400
Subject: [PATCH 14/19] update maps and charts for blog

---
 .../Blog ideas_internet access.Rmd            | 28 +++++++++----------
 1 file changed, 14 insertions(+), 14 deletions(-)

diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index f8d52b8..d85c665 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -121,7 +121,7 @@ ggplot() +
           fill = NA, color = "red", size = .1) +
   geom_sf(BroadbandAccessmap, mapping=aes(fill=pctbroadband)) +
   theme_urbn_map() +
-    scale_fill_gradient2(limits=c(0,.7), low= "#fdbf11", high= "#1696d2", midpoint = 0.3, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+    scale_fill_gradient2(limits=c(0,1), low= "#fdbf11", high= "#1696d2", midpoint = 0.5, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
   labs(fill = "Percent broadband access", color = NULL) +
   labs(title = "Percentage population with braodband internet access") + 
   theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) +
@@ -153,10 +153,10 @@ 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~"race group 1",
-                          quartile==2~"race group 2",
-                          quartile==3~"race group 3",
-                          quartile==4~"race group 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",
@@ -166,7 +166,7 @@ BroadbandAccessmap <- BroadbandAccessmap %>%
 BroadbandAccessmap2 <- BroadbandAccessmap %>% 
   group_by(incgroup) %>% 
   summarize(averagebroadband= mean(pctbroadband),
-            averageinternet= mean(pctinternet)) %>% 
+            averageinternet= mean(pctinternetsub)) %>% 
   ungroup() 
 
 ```
@@ -195,14 +195,14 @@ ggplot(data=BroadbandAccessmap2, mapping= aes(incgroup, averagebroadband))+ geom
 Try plotting internet access as well
 
 ```{r barchart for internet}
-ggplot(data=BroadbandAccessmap, mapping= aes(x=pctinternet))+ geom_freqpoly(mapping= aes(color= racegroup), binwidth= 0.1)+
+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=pctinternet))+ geom_freqpoly(mapping= aes(color= incgroup), binwidth= 0.1)
+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",
@@ -217,14 +217,14 @@ ggplot(data=BroadbandAccessmap2, mapping= aes(incgroup, averageinternet))+ geom_
 
 Broadband_long <- BroadbandAccessmap %>%
   mutate(pctwhite= PopAloneW_2013_17/TotPop_2013_17) %>% 
-  select(GEOID, Jurisdiction, metro15, geometry, pctbroadband, pctinternet, percent100Kplus, pctwhite) %>% 
+  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, pctinternet, percent100Kplus, pctwhite) 
+  select(state, Jurisdiction, metro15, geometry, pctbroadband, pctinternetsub, percent100Kplus, pctwhite) 
 
 
 DC <- Broadband_state %>% 
@@ -270,7 +270,7 @@ By mapping broadband access by state, there really is not a strong case for lack
 ggplot() +
     geom_sf(DC, mapping=aes(fill=(1-pctbroadband)), size = .05) +
     theme_urbn_map() +
-    scale_fill_gradient2(limits=c(0.4,1), low= "#73bfe2", high= "#ca5800", midpoint=0.72, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+    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)) +
@@ -280,7 +280,7 @@ ggplot() +
 ggplot() +
     geom_sf(MD, mapping=aes(fill=(1-pctbroadband)), size = .05) +
     theme_urbn_map() +
-    scale_fill_gradient2(limits=c(0.4,1), low= "#73bfe2", high= "#ca5800", midpoint=0.72,na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+    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)) +
@@ -290,7 +290,7 @@ ggplot() +
 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.71,na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+    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)) +
@@ -300,7 +300,7 @@ ggplot() +
 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.74,na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+    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)) +

From 269a5e6c5d8f12c11917a891c3c19736db24e29e Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Fri, 26 Apr 2019 17:54:06 -0400
Subject: [PATCH 15/19] reorganize ideas

---
 .../Blog ideas_internet access.Rmd            | 228 ++++++++++++------
 1 file changed, 149 insertions(+), 79 deletions(-)

diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index d85c665..3fb3fab 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -36,7 +36,7 @@ knitr::opts_chunk$set(message = FALSE)
 
 ## Internet/Broadband Access by geography and demographics
 
-The first idea is internet and broadband access very by geography, and also by 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)
@@ -116,6 +116,7 @@ Map the overall internet access. Note the categories in the internet access tabl
 
 ```{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) +
@@ -127,93 +128,74 @@ ggplot() +
   theme(legend.position ="bottom", legend.direction = "vertical", legend.text = element_text(size=8)) +
   coord_sf(crs = 4269, datum = NA)
 
+
+
+
 ```
-Since the region is large compared to DC, it is hard to see as a whole on the map. For illustrating the point, histogram and frequency plot works better in illustrating the relationship between 
-```{r scatter, echo=FALSE}
 
+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. 
 
-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"
-  )
+```{r access by region, echo=FALSE}
 
-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"
-  )
+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)
 
-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"))
 
+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)
 
-BroadbandAccessmap2 <- BroadbandAccessmap %>% 
-  group_by(incgroup) %>% 
-  summarize(averagebroadband= mean(pctbroadband),
-            averageinternet= mean(pctinternetsub)) %>% 
-  ungroup() 
 
 ```
 
-As the bar chart shows, there isn't much variation in broadband access by income and race. 
+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 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"
-  )
+```{r county comparison}
 
-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"
-  )
+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(incgroup, averagebroadband))+ geom_col()
+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))
 
-```
 
-Try plotting internet access as well
+BroadbandAccessmap2 <- BroadbandAccessmap2 %>% 
+  transform(county= reorder(county, -medianinternetwosub))
 
-```{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=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))
 
-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=BroadbandAccessmap2, mapping= aes(incgroup, averageinternet))+ geom_col()
 
-```
-## Distribution of demographics and broadband
-```{r reshape}
+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) %>% 
@@ -255,16 +237,6 @@ WVmedian <- WV %>%
 
 ```
 
-```{r broadband and demographics}
-
-#note pctinternet exceeds 1 because the categories are not mutually exclusive 
-ggplot(data=Broadband_long, mapping= aes(x=value))+ geom_freqpoly(mapping= aes(color= key), binwidth= 0.1)
-
-
-```
-## Urban Rural comparison
-
-By mapping broadband access by state, there really is not a strong case for lack of access in more rural counties in the region. DC actually have more tracts that lack access to broadband compared to DC median. 
 ```{r braodband by state, echo=FALSE}
 
 ggplot() +
@@ -307,6 +279,104 @@ ggplot() +
     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=((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)
+
+
+```
+
+

From c43433b7d9cfeb7068b360b649a3cfeea9758ebb Mon Sep 17 00:00:00 2001
From: lhendey <lhendey@urban.org>
Date: Mon, 6 May 2019 12:47:01 -0400
Subject: [PATCH 16/19] missing semicolon on libname

---
 Prog/2019/Internet Access.sas | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index e0db579..3b03f57 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -14,7 +14,7 @@
 %include "L:\SAS\Inc\StdLocal.sas";
 
 ** Define libraries **;
-%DCData_lib( ACS )
+%DCData_lib( ACS );
 %DCData_lib (RegHsg);
 
 %let year= 2013_17;

From b46ff32a729ffdd9b0690f5ff3e69d1fc04d3bc0 Mon Sep 17 00:00:00 2001
From: lhendey <lhendey@urban.org>
Date: Tue, 7 May 2019 09:07:08 -0400
Subject: [PATCH 17/19] Update Blog ideas_internet access.Rmd

---
 Prog/2019/InternetAccess/Blog ideas_internet access.Rmd | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index 3fb3fab..c9f4ffb 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -124,7 +124,7 @@ ggplot() +
   theme_urbn_map() +
     scale_fill_gradient2(limits=c(0,1), low= "#fdbf11", high= "#1696d2", midpoint = 0.5, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
   labs(fill = "Percent broadband access", color = NULL) +
-  labs(title = "Percentage population with braodband internet access") + 
+  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)
 

From 478e8555dc1fb14d7aeae70a73f4c8aa234b6900 Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Thu, 9 May 2019 12:39:39 -0400
Subject: [PATCH 18/19] minor update

---
 Prog/2019/Internet Access.sas                 |  9 ++---
 .../Blog ideas_internet access.Rmd            | 37 ++++++++++++++++++-
 2 files changed, 39 insertions(+), 7 deletions(-)

diff --git a/Prog/2019/Internet Access.sas b/Prog/2019/Internet Access.sas
index 3b03f57..87f215d 100644
--- a/Prog/2019/Internet Access.sas	
+++ b/Prog/2019/Internet Access.sas	
@@ -37,7 +37,7 @@ 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. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. popaloneaiom_&year. 
+	  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.
@@ -113,7 +113,7 @@ proc sort data= BroadbandAcccess ;
 by metro15;run;
 
 proc summary data = BroadbandAcccess;
-	var    Numhhdefined_&year. medfamincm_&year. NumPopdialupA_&year. NumPopbroadbandA_&year. NumPopnointernetA_&year. NumPopnocomputerA_&year.
+	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.
@@ -125,7 +125,7 @@ run;
 proc sort data= BroadbandAcccess;
 by Jurisdiction;run;
 proc summary data = BroadbandAcccess (where=(metro15= "47900"));
-	var    Numhhdefined_&year. medfamincm_&year. Numbroadband_&year.
+	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.;
@@ -143,12 +143,11 @@ set Accessbycounty;
 
 run;
 
-
 proc sort data=BroadbandAcccess;
 by geo2010;run;
 
 proc summary data = BroadbandAcccess (where=(metro15= "47900"));
-	var  Numbroadband_&year. medfamincm_&year. popalonew_&year. popaloneb_&year. popaloneh_&year. popalonea_&year. 
+	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. ;
diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index c9f4ffb..4c86cdc 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -122,17 +122,33 @@ ggplot() +
           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.5, na.value = "grey50", labels = scales::percent, aesthetics = "fill")+
+    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}
@@ -191,6 +207,15 @@ ggplot(data=BroadbandAccessmap2, mapping= aes(as.factor(county), medianinternetw
     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(), )+
+  geom_col()+
+  xlab()+
+  ylab()+
+  labs()
+
 ```
 
 
@@ -296,6 +321,14 @@ ggplot(data=BroadbandAccessmap, mapping= aes(y= pctbroadband, x= percentunder15K
        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",

From 31b692a25d00786c5d2b5f04b7ef76bc0c83714e Mon Sep 17 00:00:00 2001
From: Yipeng Su <ysu@urban.org>
Date: Thu, 9 May 2019 13:47:45 -0400
Subject: [PATCH 19/19] more code on chart

---
 .../Blog ideas_internet access.Rmd            | 31 ++++++++++++++++---
 1 file changed, 26 insertions(+), 5 deletions(-)

diff --git a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd
index 4c86cdc..0f994fa 100644
--- a/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
+++ b/Prog/2019/InternetAccess/Blog ideas_internet access.Rmd	
@@ -210,11 +210,32 @@ ggplot(data=BroadbandAccessmap2, mapping= aes(as.factor(county), medianinternetw
 fairfax <- BraodbandAccessmap_quantile %>% 
   filter(county== "51059")
 
-ggplot(data= fairfax, mapping = aes(), )+
-  geom_col()+
-  xlab()+
-  ylab()+
-  labs()
+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))
+
 
 ```