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。将其中一个重命名为独特的东西。

使用滑动条

1 个答案: