r - 如何根据先前的选择根据向下钻取 selectInput() 显示动态更改的地图？

Question

我想基于selectInput(). 我有两个selectInput()s：第一个 product_type 和第二个 product_name。在第二个selectInput()中，下拉选项应该只显示与 first 相关selectInput()。基于这些向下钻取输入映射应该动态变化。

这是代码：

ui <- shinyUI(dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    fluidPage(
      box("", 
          leafletOutput("abc", width = '100%', height = 300),
      
          height = 350, width = 12),
  
      box("", 
          selectInput('vtype', label = 'Prod Type',choices = brand$prod_type),
          selectInput('vname', label = 'Prod Name',choices = brand$prod_name),
          width = 4),
  
      valueBoxOutput("gr", width = 8)
  
    )
  )
))

server <- shinyServer(function(input,output,session){
  a <- ship %>% select(prod_name,prod_type,LON,LAT) %>% filter(prod_type == input$vtype)
  output$gr <- renderValueBox({
    box(table(a))
  })
  output$abc <- renderLeaflet({

      leaflet() %>% addProviderTiles(providers$OpenTopoMap ) 
%>% setView(lat = a$LAT ,lng = A$LON, zoom = 4)
  }) 

})

shinyApp(ui,server)

应标记地图中动态变化的点。我试过但无法构建代码。

对此代码的任何帮助对我来说都是优雅的。

Answer 1

我希望我的例子有所帮助。我发明了一个 data.frame 'ship' 并让一切都依赖于它。这意味着它用于您的变量“品牌”以及“船舶”。

我不确定您如何设想价值框​​，所以我将类别和产品放入其中。

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

ship <- data.frame(
    product_type = c("food","food","tool","tool","tool","accessories","accessories","lighting","lighting","lighting"),
    product_name=c("eggs", "bread","clamp","hammer","screw driver", "watch" ,"sun glases","LED","bulb","briquette"),
    LON=c(-61.783,2.632,47.395,20.068,44.563,17.544,-170.730,-65.167,136.189,50.562),
    LAT=c(17.078 ,28.163 ,40.430 ,41.143 ,40.534 ,-12.296 ,-14.318 ,-35.377 ,-24.973 ,26.019),
    stringsAsFactors = F)

ui <- dashboardPage(
    dashboardHeader(),
    dashboardSidebar(collapsed = TRUE, disable = FALSE),
    dashboardBody(
        # fluidPage(
            box(
                leafletOutput("abc", width = '100%', height = 300),
                height = 350,
                width = 12),

            box(
                selectInput('vtype', label = 'Prod Type', choices = c("< select product type>"="", ship$product_type)),
                selectInput('vname', label = 'Prod Name', choices = c("< select item>"="", ship$product_name)),
                width = 4),
            
            valueBoxOutput("gr", width = 8)
        #)
    )
)

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

    a <- reactive({
        ship %>%
            select(product_name, product_type, LON, LAT) %>%
            filter(product_type %in% input$vtype)
    })
    
    output$gr <- renderValueBox({
        valueBox( input$vtype, paste(a()$product_name, collapse=' - ') )
    })
    
    observe({
        updateSelectInput(session, 
                          inputId='vname', 
                          choices = c("< select item>"="", a()$product_name ))
    })
    
    output$abc <- renderLeaflet({
        leaflet() %>% 
            addProviderTiles(providers$OpenTopoMap ) %>%
            setView(lng=0, lat=0, zoom = 1)
    }) 
    
    observe({
        selection <- a() %>% filter(product_name %in% input$vname)
        leafletProxy("abc") %>%
            flyTo(lat = selection$LAT,
                    lng = selection$LON,
                    zoom = 4)
    }) 
})

shinyApp(ui,server)

下次请提供示例数据。