BRFSS <- SASxport::read.xport("C:\\Users\\Administrator\\Documents\\Northeastern\\Fall 2018\\HINF6400\\Incentivized Insurance\\MMSA2016.xpt")
# ----------------------- Wed Sep 26 15:47:43 2018 ------------------------#
# Spending per county

library(rvest)
htm <- read_html("C:\\Users\\Administrator\\Documents\\Northeastern\\Fall 2018\\HINF6400\\Incentivized Insurance\\Per Capita Expenditures\\Cost per County.html")
costpcty <- htm %>% html_node(css = "#report_sd_table") %>% html_table()
costpcty <- costpcty[, -c(4, 5)]
# ----------------------- Wed Sep 26 15:47:53 2018 ------------------------#
# Population per county
PopCty <- read.csv("~/Northeastern/Fall 2018/HINF6400/Incentivized Insurance/Population/ACS_17_1YR_S0101_with_ann.csv")
PopCty <- PopCty[, c(3, 4)]
# 2018-09-26 1622 Needs to be cleaned ----------------------- Wed Sep 26 16:22:22
# 2018 ------------------------# CVD by State
CVD.ST <- read.csv("~/Northeastern/Fall 2018/HINF6400/Incentivized Insurance/CVD Rate by State/raw_data.csv")
CVD.ST <- CVD.ST[, -3]
# ----------------------- Wed Sep 26 16:26:34 2018 ------------------------#
# Cleaning Pop.
PopCty %<>% separate("GEO.display.label", into = c("County", "State"), sep = "\\,\\s")
PopCty <- PopCty[-1, ]
PopCty$County %<>% sapply(FUN = function(x) {
    gsub("\\sCounty|\\sParish|\\s[Cc]ity|\\sBorough|\\sMunicipality", "", x)
})
names(PopCty)[3] <- "Pop."
CVDPop <- PopCty %>% left_join(CVD.ST, by = c(State = "Location")) %>% mutate_at(.vars = c("Pop.", 
    "Has.Cardiovascular.Disease"), .funs = parse_number)
CVDPop <- CVDPop[not(CVDPop$State == "Puerto Rico" | CVDPop$State == "District of Columbia"), 
    ]
# Virginia is matching two abbreviations, West Virginia and Virginia. We subset
# Virginia out of our grep matching function, and create the column with NAs,
# then Add the Abbreviations that worked (provided only 1 abbr)

CVDPop$ST <- rep(NA, nrow(CVDPop))
CVDPop$ST[-c(CVDPop$State %>% sapply(FUN = function(x) {
    out <- state.abb[grep(x, state.name, fixed = T)]
    return(out)
}, simplify = T) %>% sapply(FUN = function(x) {
    length(x) == 2
}) %>% which)] <- CVDPop$State[-c(CVDPop$State %>% sapply(FUN = function(x) {
    out <- state.abb[grep(x, state.name, fixed = T)]
    return(out)
}, simplify = T) %>% sapply(FUN = function(x) {
    length(x) == 2
}) %>% which)] %>% sapply(FUN = function(x) {
    out <- state.abb[grep(x, state.name, fixed = T)]
    return(out)
}, simplify = T)
# Virginia is the only State unlabeled now, we add in the state abbr for Virginia
CVDPop$ST[CVDPop$ST %>% is.na()] <- "VA"
CVDPop %<>% left_join(costpcty, by = c("County", ST = "State")) %>% mutate(PopCVD = {
    Pop. * Has.Cardiovascular.Disease
}, CostPop = {
    Pop. * Value
})
CVDPop <- CVDPop[-c(CVDPop$CostPop %>% is.na %>% which), ]  #Rm Counties not matched

Among the 33 studies, 9 allowed quantitative estimates of leisure-time physical activity. Individuals who engaged in the equivalent of 150 min/wk of moderate-intensity leisure-time physical activity (minimum amount, 2008 US federal guidelines) had a 14% lower coronary heart disease risk (relative risk, 0.86; 95% confidence interval, 0.77 to 0.96) compared with those reporting no leisure-time physical activity. Those engaging in the equivalent of 300 min/wk of moderate-intensity leisure-time physical activity (2008 US federal guidelines for additional benefits) had a 20% (relative risk, 0.80; 95% confidence interval, 0.74 to 0.88) lower risk. At higher levels of physical activity, relative risks were modestly lower. People who were physically active at levels lower than the minimum recommended amount also had significantly lower risk of coronary heart disease. There was a significant interaction by sex (P=0.03); the association was stronger among women than men.

Dose Response Between Physical Activity and Risk of Coronary Heart Disease | Circulation. (2018). Circulation. Retrieved from https://www.ahajournals.org/doi/abs/10.1161/circulationaha.110.010710

Using the reference group of 200 kcal/week of activity and after adjusting for age and randomized-treatment assignment, the relative risk reductions associated with 200–599, 600–1499, and ≥1500 kcal/week were 27%, 32%, and 41%, respectively.

Mora, S., Cook, N., Buring, J., Ridker, P., & Lee, I. (2007). Physical Activity and Reduced Risk of Cardiovascular Events. Circulation, 116(19), 2110-2118. doi:10.1161/circulationaha.107.729939

risk_reductions <- c(0.14, 0.27, 0.41)
risk_red.df <- sapply(CVDPop$CostPop, rr = risk_reductions, FUN = function(x, rr) {
    x * rr
}) %>% t %>% as.data.frame()
colnames(risk_red.df) <- c("CR.14", "CR.27", "CR.41")
CVDPop <- cbind(CVDPop, risk_red.df)
(CVDPop %<>% mutate_at(.vars = vars(starts_with("CR")), .funs = funs(pp = {
    ./CVDPop$Pop.
})))
CVDPop %>% group_by(ST) %>% summarise_at(.vars = vars(ends_with("pp")), .funs = funs(Avg = mean(., 
    na.rm = T)))