Subset a dataframe based on leaflet click event and shiny widgets

Question

I have the dataframe below

    df_1<-structure(list(`Indicator Name` = c("primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary", "primary", 
"primary", "primary", "primary", "primary", "primary"), Geography = c("Alameda", 
"Alpine", "Amador", "Butte", "Calaveras", "Colusa", "Contra Costa", 
"Del Norte", "El Dorado", "Fresno", "Glenn", "Humboldt", "Imperial", 
"Inyo", "Kern", "Kings", "Lake", "Lassen", "Los Angeles", "Madera", 
"Marin", "Mariposa", "Mendocino", "Merced", "Modoc", "Mono", 
"Monterey", "Napa", "Nevada", "Orange", "Placer", "Plumas", "Riverside", 
"Sacramento", "San Benito", "San Bernardino", "San Diego", "San Francisco", 
"San Joaquin", "San Luis Obispo", "San Mateo", "Santa Barbara", 
"Santa Clara", "Santa Cruz", "Shasta", "Sierra", "Siskiyou", 
"Solano", "Sonoma", "Stanislaus"), Year = c("2008", "2008", "2008", 
"2008", "2008", "2008", "2008", "2008", "2008", "2008", "2008", 
"2008", "2008", "2008", "2008", "2008", "2008", "2008", "2008", 
"2008", "2008", "2008", "2008", "2008", "2008", "2008", "2008", 
"2008", "2008", "2008", "2008", "2008", "2008", "2008", "2008", 
"2008", "2008", "2008", "2008", "2008", "2008", "2008", "2008", 
"2008", "2008", "2008", "2008", "2008", "2008", "2008"), Category = c("Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population", "Total Population", "Total Population", "Total Population", 
"Total Population"), Subcategory = c("Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population", 
"Total population", "Total population", "Total population", "Total population"
), Rate = c(60.5, 0, 0, 52.7, 0, 0, 52.7, 0, 0, 50.8, 0, 0, 40.9, 
0, 51.5, 0, 0, 0, 54.5, 37.6, 46.4, 0, 0, 67.5, 0, 0, 60, 92.4, 
0, 41.8, 28.4, 0, 42, 44.7, 0, 45.2, 46.2, 58.9, 40.5, 42, 42.1, 
39, 50.9, 30.8, 46.3, 0, 0, 61.5, 51.4, 20.2), State = c("California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California", "California", 
"California", "California", "California", "California")), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -50L))

I want when the app starts to display a map with the selected from the widget counties and also a table below.

Then if I click on a county on the map the table to be affected and show only the data from the clicked county also the shiny widget should show only the selected county and affects accordingly the rest of the widgets.

Then if I select more counties again from the shiny widget the map and the table and the widgets should be affected accordingly.

Now the map is displayed only after clicking on the Counties widget at the beginning. Also when I click on the map to select specific county I get error Error in <Anonymous>: error in evaluating the argument 'x' in selecting a method for function 'subset':

#app

library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(sp)
library(rgeos)
library(rgdal)
library(maptools)
library(scales)
library(raster)
library(viridis)
library(shinydashboard)
library(plotly)
library(shinyWidgets)
library(tidyverse)
library(maps)
library(DT)

                                                                                                                                                                                                                                                                                                   "tbl", "data.frame"), row.names = c(NA, -50L))
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

#dashboard
ui <- dashboardPage(skin = "blue",
                    
                    dashboardHeader(title="Mock up"),
                    #sidebar  
                    dashboardSidebar(
                      collapsed = T
                    ),
                    #body
                    dashboardBody(
                      fluidRow(
                        pickerInput(
                          inputId = "daterange3",
                          label = "",
                          choices = unique(df_1$Year),
                          selected = unique(df_1$Year)[1],
                          
                        ),
                               uiOutput("rg"), uiOutput("rt"),uiOutput("ci"),uiOutput("to")
                      ),
                      leafletOutput("map",height = 640),
                      dataTableOutput("plot5"),
                        
                                 )
                      )

#server part
server <- function(input, output,session) {
  
  
  #subset dataset based on year
  df0<-reactive({
    df<-subset(df_1,Year%in%input$daterange3)
  })
  
  
  #calls region
  output$rg<-renderUI({
    pickerInput(
      inputId = "p3",
      label = "Region",
      choices = sort(unique(df_1$State)),
      selected=unique(df_1$State)[1],
      width = "150px"  # Set the width to 300 pixels
    )
  })
  #subset dataset based on year and state
  df1<-reactive({
    df<-subset(df_1,Year%in%input$daterange3&State%in%input$p3)
  })
  #calls county
  output$rt<-renderUI({
    req(df1())
    pickerInput(
      inputId = "p7",
      label = "County",
      choices = unique(df1()$Geography),
      width = "150px",  # Set the width to 300 pixels
      
      selected = unique(df1()$Geography),
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None",
        `select-all-text` = "All",
        `none-selected-text` = "zero"
      )
    )
  })
  #resubset dataset based on year county region
  
  df7<-reactive({
    df<-subset(df_1,Year%in%input$daterange3&State%in%input$p3&Geography%in%input$p7)
  })
  
  output$ci<-renderUI({
    req(df7())
    
    pickerInput( 
      inputId = "p12",
      label = "Indicator Name",
      choices = unique(df7()$`Indicator Name`),
      width = "150px",  # Set the width to 300 pixels
      
      selected = unique(df7()$`Indicator Name`),
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None",
        `select-all-text` = "All",
        `none-selected-text` = "zero"
      )
    )
  }) 
  
  #final
  dfpls<-reactive({
    df<-subset(df_1,Year%in%input$daterange3&State%in%input$p3&Geography%in%input$p7&`Indicator Name`%in%input$p12)
    df
  })
  
  #calls tp
  output$to<-renderUI({
    req(dfpls())
    
    d<-subset(dfpls(),Category=="Total Population"|Category=="Total population")
    pickerInput( 
      inputId = "p17",
      label = "Total Population",
      choices = unique(d$Subcategory),
      width = "150px",  # Set the width to 300 pixels
      
      selected = unique(d$Subcategory),
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None",
        `select-all-text` = "All",
        `none-selected-text` = "zero"
      )
    )
  }) 

  #final
  dfpls2<-reactive({
    req(dfpls())
    
    df2<-subset(dfpls(),Subcategory%in%input$p17)
    df2
  })
  
  temp <- reactive({
    req(dfpls2())
    
    sp::merge(USA, dfpls2(), duplicateGeoms = TRUE, by.x = c("NAME_1","NAME_2"), by.y = c("State","Geography"))})
  dfpls3<- eventReactive(input$p7, {
    df<- subset(temp(),NAME_2%in%input$p7)
    df
  })
  #calls map
  output$map<-renderLeaflet({
    req(dfpls3())
    
    #
    states <- unique(df_1$State)
    temp <- subset(dfpls3(), NAME_1 %in% states)
    
    oh_sp <- temp[temp$NAME_1 == input$p3, ]
    names(oh_sp)[1] <-"State"
    names(oh_sp)[2] <-"County"
    # Determine the maximum value excluding NA values
    max_value <- max(oh_sp$Rate, na.rm = TRUE)
    
    # Calculate the maximum value rounded up to the nearest multiple of 20
    max_rounded <- ceiling(max_value / 9) 
    
    # Create the bins vector
    bins <- c(seq(0, max_value, by = max_rounded), max_value)
    pal <- colorBin("Blues", domain = as.numeric(oh_sp$Rate), bins = bins)
    
    leaflet(oh_sp) %>%
      setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(
        fillColor = ~pal(Rate),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        layerId = temp$County,
        
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE)
      )
  })
  
  
  observeEvent(input$map_shape_click,{
    click_county <- input$map_shape_click
    choices <- unique(df_1$Geography)
    selected <- click_county$id
    updatePickerInput(session = session,"p7",choices=choices, selected=selected)
  },ignoreNULL = TRUE)
  
  # Create a reactive subset of data based on selected county
  selected_county_data <- reactive({
    req(dfpls3())
    
    click_county <- input$map_shape_click
    states <- unique(df_1$State)
    dfa <- as.data.frame(dfpls3())
    if (is.null(click_county)) {
      df <- dfa[dfa$NAME_1 %in% states,]
    } else {
      clicked_county <- click_county$id
      df <- subset(dfa, NAME_1 %in% states &  NAME_2 %in% input$p7)
    }
    df
  })
  
  output$plot5<-renderDataTable({
    req(selected_county_data())
    f<-selected_county_data()
    datatable(f)
  })
  
}

shinyApp(ui, server)

choices = unique(d$Subcategory) cannot work as there is no Subcategory in your sample dataframe df_1. — YBS, Commented Aug 31, 2023 at 2:45
Use req(), that is req(df1()) while defining output$rt and all other reactive objects or output objects. — YBS, Commented Aug 31, 2023 at 3:49
I have updated code and dataframe based on your suggestion but still facing the same issues — firmo23, Commented Aug 31, 2023 at 8:09
maybe the issue is that the shiny widgets are all related one to the other?the rest of the code follows the logic of your previous answer — firmo23, Commented Aug 31, 2023 at 8:30

YBS · Accepted Answer · 2023-08-31 12:47:21Z

The map is displayed now. However, when you click on a county the table does not appear. I am hoping you can fix that part.

df_1$Subcategory <- c(rep(LETTERS[1:10],5))
df_1$State <- c(rep("California",50))
df_1$Rate <- c(rep(50,50))

library(shiny)
library(leaflet)
library(sf)
library(dplyr)
library(sp)
library(rgeos)
library(rgdal)
library(maptools)
library(scales)
library(raster)
library(viridis)
library(shinydashboard)
library(plotly)
library(shinyWidgets)
library(tidyverse)
library(maps)
library(DT)
# Get USA polygon data
USA <- getData("GADM", country = "usa", level = 2)

#dashboard
ui <- dashboardPage(skin = "blue",
                    
                    dashboardHeader(title="Mock up"),
                    #sidebar  
                    dashboardSidebar(
                      collapsed = T
                    ),
                    #body
                    dashboardBody(
                      fluidRow( column(2,
                        pickerInput(
                          inputId = "daterange3",
                          label = "",
                          choices = unique(df_1$Year),
                          selected = unique(df_1$Year)[1]
                          
                        ),
                        uiOutput("rg"), 
                        uiOutput("rt"),
                        uiOutput("ci"),
                        uiOutput("tp")
                      ),
                      column(9, # DTOutput("test"),
                        leafletOutput("map",height = 640),
                        dataTableOutput("plot5"),
                      )
                    ))
)

#server part
server <- function(input, output,session) {
  
  
  #subset dataset based on year
  df0<-reactive({
    subset(df_1,Year %in% input$daterange3)
  })
  
  
  #calls region
  output$rg<-renderUI({
    pickerInput(
      inputId = "p3",
      label = "Region",
      choices = sort(unique(df_1$State)),
      selected=unique(df_1$State)[1],
      width = "150px"  # Set the width to 300 pixels
    )
  })
  #subset dataset based on year and state
  df1<-reactive({
    req(input$p3)
    subset(df_1,Year %in% input$daterange3 & State %in% input$p3)
  })
  #calls county
  output$rt<-renderUI({
    req(df1())
    pickerInput(
      inputId = "p7",
      label = "County",
      choices = unique(df1()$Geography),
      width = "150px",  # Set the width to 300 pixels
      
      selected = unique(df1()$Geography),
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None",
        `select-all-text` = "All",
        `none-selected-text` = "zero"
      )
    )
  })
  #resubset dataset based on year county region
  
  df7<-reactive({
    req(input$p3, input$p7)
    df<-subset(df_1,Year %in% input$daterange3 & State %in% input$p3 & Geography %in% input$p7)
    df
  })
  
  output$ci<-renderUI({
    req(df7())
    pickerInput( 
      inputId = "p12",
      label = "Indicator Name",
      choices = unique(df7()$`Indicator Name`),
      width = "150px",  # Set the width to 300 pixels
      
      selected = unique(df7()$`Indicator Name`),
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None",
        `select-all-text` = "All",
        `none-selected-text` = "zero"
      )
    )
  }) 
  
  # final
  dfpls <- reactive({
    req(input$p3, input$p7, input$p12)
    df<-subset(df_1, Year %in% input$daterange3 & State %in% input$p3 & Geography %in% input$p7 & `Indicator Name` %in% input$p12)
    as.data.frame(df)
  })
  
  # calls tp
  output$tp <- renderUI({
    req(dfpls())
    d <- subset(dfpls(), (Category=="Total Population" | Category=="Total population"))
    choices = unique(d$Subcategory)
    pickerInput( 
      inputId = "p17",
      label = "Total Population",
      choices = choices,
      width = "150px",  # Set the width to 300 pixels
      
      selected = choices,
      multiple = TRUE,
      options = list(
        `actions-box` = TRUE,
        `deselect-all-text` = "None",
        `select-all-text` = "All",
        `none-selected-text` = "zero"
      )
    )
  })

  dfpls3 <- reactive({
    req(dfpls(),input$p17)
    df <- subset(dfpls(), Subcategory %in% input$p17)
    U <- sp::merge(USA, df, duplicateGeoms = TRUE, by.x = c("NAME_1","NAME_2"), by.y = c("State","Geography"))
    U
  })
 
  output$test <- renderDT({
    req(dfpls3())
    datatable(dfpls3()@data)
  })
  
  #calls map
  output$map<-renderLeaflet({
    req(dfpls3(),input$p17,input$p3)
    states <- unique(df_1$State)
    temp <- dfpls3() 
    
    oh_sp <- temp[temp@data$NAME_1 %in% input$p3 & temp@data$Subcategory %in% input$p17, ]
    names(oh_sp)[1] <-"State"
    names(oh_sp)[2] <-"County"
    # Determine the maximum value excluding NA values
    max_value <- max(oh_sp@data$Rate, na.rm = TRUE)
    
    # Calculate the maximum value rounded up to the nearest multiple of 20
    max_rounded <- ceiling(max_value / 9) 
    
    # Create the bins vector
    bins <- c(seq(0, max_value, by = max_rounded), max_value)
    pal <- colorBin("Blues", domain = as.numeric(oh_sp$Rate), bins = bins)
    
    leaflet(oh_sp) %>%
      setView(lng = -118.2437, lat = 34.0522, zoom = 7)%>%
      addProviderTiles("CartoDB.Positron")%>%
      addPolygons(
        fillColor = ~pal(Rate),
        weight = 2,
        opacity = 1,
        color = "white",
        dashArray = "3",
        fillOpacity = 0.7,
        layerId = temp$County,
        
        highlightOptions = highlightOptions(
          weight = 5,
          color = "#666",
          dashArray = "",
          fillOpacity = 0.7,
          bringToFront = TRUE)
      )
  })
  
  
  observeEvent(input$map_shape_click,{
    click_county <- input$map_shape_click
    choices <- unique(df_1$Geography)
    selected <- click_county$id
    updatePickerInput(session = session,"p7",choices=choices, selected=selected)
  },ignoreNULL = TRUE)
  
  # Create a reactive subset of data based on selected county
  selected_county_data <- reactive({
    req(dfpls3(),input$p7)
    
    click_county <- input$map_shape_click
    states <- unique(df_1$State)
    dfa <- dfpls3()@data
    if (is.null(click_county)) {
      df <- dfa[dfa$NAME_1 %in% states,]
    } else {
      clicked_county <- click_county$id
      df <- subset(dfa, NAME_1 %in% states &  NAME_2 %in% input$p7)
    }
    df
  })
  
  output$plot5<-renderDataTable({
    req(selected_county_data())
    f<-selected_county_data()
    datatable(f)
  })
  
}

shinyApp(ui, server)

output

do you have an idea about this merging issue? stackoverflow.com/questions/77019130/… — firmo23, Commented Sep 1, 2023 at 7:59

Collectives™ on Stack Overflow

Subset a dataframe based on leaflet click event and shiny widgets

1 Answer 1

Not the answer you're looking for? Browse other questions tagged
r
shiny
r-leaflet
shinywidgets
or ask your own question.

Linked

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Not the answer you're looking for? Browse other questions tagged rshinyr-leafletshinywidgets or ask your own question.

Linked

Related

Not the answer you're looking for? Browse other questions tagged
r
shiny
r-leaflet
shinywidgets
or ask your own question.