如何解决如何显示根据先前的选择根据钻取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)
请下次提供示例数据。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。