如何清除与 DT 链接的传单地图上的标记？
How do I clear the markers on a leaflet map linked with a DT?
基于此示例https://travisknocherstats.com/posts/2020-05-18-linked-dt-datatable-with-leaflet-map-in-r-shiny/ 可以link DT 和传单。 DT 上的选定行绘制在传单上。
我做了一些修改，以便默认情况下能够有一张地图〜标记以红色绘制，然后当用户 select 在 DT 上一行时，传单上的标记在 blue.It 中突出显示工作正常所以远的。
1- 但是，当该行在 DT 上取消 select 时，蓝色突出显示仍然显示。如何解决这个问题呢。
2 - 使用操作按钮 ~ 清除 table selections ~ 移除所有蓝色和红色标记。但是，我只想让蓝色高光消失，同时保留我的红色标记。
下面是我的代码，带有可重现的示例。
谢谢
require(shiny)
require(leaflet)
require(DT)
require(tidyverse)
shiny::shinyApp(
ui = fluidPage(
column(
width = 3,
br(),
actionButton(
"select_all_rows_button",
"Select All Table Rows"
),
br(),
actionButton(
"clear_rows_button",
"Clear Table Selections"
)
),
column(
width = 9,
fluidRow(
column(
width = 12,
solidHeader = TRUE,
leafletOutput(
"my_leaflet"
)
)
),
fluidRow(
column(
width = 12,
solidHeader = TRUE,
DTOutput(
"my_datatable"
)
)
)
)
),
server = function(session, input, output) {
quakes_r <- reactive({ as_tibble(quakes) })
output$my_datatable <- renderDT({
quakes_r() %>%
datatable()
})
# base map that we will add points to with leafletProxy()
output$my_leaflet <- renderLeaflet({
leaflet() %>%
addProviderTiles(
provider = providers$CartoDB.Positron,
options = providerTileOptions(
noWrap = FALSE
)
) %>%
addCircleMarkers(
data = quakes_r(),
lng = ~long,
lat = ~lat,
fillColor = "red",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4
)%>%
setView(
lat = -25.5,
lng = 178.58,
zoom = 4
)
})
observeEvent(input$my_datatable_rows_selected, {
selected_lats <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$lat[c(unique(input$my_datatable_rows_selected))])
})
selected_longs <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$long[c(unique(input$my_datatable_rows_selected))])
})
selected_depths <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$depth[c(unique(input$my_datatable_rows_selected))])
})
selected_mags <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$mag[c(unique(input$my_datatable_rows_selected))])
})
selected_stations <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$stations[c(unique(input$my_datatable_rows_selected))])
})
# this is the data that will be passed to the leaflet in the addCircleMarkers argument,
# as well as the popups when the points are hovered over
map_df <- reactive({
tibble(lat = unlist(selected_lats()),
lng = unlist(selected_longs()),
depth = unlist(selected_depths()),
mag = unlist(selected_mags()),
stations = unlist(selected_stations()))
})
leafletProxy("my_leaflet", session) %>%
# clearMarkers() %>%
addCircleMarkers(
data = map_df(),
lng = ~lng,
lat = ~lat,
fillColor = "blue",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4,
popup = paste0("lat: ", map_df()$lat, "<br>",
"lng: ", map_df()$lng, "<br>",
"depth: ", map_df()$depth, "<br>",
"mag: ", map_df()$mag, "<br>",
"stations: ", map_df()$stations)
)
})
# create a proxy to modify datatable without recreating it completely
DT_proxy <- dataTableProxy("my_datatable")
# clear row selections when clear_rows_button is clicked
observeEvent(input$clear_rows_button, {
selectRows(DT_proxy, NULL)
})
# clear markers from leaflet when clear_rows_button is clicked
observeEvent(input$clear_rows_button, {
clearMarkers(leafletProxy("my_leaflet", session))
})
# select all rows when select_all_rows_button is clicked
observeEvent(input$select_all_rows_button, {
selectRows(DT_proxy, input$my_datatable_rows_all)
})
}
)
这里的解决方案按预期工作并摆脱了很多不必要的reactives/observer:
server = function(session, input, output) {
quakes <- as_tibble(quakes)
group_name <- "my_additons"
output$my_datatable <- renderDT({
quakes %>%
datatable()
})
# base map that we will add points to with leafletProxy()
output$my_leaflet <- renderLeaflet({
leaflet() %>%
addProviderTiles(
provider = providers$CartoDB.Positron,
options = providerTileOptions(
noWrap = FALSE
)
) %>%
addCircleMarkers(
data = quakes,
lng = ~long,
lat = ~lat,
group = "original",
fillColor = "red",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4
) %>%
setView(
lat = -25.5,
lng = 178.58,
zoom = 4
)
})
observe({
sel <- quakes[input$my_datatable_rows_selected, ]
leafletProxy("my_leaflet") %>%
clearGroup(group_name) %>%
addCircleMarkers(
data = sel,
lng = ~long,
lat = ~lat,
group = group_name,
fillColor = "blue",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4,
popup = ~ paste0("lat: ", lat, "<br>",
"lng: ", long, "<br>",
"depth: ", depth, "<br>",
"mag: ", mag, "<br>",
"stations: ", stations)
)
})
# create a proxy to modify datatable without recreating it completely
DT_proxy <- dataTableProxy("my_datatable")
# clear row selections when clear_rows_button is clicked
observeEvent(input$clear_rows_button, {
selectRows(DT_proxy, NULL)
leafletProxy("my_leaflet") %>%
clearGroup(group_name)
})
# select all rows when select_all_rows_button is clicked
observeEvent(input$select_all_rows_button, {
selectRows(DT_proxy, input$my_datatable_rows_all)
})
}
- 想法是将所有手动点击分配给
group，然后您可以通过 clearGroup 而不是 clearMarkers 轻松删除整个组。
quakes不会改变，所以不需要让它响应。- 您可以为
row_selection 大量清理 observer
基于此示例https://travisknocherstats.com/posts/2020-05-18-linked-dt-datatable-with-leaflet-map-in-r-shiny/ 可以link DT 和传单。 DT 上的选定行绘制在传单上。 我做了一些修改，以便默认情况下能够有一张地图〜标记以红色绘制，然后当用户 select 在 DT 上一行时，传单上的标记在 blue.It 中突出显示工作正常所以远的。 1- 但是，当该行在 DT 上取消 select 时，蓝色突出显示仍然显示。如何解决这个问题呢。 2 - 使用操作按钮 ~ 清除 table selections ~ 移除所有蓝色和红色标记。但是，我只想让蓝色高光消失，同时保留我的红色标记。
下面是我的代码，带有可重现的示例。 谢谢
require(shiny)
require(leaflet)
require(DT)
require(tidyverse)
shiny::shinyApp(
ui = fluidPage(
column(
width = 3,
br(),
actionButton(
"select_all_rows_button",
"Select All Table Rows"
),
br(),
actionButton(
"clear_rows_button",
"Clear Table Selections"
)
),
column(
width = 9,
fluidRow(
column(
width = 12,
solidHeader = TRUE,
leafletOutput(
"my_leaflet"
)
)
),
fluidRow(
column(
width = 12,
solidHeader = TRUE,
DTOutput(
"my_datatable"
)
)
)
)
),
server = function(session, input, output) {
quakes_r <- reactive({ as_tibble(quakes) })
output$my_datatable <- renderDT({
quakes_r() %>%
datatable()
})
# base map that we will add points to with leafletProxy()
output$my_leaflet <- renderLeaflet({
leaflet() %>%
addProviderTiles(
provider = providers$CartoDB.Positron,
options = providerTileOptions(
noWrap = FALSE
)
) %>%
addCircleMarkers(
data = quakes_r(),
lng = ~long,
lat = ~lat,
fillColor = "red",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4
)%>%
setView(
lat = -25.5,
lng = 178.58,
zoom = 4
)
})
observeEvent(input$my_datatable_rows_selected, {
selected_lats <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$lat[c(unique(input$my_datatable_rows_selected))])
})
selected_longs <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$long[c(unique(input$my_datatable_rows_selected))])
})
selected_depths <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$depth[c(unique(input$my_datatable_rows_selected))])
})
selected_mags <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$mag[c(unique(input$my_datatable_rows_selected))])
})
selected_stations <- eventReactive(input$my_datatable_rows_selected, {
as.list(quakes_r()$stations[c(unique(input$my_datatable_rows_selected))])
})
# this is the data that will be passed to the leaflet in the addCircleMarkers argument,
# as well as the popups when the points are hovered over
map_df <- reactive({
tibble(lat = unlist(selected_lats()),
lng = unlist(selected_longs()),
depth = unlist(selected_depths()),
mag = unlist(selected_mags()),
stations = unlist(selected_stations()))
})
leafletProxy("my_leaflet", session) %>%
# clearMarkers() %>%
addCircleMarkers(
data = map_df(),
lng = ~lng,
lat = ~lat,
fillColor = "blue",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4,
popup = paste0("lat: ", map_df()$lat, "<br>",
"lng: ", map_df()$lng, "<br>",
"depth: ", map_df()$depth, "<br>",
"mag: ", map_df()$mag, "<br>",
"stations: ", map_df()$stations)
)
})
# create a proxy to modify datatable without recreating it completely
DT_proxy <- dataTableProxy("my_datatable")
# clear row selections when clear_rows_button is clicked
observeEvent(input$clear_rows_button, {
selectRows(DT_proxy, NULL)
})
# clear markers from leaflet when clear_rows_button is clicked
observeEvent(input$clear_rows_button, {
clearMarkers(leafletProxy("my_leaflet", session))
})
# select all rows when select_all_rows_button is clicked
observeEvent(input$select_all_rows_button, {
selectRows(DT_proxy, input$my_datatable_rows_all)
})
}
)
这里的解决方案按预期工作并摆脱了很多不必要的reactives/observer:
server = function(session, input, output) {
quakes <- as_tibble(quakes)
group_name <- "my_additons"
output$my_datatable <- renderDT({
quakes %>%
datatable()
})
# base map that we will add points to with leafletProxy()
output$my_leaflet <- renderLeaflet({
leaflet() %>%
addProviderTiles(
provider = providers$CartoDB.Positron,
options = providerTileOptions(
noWrap = FALSE
)
) %>%
addCircleMarkers(
data = quakes,
lng = ~long,
lat = ~lat,
group = "original",
fillColor = "red",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4
) %>%
setView(
lat = -25.5,
lng = 178.58,
zoom = 4
)
})
observe({
sel <- quakes[input$my_datatable_rows_selected, ]
leafletProxy("my_leaflet") %>%
clearGroup(group_name) %>%
addCircleMarkers(
data = sel,
lng = ~long,
lat = ~lat,
group = group_name,
fillColor = "blue",
stroke = TRUE,
color = "white",
radius = 3,
weight = 1,
fillOpacity = 0.4,
popup = ~ paste0("lat: ", lat, "<br>",
"lng: ", long, "<br>",
"depth: ", depth, "<br>",
"mag: ", mag, "<br>",
"stations: ", stations)
)
})
# create a proxy to modify datatable without recreating it completely
DT_proxy <- dataTableProxy("my_datatable")
# clear row selections when clear_rows_button is clicked
observeEvent(input$clear_rows_button, {
selectRows(DT_proxy, NULL)
leafletProxy("my_leaflet") %>%
clearGroup(group_name)
})
# select all rows when select_all_rows_button is clicked
observeEvent(input$select_all_rows_button, {
selectRows(DT_proxy, input$my_datatable_rows_all)
})
}
- 想法是将所有手动点击分配给
group，然后您可以通过clearGroup而不是clearMarkers轻松删除整个组。 quakes不会改变，所以不需要让它响应。- 您可以为
row_selection 大量清理
observer