如何显示根据先前的选择根据钻取selectInput动态变化的地图？

问题描述

我想基于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)

地图中动态更改的点应标记出来。我尝试过但无法生成代码。

在此代码上的任何帮助对我来说都是很自然的。

解决方法

希望我的榜样对您有所帮助。我发明了一个data.frame“船”，并使所有东西都依赖它。这意味着它既可以用于变量“品牌”也可以用于“船运”。

我不确定您如何设想值框，因此我将类别和产品放入其中。

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

ship <- data.frame(
    product_type = c("food","food","tool","accessories","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',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)

请下次提供示例数据。