How to Load Initial Data Before Clicking on Leaflet Polygon?

shiny
4

This is close, but not quite right. Something weird happens when you click on the map when the state is DC. But it should get you closer anyway.

# Run the application
shinyApp(ui = ui, server = server)
library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(leaflet)
library(raster)
library(stringr)
library(dplyr)

# table data --------
state_name<-c('Delaware','Delaware','Delaware','District of Columbia')
fips<-c(10001,10003,10005,11001)
county_name<-c('Kent County','New Castle County','Sussex County','District of Columbia')
df <- as.data.frame(cbind(state_name,fips,county_name)) %>%
  as_tibble()

# Get USA polygon data ---------
USA <- getData("GADM", country = "usa", level = 2)
USA$CountyName <- str_c(USA$NAME_2, ' ', USA$TYPE_2)
state_select <- unique(df$state_name)

# initial choices
initial_counties <- subset(df, df$state_name == "Delaware")$county_name

# Define UI for application ---------
ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title=""),
    dashboardSidebar(
      sidebarMenu(
        menuItem("State Results",
                 tabName = "sta_results",
                 icon=icon("map-marker-alt")
        )
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(
          tabName = "sta_results",
          fluidRow(align="center",
                   column(width=12,
                          selectInput(inputId = "state_select1",
                                      label="Select a state:",
                                      choices=as.list(state_select),
                                      selected = state_select[1]),
                          selectInput(inputId = "county_select1",
                                      label="Select a county:",
                                      choices= initial_counties,
                                      selected = initial_counties[1])
                   )
          ),
          fluidRow(align='center',valueBoxOutput("vbox0",width=12)),
          fluidRow(
            align='center',
            leafletOutput("state_results")
          )
        )
      )
    )))
# Define server logic -------------
server <- function(input, output, session) {
  #Create Datasets to use for mapping
  filter <- reactive({
    temp <- merge(USA, df,
                  by.x = c("NAME_1", "CountyName"),
                  by.y = c("state_name", "county_name"),
                  all.x = TRUE)
  })
  
  # Filter down to just state level data
  state_filter=reactive({
    filter=subset(filter(),NAME_1==input$state_select1)
    return(filter)
  })
  
  #Filter the United States map down to one state
  just_the_map=reactive({
    filter=subset(USA,NAME_1==input$state_select1)
    return(filter)
  })
  
  # reactive text
  rv <- reactiveValues()
  
  #Grab the county filtered data
  just_the_county <- reactive({
    req(rv$county)
    county_data <-subset(df,df$state_name==input$state_select1)
    county_data <-subset(county_data,county_data$county_name==rv$county)
    return(county_data)
  })
  
  output$vbox0 <- renderValueBox({
    valueBox(value = input$county_select1,
             subtitle = '',
             color = "light-blue"
    )
  })
  output$state_results <-renderLeaflet({
    leaflet() %>%
      addProviderTiles("OpenStreetMap.Mapnik") %>%
      addPolygons(data = just_the_map(), stroke = TRUE, weight = 0.9,
                  smoothFactor = 0.2, fillOpacity = 0.3,
                  layerId = ~CountyName,
                  popup = paste("County: ", state_filter()$CountyName))
  })
  
  # update county options on state select
  observeEvent(input$state_select1,{
    choices <- subset(df, df$state_name == input$state_select1)$county_name
    updateSelectInput(session,
                      "county_select1",
                      choices = choices,
                      selected = choices[1])
    rv$county <- input$county_select1
  })
  
  # update county on map click
  observeEvent(input$state_results_shape_click,{
    rv$county <- input$state_results_shape_click$id
    choices <- subset(df, df$state_name == input$state_select1)$county_name
    updateSelectInput(session,
                      "county_select1",
                      selected = input$state_results_shape_click$id)
  })
}

# Run the application
shinyApp(ui = ui, server = server)

It sort of comes from here: Select polygon by clicking on map, changing item selected via dropdown

1 Like