Shiny leaflet doesn't work properly with dynamic menu

Question

I have been struggling with this issue for some time, without success. I want to build a shiny interactive app with table and map. It combines different data sets. The idea is to be able to choose a required data set and to filter data within this data set and render them on a map.

I managed to build an interactive menu and reactive filtering function, however I have problem with the leaflet map. It crushes when I am switching between some of the datasets. I am only able to switch between localisations-macro or localisations-micro, but it doesnet work when I switch between micro and macro (see picture below).

The problem has something to do with error: Warning: Error in sum: invalid 'type' (list) of argument however I have now idea how to fix that.

I also tried something like this within observerEvent :

if(inpud$data.type=="Localisations"){}..... else if (input$data.type=="Micro"){}..... else{}

But also doesnt work.

Here is example of the app:

library(shiny)
library(leaflet)
library(dplyr)


#### UI
ui <- fluidPage(

  titlePanel("Map"),

  leafletOutput("map"),

  fluidRow(
    column(2, offset = 0, style='padding:10px;',
           radioButtons("data.type", "Type of  data", c("Localisations", "Micro", "Macro"))),
    column(2, offset = 0, style='padding:10px;',
           uiOutput("position")),
    column(2, offset = 0, style='padding:10px;',
           uiOutput("kind"))
  ),

  dataTableOutput("table") ## to check the filtering

)


server <- function(input, output, session) {

  ##### data #####


  sites <- data.frame(Site=c("Site1", "Site2"),
                      Lat=c(54, 56), 
                      Long=c(16, 18)) 


  micro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
                      Position=c("Micro_pos1","Micro_pos1", "Micro_pos2", "Micro_pos2"),
                      Kind=rep(c("blue_fiber", "red_fiber"), 4),
                      Amount=c(5, 46, 64, 32, 54, 38, 29, 31) )  

  micro <- full_join(micro, sites)

  macro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
                      Position=c("Macro_pos1","Macro_pos1", "Macro_pos2", "Macro_pos2"),
                      Kind=rep(c("Cigarretes", "Pellets"), 4),
                      Amount=c(3, 16, 4, 12, 14, 18, 19, 21) )  

  macro <- full_join(macro, sites)    


  #### dynamic menu ####

  ### position
  output$position <- renderUI({


    switch(input$data.type,
           "Micro"=radioButtons("position", "Micro position:", 
                                                       choices = c("Micro_pos1", "Micro_pos2")),
           "Macro"=radioButtons("position", "Macro position:", 
                                               choices = c("Macro_pos1", "Macro_pos2"))
    )
  })

  ## kind

  output$kind <- renderUI({


    switch(input$data.type,
           "Micro"=checkboxGroupInput("kind", "kind of micro:", 
                                                             choices = c("blue_fiber", "red_fiber"),
                                                             selected = c("blue_fiber", "red_fiber")),
           "Macro"=checkboxGroupInput("kind", "kind of macro:", 
                                                     choices = c("Cigarretes", "Pellets"),
                                                     selected=c("Cigarretes", "Pellets"))
    )
  })


#### reactive table to filter data to map ####

table <- reactive({


    if(input$data.type=="Localisations"){

      return(sites)
    }  

    else if (input$data.type=="Micro") {

      if (is.null(input$position))
        return(NULL)
      if (!is.null(input$position))

        micro <-micro[micro$Position==input$position,]
      micro<-micro[micro$Kind %in% input$kind,]

      micro <- micro %>% 
        group_by(Site, Lat, Long, Position)%>%
        summarise(Amount=sum(Amount))
      micro
      }

  else if (input$data.type=="Macro") {

    if (is.null(input$position))
      return(NULL)
    if (!is.null(input$position))

      macro <-macro[macro$Position==input$position,]
    macro<-macro[macro$Kind %in% input$kind,]

     macro <- macro %>%
      group_by(Site, Lat, Long, Position)%>%
      summarise(Amount=sum(Amount))
    macro
    }
  })


#### table with filtered data ####
output$table <- renderDataTable({
  table()
})



#### base map ####


  output$map <- renderLeaflet({
    leaflet(sites) %>%
      setView(lat=55, lng=17, zoom=6) %>%
      addProviderTiles(providers$Esri.WorldImagery) %>%
      addCircleMarkers(lng=~Long, lat=~Lat, label=~Site, 
                       labelOptions = labelOptions(noHide =T))
  })




  ##### and now it gets complicated :( ####

   observeEvent( c( input$data.type, input$position, input$kind), {

    if(input$data.type=="Localisations"){

      leafletProxy("map", data=sites) %>%
        clearMarkers() %>%
        clearShapes()%>%
        addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
                         labelOptions = labelOptions(noHide =T), fillColor = "red")
    }


     else {

        if (is.null(input$position))
           return(NULL)
        if (is.null(input$kind))
          return(NULL)


        leafletProxy("map", data=table()) %>%
        clearMarkers() %>%
        clearShapes()%>%

        addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
                   labelOptions = labelOptions(noHide =T),
                   radius = ~Amount*1000) %>%
        addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
                            labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))

     }



  })

  ### server end
}

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

Answer 1

The problem is the timing:

• When you switch from micro to macro, input$kind is still set to the values applicable only for micro
• Then table() is called to create the map. It filters macro[macro$Kind %in% input$kind,], which will result in an empty set, because input$kind contains still red and blue fiber instead of "Cigarretes" and "Pellets"

• You update the selection boxes with

  output$kind <- renderUI({
  
  
  switch(input$data.type,
         "Micro"=checkboxGroupInput("kind", "kind of micro:", 
                                    choices = c("blue_fiber", "red_fiber"),
                                    selected = c("blue_fiber", "red_fiber")),
         "Macro"=checkboxGroupInput("kind", "kind of macro:", 
                                    choices = c("Cigarretes", "Pellets"),
                                    selected=c("Cigarretes", "Pellets"))
  )
  })
  

but this has only effect on input$kind after table() is called.

• The first solution that occurs to me would be to trigger the call of table() by a submit button rather than by every change to input$kind, input$data.type and input$position. So table() would become a non-reactive function, and the observer observeEvent( c( input$data.type, input$position, input$kind), {...}) that creates the map is changed:

So include an action button: ui <- fluidPage( titlePanel("Map"),

     leafletOutput("map"),

     fluidRow(
       column(2, offset = 0, style='padding:10px;',
              radioButtons("data.type", "Type of  data", c("Localisations", 
     "Micro", "Macro"))),
        column(2, offset = 0, style='padding:10px;',
             uiOutput("position")),
       column(2, offset = 0, style='padding:10px;',
             uiOutput("kind"))
     ),
     actionButton("button", "submit"),
     dataTableOutput("table") ## to check the filtering      
    )

Then change the table function:

  table <- function(){


    if(input$data.type=="Localisations"){

      return(sites)
    }  

    else if (input$data.type=="Micro") {

      if (is.null(input$position))
        return(NULL)
      if (!is.null(input$position))

        micro <-micro[micro$Position==input$position,]
      micro<-micro[micro$Kind %in% input$kind,]

      micro <- micro %>% 
        group_by(Site, Lat, Long, Position)%>%
        summarise(Amount=sum(Amount))
      micro
    }

    else if (input$data.type=="Macro") {

      if (is.null(input$position))
        return(NULL)
      if (!is.null(input$position))

        macro <-macro[macro$Position==input$position,]
      macro<-macro[macro$Kind %in% input$kind,]

      macro <- macro %>%
        group_by(Site, Lat, Long, Position)%>%
        summarise(Amount=sum(Amount))
      macro
    }
  }

And finally adjust the observer:

  observeEvent( input$button, {

    if(input$data.type=="Localisations"){

      leafletProxy("map", data=sites) %>%
        clearMarkers() %>%
        clearShapes()%>%
        addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
                         labelOptions = labelOptions(noHide =T), fillColor = "red")
    }


    else {

      if (is.null(input$position))
        return(NULL)
      if (is.null(input$kind))
        return(NULL)


      leafletProxy("map", data=table()) %>%
        clearMarkers() %>%
        clearShapes()%>%

        addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
                   labelOptions = labelOptions(noHide =T),
                   radius = ~Amount*1000) %>%
        addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
                            labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))

    }
  })

To make your data table reactive, you can do this:

  output$table <- renderDataTable({
    input$button
    table()
  })

Answer 2

Many thank for the effort @ge.org , however the solution with summit button is not suitable for my app since in real app I have much more categories and it would be awkward for the user to summit changes every time. But thanks to your comment about timing I managed to bypass this by edditig the observeEvent. I split it into three separate conditions for each data.type and than in conditions responsible for micro and macro I added new conditions to omit the wrong categories from input$kind. This gives some warning in the console but is seems not to influence the whole app.

Here is the new code:

library(shiny)
library(leaflet)
library(dplyr)



#### UI
ui <- fluidPage(

  titlePanel("Map"),

  leafletOutput("map"),

  fluidRow(
    column(2, offset = 0, style='padding:10px;',
           radioButtons("data.type", "Type of  data", c("Localisations", "Micro", "Macro"))),
    column(2, offset = 0, style='padding:10px;',
           uiOutput("position")),
    column(2, offset = 0, style='padding:10px;',
           uiOutput("kind"))
  ),

  dataTableOutput("table"), ## to check the filtering
  textOutput("kind.of")
)


server <- function(input, output, session) {

  ##### data #####


  sites <- data.frame(Site=c("Site1", "Site2"),
                      Lat=c(54, 56), 
                      Long=c(16, 18)) 


  micro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
                      Position=c("Micro_pos1","Micro_pos1", "Micro_pos2", "Micro_pos2"),
                      Kind=rep(c("blue_fiber", "red_fiber"), 4),
                      Amount=c(5, 46, 64, 32, 54, 38, 29, 31) )  

  micro <- full_join(micro, sites)

  macro <- data.frame(Site=c(rep("Site1",4), rep("Site2", 4)),
                      Position=c("Macro_pos1","Macro_pos1", "Macro_pos2", "Macro_pos2"),
                      Kind=rep(c("Cigarretes", "Pellets"), 4),
                      Amount=c(3, 16, 4, 12, 14, 18, 19, 21) )  

  macro <- full_join(macro, sites)    


  #### dynamic menu ####

  ### position
  output$position <- renderUI({


    switch(input$data.type,
           "Micro"=radioButtons("position", "Micro position:", 
                                                       choices = c("Micro_pos1", "Micro_pos2")),
           "Macro"=radioButtons("position", "Macro position:", 
                                               choices = c("Macro_pos1", "Macro_pos2"))
    )
  })

  ## kind

  output$kind <- renderUI({


    switch(input$data.type,
           "Micro"=checkboxGroupInput("kind", "kind of micro:", 
                                                             choices = c("blue_fiber", "red_fiber"),
                                                             selected = c("blue_fiber", "red_fiber")),
           "Macro"=checkboxGroupInput("kind", "kind of macro:", 
                                                     choices = c("Cigarretes", "Pellets"),
                                                     selected=c("Cigarretes", "Pellets"))
    )
  })


#### reactive table to filter data to map ####

table <- reactive({


    if(input$data.type=="Localisations"){

      return(sites)
    }  

    else if (input$data.type=="Micro") {

      if (is.null(input$position))
        return(NULL)
      if (!is.null(input$position))

        micro <-micro[micro$Position==input$position,]
      micro<-micro[micro$Kind %in% input$kind,]

      micro <- micro %>% 
        group_by(Site, Lat, Long, Position)%>%
        summarise(Amount=sum(Amount))
      micro
      }

  else if (input$data.type=="Macro") {

    if (is.null(input$position))
      return(NULL)
    if (!is.null(input$position))

      macro <-macro[macro$Position==input$position,]
    macro<-macro[macro$Kind %in% input$kind,]

     macro <- macro %>%
      group_by(Site, Lat, Long, Position)%>%
      summarise(Amount=sum(Amount))
    macro
    }
  })


#### table with filtered data ####
output$table <- renderDataTable({
  table()
})


#### base map ####


  output$map <- renderLeaflet({
    leaflet(sites) %>%
      setView(lat=55, lng=17, zoom=6) %>%
      addProviderTiles(providers$Esri.WorldImagery) %>%
      addCircleMarkers(lng=~Long, lat=~Lat, label=~Site, 
                       labelOptions = labelOptions(noHide =T))
  })


  #### updating the map #####

   observeEvent( c( input$data.type, input$position, input$kind), {



  if(input$data.type=="Localisations"){

      leafletProxy("map", data=sites) %>%
        clearMarkers() %>%
        clearShapes()%>%
        addCircleMarkers(lng=~Long, lat=~Lat, label=~Site,
                         labelOptions = labelOptions(noHide =T), fillColor = "red")
    }


     else if (input$data.type=="Micro") {

        if (is.null(input$position))
           return(NULL)
         if (is.null(input$kind))
          return(NULL)

###########################################################
  ####### and here 4 new line that did all the job #########
       if (input$position %in% c("Macro_pos1", "Macro_pos2")) 
         return(NULL) ## new line
       if (input$kind %in% c("Cigarretes", "Pellets"))
         return(NULL)
  #################################################### 



        leafletProxy("map", data=table()) %>%
        clearMarkers() %>%
        clearShapes()%>%

        addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
                   labelOptions = labelOptions(noHide =T),
                   radius = ~Amount*1000) %>%
        addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
                            labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))

           }

     else if(input$data.type=="Macro") {

       if (is.null(input$position))
         return(NULL)
       if (is.null(input$kind))
         return(NULL)

###########################################################
  ####### and here 4 new line that did all the job #########
       if (input$position %in% c("Micro_pos1", "Micro_pos2"))
         return(NULL)
       if (input$kind %in% c("blue_fiber", "red_fiber"))
         return(NULL)
  ##############################################

       leafletProxy("map", data=table()) %>%
         clearMarkers() %>%
         clearShapes()%>%

         addCircles(lng=~Long, lat=~Lat, label=~Site, color="white", fill="white",
                    labelOptions = labelOptions(noHide =T),
                    radius = ~Amount*1000) %>%
         addLabelOnlyMarkers(lng=~Long, lat=~Lat, label=~as.character(Amount),
                             labelOptions = labelOptions(noHide = T, direction = 'top', textOnly = T, textsize="20px"))

     }

      })

  ### server end
}

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