刪除R閃亮的特定單張標記。

Question

我有一個CircleMarkers層，我試圖刪除只有具有某個layerId的標記。這些圓圈標記的ID位於數據框中。

下面是一個簡單的例子： 假設我有3行與ID的1，2和3中的數據幀我試圖做一個checkboxInput與選項刪除ID的1和2或3

以下輸入將觸發使用removeMarker函數的ObserveEvent。然而，沒有任何反應。我已經嘗試了一百萬種方法將id輸入到removeMarker中，並且我還嘗試了其他幾種刪除方法。要麼沒有任何反應，要麼全部消失。我需要一種方法來刪除特定的標記。

ui <- shinyUI(fluidPage(
sidebarLayout(
    sidebarPanel(
     checkboxInput("delete1", "Delete ID=1 and 2",value=FALSE), 
    checkboxInput("delete3", "Delete ID=3",value=FALSE) 
    ), 
    mainPanel(
     leafletOutput("map") 
    ) 
) 
)) 

df <- data.frame(id=c(1,2,3),lng = rnorm(3, -106.1039361, 0.5) , 
       lat = rnorm(3, 50.543981, 0.5)) 

server <- shinyServer(function(input, output, session) { 

output$map <- renderLeaflet(
    leaflet() %>% 
addTiles() %>% addCircleMarkers(layerId=df$id,df$lng,df$lat, group='marker', radius=2, fill = TRUE,color='red') 


    ) 

observeEvent(input$delete1, { 
    proxy <- leafletProxy('map') 
    if (input$delete1){ proxy %>% removeMarker(df[1:2,1]) 
} 
}) 

observeEvent(input$delete3, { 
    proxy <- leafletProxy('map') 
    if (input$delete3){ proxy %>% removeMarker(3)} 
    }) 
}) 

shinyApp(ui, server) 

Answer 1

你可以做類似下面的事情，但是他們現在設置的方式不會把標記放回去，如果你取消勾選這個框。

server <- shinyServer(function(input, output, session) { 

    output$map <- renderLeaflet(
     leaflet() %>% 
     addTiles() %>% 

     # Add circle markers in different groups 
     addCircleMarkers(layerId=df$id[1:2], df$lng[1:2], df$lat[1:2], group='one', radius=2, fill = TRUE,color='red') %>% 
     addCircleMarkers(layerId=df$id[3], df$lng[3], df$lat[3], group='two', radius=2, fill = TRUE,color='red') 
    ) 

    # Remove group 'one' 
    observeEvent(input$delete1, { 
     proxy <- leafletProxy('map') 
     if (input$delete1){ proxy %>% clearGroup(group = "one")} 
    }) 

    # Remove group 'two' 
    observeEvent(input$delete3, { 
     proxy <- leafletProxy('map') 
     if (input$delete3){ proxy %>% clearGroup(group = "two")} 
    }) 
}) 

shinyApp(ui, server) 

Answer 2

我認爲對這些ID進行分組仍然是不錯的選擇。這個分組變量可以被添加到你的數據框中，你可以使用它來切換顯示/隱藏點，如下圖所示。這與你最初的嘗試沒有什麼不同，因爲你仍然必須明確指出你想刪除哪些ID。你仍然必須這樣做，但是現在你必須將它們放在確定的組中。

require(shiny) 
require(leaflet) 
require(dplyr) 

ui <- shinyUI(fluidPage(
    sidebarLayout(
    sidebarPanel(
     #Set value = TRUE so points are shown by default 
     checkboxInput("delete1", "Toggle ID 1 and 2", value = TRUE), 
     checkboxInput("delete3", "Toggle ID 3", value = TRUE) 
    ), 
    mainPanel(
     leafletOutput("map") 
    ) 
) 
)) 


df <- data.frame(
     id = c(1,2,3), 
     #Add grouping variable 
     group = c("one", "one", "two"), 
     lng = rnorm(3, -106.1039361, 0.5) , 
     lat = rnorm(3, 50.543981, 0.5) 
) 


server <- shinyServer(function(input, output, session) { 

    output$map <- renderLeaflet(
    leaflet() %>% 
    addTiles() %>% 

    #Add markers with group 
    addCircleMarkers(group = df$group, df$lng, df$lat, radius=2, fill = TRUE, color = 'red') 
) 

    observeEvent(input$delete1, { 
    proxy <- leafletProxy('map') 

    #Always clear the group first on the observed event 
    proxy %>% clearGroup(group = "one") 

    #If checked 
    if (input$delete1){ 

     #Filter for the specific group 
     df <- filter(df, group == "one") 

     #Add the specific group's markers 
     proxy %>% addCircleMarkers(group = df$group, df$lng, df$lat, radius=2, fill = TRUE, color = 'red') 
    } 
    }) 

    #Repeat for the other groups 
    observeEvent(input$delete3, { 
    proxy <- leafletProxy('map') 
    proxy %>% clearGroup(group = "two") 
    if (input$delete3){ 
     df <- filter(df, group == "two") 
     proxy %>% addCircleMarkers(group = df$group, df$lng, df$lat, radius=2, fill = TRUE, color = 'red') 
    } 
    }) 
}) 

shinyApp(ui, server) 

，你可以使用另一個想法是不是一個checkboxInput的是selectInput，你可以在一個選擇的倍數。這將爲每組保存observeEvents。如下所示。我設置它，所以它默認顯示所有的點，如果你選擇一個組，它將從圖中刪除。

require(shiny) 
require(leaflet) 
require(dplyr) 

df <- data.frame(
     id = c(1,2,3), 
     #Add grouping variable 
     group = c("one", "one", "two"), 
     lng = rnorm(3, -106.1039361, 0.5) , 
     lat = rnorm(3, 50.543981, 0.5) 
) 

ui <- shinyUI(fluidPage(
    sidebarLayout(
    sidebarPanel(
     #Set value = TRUE so points are shown by default 
     selectInput("toggle", "Toggle Groups", choices = unique(df$group), multiple = TRUE) 
    ), 
    mainPanel(
     leafletOutput("map") 
    ) 
) 
)) 

server <- shinyServer(function(input, output, session) { 

    output$map <- renderLeaflet(
    leaflet() %>% 
    addTiles() %>% 
    addCircleMarkers(df$lng, df$lat, radius=2, fill = TRUE, color = 'red') 
) 

    observe({ 

    proxy <- leafletProxy('map') 

    if(is.null(input$toggle)){ 
     proxy %>% clearMarkers() %>% 
     addCircleMarkers(df$lng, df$lat, radius=2, fill = TRUE, color = 'red') 
    } else { 

     #Always clear the shapes on the observed event 
     proxy %>% clearMarkers() 

     #Filter for the specific group 
     df <- filter(df, !(group %in% input$toggle)) 

     #Add the specific group's markers 
     proxy %>% addCircleMarkers(group = df$group, df$lng, df$lat, radius=2, fill = TRUE, color = 'red') 
    } 
    }) 

}) 

shinyApp(ui, server) 

Answer 3

出於某種原因，這個工作如果在addCirleMarkers並在removeMarker是字符layerId，你可以嘗試在服務器部分：

server <- shinyServer(function(input, output, session) { 

    output$map <- renderLeaflet(
    leaflet() %>% 
     addTiles() %>% addCircleMarkers(layerId=as.character(df$id),df$lng,df$lat, group='marker', radius=2, fill = TRUE,color='red') 


) 

    observeEvent(input$delete1, { 
    proxy <- leafletProxy('map') 
    if (input$delete1){ proxy %>% removeMarker(c("1","2")) 
    } 
    }) 

    observeEvent(input$delete3, { 
    proxy <- leafletProxy('map') 
    if (input$delete3){ proxy %>% removeMarker("3")} 
    }) 

})