state_v2.Rmd

---
title: ''
output: html_document
---

```{r setup, include=FALSE}

## Loading Packages
library(forcats)
library(DT)
library(readxl)
library(tidyverse)
library(highcharter)
library(glue)
library(acs)
library(stringr)

## Setting Formatting for output
knitr::knit_hooks$set(inline = function(x) { if(!is.numeric(x)){ x }else{ prettyNum(round(x,2), big.mark=",", digits=6) } })
## Formatting for Graphics
hcoptslang <- getOption("highcharter.lang")
hcoptslang$thousandsSep <- ","
options(highcharter.lang = hcoptslang)

# Getting Map Data?
mapdata <- get_data_from_map(download_map_data("countries/us/us-all"))

#Read in files
state_edu<- readxl::read_xlsx("raw_data/state/state_edu.xlsx")
state_edu$pop_id <- as.factor(state_edu$pop_id)

### Education Cleaning ####

### Getting Rid of Estimates where the "CHECK" variable is flagging uncertainty
state_edu <- state_edu %>% 
  mutate(est_hsless = 
            case_when( check_hsless == 1 ~  NA_real_ ,TRUE ~ est_hsless),
         est_hsged  =
          case_when( check_hsged == 1 ~  NA_real_ ,TRUE ~ est_hsged),
         est_somecollegeaa  =
          case_when( check_somecollegeaa == 1 ~  NA_real_ ,TRUE ~ est_somecollegeaa),
         est_bahigher  =
          case_when( check_bahigher == 1 ~  NA_real_ ,TRUE ~ est_bahigher))

# Dropping those indicators
state_edu <- state_edu %>% select(-check_hsless,
                                  -check_hsged,
                                  -check_somecollegeaa,
                                  -check_bahigher)

state_edu <- state_edu %>% mutate(
  pct_hsless   = est_hsless/est_totpop,
  pct_bahigher = est_bahigher/ est_totpop)


## Creating Lookup for Pop_id
aapi_alone<- c(1,12,50)
aapi_combo<- c(1,31,60)

## Converting it to LONG format
state_edu_long<- state_edu %>% select(-geoid)  %>%
  gather(estimate_type,
         estimate,
         -geodisplaylabel,
         -pop_id)

## Recoding state_edu_long$pop_id
state_edu_long$pop_id_rec <- as.character(state_edu_long$pop_id)
state_edu_long$pop_id_rec <- fct_recode(state_edu_long$pop_id_rec,
               "State Pop" = "1",
               "Asian" = "12",
               "Asian" = "31",
               "NHPI" = "50",
               "NHPI" = "60")

## Recoding state_edu_long$estimate_type into state_edu_long$estimate_type_rec
state_edu_long$estimate_type_rec <- fct_recode(state_edu_long$estimate_type,
               "Total Pop" = "est_totpop",
               "HS or Less" = "est_hsless",
               "HS Diploma" = "est_hsged",
               "Some College or AA" = "est_somecollegeaa",
               "BA or Higher" = "est_bahigher",
               "% HS or Less"= "pct_hsless",
               "% BA or Higher" = "pct_bahigher")

state_edu_alone_raw <- state_edu_long  %>%
  filter(pop_id %in% aapi_alone) %>% 
  select(-pop_id,-estimate_type) %>% 
  filter(estimate_type_rec !="% BA or Higher") %>%
  filter(estimate_type_rec !="% HS or Less")

state_edu_combo_raw <- state_edu_long  %>%
  filter(pop_id %in% aapi_combo )%>%
  select(-pop_id,-estimate_type)%>% 
  filter(estimate_type_rec !="% BA or Higher") %>%
  filter(estimate_type_rec !="% HS or Less")

state_edu_alone_pct <- state_edu_long  %>%
  filter(pop_id %in% aapi_alone) %>% 
  select(-pop_id,-estimate_type) %>% 
  filter(estimate_type_rec =="% BA or Higher" | estimate_type_rec =="% HS or Less") 

state_edu_combo_pct <- state_edu_long  %>%
  filter(pop_id %in% aapi_combo )%>%
  select(-pop_id,-estimate_type)%>% 
  filter(estimate_type_rec =="% BA or Higher" | estimate_type_rec =="% HS or Less")




### FUNCTIONS ####
# Table for Just raw counts 
state_create_table <- function(data){
  data %>%
  mutate(long_key=paste(pop_id_rec, estimate_type_rec, sep=": ")) %>% #Combining Pop_ID and Estimate type
  select(-pop_id_rec, -estimate_type_rec) %>% 
  spread(long_key, estimate,fill = NA) %>% 
  rename(State= geodisplaylabel)
}




state_display_edu_raw <- function(data){
  data %>%
 datatable(extensions = 
              list("Buttons" = NULL, 'FixedColumns'= T, "Scroller"=T),
            rownames= FALSE, 
            options = list(
              dom = 'rtB',
              buttons = c('copy', 'csv', 'excel'),
              scrollX = TRUE,
              fixedColumns = list(leftColumns = 1),
              columnDefs = list(list(className = 'dt-head-left')),
              lengthMenu = c(25, 50, 100), pageLength = 50)) %>%
  formatCurrency(columns = c(2:16),currency = "", interval = 3, mark = ",", digits=0)
}

state_display_edu_pct <- function(data){
  data %>%
 datatable(extensions = 
              list("Buttons" = NULL, 'FixedColumns'= T, "Scroller"=T),
            rownames= FALSE, 
            options = list(
              dom = 'rtB',
              buttons = c('copy', 'csv', 'excel'),
              scrollX = TRUE,
              fixedColumns = list(leftColumns = 1),
              columnDefs = list(list(className = 'dt-head-left')),
              lengthMenu = c(25, 50, 100), pageLength = 50)) %>%
    formatPercentage(columns =(2:7),0)
}

  ### Calculating Average for the sentence
 avg_hs_less <- state_edu %>% filter(pop_id == 1) %>% select(geodisplaylabel, pct_hsless) %>%  summarize(mean = mean(pct_hsless)) %>% pull() %>% round(.,4)
  avg_hs_less <- avg_hs_less*100
 
avg_ba_higher <- state_edu %>% filter(pop_id == 1) %>% select(geodisplaylabel, pct_bahigher) %>%  summarize(mean = mean(pct_bahigher)) %>% pull() %>% round(.,4)
avg_ba_higher <- avg_ba_higher*100

```


<div class="jumbotron">
  <h1>State Data</h1>
  <p>Use the buttons to select the topic and then the tabs for population groups</p>
</div>

# Education {.tabset .tabset-fade .tabset-pills}
These tables use the 2011-2015 5YR data from the American Community Survey.

## % Asian & NHPI Alone
Nationally, about **`r avg_hs_less`**% of Americans have less than a High School diploma and about **`r avg_ba_higher`**% have a Bachelor's Degree or higher.

```{r EDU-alone-pct, echo=FALSE, message=FALSE, warning=FALSE}

## Using the function I created above to spread the data into the right format
state_edu_table_pct<- state_create_table(state_edu_alone_pct)

## Reordering columns (WE should be able to automate this, I got an error when I tried to include it in the function, not sure what the issue is though)
state_edu_table_pct <- state_edu_table_pct [c(1,6,7,2,3,4,5)]

## Passing the created table to the Display Table Function Created Above
state_display_edu_pct(state_edu_table_pct)


```

## % Asian & NHPI Combo
Nationally, about **`r avg_hs_less`**% of Americans have less than a High School diploma and about **`r avg_ba_higher`**% have a Bachelor's Degree or higher.

```{r EDU-combo-pct, echo=FALSE, message=FALSE, warning=FALSE}

## Using the function I created above to spread the data into the right format
state_edu_table_combo_pct<- state_create_table(state_edu_combo_pct)

## Reordering columns (WE should be able to automate this, I got an error when I tried to include it in the function, not sure what the issue is though)
state_edu_table_combo_pct <- state_edu_table_combo_pct [c(1,6,7,2,3,4,5)]

## Passing the created table to the Display Table Function Created Above
state_display_edu_pct(state_edu_table_combo_pct)


```

## Raw Asian & NHPI Alone
Nationally, about **`r avg_hs_less`**% of Americans have less than a High School diploma and about **`r avg_ba_higher`**% have a Bachelor's Degree or higher.

```{r EDU-combo-Alone, echo=FALSE, message=FALSE, warning=FALSE}

## Using the function I created above to spread the data into the right format
state_edu_table_alone <- state_create_table(state_edu_alone_raw)

## Reordering columns (WE should be able to automate this, I got an error when I tried to include it in the function, not sure what the issue is though)
state_edu_table_alone <- state_edu_table_alone [c(1,16,15,14,13,12,2,3,4,5,7,8,9,10,11)]

## Passing the created table to the Display Table Function Created Above
state_display_edu_raw(state_edu_table_alone)

```


## Raw Asian & NHPI Combo
Nationally, about **`r avg_hs_less`**% of Americans have less than a High School diploma and about **`r avg_ba_higher`**% have a Bachelor's Degree or higher.

```{r EDU-Combo, echo=FALSE, message=FALSE, warning=FALSE}

## Using the function I created above to spread the data into the right format
state_edu_table_combo<- state_create_table(state_edu_combo_raw)

## Reordering columns (WE should be able to automate this, I got an error when I tried to include it in the function, not sure what the issue is though)
state_edu_table_combo <- state_edu_table_combo [c(1,16,15,14,13,12,2,3,4,5,7,8,9,10,11)]

## Passing the created table to the Display Table Function Created Above
state_display_edu_raw(state_edu_table_combo)

```


## Visualize Data

Bachelor's Degree or Higher by State population


```{r edu visualize, echo=FALSE, message=FALSE, warning=FALSE}
mapdata <- get_data_from_map(download_map_data("countries/us/us-all"))

state_edu_table_pct <- state_edu_table_pct %>% mutate(value = `State Pop: % BA or Higher`*100, na.omit=T)
state_edu_table_pct <- state_edu_table_pct %>% mutate(value2 = `Asian: % BA or Higher`*100, na.omit=T)
state_edu_table_pct <- state_edu_table_pct %>% mutate(value3 = `NHPI: % BA or Higher`*100, na.omit=T)

data(fips.state)
fips.state <- fips.state %>% rename(State = STATE_NAME)
state_edu_table_pct<- state_edu_table_pct %>% inner_join(fips.state, by = "State")



x <- c("{point.name}:", "Asian Alone:","NHPI Alone:")
title<-"Percent BA or Higher"
y <- c(" {point.value:.1f}%", " {point.value2:.1f}%",
" {point.value3:.1f}%")
style <- "style=font-size:80%"


highchart() %>%
  hc_title(text = "Bachelors Degree or Higher", align = "center") %>%
  hc_subtitle(text = "Source: 2011-2015 ACS using Asian/NHPI Alone", align = "center") %>%
  hc_chart(backgroundColor = "#ffffff") %>%
  hc_add_series_map(usgeojson, state_edu_table_pct, name = "Education",value = "value", joinBy = c("postalcode", "STUSAB"),
                    borderColor= "null",
            borderWidth= 0) %>%
  hc_tooltip(pointFormat = tooltip_table(x,y,title), useHTML=T,  headerFormat= "")%>%
  hc_add_theme(hc_theme_538()) %>%
  hc_colorAxis(stops = color_stops(),labels= list(format = "{value}%"),showInLegend=T) %>%
   hc_legend(title = list(text= "Statewide Percentage", fontStyle ='italic'),align = "center",verticalAlign = "bottom",
            layout = "horizontal", padding = 5) 


```