shiny-happy-hour-address-lookup.R

library(tidyverse)
library(tidycensus)
library(leaflet)
library(sf)
library(shiny)
library(ggmap)
library(htmltools)


# Data --------------------------------------------------------------------


var_name_median_hh_income <- "B19013_001"

median_hh_income <- tidycensus::get_acs(
  geography = "tract", 
  variables = var_name_median_hh_income, 
  year = 2019, 
  cache_table = TRUE, 
  state = "OR", 
  county = "Multnomah", 
  survey = "acs5", 
  geometry = TRUE
)


median_hh_income <- median_hh_income %>% 
  select(GEOID, median_hh_income = estimate) %>% 
  filter(!is.na(median_hh_income))

multnomah_county_tracts <- sort(median_hh_income$GEOID)
median_hh_income <- st_transform(median_hh_income, crs = 4326)


# Functions ---------------------------------------------------------------


make_map <- function(data_to_map, address) {
  
  tract_pal <- colorNumeric(palette = "Blues", domain = data_to_map$median_hh_income, na.color = NA)
  tract_label <- as.list(paste0(
    "Median Household Income: ", scales::dollar(data_to_map$median_hh_income)
  ))
  
  if (address == "") {
    
    map_output <- data_to_map %>% 
      leaflet() %>% 
      addTiles() %>% 
      addPolygons(
        stroke = TRUE,
        color = "black",
        weight = 0.9,
        smoothFactor = 0.2,
        opacity = 2,
        fillOpacity = 0.75,
        fillColor = ~tract_pal(median_hh_income),
        label = lapply(tract_label, HTML),
        highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = TRUE)
      ) %>% 
      addLegend("bottomright",
                pal = tract_pal,
                values = ~median_hh_income,
                title = "Median Household Income (2019)",
                labFormat = labelFormat(
                  prefix = "$", suffix = "", between = " "
                ),
                opacity = 1)
  }
  
  else if (address != "") {
    
    geocoded_address <- ggmap::geocode(address, source = "google")
    
    map_output <- data_to_map %>% 
      leaflet() %>% 
      setView(lng = geocoded_address$lon, lat = geocoded_address$lat, zoom = 14) %>% 
      addTiles() %>% 
      addPolygons(
        stroke = TRUE,
        color = "black",
        weight = 0.9,
        smoothFactor = 0.2,
        opacity = 2,
        fillOpacity = 0.75,
        fillColor = ~tract_pal(median_hh_income),
        label = lapply(tract_label, HTML),
        highlightOptions = highlightOptions(color = "white", weight = 2, bringToFront = TRUE)
      ) %>% 
      addLegend("bottomright",
                pal = tract_pal,
                values = ~median_hh_income,
                title = "Median Household Income (2019)",
                labFormat = labelFormat(
                  prefix = "$", suffix = "", between = " "
                ),
                opacity = 1)
  }
  
  return(map_output)
  
}




# Javascript --------------------------------------------------------------


js_code <- '
$(document).on("keyup", function(e) {
if(e.keyCode == 13){
Shiny.onInputChange("keyPressed", Math.random());
}
});
'


# UI ----------------------------------------------------------------------



ui <- fluidPage(
  sidebarLayout(
    sidebarPanel = sidebarPanel(
      textInput(
        inputId = "user_address", 
        label = "Enter Address to Center Map" ,
        value = "",
        placeholder = "Ex: 222 SW Columbia St, Portland OR"
      )
    ),
    mainPanel = mainPanel(
      leaflet::leafletOutput(outputId = "median_hh_income_map", width = 500, height = 800),
      tags$script(js_code)
    )
  )
)


# Server ------------------------------------------------------------------


server <- function(input, output, session) {
  
  # observe the event of a user inputting a search to the address bar
  reactive_address <- reactiveVal(value = "")
  
  observeEvent(
    input$keyPressed,
    {
      reactive_address(input$user_address)
    }
  )
  
  output$median_hh_income_map <- renderLeaflet({
    make_map(data_to_map = median_hh_income, address = reactive_address())
  })
  
}


# Run App -----------------------------------------------------------------


shinyApp(ui, server)

Marley...thank you for this.