使用滑动条在闪亮的应用程序中清除传单标记

Question

我正在尝试构建一个闪亮的应用程序，它只会在具有滑动条范围内的值的行上绘制点。如果我增加滑块的范围，点将被添加，但当我减少滑块的范围时，点永远不会被删除。下面是我的问题的可重现示例。如果将滑块增加到全范围，地图上将显示 3 个点。如果您随后将范围减小到足够大，它将放大一个点，但如果您缩小，您会看到地图上仍然绘制了 3 个点。我认为传单中的 clearShapes 或 clearMarkers 功能会删除这些点，但它不起作用。有什么建议吗？

library(shiny)
library(leaflet)
library(tidyverse)

ui <- fluidPage(

   titlePanel("Test"),

   sidebarLayout(
      sidebarPanel(
         radioButtons("choice","Group:",choices = c(1,2), selected = 1),
         uiOutput("value"),
         verbatimTextOutput("Click_text")
      ),

      mainPanel(
         leafletOutput("Map")
      )
   )
)

server <- function(input, output) {

  df <- data.frame(lat = c(42.34,43.65,45.26,48.63,47.65,47.52),
                   lng = c(-96.43,-97.45,-98.56,-92.35,-94.56,-95.62),
                   id = c(32,45,65,76,34,12),
                   grp = c(1,1,1,2,2,2),
                   val = c(1.75,2.12,3.2,3.32,4.76,4.85))

  subsetData1 <- reactive({

    df %>% filter(grp == input$choice)

  })

  output$value <- renderUI({

    sliderInput("value",label = h3("value"),
                min = min(subsetData1()$val,na.rm = TRUE),
                max = max(subsetData1()$val,na.rm=TRUE),
                value = c(quantile(subsetData1()$val,.25,na.rm = TRUE),quantile(subsetData1()$val,.75,na.rm=TRUE))) 

  })      

  subsetData <- reactive({

    df2 <- subsetData1() %>% data.frame()

    df2 %>% filter(val >= min(as.numeric(input$value)) & val <= max(as.numeric(input$value)))

  })   

  output$Map <- renderLeaflet({

    leaflet(height = 1000) %>% 
      addTiles() %>% 
      fitBounds(min(df$lng),min(df$lat),max(df$lng),max(df$lat))

  })

  observe({
    leafletProxy("Map") %>%
      clearMarkers() %>%
      clearShapes() %>%
      addCircleMarkers(data = subsetData(),
                       lng  = ~lng,
                       lat  = ~lat,
                       layerId = ~id,
                       radius = 8,
                       weight = 10) %>%
      fitBounds(.,min(subsetData()$lng),min(subsetData()$lat),
                max(subsetData()$lng),max(subsetData()$lat))

  })

  observe({

    click<-input$Map_marker_click
    if(is.null(click))
      return()
    text<-paste("Latitude ", click$lat, "Longtitude ", click$lng)
    text2<-paste("You've selected point ", click$id)

    output$Click_text<-renderText({
      text2
    })

  })

}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

您可以更改 observe 函数，将标记清除为 observeEvent 函数。

  observeEvent(input$value,{
    leafletProxy("Map") %>%
      clearMarkers() %>%
      clearShapes() %>%
      addCircleMarkers(data = subsetData(),
                       lng  = ~lng,
                       lat  = ~lat,
                       layerId = ~id,
                       radius = 8,
                       weight = 10) %>%
      fitBounds(.,min(subsetData()$lng),min(subsetData()$lat),
                max(subsetData()$lng),max(subsetData()$lat))

  })

您还拥有相同的 uiOutput 和 sliderInput id (value)。你应该确保每个元素都有一个唯一的 id。将其中一个重命名为独特的名称。