使用动态菜单时，闪亮的传单无法正常工作

Question

我一直在努力解决这个问题，但没有成功。我想用桌子和地图构建一个闪亮的交互式应用程序。它结合了不同的数据集。我们的想法是能够选择所需的数据集并过滤此数据集中的数据并在地图上呈现它们。

我设法建立了一个交互式菜单和反应过滤功能，但是我的传单地图有问题。当我在某些数据集之间切换时，它会崩溃。我只能在localisations-macro或localisations-micro之间切换，但是当我在micro和macro之间切换时它会工作（见下图）。

这个问题与错误有关：Warning: Error in sum: invalid 'type' (list) of argument但我现在知道如何解决这个问题。

我也在observerEvent中尝试过类似的东西：

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

但也不起作用。

以下是该应用的示例：

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

另一答案