Gentrification Tool.Rmd

---
title: "Census-Based Gentrification Methods"
output: 
  html_notebook: 
    toc: true
    toc_depth: 3
    toc_float: true
    css:  "www/app.css"
runtime: shiny
bibliography: references.bib
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)

library(ggplot2)
library(dplyr)
library(tidyr)
library(tmap)
library(tigris)
library(sf)
library(MITREShiny)
library(DT)
library(plotly)
library(rgdal)

# Read in data ----
data <- readRDS("outputs/indicators_long.RDS")
outcomes <- readRDS("outputs/outcomes.RDS")
tracts <- readRDS("outputs/final_places_tracts.RDS")
  #st_crs(tracts) = 4326
  
large_places <- readRDS("outputs/places_pop_gt_50k.RDS") %>% 
  select(STATEFP.PLACE, PLACE) 
fips_xw <- unique(fips_codes[,1:3]) %>% 
  full_join(large_places, 
            by = c("state_code" = "STATEFP.PLACE"))

# Define colors and theme ---- 
holc_colors <- c(
  "A" = "#759e64", # green
  "B" = "#75a3b6", # blue
  "C" = "#c5c473", # yellow
  "D" = "#c27e8d" # red
)

gent_colors <- c(
  "Not Eligible" = "#D0E1D4",  
  "Positive Indicator" = "#0C6291", 
  "Still Susceptible" = "#C05746" 
)

theme_set(theme_minimal()) +
  theme(plot.title = element_text(hjust=0.5),
        plot.subtitle = element_text(hjust = 0.5))
```

# Introduction

## What is Gentrification?

Our neighborhoods are all unique places, shaped by the landscape, geography, resources, and the people who live in it. However, over time, our neighborhoods and communities change, businesses enter and leave, building are built up and torn down, and people move in and out. It is difficult to separate out the causes and the consequences of these types of changes and the many ways they interact and influence each other.

However, certain patterns of neighborhood change occur with enough frequency under similar circumstances that they fit a described pattern. The term *gentrification*, coined in 1964 by Ruth Glass, was defined to capture patterns Glass observed in London, where "all or most of the original working-class occupiers are displaced, and the whole social character of the district is changed." However, this term has evolved over time, shifting and evolving in meaning, holding different connotations for different groups across diverse geography. As such, researchers who study gentrification both conceptualize and measure in various ways [@Bhavsar2020][@easton2019], and often times, these methods result in differing classifications [@preis2020].

## How do we measure it? {.tabset}

The purpose of this document is to help users understand how the measures and indicators used in census-based gentrification affect which areas are classified as gentrified. In even as early as 1986, George Galster & Stephen Peacock reported "great sensitivity in the number and location of gentrified tracts to the definition chosen and stringency applied", when examining areal changes in Philadelphia between 1970 - 1980. [@galster1986] This definition explorer document hopes to visualize and elucidate some of those sensitivities.

Census-based gentrification definitions have often been used as a quantitative, quick way approximate the difficult concept of gentrification.

However, this has been little consensus among researchers in defining gentrification, much less in operationalizing the definition. In a systematic review of gentrification definitions used in epidemiologic research, 18 different indicators were used to capture and measure gentrification including Median Household Income, Education, Rent, Race, Home Value, Poverty, etc. [@Bhavsar2020]

Two common concepts are used in defining gentrification.

1.  Neighborhoods are **eligible** to be gentrified.
2.  Neighborhoods that meet threshold criteria are **determined** to be gentrified.

Indicators can be used to define eligibility, determination, or both.

In addition to areal indicators, time period of evaluation and reference geographic region are also important decisions which may impact the quantification of tracts as gentrified.

Click on the tabs below to see how you can replicate different gentrification methodologies with the tool.

### Governing Method

In 2015, *Governing: The Future of States and Localities*, published a <a href="https://www.governing.com/archive/gentrification-in-cities-governing-report.html" target="_blank">report</a> analyzing the landscape of gentrification in across the nation's 50 largest cities.

Their <a href="https://www.governing.com/archive/gentrification-report-methodology.html" target="_blank">methodology</a> used to determine tract eligibility is described as follows:

**Eligibility**

1.  The tract had a population of at least 500 residents at the beginning and end of a decade and was located within a central city
2.  The tract's median household income was in the bottom 40th percentile when compared to all tracts within its metro area at the beginning of the decade
3.  The tracts median home value was in the bottom 40th percentile when compared to all tracts within its metro area at the beginning of the decade.

**Determination**

1.  An increase in the tract's educational attainment, as measured by the percentage of residents age 25 and over holding bachelor's degrees, was in the top third percentile of all tracts within a metro area.
2.  A tract's median home value increase when adjusted for inflation.
3.  The percentage increase in a tract's inflation-adjusted median home value was in the top third percentile of all tracts within a metro area.

In order to replicate this method using the application, in **Define Indicators** select:

-   `Median Household Income` eligibility threshold = 0.4, determination threshold = 0
-   `Median Home Value` eligibility threshold = 0.4, determination threshold = 0.66
-   `Higher Education` eligibility threshold = 1, determination threshold = 0.75

In **Select Indicators**, check only `Median Household Income`, `Median Home Value`, and `Higher Education`.

Only tracts with all 3 positive indicators of gentrification would be classified as gentrified.

<hr>

### National Neighborhood Indicators Partnership (NHIP)

In 2019, the National Neighborhood Indicators Partnership released a "Guide to Measuring Neighborhood Change to Understand and Prevent Displacement".

This <a href="https://www.urban.org/sites/default/files/publication/100135/guide_to_measuring_neighborhood_change_to_understand_and_prevent_displacement.pdf" target="_blank">document</a> provides a guide which helps users consider analytic approaches, indicators, and data sources to measure neighborhood change as specified for the community to prevent displacement.

This dashboard can help with decisions around a few key considerations when creating a measurement approach around gentrification. For instance:

1.  **Geography:** There are two levels of geography researchers need to consider when identifying gentrifying neighborhoods: 1) the geographic unit of analysis and 2) the geographic scope. The unit analysis might be thought of as a "neighborhood unit" - often times this is practically defined at the census block, census tract, or zip code level, and reflect the level at which a particular intervention might be implemented. The geographic scope is the larger boundary which defines the set of all neighborhoods that each unit is compared to in order to understand the sense of relative change. Our tool allows for a dynamic selection of the geographic scope, though the use of Census Places. Users can use the multiple-select to build up the geographies to include in the overall boundary, allowing for a wider base of comparison. This tool does not, however, allow the user to change the unit of analysis, and instead is fixed at the census tract level, primarily due to the geographic granularity of other datasets within the tool.

2.  **Time Period:** This tool contains 6 decades of decennial demographic and neighborhood data, from 1970 to 2020. Users can select comparisons at the beginning and end of decade intervals. One limitation of this tool is that it does not enable the selection of individual years of data, as such it would not be able to detect "rapidly" gentrifying area, or change that is happening over the course if a couple years.

3.  **Indicators and Data Sources:** The NHIP guide contains organizes indicators and data sources by Resident Characteristics, Housing Markets and Conditions, Economic Activity and Investment, and Neighborhood Conditions. This tool contains 8 indicators which primarily fall under Resident Characteristics and Housing Markets and Conditions.

<hr>

# Explore Indicators

```{r data_prep, echo=FALSE, message=FALSE}

# Generates scatter plot for all the measure functions used in the Explore Indicators Section
#'
#' @param data dataframe with columns `Rank Start`, `Rank End`, `Total Pop End` and `Label`
#' @return ggplot with defined aesthetics and geoms based on selected measure input `input$measure`

plot_measure_scatter <- function(data){
  plot <- data %>%
   ggplot(aes(x = `Rank Start`, y = `Rank End`)) +
      geom_point(aes(size = `Total Pop End`, color = Label), alpha = 0.7) +
      scale_color_manual(values = gent_colors) +
      theme(aspect.ratio = 1,
            legend.position = "bottom") +
    labs(title = paste(input$measure))
  
  return(plot)
}


#' Processes data to add categorical gentrification labels based on threshold inputs
#'
#' @param data dataframe with columns `Rank Start` and `Rank End`
#' @param input_eligibility User Defined input to determine the eligibility threshold
#' @param input_determination User Defined input to determine the determination threshold 
#' @return labelled datasframe with additional column `Label`

add_gentrification_label <- function(data, input_eligibility, input_determination){
  labelled <- data %>%
    mutate(Label = case_when(`Rank Start` > input_eligibility ~ "Not Eligible",
                             `Rank Start` <= input_eligibility & 
                               `Rank End` <= input_determination ~ "Still Susceptible",
                             `Rank Start` <= input_eligibility & 
                               `Rank End` > input_determination ~ "Positive Indicator"))
  return(labelled)
}
```

```{r core-explore, echo=FALSE, message=FALSE,}
# Input panel to select Year, State, County, and Measure
inputPanel(
    sliderInput("range", 
                label = "Select Year Range:",
                min = 1970, max = 2020, 
                value = c(2000, 2020), 
                step = 10, sep = ""),
    
    selectInput("state", 
                label = "Choose a State:",
                choices = sort(unique(data$STATE)), 
                selected = "Oregon"),
    
    renderUI({
      places <- na.omit(unique(data[data$STATE == input$state, "NAME"]))
      selectInput("places", 
                  label = "Choose a Place(s):",
                  choices = places, 
                  selected = "Portland",
                  multiple = TRUE,
                  selectize = TRUE)
      }),
    
    selectInput("measure", 
                label = "Choose a Measure to Explore:",
                choices = unique(data$Measure),
                selected = "Median Household Income"
                )
  )


start <- reactive({
  data %>%
    filter(YEAR == input$range[1],
           STATE == input$state,
           NAME %in% input$places) %>% 
  group_by(YEAR, STATE, Measure) %>%
  mutate(Rank = percent_rank(Value)) %>%
  ungroup()
})

end <- reactive({
  data %>%
    filter(YEAR == input$range[2],
           STATE == input$state,
           NAME %in% input$places) %>% 
  group_by(YEAR, STATE, Measure) %>%
  mutate(Rank = percent_rank(Value)) %>%
  ungroup()
})

start_end <- reactive({
  inner_join(start(), end(),
               by = c("GEOID", "STATE", "NAME", "Measure"),
               suffix = c(" Start", " End")
    )
})

fips <- reactive({fips_xw[fips_xw$state_name == input$state & 
                          fips_xw$PLACE %in% input$places,]
    })
    

# Histogram + density plot to explore distribution of measures
splitLayout(
  
  renderPlot({
    data %>%
      filter(YEAR %in% input$range,
             STATE == input$state,
             NAME %in% input$places,
             Measure == input$measure) %>%
      ggplot(aes(x = Value)) +
      geom_histogram(aes(y = ..density..,
                         fill = as.factor(YEAR)),
                     alpha = 0.4, position = "dodge") + 
      geom_density(aes(color = as.factor(YEAR)), show.legend = FALSE) +
      labs(fill = "Year",
           y = "# of Tracts",
           title = paste(input$measure)) +
      theme(legend.position = "bottom",
            aspect.ratio = 1) 

  }),
  
  renderPlot({
    start_end() %>%
      filter(Measure == input$measure) %>%
      ggplot(aes(x = `Value Start`, y = `Value End`)) +
      geom_point(aes(size = `Total Pop End`),
                 alpha = 0.3) +
      geom_abline(slope = 1, intercept = 0, lty = "dotted", color = "gray") +
      theme(aspect.ratio = 1,
            legend.position = "bottom") +
      labs(title = paste(input$measure))
  })
)

```

# Define Indicators {.tabset}

Select the thresholds for each potential measure to define the eligibility and determination thresholds relative relative to the surrounding tracts in the county.

The selected thresholds will persist throughout the rest of the document.

-   Eligibility threshold characterizes which set of tracts can be considered candidates for gentrification.
-   Determination thresholds characterize what change is significant to capture neighborhood change.

## Median Household Income

```{r mhi, echo=FALSE}
# Input panel information
inputPanel(
    sliderInput("eligibility_mhi", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_mhi", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_mhi", "Update Thresholds")
  )


# Generate MHI data set

mhi_et <- reactiveVal(0.5)
mhi_dt <- reactiveVal(0.5)

observeEvent(input$update_mhi, {
  mhi_et(input$eligibility_mhi)
  mhi_dt(input$determination_mhi)
})

mhi <- reactive({
  start_end() %>%
    filter(Measure == "Median Household Income") %>%
    add_gentrification_label(input_eligibility = mhi_et(), 
                             input_determination = mhi_dt())
})

tract_mhi <- reactive({
  tracts %>%
    filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
    left_join(.,mhi(), by = "GEOID") %>% st_as_sf()
})

# Output
splitLayout(
  renderPlot({
    mhi() %>%
      plot_measure_scatter() 
  }),
  
  renderTmap({
    tm_shape(tract_mhi()) +
      tm_polygons(col = "Label", 
                  palette = gent_colors,
                  alpha = 0.4)
  })
)
```

## Median Rent

```{r rent, echo=FALSE}
inputPanel(
    sliderInput("eligibility_rent", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_rent", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_rent", "Update Thresholds")
  )

# Generate MHI data set

rent_et <- reactiveVal(0.5)
rent_dt <- reactiveVal(0.5)

observeEvent(input$update_rent, {
  rent_et(input$eligibility_rent)
  rent_dt(input$determination_rent)
})

rent <- reactive({
  start_end() %>%
    filter(Measure == "Median Rent") %>%
    add_gentrification_label(input_eligibility = rent_et(),
                             input_determination = rent_dt())
})

tract_rent <- reactive({tracts %>%
        filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
        left_join(.,rent(), by = "GEOID") %>% st_as_sf()
      })

# Output
splitLayout(
  renderPlot({
    rent() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_rent()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
)
```

## Higher Education

```{r edu, echo=FALSE}
inputPanel(
    sliderInput("eligibility_edu", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_edu", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_edu", "Update Thresholds")
  )

# Generate MHI data set

edu_et <- reactiveVal(0.5)
edu_dt <- reactiveVal(0.5)

observeEvent(input$update_edu, {
  edu_et(input$eligibility_edu)
  edu_dt(input$determination_edu)
})

edu <- reactive({
  start_end() %>%
    filter(Measure == "Median Household Income") %>%
    add_gentrification_label(input_eligibility = edu_et(),
                             input_determination = edu_dt())
})

tract_edu <- reactive({tracts %>%
        filter(STATEFP == fips()$state_code,
               NAME %in% fips()$PLACE) %>%
        left_join(.,edu(), by = "GEOID") %>% st_as_sf()
      })

# Output
splitLayout(
  renderPlot({
    edu() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_edu()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
)
```

## Median Home Value

```{r mhv, echo=FALSE}
inputPanel(
    sliderInput("eligibility_mhv", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_mhv", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_mhv", "Update Thresholds")
  )


# Generate MHV data set


mhv_et <- reactiveVal(0.5)
mhv_dt <- reactiveVal(0.5)

observeEvent(input$update_mhv, {
  mhv_et(input$eligibility_mhv)
  mhv_dt(input$determination_mhv)
})

mhv <- reactive({
  start_end() %>%
    filter(Measure == "Median Home Value") %>%
    add_gentrification_label(input_eligibility = mhv_et(),
                             input_determination = mhv_dt())
})

tract_mhv <- reactive({tracts %>%
        filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
        left_join(.,mhv(), by = "GEOID")%>% st_as_sf()
      })

# Output
splitLayout(
  renderPlot({
    mhv() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_mhv()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
)
```

## Percent Non-Hispanic White

```{r nhw, echo=FALSE}
inputPanel(
    sliderInput("eligibility_nhw", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_nhw", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_nhw", "Update Thresholds")
  )

# Generate NHW data set

nhw_et <- reactiveVal(0.5)
nhw_dt <- reactiveVal(0.5)

observeEvent(input$update_nhw, {
  nhw_et(input$eligibility_nhw)
  nhw_dt(input$determination_nhw)
})
nhw <- reactive({
  start_end() %>%
    filter(Measure == "Percent Non-Hispanic White") %>%
    add_gentrification_label(input_eligibility = nhw_et(),
                             input_determination = nhw_dt())
})

tract_nhw <- reactive({tracts %>%
        filter(STATEFP == fips()$STATE_FIP,
               COUNTYFP == fips()$COUNTY_FIP) %>%
        merge(.,nhw(), by = "GEOID")
      })

# Output
splitLayout(
  renderPlot({
    nhw() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_nhw()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
)
```

## Housing Structure Age

```{r hsa, echo=FALSE}
inputPanel(
    sliderInput("eligibility_hsa", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_hsa", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_hsa", "Update Thresholds")
  )

# Generate NHW data set
hsa_et <- reactiveVal(0.5)
hsa_dt <- reactiveVal(0.5)

observeEvent(input$update_hsa, {
  hsa_et(input$eligibility_hsa)
  hsa_dt(input$determination_hsa)
})

hsa <- reactive({
  start_end() %>%
    filter(Measure == "Percent Structures more than 30 years old") %>%
    add_gentrification_label(input_eligibility = hsa_et(),
                             input_determination = hsa_dt())
})

tract_hsa <- reactive({tracts %>%
        filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
        left_join(.,hsa(), by = "GEOID") %>% st_as_sf()
      })

# Output
splitLayout(
  renderPlot({
    hsa() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_hsa()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
)
```

## Household Tenure

```{r ten, echo=FALSE}
inputPanel(
    sliderInput("eligibility_ten", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_ten", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_ten", "Update Thresholds")
  )

# Generate tenure data set

ten_et <- reactiveVal(0.5)
ten_dt <- reactiveVal(0.5)

observeEvent(input$update_ten, {
  ten_et(input$eligibility_ten)
  ten_dt(input$determination_ten)
})

ten <- reactive({
  start_end() %>%
    filter(Measure == "Households in neighborhood 10 years or less") %>%
    add_gentrification_label(input_eligibility = ten_et(),
                             input_determination = ten_dt())
})

tract_ten <- reactive({tracts %>%
        filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
        left_join(.,ten(), by = "GEOID") %>% st_as_sf()
      })

# Output
splitLayout(
  renderPlot({
    ten() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_ten()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
)
```

## Percent Above FPL

```{r fpl, echo=FALSE}
inputPanel(
    sliderInput("eligibility_pov", "Select Elgibility Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01), 
    
    sliderInput("determination_pov", "Select Determination Threshold",
                min = 0, max = 1, value = 0.5, step = 0.01),
    
    actionButton("update_pov", "Update Thresholds")
  )

# Generate tenure data set
fpl_et <- reactiveVal(0.5)
fpl_dt <- reactiveVal(0.5)

observeEvent(input$update_fpl, {
  fpl_et(input$eligibility_fpl)
  fpl_dt(input$determination_fpl)
})

pov <- reactive({
  start_end() %>%
    filter(Measure == "Percent Above Poverty") %>%
    add_gentrification_label(input_eligibility = fpl_et(),
                             input_determination = fpl_dt())
})

tract_pov <- reactive({tracts %>%
        filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
        left_join(.,pov(), by = "GEOID") %>% st_as_sf()
      })

# Output
splitLayout(
  renderPlot({
    pov() %>%
      plot_measure_scatter()
  }),
  
   renderTmap({
        tm_shape(tract_pov()) +
          tm_polygons(col = "Label", 
                      palette = gent_colors,
                      alpha = 0.4)
      })
) 
```

# Select Indicators

Selection of indicators should be guided by local expertise in identifying the relevant indicators of gentrification within that community.

Based on the @Bhavsar2020 paper, the following were the most commonly used indicators across 24 papers examined in a recent literature review.

| Indicator Type                       | N = 24 (%) |
|:-------------------------------------|:-----------|
| Median Household income              | 17 (70.8%) |
| Education                            | 17 (70.8%) |
| Rent                                 | 12 (50%)   |
| Home Value                           | 6 (25%)    |
| Race                                 | 6 (25%)    |
| Poverty                              | 4 (16.7%)  |
| Housing Stock Age                    | 3 (12.5%)  |
| Composite Measure (SEIFA, IMD, NCGS) | 3 (12.5%)  |
| Immigrant Population %               | 2 (8.4%)   |
| Occupation                           | 2 (8.4%)   |
| Residential Mobility                 | 2 (8.4%)   |

Some additional measures used (though only appearing once among the reviewed literature) included Non-family households, Owner Occupied, Unemployment, Dollar Amount for Improvement Loans, and Mean Dollar Amount of Home Loans.

Our tool defaults to the top 3 most frequently used indicators of gentrification, but includes the top 7 most commonly used indicators.

```{r, echo = FALSE}
checkboxGroupInput("measures",
                   label = "Select which measures you would like to include in your gentrification definition:",
                   choices = unique(data$Measure),
                   selected = unique(data$Measure)[1:3])



add_gentrification_label_full <- function(data, measure, input_eligibility, input_determination){
  data %>%
    mutate(Label = case_when(Measure == measure & `Rank Start` > input_eligibility ~ "Not Eligible",
                             Measure == measure & `Rank Start` <= input_eligibility & 
                               `Rank End` <= input_determination ~ "Still Susceptible",
                             Measure == measure & `Rank Start` <= input_eligibility & 
                               `Rank End` > input_determination ~ "Positive Indicator",
                             Measure != measure ~ Label))
}

start_end_labelled <- reactive({
  start_end() %>%
    mutate(Label = "")%>%
    add_gentrification_label_full("Median Rent", 
                                  input$eligibility_rent, 
                                  input$determination_rent) %>%
    add_gentrification_label_full("Median Household Income", 
                                  input$eligibility_mhi, 
                                  input$determination_mhi ) %>%
    add_gentrification_label_full("Percent with 4-year College Degree or More",
                                  input$eligibility_edu, 
                                  input$determination_edu) %>%
    add_gentrification_label_full("Median Home Value",
                                  input$eligibility_mhv, 
                                  input$determination_mhv) %>%
    add_gentrification_label_full("Percent Above Poverty",
                                  input$eligibility_pov, 
                                  input$determination_pov) %>%
    add_gentrification_label_full("Percent Non-Hispanic White",
                                  input$eligibility_nhw, 
                                  input$determination_nhw) %>%
    add_gentrification_label_full("Percent Structures more than 30 years old",
                                  input$eligibility_hsa, 
                                  input$determination_hsa) %>%
    add_gentrification_label_full("Households in neighborhood 10 years or less",
                                  input$eligibility_ten, 
                                  input$determination_ten) %>%
    filter(Measure %in% input$measures) %>%
    select(GEOID, STATE, NAME, Measure, Label) %>%
    spread(key = "Measure", value = "Label")
})

measures <- reactive({
  start_end_labelled() %>%
    mutate(`Positive Indicator` = as.integer(rowSums(. == "Positive Indicator")),
           `Not Eligible` = as.integer(rowSums(. == "Not Eligible")),
           `Still Susceptible` = as.integer(rowSums(. == "Still Susceptible")))
})


tract_measures <- reactive({tracts %>%
    filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
    left_join(.,measures(), by = "GEOID") %>% st_as_sf()
})

renderTmap({
  tm_shape(tract_measures()) +
    tm_polygons(col = "Still Susceptible",
                alpha = 0.5,
                palette = c("#FFFFFF", gent_colors[3]),
                legend.format = list(digits = 0)
    ) +
    tm_shape(tract_measures()) +
    tm_polygons(col = "Positive Indicator",
                alpha = 0.5,
                palette = c("#FFFFFF", gent_colors[2]),
                legend.format = list(digits = 0),
                popup.vars = c("Positive Indicator",
                               "Still Susceptible",
                               "Not Eligible"),
                popup.format = list(digits = 0))
}) 

renderDataTable(datatable({
  measures()
},
extensions = 'Buttons',
options = list(
  dom = 'lBtip',
  buttons = c('copy', 'excel', 'csv'),
  pageLength = 10,
  lengthMenu = list(c(10, 25, 50, -1),
                    c('10', '25', '50', 'All'))
),
class = "display"))
```

# Compare Results

Given the selected measures and thresholds to mark gentrification, this tool allows for comparisons with selected health outcomes.

The health outcomes data come from the <a href="https://www.cdc.gov/nchs/nvss/usaleep/usaleep.html" target="_blank">U. S. Small-area Life Expectancy Estimates Project (USALEEP)</a>, and from CDC's <a href="https://chronicdata.cdc.gov/browse?category=500+Cities+%26+Places&sortBy=newest&utf8" target="_blank">PLACES: Local Data for Better Health</a>.

To use this section, select a health outcome of interest from the drop-down list. The following visuals will display a map colored by the number and type of gentrification indicators, with bubbles representing the prevalence of the the selected health outcome.

The violin plots below show the relationship between the distribution of the chosen health outcome (Y-axis) and the number of Positive Gentrification Indicators (X-axis for the figure on the left) and the number of Still Eligible Gentrification Indicator (X-axis for the figure on the right).

```{r, echo = FALSE}
outcomes <- outcomes %>%
  select(GEOID, `Life Expectancy`,
         BINGE, CSMOKING, BPHIGH, CANCER, CASTHMA, DIABETES, HIGHCHOL, MHLTH, PHLTH, LPA, SLEEP, ACCESS2, DENTAL) %>%
  unique()

colnames(outcomes) <- c("GEOID",
                        "Life Expectancy",
                        "Binge Drinking",
                        "Current Smoker",
                        "High Blood Pressure",
                        "Cancer",
                        "Asthma",
                        "Diabetes",
                        "High Cholesterol",
                        "Poor Mental Health",
                        "Poor Physical Health",
                        "Limited Physical Activity",
                        "Insufficient Sleep",
                        "Uninsured",
                        "Dental Visits")

outcomes <- outcomes %>%
  gather(key = "Health Outcomes",
         value = "Prevalence",
         -GEOID, na.rm = TRUE)


inputPanel(
    selectInput("brfss", 
                label = "Choose a Health Outcome to Explore:",
                choices = unique(outcomes$`Health Outcomes`),
                selected = "Binge Drinking"
                )
  )

outcomes_measures <- reactive({
  measures() %>%
    left_join(outcomes, by = "GEOID") %>%
    filter(`Health Outcomes` == input$brfss)
})

tracts_outcomes_measures <- reactive({
  tracts %>%
        filter(STATEFP == fips()$state_code,
           NAME %in% fips()$PLACE) %>%
        merge(.,outcomes_measures(), by = "GEOID") %>% st_as_sf()

})

renderTmap({

  tm_shape(tract_measures()) +
    tm_polygons(col = "Still Susceptible",
                alpha = 0.5,
                palette = c("#FFFFFF", gent_colors[3]),
                legend.format = list(digits = 0)
                ) +
    tm_shape(tract_measures()) +
    tm_polygons(col = "Positive Indicator",
                alpha = 0.5,
                palette = c("#FFFFFF", gent_colors[2]),
                legend.format = list(digits = 0),
                popup.vars = c("Positive Indicator",
                               "Still Susceptible",
                               "Not Eligible"),
                popup.format = list(digits = 0)) +
    tm_shape(tracts_outcomes_measures()) +
    tm_bubbles(col = "Prevalence",
               size = "Prevalence",
               palette = "Greens",
               alpha = 0.5,
               scale = 0.5)
})

splitLayout(
  renderPlot({
    
    counts <- outcomes_measures() %>%
      group_by(`Positive Indicator`) %>%
      summarize(n = n(),
                Prevalence = mean(Prevalence, na.rm = T))
    
    outcomes_measures() %>%
      ggplot(aes(y = Prevalence, 
                 x = factor(`Positive Indicator`))) +
      geom_violin(aes(fill = factor(`Positive Indicator`)),
                  alpha = 0.6, 
                  color = "white",
                  show.legend = FALSE) +
      geom_text(data = counts, aes(label = n)) +
      labs(x = "Number of Positive Indicators of Gentrification",
           y = paste("Prevalence"),
           title = paste(input$brfss, "by # of Gentrification Indicators"))
  }),
  
  renderPlot({
    
    counts <- outcomes_measures() %>%
      group_by(`Still Susceptible`) %>%
      summarize(n = n(),
                Prevalence = mean(Prevalence, na.rm = T))
    
    outcomes_measures() %>%
      ggplot(aes(y = Prevalence,
                 x = factor(`Still Susceptible`))) +
      geom_violin(aes(fill = factor(`Still Susceptible`)),
                  alpha = 0.6, 
                  color = "white",
                  show.legend = FALSE) +
      geom_text(data = counts, aes(label = n)) +
      labs(x = "Number of Still Susceptible Indicators of Gentrification",
           y = paste("Prevalence"),
           title = paste(input$brfss, "by # of Susceptibility Indicators"))
  })
)

```

# Evaluate Methods

## Moran's I

Moran's I is a measure of spatial autocorrelation, or in this context, how similar one tract is to its neighbors. Moran's I can take on values between [-1, 1], such that a value of

-   -1: indicates a **dispersed** spatial process (imagine checkerboard)
-   0: indicates a **random** spatial process (imagine TV static)
-   1: indicates a **clustered** spatial process (imagine circle on a background)

With the selected gentrification indicators defined above, we can examine Moran's I values for our gentrified labels.

In the context of this tool, we are testing the null hypothesis that the number of gentrification indicators is randomly dispersed (I = 0).

```{r, echo = FALSE}
cent <- reactive({

  cent <- st_centroid(tract_measures()$geometry)
  
  lat_list = tibble(lat = 0)
  lon_list = tibble(lon = 0)
  
  for (i in 1:length(cent)) {
    lat <- cent[[i]][1]
    lon <- cent[[i]][2]
    
    lat_list <- rbind(lat_list, lat)
    lon_list <- rbind(lon_list, lon)
  }
  
  lat <- lat_list[-1,]
  lon <- lon_list[-1,]
  
  return(cbind(lat, lon))
})

morans_i <- reactive({
  dist <- as.matrix(dist(cent()))
  dist.inv <- 1/dist
  diag(dist.inv) <- 0
  ape::Moran.I(tract_measures()$`Positive Indicator`, dist.inv, na.rm = TRUE)
})

interpretation_observed <- reactive({
  case_when(
    morans_i()$observed >= 0.75 ~ "This inidcates that the distribution of gentrification indicators is a highly clustered spatial process.",
    morans_i()$observed >= 0.25 &
      morans_i()$observed < 0.75 ~ "This indicates that the distribution of gentrification indicators is a moderately clustered spatial process.",
    morans_i()$observed > 0 &
      morans_i()$observed < 0.25 ~ "This indicates that the distribution of gentrification indicators is a slightly clustered spatial process, though close to random.",
    morans_i()$observed == 0 ~ "This indicates that the distribution of gentrification indicators is a highly random spatial process.",
    morans_i()$observed >= -0.25 &
      morans_i()$observed < 0 ~ "This indicates that the distribution of gentrification indicators is a slightly dispersed spatial process, though close to random.",
    morans_i()$observed >= -0.75 &
      morans_i()$observed < -0.25 ~ "This indicates that the distribution of gentrification indicators is a moderately dispersed spatial process.",
    morans_i()$observed < -0.75 ~ "This indicates that the distribution of gentrification indicators is a highly dispersed spatial process"
  )
})


interpretation_pvalue <- reactive({
  ifelse(
    morans_i()$p.value < 0.05,
    "At a signficance level of 0.05, we would reject the null hypothesis that the number of gentrification indicators is randomly dispersed.",
    "At a signficance level of 0.05, we would fail to reject the null hypothesis that the number of gentrification indicators is randomly dispersed."
  )
})

renderText(paste(
  "The P-value is: ",
  morans_i()$p.value,
  interpretation_pvalue()
))


renderText(paste(
  "The observed value for Moran's I is: ",
  round(morans_i()$observed, 2),
  interpretation_observed()
))

```

## Urban Displacement Typologies

Compare your selected method with Urban Displacement's Typologies.

```{r, echo = FALSE}
## TODO download csvs from gitlab and read from files
udp_gitlab <- "raw data/UrbanDisplacementTypologies/"

inputPanel(
  selectInput("udp_city", 
                label = "Choose a City to compare your selected method with classifications :",
                choices = c("Atlanta", "Chicago", "Denver", "Los Angeles", "San Francisco", "Seattle"), 
                selected = "Atlanta")
)

# Read in different .csv depending on input city
get_udp_data <- reactive({
  if (input$udp_city == "Atlanta") {
    data <- read.csv(
        file.path(udp_gitlab, "atlanta.csv"),
        colClasses = c("character", "character")
    )
  } else if (input$udp_city == "Chicago") {
    data <- read.csv(
        file.path(udp_gitlab, "chicago.csv"),
        colClasses = c("character", "character")
    )
  } else if (input$udp_city == "Denver") {
    data <- read.csv(
        file.path(udp_gitlab, "denver.csv"),
        colClasses = c("character", "character")
    )
  } else if (input$udp_city == "Los Angeles") {
    data <- read.csv(
        file.path(udp_gitlab, "losangeles.csv"),
        colClasses = c("character", "character")
    )
  } else if (input$udp_city == "San Francisco") {
    data <- read.csv(
        file.path(udp_gitlab, "sanfrancisco.csv"),
        colClasses = c("character", "character")
    )
  } else if (input$udp_city == "Seattle") {
    data <- read.csv(
        file.path(udp_gitlab, "seattle.csv"),
        colClasses = c("character", "character")
    )
  } 
  
  return(data)
})

# filter data based on year selection in the orignal input and geography selections from the UDP selected geography
start_udp <- reactive({
  data %>%
    filter(YEAR == input$range[1],
           GEOID %in% get_udp_data()$GEOID) %>% 
  group_by(YEAR, Measure) %>%
  mutate(Rank = percent_rank(Value)) %>%
  ungroup()})

end_udp <- reactive({
  data %>%
    filter(YEAR == input$range[2],
           GEOID %in% get_udp_data()$GEOID) %>% 
  group_by(YEAR, STATE, Measure) %>%
  mutate(Rank = percent_rank(Value)) %>%
  ungroup()
})

start_end_udp <- reactive({
  inner_join(start_udp(), end_udp(),
               by = c("GEOID", "Measure"),
               suffix = c(" Start", " End")
  )
})

start_end_labelled_udp <- reactive({
  start_end_udp() %>%
    mutate(Label = "")%>%
    add_gentrification_label_full("Median Rent", 
                                  input$eligibility_rent, 
                                  input$determination_rent) %>%
    add_gentrification_label_full("Median Household Income", 
                                  input$eligibility_mhi, 
                                  input$determination_mhi ) %>%
    add_gentrification_label_full("Percent with 4-year College Degree or More",
                                  input$eligibility_edu, 
                                  input$determination_edu) %>%
    add_gentrification_label_full("Median Home Value",
                                  input$eligibility_mhv, 
                                  input$determination_mhv) %>%
    add_gentrification_label_full("Percent Above Poverty",
                                  input$eligibility_pov, 
                                  input$determination_pov) %>%
    add_gentrification_label_full("Percent Non-Hispanic White",
                                  input$eligibility_nhw, 
                                  input$determination_nhw) %>%
    add_gentrification_label_full("Percent Structures more than 30 years old",
                                  input$eligibility_hsa, 
                                  input$determination_hsa) %>%
    add_gentrification_label_full("Households in neighborhood 10 years or less",
                                  input$eligibility_ten, 
                                  input$determination_ten) %>%
    filter(Measure %in% input$measures) %>%
    select(GEOID, Measure, Label) %>%
    unique() %>%
    pivot_wider(names_from = Measure, 
                values_from = Label)
    
})

measures_udp <- reactive({
  start_end_labelled_udp() %>%
    mutate(`Positive Indicator` = as.integer(rowSums(. == "Positive Indicator")),
           `Not Eligible` = as.integer(rowSums(. == "Not Eligible")),
           `Still Susceptible` = as.integer(rowSums(. == "Still Susceptible")))
})



tract_measures_udp_matched <- reactive({
  tracts %>%
    filter(GEOID %in% get_udp_data()$GEOID) %>%
    left_join(.,measures_udp(), by = "GEOID") %>% st_as_sf()
})

tract_measures_udp_original <- reactive({
  tracts %>%
    filter(GEOID %in% get_udp_data()$GEOID) %>%
    left_join(., get_udp_data(), by = "GEOID") %>% st_as_sf()
})

displacement_typologies_pal <- 
        c(
            # '#e3dcf5',
            '#87CEFA',#cbc9e2', # "#f2f0f7", 
            '#6495ED',#5b88b5', #"#6699cc", #light blue              
            '#9e9ac8', #D9D7E8', #"#cbc9e2", #D9D7E8     
            # "#9e9ac8",
            '#756bb1', #B7B6D3', #"#756bb1", #B7B6D3
            '#54278f', #8D82B6', #"#54278f", #8D82B6
            '#FBEDE0', #"#ffffd4", #FBEDE0
            # '#ffff85',
            '#F4C08D', #"#fed98e", #EE924F
            '#EE924F', #"#fe9929", #EE924F
            '#C95123', #"#cc4c02", #C75023
            "#8f8f8f", # High student pop
            "#C0C0C0"
    )

renderDataTable(
  datatable({
    start_end_labelled_udp()
    })
  )

renderTmap({
  tm_shape(tract_measures_udp_matched()) +
    tm_polygons(
      col = "Still Susceptible",
      alpha = 0.5,
      palette = c("#FFFFFF", gent_colors[3]),
      legend.format = list(digits = 0)
    ) +
    tm_shape(tract_measures_udp_matched()) +
    tm_polygons(
      col = "Positive Indicator",
      alpha = 0.5,
      palette = c("#FFFFFF", gent_colors[2]),
      legend.format = list(digits = 0),
      popup.vars = c("Positive Indicator",
                     "Still Susceptible",
                     "Not Eligible"),
      popup.format = list(digits = 0)
    )
})


renderTmap({
  tm_shape(tract_measures_udp_original()) +
    tm_polygons(col = "Typology",
                alpha = 0.5,
                palette = displacement_typologies_pal)
})
```

```{r, echo = FALSE}

inputPanel(
  selectInput("udp_typology", 
                label = "Choose a UDP Typology to compare how your selected method relates:",
                choices = c("Advanced Gentrification",
                            "Stable Moderate/Mixed Income",           
                            "At Risk of Gentrification",           
                            "Low-Income/Susceptible to Displacement",
                            "At Risk of Becoming Exclusive",          
                            "Stable/Advanced Exclusive",              
                            "Early/Ongoing Gentrification",
                            "Ongoing Displacement", 
                            "Unavailable or Unreliable Data",
                            "High Student Population",
                            "Becoming Exclusive"), 
                selected = "Advanced Gentrification")
)

udp_type_matrix <- reactive({
  
  df <- get_udp_data() %>%
    left_join(measures_udp(), by = "GEOID")
  
  ss <- df %>% filter(Typology == input$udp_typology) %>%
    group_by(`Still Susceptible`) %>%
    count() %>%
    rename(n_indicator = `Still Susceptible`,
           `Still Susceptible` = n)
  
  
  ne <- df %>% filter(Typology == input$udp_typology) %>%
    group_by(`Not Eligible`) %>%
    count() %>%
    rename(n_indicator = `Not Eligible`,
           `Not Eligible` = n)
  
  pi <- df %>% filter(Typology == input$udp_typology) %>%
    group_by(`Positive Indicator`) %>%
    count() %>%
    rename(n_indicator = `Positive Indicator`,
           `Positive Indicator` = n)
  
  full_join(ss, ne, by = "n_indicator") %>%
    full_join(pi, by = "n_indicator") %>%
    filter(!is.na(n_indicator)) %>%
    arrange(n_indicator) %>%
    mutate_at(c("Still Susceptible", "Not Eligible", "Positive Indicator"),
              replace_na,
              0) %>%
    rename(
      "Number of Indicators" = n_indicator
    ) 
})

renderPlot({
  udp_type_matrix() %>%
    gather(key = "Indicator Type",
           value = "Number of Tracts",
           -`Number of Indicators`) %>%
    ggplot(aes(y = `Number of Indicators`,
               x = `Indicator Type`,
               fill = `Number of Tracts`)) +
    geom_tile() +
    geom_text(aes(label = `Number of Tracts`), color = "black") +
    scale_fill_gradient(low = "lightgray", high = "steelblue") +
    theme_minimal() +
    labs(title = input$udp_typology)
})

```

<hr>

<hr>