index.Rmd

---
title: "Massachusetts"
---

<style type="text/css">
.main-container {
  max-width: 60%;
  margin-left: auto;
  margin-right: auto;
  div.info.legend.leaflet-control br {clear: both;}
}
h1.title {
  text-align: center;
}
</style>

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo=FALSE, message=FALSE, warning=FALSE)
# library(flexdashboard)
library(tidyverse)
library(sf)
library(tmap)
library(maptools)
# library(janitor)
# library(kableExtra)
library(tigris)
options(tigris_use_cache = TRUE, tigris_class = "sf")
library(leaflet)
library(leaflet.extras)
library(DT)
# set common data table options
# options(DT.options = list(scrollY="100vh", lengthMenu = c(5, 10, 15, 20)))
options(DT.options = list(lengthMenu = c(10, 20, 50, 100)))
library(highcharter)
library(rmapshaper)
library(metathis)
library(RColorBrewer)

meta() %>%
  meta_description(
    "Environmental justice analysis of transportation-related burdens and benefits in Massachusetts") %>% 
  meta_viewport() %>% 
  meta_social(
    title = "Investing for Equity in Massachusetts",
    url = "http://dgl.salemstate.edu/luna/InvestingForEquity/MA/",
    og_type = "website",
    og_author = c("Marcos Luna", "Neenah Estrella-Luna"),
    twitter_card_type = "summary",
    twitter_creator = "@CLF"
  )
```

```{r data, include=FALSE, cache=TRUE}
# load("DATA/ne_layers.rds")
ma_blkgrps_sf <- readRDS(file = "../DATA/ma_blkgrps_sf_CUM.Rds")

# download state outline
ma_state <- states(cb = TRUE) %>% 
  filter(NAME == "Massachusetts")

#create layer of municipalities
ma_towns <- county_subdivisions("MA") %>% 
  st_transform(., crs = 4326) %>% 
  select(NAME,NAMELSAD) %>% 
  filter(NAME != "County subdivisions not defined") %>% 
  ms_clip(., ma_state) %>% 
  ms_simplify(., keep = 0.1, keep_shapes = TRUE) 

# Assign municipality names to block groups
ma_blkgrps_sf <- county_subdivisions("MA") %>% 
  st_transform(., crs = st_crs(ma_blkgrps_sf)) %>% 
  transmute(TOWN = NAME) %>% 
  st_join(ma_blkgrps_sf, ., largest = TRUE) %>% 
  mutate(NAME = str_remove_all(NAME, ", Massachusetts")) %>% 
  st_transform(., crs = 4326)

# create layer of state house districts and join table of burdens

house_districts <- st_read("../DATA/shapefiles/house2012",
                            "HOUSE2012_POLY") %>% 
  select(REP_DIST) %>% 
  st_transform(., crs = 4326) %>% 
  st_make_valid() %>% 
  left_join(., read_csv("../tables/burdensCnt_house.csv"), 
            by = c("REP_DIST" = "House District")) 

# create layer of state senate districts and join table of burdens
senate_districts <- st_read("../DATA/shapefiles/senate2012",
                            "SENATE2012_POLY") %>% 
  select(SEN_DIST) %>% 
  st_transform(., crs = 4326) %>% 
  st_make_valid() %>% 
  left_join(., read_csv("../tables/burdensCnt_senate.csv"), 
            by = c("SEN_DIST" = "Senate District")) 

# Assign state house district names to block groups
ma_blkgrps_sf <- house_districts %>% 
  select(REP_DIST) %>% 
  st_join(ma_blkgrps_sf, ., largest = TRUE)

# Assign state senate district names to block groups
ma_blkgrps_sf <- senate_districts %>% 
  select(SEN_DIST) %>% 
  st_join(ma_blkgrps_sf, ., largest = TRUE)


# Create labeling variables to identify burdens and pops of a concern in a given block group that contributed to cumulative burden score
ma_blkgrps_sf <- ma_blkgrps_sf %>% 
  mutate(EmissionsBurden2 = if_else(EmissionsBurden == "P", "Emissions", "NA"),
         TransportBurden2 = if_else(TransportBurden == "T", "Transportation", "NA"),
         HeatBurden2 = if_else(HeatBurden == "H", "Heat", "NA"),
         EvacBurden2 = if_else(EvacBurden == "E", "Evacuation", "NA"),
    BURDENSlabel = gsub("^,*|(?<=,),|,*$", "", # get rid of extra commas
    str_remove_all( # get rid of NAs
      paste(EmissionsBurden2,
          TransportBurden2,
          HeatBurden2,
          EvacBurden2, sep = ","),
      pattern = "NA"), 
    perl=T
    ),
    BURDENSlabel = if_else(BURDENSlabel == "", "No Burden", BURDENSlabel),
    Minority80th = if_else(percent_rank(minority_pctE) >= 0.8, "People of Color","NA"),
    Under5_80th = if_else(percent_rank(pct_under5E) >= 0.8, "Under 5", "NA"),
    Under18_80th = if_else(percent_rank(pct_under18E) >= 0.8, "Under 18", "NA"),
    Over64_80th = if_else(percent_rank(pct_over64E) >= 0.8, "Over 64", "NA"),
    lths80th = if_else(percent_rank(pct_lthsE) >= 0.8, "No HS Diploma", "NA"),
    pct2pov80th = if_else(percent_rank(pct2povE) >= 0.8, "Low Income", "NA"),
    eng_limit_pct80th = if_else(percent_rank(eng_limit_pctE) >= 0.8, "Limited English HH", "NA"),
    MA_INCOME_80th = if_else(MA_INCOME == "I", "MA Low Income", "NA"),
    MA_MINORITY_80th = if_else(MA_MINORITY == "M", "MA Minority", "NA"),
    MA_ENGLISH_80th = if_else(MA_ENGLISH == "E", "MA Limited English HH", "NA"),
    POPSlabel = gsub("^,*|(?<=,),|,*$", "", # get rid of extra commas
    str_remove_all( # get rid of NAs
      paste(Minority80th,
            Under5_80th,
            Under18_80th,
            Over64_80th,
            lths80th,
            pct2pov80th,
            eng_limit_pct80th,
            MA_INCOME_80th,
            MA_MINORITY_80th,
            MA_ENGLISH_80th, sep = ","),
      pattern = "NA"), 
    perl=T
    ),
    POPSlabel = if_else(POPSlabel == "", "No Pops of Concern", POPSlabel)
    ) %>% 
  filter(BURDENSlabel != "No Burden" & POPSlabel != "No Pops of Concern")

# create layer of EJ polygons
EJbgs <- ma_blkgrps_sf %>% 
  filter(MA_INCOME == "I" | MA_MINORITY == "M" | MA_ENGLISH == "E") %>% 
  mutate(EJlabel = gsub("^,*|(?<=,),|,*$", "", # get rid of extra commas
    str_remove_all( # get rid of NAs
      paste(MA_INCOME_80th,
            MA_MINORITY_80th,
            MA_ENGLISH_80th, sep = ","),
      pattern = "NA"), 
    perl=T
    )) %>% 
  select(NAME, TOWN, REP_DIST, SEN_DIST, EJlabel, BurdenCount, BURDENSlabel) %>% 
  ms_simplify(., keep = 0.1, keep_shapes = TRUE)


# reduce number of variables in ma_blkgrps_sf for faster loading AND reduce number of vertices
ma_blkgrps_sf <- ma_blkgrps_sf %>%
  select(BurdenCount, NAME, REP_DIST, SEN_DIST, TOWN, BURDENSlabel, 
         POPSlabel) %>% 
  ms_simplify(., keep = 0.1, keep_shapes = TRUE)

# reduce number of vertices, but note that ms_simplify mangles column headings that begin with numbers so need to fix
house_districts <- house_districts %>% 
  ms_simplify(., keep = 0.1, keep_shapes = TRUE) %>% 
  rename(`3 Burdens` = X3.Burdens,
         `4 Burdens` = X4.Burdens,
         `3+ Burdens` = X3..Burdens)

senate_districts <- senate_districts %>% 
  ms_simplify(., keep = 0.1, keep_shapes = TRUE) %>% 
  rename(`3 Burdens` = X3.Burdens,
         `4 Burdens` = X4.Burdens,
         `3+ Burdens` = X3..Burdens)
```
---
# Cumulative Burdens + Priority Populations
Massachusetts needs progressive and equitable investment in transportation. This investment should prioritize communities that have borne the brunt of burdens from the current transportation system, and which have benefited the least from the same system.

Our analysis shows that 

* Areas with high percentages of priority populations and the highest rankings of multiple cumulative environmental burdens fall in the eastern and southern regions of state, particularly around the largest urban areas. 
* Limited English speaking households and people of color most frequently experience the greatest number and types of burdens, especially for air quality, heat, and flood or evacuation risks. 
* Priority populations, especially those over 64 and in lower income households, in rural and suburban areas, lack transportation options and face high costs for transportation.

These interactive figures identify communities across Massachusetts that are most overburdened and most vulnerable to transportation-related environmental burdens or the absence of transportation-related benefits.

<br>

## Cumulative burdens by Census block group {.tabset}

### Map
```{r map, fig.align="left", fig.cap="Map of Census block groups with the highest concentrations of one or more priority populations AND exposed to the highest levels of 1 - 4 cumulative environmental burdens (e.g., emissions, lack of transport access, heat risk, flood evacuation risk)."}
# create labeling variable for map of cumulative burden scores. Note that for some reason that I can't fathom, the legend items will be displayed out of alignment if I try to manually add labels in the labels parameter for addLegend. 
ma_blkgrps_sf <- ma_blkgrps_sf %>% 
  mutate(BurdenCountLabel = 
           if_else(BurdenCount == 1, 
                   paste0(BurdenCount," Hi Burden + Hi Priority Pops"),
                   paste0(BurdenCount," Hi Burdens + Hi Priority Pops")))

pal <- colorFactor(
  palette = "YlOrRd",
  domain = ma_blkgrps_sf$BurdenCountLabel)

# alternatively, create a colors vector to pair with arbitrary labels
colors <- brewer.pal(n = 4, "YlOrRd")

PopupEJ <- paste0(EJbgs$NAME, "<br/>",
                      "<b>Town:</b> ", EJbgs$TOWN, "<br/>",
                  "<b>State House District:</b> ", EJbgs$REP_DIST, "<br/>",
                  "<b>State Senate District:</b> ", EJbgs$SEN_DIST, "<br/>",
                      "<b>Environmental Justice categories: </b>", EJbgs$EJlabel, "<br/>",
                  "<b>Number of Burdens:</b> ", EJbgs$BurdenCount, "<br/>",
                      "<b>Burden Categories: </b>", EJbgs$BURDENSlabel)

PopupHouse <- paste0("Massachusetts state House District ", "<b>",house_districts$REP_DIST,"</b>", " has ", "<b>",house_districts$`3 Burdens`,"</b>", " <b>Block Groups</b> with high percentages of priority populations experiencing <b>3 categories</b> of highest cumulative burdens, and ", "<b>",house_districts$`4 Burdens`,"</b>", " <b>Block Groups</b> experiencing <b>4 categories</b> of highest cumulative burdens.")

PopupSenate <- paste0("Massachusetts state Senate District ", "<b>",senate_districts$SEN_DIST,"</b>", " has ", "<b>",senate_districts$`3 Burdens`,"</b>", " <b>Block Groups</b> with high percentages of priority populations experiencing <b>3 categories</b> of highest cumulative burdens, and ", "<b>",senate_districts$`4 Burdens`,"</b>", " <b>Block Groups</b> experiencing <b>4 categories</b> of highest cumulative burdens.")

Popup <- paste0(ma_blkgrps_sf$NAME, "<br/>",
                "<b>State House District:</b> ", ma_blkgrps_sf$REP_DIST, "<br/>",
                  "<b>State Senate District:</b> ", ma_blkgrps_sf$SEN_DIST, "<br/>",
                      "<b>Town:</b> ", ma_blkgrps_sf$TOWN, "<br/>",
                      "<b>Number of Burdens:</b> ", ma_blkgrps_sf$BurdenCount, "<br/>",
                      "<b>Burden Categories: </b>", ma_blkgrps_sf$BURDENSlabel,"<br/>",
                      "<b>Priority Populations: </b>", ma_blkgrps_sf$POPSlabel)

leaflet(width = "100%") %>% 
  addProviderTiles(providers$Stamen.TonerLite) %>% 
  addPolygons(data = ma_towns,
              weight = 0.7,
              opacity = 1,
              color = "gray",
              fillOpacity = 0,
              label=~NAME, popup=~NAMELSAD, group='muni') %>% 
  addPolygons(data = house_districts,
              weight = 2,
              opacity = 1,
              color = "blue",
              dashArray = 3,
              fillOpacity = 0,
              # fillColor = "blue",
              label = ~REP_DIST,
              popup = PopupHouse,
              highlight = highlightOptions(
                weight = 5,
                color = "#666",
                dashArray = "",
                fillOpacity = 0,
                bringToFront = TRUE),
              group = "State House Districts") %>% 
  addPolygons(data = senate_districts,
              # fillColor = "red",
              weight = 2,
              opacity = 1,
              color = "green",
              dashArray = 3,
              fillOpacity = 0,
              label=~SEN_DIST,
              popup = PopupSenate,
              highlight = highlightOptions(
                weight = 5,
                color = "#666",
                dashArray = "",
                fillOpacity = 0,
                bringToFront = TRUE),
              group = "State Senate Districts") %>% 
  addPolygons(data = EJbgs,
              # fillColor = "red",
              weight = 2,
              opacity = 1,
              color = "purple",
              dashArray = 3,
              fillOpacity = 0,
              label=~TOWN,
              popup = PopupEJ,
              highlight = highlightOptions(
                weight = 5,
                color = "#666",
                dashArray = "",
                fillOpacity = 0,
                bringToFront = TRUE),
              group = "Environmental Justice communities") %>% 
  addPolygons(data = ma_blkgrps_sf,
              fillColor = ~pal(BurdenCountLabel), 
              weight = 0.5,
              opacity = 0.7,
              color = "white",
              dashArray = 3,
              fillOpacity = 0.7,
              label=~TOWN, 
              popup = Popup,
              highlight = highlightOptions(
                weight = 5,
                color = "#666",
                dashArray = "",
                fillOpacity = 0.7,
                bringToFront = TRUE)) %>% 
  addLegend(title = "Cumulative Burdens", 
            pal = pal, # palette colors tied to values
            values = ma_blkgrps_sf$BurdenCountLabel,
            # colors = colors, # hex color values paired with labels
            # labels = c("1 Hi Burden + Hi Priority Pops ",
            #            "2 Hi Burdens + Hi Priority Pops",
            #            "3 Hi Burdens + Hi Priority Pops",
            #            "4 Hi Burdens + Hi Priority Pops"),
            position = "bottomleft") %>% 
  setView(lng = -71.7, 42.1, zoom = 8) %>% 
  # addMiniMap() %>% 
  addScaleBar(position = "bottomright") %>% 
  addSearchFeatures(targetGroups  = 'muni', 
                    options = searchFeaturesOptions(zoom=14, openPopup=TRUE, hideMarkerOnCollapse=T)) %>% 
  addLayersControl(
    overlayGroups = c("Environmental Justice communities", "State House Districts","State Senate Districts"),
    options = layersControlOptions(collapsed = TRUE)
  ) %>% 
  hideGroup(c("Environmental Justice communities", "State House Districts","State Senate Districts"))
```

<br>

<br>

### About the map

This map shows communities (i.e. Census Block Groups) with high percentages of one or more priority population groups (80th percentile for the state) *AND* that experience the highest burdens (80th percentile for the state) for one or more categories of environmental burdens. 

Priority populations represent demographic groups that environmental justice policy and research have identified as being especially vulnerable to environmental burdens as a consequence of social or economic disadvantage, physical vulnerability, or historic and persistent discrimination and inequality. These include:

* People of color (i.e., persons who are of Hispanic ethnicity or racially not White)
* Low income persons (i.e., income less than 200% of the poverty line)
* Limited English speaking households (i.e., households where no adult speaks English "very well")
* Adults 25 years or older without a high school diploma
* Children under the age of 5
* Adults over the age of 64
* Environmental Justice communities defined by state policy


Environmental burdens and benefits span four domains:

* Emissions: Air emissions related to transportation (e.g., particulates, smog, cancer risk)
* Transportation: Access and adequacy of transportation options (e.g., access to public transit, transportation cost burden)
* Evacuation: Risk from flooding or hurricane storm surge
* Heat: Elevated heat risk (which exacerbates air pollution and other risks)


<br>

<br>

## Cumulative percentages of burdens for priority populations {.tabset}

### Graph

```{r graph, fig.align="center", fig.cap="Cumulative percentages of priority populations experiencing one or more highest cumulative burdens."}
# # create a stacked bar chart to compare cumulative burdens
# read_csv("tables/cum_burden.csv") %>% 
#   select(Group,PctB1:PctB4) %>% 
#   pivot_longer(.,cols = starts_with("Pct"), names_to = "Burdens") %>% 
#   mutate(Burdens = as.factor(Burdens)) %>% 
#   ggplot(aes(x = reorder(Group,value), y = value, fill = fct_rev(Burdens))) +
#   geom_bar(stat = "identity") +
#   coord_flip() +
#   labs(x = "", y = "Percentage", fill = "Burden\nCategories",
#        title = "Percentage of Massachusetts Population within\nCumulative Burden Categories") + 
#   theme_light() +
#   theme(panel.grid.major.y = element_blank(),
#         panel.border = element_blank(),
#         axis.ticks.y = element_blank()) +
#   scale_fill_discrete(labels = c("4 categories", "3 categories", 
#                                  "2 categories", "1 category"))

# create a wide table for use in dynamic highchart
ma_cum_burdens <- read_csv("../tables/cum_burden.csv") %>% 
  as.data.frame() %>% 
  mutate(Group = recode(Group, "Minority" = "People of Color",
                        "No HS Dip" = "No HS Diploma")) %>%
  transmute(Group = Group, `1 Burden` = round(PctB1,1),
            `2 Burdens` = round(PctB2,1),
            `3 Burdens` = round(PctB3,1),
            `4 Burdens` = round(PctB4,1)) %>% 
  rowwise() %>% 
  mutate(totals = sum(c_across(`1 Burden`:`4 Burdens`))) %>% 
  arrange(., desc(totals)) %>% 
  select(-totals) %>% 
  as.data.frame()

# store values for use in text
LEH1 <- ma_cum_burdens %>% filter(Group == "Limited English HH") %>% select(`1 Burden`) %>% pull()
LEH2 <- ma_cum_burdens %>% filter(Group == "Limited English HH") %>% select(`2 Burdens`) %>% pull()
LEH4 <- ma_cum_burdens %>% filter(Group == "Limited English HH") %>% rowwise %>% summarize(Total = sum(c_across(2:5))) %>% pull()
THH <- ma_cum_burdens %>% filter(Group == "Total HH") %>% rowwise %>% summarize(Total = sum(c_across(2:5))) %>% pull()

# create a function to generate chart, otherwise each series must be added manually. Thanks to https://ox-it.github.io/OxfordIDN_htmlwidgets/charts/StackedBarCharts/ for this solution!
stacked_bar_chart <- function(data = NA,
                              categories_column = NA,
                              measure_columns = NA,
                              stacking_type = NA,
                              ordering_function = c,
                              explicit_order = NA) {
  ordered_measure <-
    order(unlist(lapply(measure_columns, function(x) {
      ordering_function(data[, x])
    })),
    decreasing = TRUE) - 1
  
  chart <- highchart() %>%
    hc_xAxis(categories = data[, categories_column],
             title = categories_column) %>% 
    hc_colors(., colors) # use hex colors to match map
  
  invisible(lapply(1:length(measure_columns), function(colNumber) {
    chart <<-
      hc_add_series(
        hc = chart,
        name = measure_columns[colNumber],
        data = data[, measure_columns[colNumber]],
        index = {
          if (is.na(explicit_order)) {
            ordered_measure[colNumber]
          } else
            explicit_order[colNumber]
        }
      )
  }))
  
  chart %>%
    hc_chart(type = "bar") %>%
    hc_plotOptions(series = list(stacking = as.character(stacking_type))) %>%
    hc_legend(reversed = TRUE)
}

categories_column <- names(ma_cum_burdens[,1])
measure_columns <- names(ma_cum_burdens[,2:5])

stacked_bar_chart(data = ma_cum_burdens,
                  categories_column = "Group",
                  measure_columns = measure_columns,
                  stacking_type = "normal",
                  ordering_function = cumsum) %>% 
  hc_yAxis(max = 100, title = list(text = "Cumulative percentage of 1 or more burdens"),
           labels = list(format = "{value}%")) %>% 
  hc_tooltip(pointFormat = "{point.y}%")
```

<br>

<br>

### About the graph

This graph shows the categorical and cumulative percentages of a given population group that lives within areas designated as experiencing one or more of the highest transportation-related environmental burden categories. A highest burdened community is a block group in which there is a high percentage of one or more priority population groups (80th percentile for the state) AND they experience the highest burdens (80th percentile for the state) for one to four categories of environmental burdens (i.e., Emissions, Heat, Evacuation, or Transportation). 

For example, `r LEH1`% of limited English speaking households (i.e., 'Limited English HH') in the state reside in Census block groups that experience 1 high environmental burden category, and `r LEH2`% reside in block groups experiencing 2 environmental burden categories. Cumulatively, `r LEH4`% of limited English speaking households live in communities experiencing 1 to 4 highest environmental burden categories. Compare this to the `r THH`% of all households in the state (i.e., 'Total HH') who experience these conditions. 

<br>

<br>

## Highest Burdens by Jurisdiction {.tabset}

### By municipality

```{r townTable, fig.align="center"}
# create object to hold complex headers for table
sketch1 = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'City/Town'),
      th(align="center", colspan = 2, '3 Burdens'),
      th(align="center", colspan = 2, '4 Burdens'),
      th(align="center", colspan = 2, '3+ Burdens')
    ),
    tr(
      lapply(rep(c('Pop', 'Pct'), 3), th)
    )
  )
))

read_csv("../tables/burdens_town.csv") %>% 
  mutate(across(starts_with("Pct"), ~./100)) %>% # let DT do formatting
  datatable(., rownames = FALSE, options = list(pageLength = 10), 
            container = sketch1) %>% 
  formatRound(., columns = c(2,4,6), digits = 0, mark = ",") %>% 
  formatPercentage(., columns = c(3,5,7), digits = 1)
```

<!-- > Number of Census block groups with three or more cumualtive environmental burdens and high concentrations of populations of concern -->


### By state house district

```{r houseTable, fig.align="center"}
# create object to hold complex headers for table
sketch2 = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'House District'),
      th(align="center", colspan = 2, '3 Burdens'),
      th(align="center", colspan = 2, '4 Burdens'),
      th(align="center", colspan = 2, '3+ Burdens')
    ),
    tr(
      lapply(rep(c('Pop', 'Pct'), 3), th)
    )
  )
))

read_csv("../tables/burdens_house.csv") %>% 
  mutate(across(starts_with("Pct"), ~./100)) %>% # let DT do formatting
  datatable(., rownames = FALSE, options = list(pageLength = 10), 
            container = sketch2) %>% 
  formatRound(., columns = c(2,4,6), digits = 0, mark = ",") %>% 
  formatPercentage(., columns = c(3,5,7), digits = 1)
```


### By state senate district

```{r senateTable, fig.align="center"}
# create object to hold complex headers for table
sketch3 = htmltools::withTags(table(
  class = 'display',
  thead(
    tr(
      th(rowspan = 2, 'Senate District'),
      th(align="center", colspan = 2, '3 Burdens'),
      th(align="center", colspan = 2, '4 Burdens'),
      th(align="center", colspan = 2, '3+ Burdens')
    ),
    tr(
      lapply(rep(c('Pop', 'Pct'), 3), th)
    )
  )
))

read_csv("../tables/burdens_senate.csv") %>% 
  mutate(across(starts_with("Pct"), ~./100)) %>% # let DT do formatting
  datatable(., rownames = FALSE, options = list(pageLength = 10), 
            container = sketch3) %>% 
  formatRound(., columns = c(2,4,6), digits = 0, mark = ",") %>% 
  formatPercentage(., columns = c(3,5,7), digits = 1)

# read_csv("../tables/burdens_senate.csv") %>% 
#   rename(., `BGs with 3 Burdens` = `3 Burdens`, 
#          `BGs with 4 Burdens` = `4 Burdens`, 
#          `BGs with 3+ Burdens` = `3+ Burdens`) %>%
#   datatable(., rownames = FALSE, options = list(pageLength = 10))
```


### About the tables

These tables show the aggregate number and percentage of the general population living in Census block groups with three or more highest cumulative environmental burdens. A block group is classified as having a high cumulative burden if it has a high percentage of one or more priority population groups (80th percentile for the state) *AND* it experiences the highest level of burdens (80th percentile for the state) for one or more categories of environmental burdens. 

Priority populations represent demographic groups that environmental justice policy and research have identified as being especially vulnerable to environmental burdens as a consequence of social or economic disadvantage, physical vulnerability, or historic and persistent discrimination and inequality. These include:

* People of color (i.e., persons who are of Hispanic ethnicity or racially not White)
* Low income persons (i.e., income less than 200% of the poverty line)
* Limited English speaking households (i.e., households where no adult speaks English "very well")
* Adults 25 years or older without a high school diploma
* Children under the age of 5
* Adults over the age of 64
* Environmental Justice communities defined by state policy


Environmental burdens and benefits span four domains:

* Emissions: Air emissions related to transportation (e.g., particulates, smog, cancer risk)
* Transportation: Access and adequacy of transportation options (e.g., access to public transit, transportation cost burden)
* Evacuation: Risk from flooding or hurricane storm surge
* Heat: Elevated heat risk (which exacerbates air pollution and other risks)