删除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")} 
    }) 

})