Select polygon by clicking on map, changing the Selectedinput

...
I'm having a problem since I started learning shiny and R, so please be patient.

I'm working on a shiny map where whenever a user clicks on a polygon, it changes the first selection to the same area that the user picked on the map.

This is my code:

# Install an load all required packages
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, data.table, bslib, shiny, sf, leaflet, tiff, openxlsx, rgdal, purrr)

# set working directory to this script's locations: no need to check the file path manually
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))

# Add the layers and the map
dir.layers <- "syr_admin_20200816.gdb"
df <- st_read(dir.layers, layer="syr_admbnda_adm1_uncs_unocha") %>%
  st_transform(crs = 4326) %>%
  st_zm(df, drop = TRUE) %>%
  select(name=admin1Pcode, shape=SHAPE)



df <- subset(df, df$name %in% c("SY01", "SY02", "SY03", "SY04", "SY05", "SY06", "SY07"))

#leaflet(df) %>%
 # addPolygons(color = "#444444", weight = 1, smoothFactor = 0.5,
  #            opacity = 1.0, fillOpacity = 0.5,
   #           highlightOptions = highlightOptions(color = "white", weight = 2,
    #                                              bringToFront = TRUE))


#ui
ui <- fluidPage(
     theme = bs_theme(version = 4, bootswatch = "minty"),
  
     # App title ----
     navbarPage(title = "Flood-Model Shiny App",
                tags$script(HTML("var header = $('.navbar > .container-fluid');
             header.append('<div style=\"float:right\"><img src=\"cwg.jpg\" alt=\"alt\" style=\"float:right;width:auto;height:35px;padding-top:0px;\"> </a>`</div>');
    console.log(header)")
                )),
  
     # Sidebar panel for inputs ----
     sidebarLayout( 

     position = "right",
    
     sidebarPanel( 
              
       # Input: Choose dataset ----
       selectInput("dataset", "Choose a Location:",
                  choices = c("location_A", "Location_B",
                              "Location_C", "Location_D", 
                              "Location_E", "Location_F")),
      
       # Input: choose file
       uiOutput("secondSelection"),
      
       # Button
       downloadButton("downloadData", "Download")), 
  
        # Main panel for displaying outputs ----
        mainPanel(
          
          #loading the map in Output layer
         leafletOutput("map"),
         
         #loading the map information after hover on the map
         uiOutput('map_text')
         
   )))

 

# Define server logic to display and download selected file ----
server <- function(input, output, session) {

  output$map <- renderUI({
    HTML(paste(h4(map$name)))
    })

  output$map <- renderLeaflet({
    leaflet(df) %>%
      addPolygons(color = "gray", fillColor = "blue", weight = 1, smoothFactor = 0.5,
                  opacity = 1.0, fillOpacity = 0.5,
                  layerId = ~name,
                  highlightOptions = highlightOptions(color = "white", weight = 2,
                                                      bringToFront = TRUE)) %>%
      addTiles()
      #addProviderTiles("Esri.WorldImagery")
    })
  

  # Table of selected file ----
   output$secondSelection <- renderUI({
     database <- input$dataset
     selectInput( "file",  "Choose a file:", choices = 
      switch(database,
             "location_A" = c("A_flood_Hazard","A_flood_depth") ,
             "Location_B" = c("B_flood_Hazard","B_flood_depth"),
             "Location_C" = c("C_flood_Hazard","C_flood_depth"),
             "Location_D" = c("D_flood_Hazard","D_flood_depth"),
             "Location_E" = c("E_flood_Hazard","E_flood_depth"),
             "Location_F" = c("F_flood_Hazard","F_flood_depth")))
  })
  
  

  # Reactive value for selected dataset ----
  datasetInput <- reactive({
    switch(input$file,
           "A_flood_Hazard" = A_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "A_flood_depth"  = A_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "B_flood_Hazard" = B_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "B_flood_depth"  = B_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "C_flood_Hazard" = C_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "C_flood_depth"  = C_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "D_flood_Hazard" = D_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "D_flood_depth"  = D_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "E_flood_Hazard" = E_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "E_flood_depth"  = E_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "F_flood_Hazard" = F_flood_Hazard <- readTIFF("NorthDana_flood_Hazard.tif.tif") ,
           "F_flood_depth"  = F_flood_depth<- readTIFF("NorthDana_flood_Hazard.tif.tif") )
  
  }) 
  
  # Downloadable csv of selected dataset ----
  output$downloadData <- downloadHandler(
    filename = function() {
      paste(input$file, ".tif.tif", sep = "")
    },
    content = function(file) {
      writeTIFF(datasetInput(), file )
    }
  )
  
  #Event  click on map 
  observe({ 
    event <- input$map_shape_click
    as.character(event$id)
    updateSelectInput(session,
                      inputId = "dataset",
                      choices = switch(event$id,
                                       "SY04" = "location_A",
                                       "SY01" = "Location_B",
                                       "SY02" = "Location_C",
                                       "SY03" = "Location_D",
                                       "SY05" = "Location_E",
                                       "SY06" = "Location_F"  ))
  })
  
}

# Create Shiny app ----
shinyApp(ui, server)


whenever I start the app it gives me this error
the error is Error in switch: EXPR must be a length 1 vector

I have no means to actually run your app, as it uses external data (in the future you may consider rewriting your code to use the nc.shp that ships with {sf} and is widely available).

But my hunch - since the error occurs on start, before there is a chance to click on anything - is that your issue is with the initial state when the observation will be NULL (nothing was clicked).

I suggest wrapping the updateSelectInput in a block testing the value of event$id to have a defined value.

Thanks Jlacko i have fixed it by change the locations name to actually one and then reused them in the updateselect input

We don't have access to syr_admin_20200816.gdb so can't run the script.

Anyway, this is a response that @jlacko provided to a similar question that I had:

1 Like

Thanks, mute Approcitaed

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.