How to Load Initial Data Before Clicking on Leaflet Polygon?

shiny
1

I am working on a project that involves analyzing county level data on maps. I have this minimal example of my map where I have a dropdown box that allows a user to select a state.

There is a value box above the map that first appears blank, but if the user clicks on a county, the county name appears in the value box. If I switch over to a different state, the last selected county remains in the box.

I want to be able to have the first county alphabetically within a state show up in the value box when a state is selected (including when the page is first loaded before anything is clicked).

For example, when the page first loads, I want to see 'Kent County' and then when switching to the District of Columbia, I want to see 'District of Columbia' show up in the box.

Here is my code so far:

library(shiny)
library(shinydashboard)
library(ggplot2)
library(plotly)
library(leaflet)
library(raster)
library(stringr)
library(dplyr)

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))
df <- as_tibble(df)

# 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)

# 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])
                             )
                             
                    ),
                    fluidRow(align='center',valueBoxOutput("vbox0",width=12)),
     
                    fluidRow(
                        align='center',
                        leafletOutput("state_results")
                        )
                    )
                    
                )
            )))

# Define server logic 
server <- function(input, output) {
    
    #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 = paste(rv$county),
                 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 on map click
    observe({ 
        rv$county <- input$state_results_shape_click$id
        
    })
    
}

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

I'm not sure how to proceed. Any help would be appreciated! Thank you!

2

You could add this to get the values to update when you click. There are probably better ways of doing it too.

There are ways to get the county names on loading, but I can't think of any right now.

# observe the state 
  observeEvent(input$state_select1, {
    
    if(input$state_select1 == "Delaware"){
      rv$county <- "Kent County"
    } else {
      rv$county <- "District of Columbia District"
    }
    
  })
3

Thanks @williaml ! I tried your solution, but I found that when Delaware is selected, "Kent County" shows up no matter which county is clicked. Is there a way to set something like a "starting" county before anything is clicked, but also allow the valuebox to update once a county is clicked?

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
5

Thank you @williaml ! This solution was what I was looking for! Thank you!

1 Like
6

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.