Question

我有一层CircleMarkers，我试图只删除具有某个layerId的标记。这些圈标记的ID位于数据框中。

下面是一个简单的例子：假设我有一个包含3行且id为1,2和3的数据帧。我尝试使用选项删除id＆＃39; s 1和2或3来创建一个checkboxInput。

在输入下方将触发使用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

由于某些原因，如果layerId和addCirleMarkers中的removeMarker是字符，您可以尝试使用服务器部分：

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

})

Answer 2

您可以执行以下操作，但是如果您取消选中该框，则他们现在设置的方式不会将标记放回。

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 3

我认为分组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)

删除R闪亮的特定传单标记。

3 个答案: