从 DT 行单击中选择传单上的标记，反之亦然 [英] selecting a marker on leaflet, from a DT row click and vice versa
问题描述
下面的最小示例呈现包含 3 个市场的传单地图和包含 3 个记录的 DT 表.当地图上的一个市场被选中时，表上的匹配记录也是如此.但是，我不能做的是也有相反的情况，在表格上单击的行也会在地图上显示相关的弹出窗口.
The minimal example below renders a leaflet map with 3 markets, and a DT table with 3 records. When a market on the map is selected, so to is the matching record on the table. However, what I cannot do, is to also have the reverse of that, where a clicked row on the table also shows the related popup on the map.
我一直无法找到执行类似操作的示例 R 闪亮传单应用程序.
I have been unable to find an example R shiny leaflet app that does something similar.
调整代码以反映最初的评论
CODE tweaked to reflect initial comments
library(shiny)
library(leaflet)
library(DT)
library(tidyverse)
# Define UI for application that draws a histogram
ui <- fluidPage(
leafletOutput("opsMap"),
DT::dataTableOutput('ranksDT')
)
# Define server logic required to draw a histogram
server <- function(input, output) {
lats <- c(21.608889,21.693056, 24.04)
longs <- c(-74.650833, -73.095,-74.341944)
popups <- c('a','b','c')
layerids <- c('a','b','c')
iconNames <- c('cog','cog','cog')
iconColors <- c('red','red','red')
sampleData <- tibble(lats,longs, popups,layerids,iconNames,iconColors)
score <- c(7,3,9)
locationRanks <- tibble(popups, score)
output$opsMap <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addAwesomeMarkers(lat = sampleData$lats,
lng = sampleData$longs,
popup = sampleData$popups,
layerId = sampleData$layerids,
icon = makeAwesomeIcon(icon=sampleData$iconNames,
markerColor=sampleData$iconColors))
})
output$ranksDT <- DT::renderDataTable({
d1 <- datatable(locationRanks,
selection = 'single',
rownames=FALSE,
options = list(dom = 'tpi',
pageLength =5,
paging=FALSE,
searching=FALSE
)
)
d1
})
# create a reactive value that will store the click position
mapClick <- reactiveValues(clickedMarker=NULL)
mapClick <- reactiveValues(clickedGroup=NULL)
# create a reactive for the DT table
locationClick <-reactiveValues(clickedRow = NULL)
# observe click events
observe({
mapClick$clickedMarker <- paste(input$opsMap_marker_click$id)
mapClick$clickedGroup <- paste(input$opsMap_marker_click$group)
locationClick$clickedRow <- input$ranksDT_rows_selected
})
# define a proxy variable for the plant rank table
proxy1 = dataTableProxy('ranksDT')
# when map is clicked, make the same table row selection - need row number
observeEvent(input$opsMap_marker_click$id, {
a <- which(locationRanks[1] == input$opsMap_marker_click$id)
proxy1 %>% selectRows(a)
})
proxy2 = leafletProxy('opsMap', session = shiny::getDefaultReactiveDomain())
# if table is clicked, select the same market from the map
observeEvent(locationClick$clickedRow, {
a <- as.character(locationRanks[locationClick$clickedRow,1])
cat(file=stderr(),"clicked row", locationClick$clickedRow, a,'
')
#proxy2 %>% opsMap_marker_click$id <- a
})
}
# Run the application
shinyApp(ui = ui, server = server)
推荐答案
一个解决方案是使用 input$map01_marker_click$id 和 dataTableProxy(), selectRows() 和 selectPage() 如果要突出显示数据表中的行.
A solution could be to use input$map01_marker_click$id together with dataTableProxy(), selectRows() and selectPage() if you want to highlight rows in the datatable.
为了突出标记，我认为您可以使用一些 javascript 来模拟对标记的点击.但我也会采用更简单的方法来添加突出显示的标记并在之后将其删除.
In order to highlight markers, i think you could either use some javascript to simulate a click on the marker. But i would also go for the easier way to adding a highlighted marker and removing it afterwards.
基本上你的问题在这个问题中得到了部分回答:Shiny - 如何在数据表中选择记录时突出显示传单地图上的对象? 其余部分在其中一个答案中.->归功于他们.由于代码很长，我努力将其减少到一个最小的可重现示例.
Basically your question was partly answered in this question: Shiny - how to highlight an object on a leaflet map when selecting a record in a datatable? and the remaining part was in one of the answers. -> credits to them. As the code was quity lengthy, i made the effort to reduce it towards a minimal reproducible example.
最小可重现示例:
library(shiny)
library(leaflet)
library(DT)
qDat <- quakes[1:10, ]
qDat$id <- seq.int(nrow(qDat))
ui <- fluidPage(
mainPanel(
leafletOutput('map01'),
dataTableOutput('table01')
)
)
server <- function(input,output){
output$table01 <- renderDataTable({
DT::datatable(qDat, selection = "single", options = list(stateSave = TRUE))
})
# to keep track of previously selected row
prev_row <- reactiveVal()
# new icon style
highlight_icon = makeAwesomeIcon(icon = 'flag', markerColor = 'green', iconColor = 'white')
observeEvent(input$table01_rows_selected, {
row_selected = qDat[input$table01_rows_selected, ]
proxy <- leafletProxy('map01')
proxy %>%
addAwesomeMarkers(popup = as.character(row_selected$mag),
layerId = as.character(row_selected$id),
lng = row_selected$long,
lat = row_selected$lat,
icon = highlight_icon)
# Reset previously selected marker
if(!is.null(prev_row())){
proxy %>%
addMarkers(popup = as.character(prev_row()$mag),
layerId = as.character(prev_row()$id),
lng = prev_row()$long,
lat = prev_row()$lat)
}
# set new value to reactiveVal
prev_row(row_selected)
})
output$map01 <- renderLeaflet({
leaflet(data = qDat) %>%
addTiles() %>%
addMarkers(popup = ~as.character(mag), layerId = as.character(qDat$id))
})
observeEvent(input$map01_marker_click, {
clickId <- input$map01_marker_click$id
dataTableProxy("table01") %>%
selectRows(which(qDat$id == clickId)) %>%
selectPage(which(input$table01_rows_all == clickId) %/% input$table01_state$length + 1)
})
}
shinyApp(ui = ui, server = server)
这篇关于从 DT 行单击中选择传单上的标记，反之亦然的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
