从 DT 行单击中选择传单上的标记，反之亦然

Question

下面的最小示例呈现包含 3 个市场的传单地图和包含 3 个记录的 DT 表。当地图上的一个市场被选中时，表上的匹配记录也是如此。但是，我不能做的是也有相反的情况，在表格上单击的行也会在地图上显示相关的弹出窗口。

我一直无法找到执行类似操作的示例 R 闪亮传单应用程序。

调整代码以反映初始 cmets

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,'\n')
        #proxy2 %>% opsMap_marker_click$id <- a
    })
    
    
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

这不是解决方案，只是我在查看代码时发现的一些事情。

1. ID plantRanks 在您的代码中只出现一次。

那是input$plantRanksDT_rows_selected。这样的事情很容易找到并且很容易修复。正确的id应该是数据表的输出id，所以ranksDT。替换后，您将看到第二个问题

1. proxy2 %>% opsMap_marker_click$id <- a 毫无意义。

input$opsMap_marker_click$id 存在但显然不能写。我不太清楚leaflet 代理是如何工作的，但是

leaflet::addMarkers()

看起来很有希望。祝你好运！

Answer 2

如果您想突出显示数据表中的行，一个解决方案可能是将input$map01_marker_click$id 与dataTableProxy()、selectRows() 和selectPage() 一起使用。

为了突出标记，我认为您可以使用一些 javascript 来模拟对标记的点击。但我也会采用更简单的方法来添加突出显示的标记并在之后将其删除。

基本上，您的问题在此问题中得到了部分回答：Shiny - how to highlight an object on a leaflet map when selecting a record in a datatable?，其余部分在其中一个答案中。 -> 归功于他们。 由于代码很长，我努力将其减少到一个最小的可重现示例。

最小的可重现示例：

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)