Яркие маркеры буклетов в блестящем приложении со слайдером

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 идентификаторы, как же (value). Вы должны убедиться, что каждый элемент имеет уникальный идентификатор. Переименуйте одно из них в нечто уникальное.