Question

我一直在尝试从我的传单地图中选择多个区域，并更新选择输入框，随后Go按钮将用户引导到一个新选项卡，显示有关所选区域的信息。简而言之，我需要让我的Map响应Multi Select，或者将我们之前点击的缓存存储在某处，这样每次点击时都不会重新启动选择输入。

附上我的代码。

任何帮助都会有所帮助。

library(shiny)
library(rgdal)
library(leaflet)
library(raster)
library(tmap)
library(shinyjs)

India <- getData("GADM", country = "India", level = 2)
wb <- subset(India, NAME_1 == "West Bengal")

#making a dummy dataframe x

x<-data.frame(wb$NAME_2,wb$ID_2)
KPI<-1:20
x<-cbind(x,KPI)

y<-vector()
edit<-NULL
ui <-fluidPage(
  #use shinyjs
  #plotOutput("shpPlot"),
  leafletOutput("Mapp"),
  selectizeInput("indistrict1","select",choices=wb$NAME_2, multiple=TRUE, 
                 options = list(maxItems = 3)),

  tabsetPanel(id = "inTabset",
              tabPanel("tab_1",actionButton("Button1", "Go")),
              tabPanel("tab_2",actionButton("Button2", "Back" ), tableOutput("q"))
  )
  #tableOutput("my_table")
) 

server <- function(input, output, session){
  output$Mapp<-renderLeaflet({
    leaflet() %>% addPolygons(data = wb, highlightOptions = 
                                highlightOptions(color = "red", weight = 3, bringToFront = TRUE), layerId = 
                                wb$ID_2)
  })

  #Go Button Work
  observeEvent(input$Button1,{
    updateTabsetPanel(session, "inTabset", selected = "tab_2")
  })

  observeEvent(input$Button2,{
    updateTabsetPanel(session, "inTabset", selected = "tab_1")
  })

  #click event work
  data<- reactiveValues(clicked = NULL)
  z<-reactive({
    df <- data.frame(x)
    colnames(df) <- c("district","id","kpi")
    df
  })

  observeEvent(input$Mapp_shape_click,{
    data$clicked <- input$Mapp_shape_click
    y<-subset(z(), id == data$clicked$id)

    edit<-unique(as.character(y$district))

    updateSelectizeInput(session, "indistrict1",
                         label = "select",
                         choices = c(unique(as.character(y$district)),"All 
                                     Districts"),
                         selected = edit,
                         options = list(maxItems = 3),
                         server = TRUE
                         )
  })

  observeEvent(input$indistrict1,{
    output$q<-renderTable({
      subset(z(), district %in% input$indistrict1)
    })
  })  
}

shinyApp(ui = ui,server = server)

Answer 1

这只是一个开始，但它可能对你有帮助。

现在它只收听传单地图中的点击，但存储了点击的形状ID，因此您可以单击几个shapefile，这些形状文件将在地图中突出显示并显示在表格中。但是缺少删除单击的shapefile（通过再次单击shapefile）。在selectInput上选择shapefile目前也不起作用，只能使用点击的shapefile更新selectInput。

library(shiny)
library(leaflet)
library(raster)
library(DT)

India <- getData("GADM", country = "India", level = 2)
wb <- subset(India, NAME_1 == "West Bengal")

ui <- {fluidPage(
  uiOutput("raumselect"),
  leafletOutput("map"),
  DT::dataTableOutput("mytable")
)}


server <- shinyServer(function(input, output, session) {
  indiashape <- reactiveValues(geom = wb)
  click_list <- reactiveValues(ids = vector())
  selectedLines <- reactiveValues(geom = NULL)

  output$raumselect <- renderUI({
    click <- input$map_shape_click
    sel_lines_name <- as.character(indiashape$geom[as.character(
      indiashape$geom$OBJECTID) %in% click_list$ids, ]$NAME_2)

    selectInput("nameslanes", choices = wb$NAME_2,
                selected = sel_lines_name,
                label = "Select a Line Segment:", multiple = T)
  })

  output$map <- renderLeaflet({
    mapl <- leaflet(options = leafletOptions(doubleClickZoom= FALSE)) %>% 
      addTiles() %>% 
      addPolylines(data = indiashape$geom,
                   layerId = as.character(indiashape$geom$OBJECTID),
                   group = indiashape$geom$TYPE_2,
                   color = "blue",
                   highlightOptions = highlightOptions(color="red", weight = 10, bringToFront = T, opacity = 1))        
    mapl
  })

  observeEvent(input$map_shape_click, {
    click <- input$map_shape_click
    proxy <- leafletProxy("map")

    click_list$ids <- c(click_list$ids, click$id)

    sel_lines <- indiashape$geom[as.character(indiashape$geom$OBJECTID) %in% click_list$ids, ]

    proxy %>% addPolylines(data = sel_lines, 
                           layerId = as.character(sel_lines@data$osm_id), 
                           color="red", weight=5,opacity=1)
    selectedLines$geom <- sel_lines
  })

  output$mytable <- DT::renderDataTable({
    req(selectedLines$geom)

    if (!is.null(selectedLines$geom)) {
      sel_lines <- selectedLines$geom
      datafr <- as.data.frame(cbind(
        as.numeric(sel_lines$OBJECTID),
        as.character(sel_lines$NAME_2)
      ))
    }
    colnames(datafr) <- c("OBJECTID", "Name")
    datatable(data = datafr, rownames = T)
  })
})

shinyApp(ui, server)

如何在闪亮的R中多次更新外部点击的选择性输入

1 个答案: