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

Question

我想根据 selectInput() 渲染地图。我有两个 selectInput()s：第一个 product_type 和第二个 product_name。在第二个 selectInput() 中，下拉选项应该只显示与第一个 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' 并让一切都依赖于它。这意味着它用于您的变量 'brand' 以及 '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)

下次请提供示例数据。

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

How to display map dynamically changed as per drilldown selectInput() based on previous selections?

r

leaflet

shiny

shinydashboard

selectinput