Extra_Cred_Pt2
Kat Rodriguez
May 13, 2019
Reading in Data & Data Preparation
library(tigris)## To enable
## caching of data, set `options(tigris_use_cache = TRUE)` in your R script or .Rprofile.##
## Attaching package: 'tigris'## The following object is masked from 'package:graphics':
##
## plotlibrary(tmap)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(readr)
library(sf)## Linking to GEOS 3.6.1, GDAL 2.2.3, PROJ 4.9.3options(tigris_class = "sf")
US_map <- counties(cb = TRUE)##
|
| | 0%
|
| | 1%
|
|= | 1%
|
|= | 2%
|
|== | 2%
|
|== | 3%
|
|== | 4%
|
|=== | 4%
|
|=== | 5%
|
|==== | 5%
|
|==== | 6%
|
|==== | 7%
|
|===== | 7%
|
|===== | 8%
|
|====== | 9%
|
|====== | 10%
|
|======= | 10%
|
|======= | 11%
|
|======== | 12%
|
|======== | 13%
|
|========= | 13%
|
|========= | 14%
|
|========= | 15%
|
|========== | 15%
|
|========== | 16%
|
|=========== | 16%
|
|=========== | 17%
|
|=========== | 18%
|
|============ | 18%
|
|============ | 19%
|
|============= | 19%
|
|============= | 20%
|
|============= | 21%
|
|============== | 21%
|
|============== | 22%
|
|=============== | 22%
|
|=============== | 23%
|
|=============== | 24%
|
|================ | 24%
|
|================ | 25%
|
|================= | 26%
|
|================= | 27%
|
|================== | 27%
|
|================== | 28%
|
|=================== | 28%
|
|=================== | 29%
|
|=================== | 30%
|
|==================== | 30%
|
|==================== | 31%
|
|===================== | 32%
|
|===================== | 33%
|
|====================== | 33%
|
|====================== | 34%
|
|====================== | 35%
|
|======================= | 35%
|
|======================= | 36%
|
|======================== | 36%
|
|======================== | 37%
|
|======================== | 38%
|
|========================= | 38%
|
|========================= | 39%
|
|========================== | 39%
|
|========================== | 40%
|
|========================== | 41%
|
|=========================== | 41%
|
|=========================== | 42%
|
|============================ | 43%
|
|============================ | 44%
|
|============================= | 44%
|
|============================= | 45%
|
|============================== | 46%
|
|============================== | 47%
|
|=============================== | 47%
|
|=============================== | 48%
|
|================================ | 48%
|
|================================ | 49%
|
|================================ | 50%
|
|================================= | 50%
|
|================================= | 51%
|
|================================== | 52%
|
|================================== | 53%
|
|=================================== | 53%
|
|=================================== | 54%
|
|=================================== | 55%
|
|==================================== | 55%
|
|==================================== | 56%
|
|===================================== | 56%
|
|===================================== | 57%
|
|===================================== | 58%
|
|====================================== | 58%
|
|====================================== | 59%
|
|======================================= | 59%
|
|======================================= | 60%
|
|======================================= | 61%
|
|======================================== | 61%
|
|======================================== | 62%
|
|========================================= | 62%
|
|========================================= | 63%
|
|========================================= | 64%
|
|========================================== | 64%
|
|========================================== | 65%
|
|=========================================== | 65%
|
|=========================================== | 66%
|
|=========================================== | 67%
|
|============================================ | 67%
|
|============================================ | 68%
|
|============================================= | 69%
|
|============================================= | 70%
|
|============================================== | 70%
|
|============================================== | 71%
|
|============================================== | 72%
|
|=============================================== | 72%
|
|=============================================== | 73%
|
|================================================ | 73%
|
|================================================ | 74%
|
|================================================= | 75%
|
|================================================= | 76%
|
|================================================== | 76%
|
|================================================== | 77%
|
|================================================== | 78%
|
|=================================================== | 78%
|
|=================================================== | 79%
|
|==================================================== | 79%
|
|==================================================== | 80%
|
|==================================================== | 81%
|
|===================================================== | 81%
|
|===================================================== | 82%
|
|====================================================== | 82%
|
|====================================================== | 83%
|
|====================================================== | 84%
|
|======================================================= | 84%
|
|======================================================= | 85%
|
|======================================================== | 85%
|
|======================================================== | 86%
|
|======================================================== | 87%
|
|========================================================= | 87%
|
|========================================================= | 88%
|
|========================================================== | 89%
|
|========================================================== | 90%
|
|=========================================================== | 90%
|
|=========================================================== | 91%
|
|============================================================ | 92%
|
|============================================================ | 93%
|
|============================================================= | 93%
|
|============================================================= | 94%
|
|============================================================= | 95%
|
|============================================================== | 95%
|
|============================================================== | 96%
|
|=============================================================== | 96%
|
|=============================================================== | 97%
|
|=============================================================== | 98%
|
|================================================================ | 98%
|
|================================================================ | 99%
|
|=================================================================| 99%
|
|=================================================================| 100%US_map$GEOID <- as.integer(US_map$GEOID)
religion <- read_csv("C:/Users/Skippz/Desktop/religion.csv")%>%
rename( Total = TR_T002_001, GEOID = Geo_FIPS)## Parsed with column specification:
## cols(
## .default = col_double(),
## Geo_FIPS = col_character(),
## Geo_NAME = col_character(),
## Geo_QName = col_character(),
## Geo_STUSAB = col_character(),
## Geo_SUMLEV = col_character(),
## Geo_STATE = col_character(),
## Geo_COUNTY = col_character(),
## Geo_COUSUB = col_logical(),
## Geo_PLACE = col_logical(),
## Geo_ZCTA5 = col_logical(),
## Geo_PUMA5 = col_logical()
## )## See spec(...) for full column specifications.religion$GEOID<- as.integer(religion$GEOID)
Health <- read_csv("C:/Users/Skippz/Desktop/womenhealth.csv")%>%
rename(Low_Birth = SE_T003_001, Sex_Act = SE_T009_001, HI = SE_T006_002, GEOID = Geo_FIPS, PCP = SE_T004_001, MHP = SE_T004_002, Dentist = SE_T004_003, LA = SE_T005_001)## Parsed with column specification:
## cols(
## .default = col_double(),
## Geo_FIPS = col_character(),
## Geo_NAME = col_character(),
## Geo_QNAME = col_character(),
## Geo_STATE = col_character(),
## Geo_COUNTY = col_character()
## )
## See spec(...) for full column specifications.Health$GEOID<- as.integer(Health$GEOID)Merging the Data
library(tmaptools)
#Merging US country map with Health Data
merge <- left_join(US_map, Health, by="GEOID")
merge$STATEFP <- as.integer(merge$STATEFP)
women_map <- merge %>%
filter(STATEFP != 02) %>%
filter(STATEFP != 15) %>%
filter(STATEFP != 60) %>%
filter(STATEFP != 66) %>%
filter(STATEFP != 69) %>%
filter(STATEFP != 72) %>%
filter(STATEFP != 78) %>%
filter(STATEFP != 79)
usmap <- merge %>%
aggregate_map(by = "STATEFP")
#Merging US Map with Religion Data
merge1 <- left_join(US_map, religion, by="GEOID")
merge1$STATEFP <- as.integer(merge1$STATEFP)
religion_map <- merge1 %>%
filter(STATEFP != 02) %>%
filter(STATEFP != 15) %>%
filter(STATEFP != 60) %>%
filter(STATEFP != 66) %>%
filter(STATEFP != 69) %>%
filter(STATEFP != 72) %>%
filter(STATEFP != 78) %>%
filter(STATEFP != 79)
usmap1 <- merge1 %>%
aggregate_map(by = "STATEFP")Mapping Religiosity Across the U.S.
tm_shape(religion_map, projection = 2163) +
tm_polygons("Total", palette = "Blues", showNA = TRUE, border.col = "gray50", border.alpha = .4) +
tm_shape(usmap1) +
tm_borders(lwd = .36, col = "black", alpha = 1) +
tm_layout(panel.labels=("Religious Prominence Across the U.S., (2010)"),legend.position = c("left","bottom"))
Mapping No Health Insurance Across the U.S.
california <- religion_map %>%
filter(STATEFP == 6)
tm_shape(california, projection = 2163) +
tm_polygons("Total", palette = "Dark2", border.col = "black") +
tm_text("NAME", size = .3) +
tm_layout(title = "Religiosity in California (2016)",
title.position = c("left", "top"),
legend.position = c("left", "top"),
legend.text.size = .5,
legend.outside = TRUE,
frame = FALSE)
##Mapping Sexual_Activity across California
california <- women_map %>%
filter(STATEFP == 6)
tm_shape(california, projection = 2163) +
tm_polygons("LA", palette = "Dark2", border.col = "black") +
tm_text("NAME", size = .3) +
tm_layout(title = "Limited Access to Healthcare in California (2016)",
title.position = c("left", "top"),
legend.position = c("left", "top"),
legend.text.size = .5,
legend.outside = TRUE,
frame = FALSE)
Mapping Low_Birthweight across California
california <- women_map %>%
filter(STATEFP == 6)
tm_shape(california, projection = 2163) +
tm_polygons("Low_Birth", palette = "Accent", border.col = "black") +
tm_text("NAME", size = .3) +
tm_layout(title = "Low_Birthweight in California (2016)",
title.position = c("left", "top"),
legend.position = c("left", "top"),
legend.text.size = .5,
legend.outside = TRUE,
frame = FALSE)
Mapping Health Care Providers in Calfornia
california <- women_map %>%
filter(STATEFP == 6)
tm_shape(california, projection = 2163) +
tm_polygons("PCP", palette = "Dark2", border.col = "black") +
tm_text("NAME", size = .3) +
tm_layout(title = "Limited Access to Healthcare in California (2016)",
title.position = c("left", "top"),
legend.position = c("left", "top"),
legend.text.size = .5,
legend.outside = TRUE,
frame = FALSE)
california <- women_map %>%
filter(STATEFP == 6)
tm_shape(california, projection = 2163) +
tm_polygons("MHP", palette = "Dark2", border.col = "black") +
tm_text("NAME", size = .3) +
tm_layout(title = "Limited Access to Healthcare in California (2016)",
title.position = c("left", "top"),
legend.position = c("left", "top"),
legend.text.size = .5,
legend.outside = TRUE,
frame = FALSE)
california <- women_map %>%
filter(STATEFP == 6)
tm_shape(california, projection = 2163) +
tm_polygons("Dentist", palette = "Dark2", border.col = "black") +
tm_text("NAME", size = .3) +
tm_layout(title = "Limited Access to Healthcare in California (2016)",
title.position = c("left", "top"),
legend.position = c("left", "top"),
legend.text.size = .5,
legend.outside = TRUE,
frame = FALSE)
Model 1-3: Low_Birthweight & Limited Access, Health insurance
library(tidyverse)## -- Attaching packages ------------------------------------------------------------------------------------------------------------------ tidyverse 1.2.1 --## v ggplot2 3.1.0 v purrr 0.3.1
## v tibble 2.0.1 v stringr 1.4.0
## v tidyr 0.8.3 v forcats 0.4.0## -- Conflicts --------------------------------------------------------------------------------------------------------------------- tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()library(Zelig)## Loading required package: survival##
## Attaching package: 'Zelig'## The following object is masked from 'package:purrr':
##
## reduce## The following object is masked from 'package:ggplot2':
##
## statlibrary(pander)
library(texreg)## Version: 1.36.23
## Date: 2017-03-03
## Author: Philip Leifeld (University of Glasgow)
##
## Please cite the JSS article in your publications -- see citation("texreg").##
## Attaching package: 'texreg'## The following object is masked from 'package:tidyr':
##
## extractmodel1 <- lm(Low_Birth ~ LA, data = Health)
summary(model1)##
## Call:
## lm(formula = Low_Birth ~ LA, data = Health)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.6412 -1.1254 -0.1765 0.8593 7.8358
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.620379 0.099273 56.62 <2e-16 ***
## LA 0.175630 0.006555 26.79 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.711 on 2512 degrees of freedom
## (627 observations deleted due to missingness)
## Multiple R-squared: 0.2223, Adjusted R-squared: 0.222
## F-statistic: 717.9 on 1 and 2512 DF, p-value: < 2.2e-16#Limited Access & Health Insurance
model2<- lm(Low_Birth ~ LA + HI, data = Health)
summary(model2)##
## Call:
## lm(formula = Low_Birth ~ LA + HI, data = Health)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.7273 -1.1352 -0.1730 0.8689 7.8197
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.445427 0.123604 44.055 <2e-16 ***
## LA 0.163595 0.008285 19.747 <2e-16 ***
## HI 0.019831 0.008361 2.372 0.0178 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.709 on 2511 degrees of freedom
## (627 observations deleted due to missingness)
## Multiple R-squared: 0.224, Adjusted R-squared: 0.2234
## F-statistic: 362.4 on 2 and 2511 DF, p-value: < 2.2e-16#Seeing Interaction between Limited Access & Health Insurance
model3<- lm(Low_Birth ~ LA *HI, data = Health)
summary(model3)##
## Call:
## lm(formula = Low_Birth ~ LA * HI, data = Health)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.7079 -1.1237 -0.1631 0.8898 7.7894
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.239925 0.312395 13.572 < 2e-16 ***
## LA 0.258400 0.024039 10.749 < 2e-16 ***
## HI 0.091011 0.018889 4.818 1.53e-06 ***
## LA:HI -0.005234 0.001246 -4.199 2.77e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.704 on 2510 degrees of freedom
## (627 observations deleted due to missingness)
## Multiple R-squared: 0.2294, Adjusted R-squared: 0.2285
## F-statistic: 249.1 on 3 and 2510 DF, p-value: < 2.2e-16**Model 4 & 5: Low_Birthweight & Healthcare Providers
model4<-lm(Low_Birth ~ PCP, data = Health)
summary(model4)##
## Call:
## lm(formula = Low_Birth ~ PCP, data = Health)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.1983 -1.3947 -0.2983 1.0037 8.5017
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.199e+00 3.845e-02 213.213 <2e-16 ***
## PCP -2.489e-05 1.031e-04 -0.241 0.809
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.969 on 2821 degrees of freedom
## (318 observations deleted due to missingness)
## Multiple R-squared: 2.066e-05, Adjusted R-squared: -0.0003338
## F-statistic: 0.05829 on 1 and 2821 DF, p-value: 0.8092model5<-lm(Low_Birth ~ PCP + MHP + Dentist, data = Health)
summary(model5)##
## Call:
## lm(formula = Low_Birth ~ PCP + MHP + Dentist, data = Health)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.1861 -1.3353 -0.2927 1.0142 8.5235
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 8.1834331 0.0383895 213.169 < 2e-16 ***
## PCP 0.0023266 0.0004325 5.379 8.10e-08 ***
## MHP -0.0007646 0.0004173 -1.832 0.067 .
## Dentist -0.0031988 0.0006462 -4.950 7.86e-07 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.959 on 2819 degrees of freedom
## (318 observations deleted due to missingness)
## Multiple R-squared: 0.01102, Adjusted R-squared: 0.00997
## F-statistic: 10.47 on 3 and 2819 DF, p-value: 7.523e-07Which is the best model?
| Model 1 | Model 2 | Model 3 | ||
|---|---|---|---|---|
| (Intercept) | 5.62*** | 5.45*** | 4.24*** | |
| (0.10) | (0.12) | (0.31) | ||
| LA | 0.18*** | 0.16*** | 0.26*** | |
| (0.01) | (0.01) | (0.02) | ||
| HI | 0.02* | 0.09*** | ||
| (0.01) | (0.02) | |||
| LA:HI | -0.01*** | |||
| (0.00) | ||||
| R2 | 0.22 | 0.22 | 0.23 | |
| Adj. R2 | 0.22 | 0.22 | 0.23 | |
| Num. obs. | 2514 | 2514 | 2514 | |
| RMSE | 1.71 | 1.71 | 1.70 | |
| p < 0.001, p < 0.01, p < 0.05 | ||||
Graphing
library(visreg)
library(effects)## Loading required package: carData## lattice theme set by effectsTheme()
## See ?effectsTheme for details.visreg(model1, "LA", scale = "response")