R Shiny Leaflet- 从测量工具获取数据

Question

我正在尝试获取用户在 RShiny Leaflet 地图上使用测量工具时的结果（具体区域）。根据leaflet-measure documentation，您可以在名为 measurestart 和 measurefinish 的传单地图上订阅 2 个事件。我需要订阅这些事件并获取事件提供的结果数据，但我不知道如何。

我尝试了许多不同的方式来订阅该事件，但都没有被地图触发。

这是一些感觉最接近工作的代码：

observeEvent(input$map1_measurefinish, {
    print("user finished measurement")
})

或

observeEvent(input$measurefinish, {
    print("user finished measurement")
})

我的服务器部分的传单代码如下所示：

output$map1 <-renderLeaflet({
      m<-leaflet() %>%
      addProviderTiles('Esri.WorldImagery') %>%...
# there's more code here but I don't think its relevant for the issue

我需要做什么来 1. 正确订阅事件以检测测量何时完成 2. 接收输出数据以在观察者方法中执行操作？

编辑：解决方案（由@NicE 给出）

我对代码所做的更改以使其正常工作：

在传单里面添加了标记代码：

output$map1 <-renderLeaflet({
     m<-leaflet() %>%
     addMeasure() %>%
     # Start
     htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
          function (e) {
            Shiny.onInputChange('selectedArea', e.area);
            Shiny.onInputChange('inputtedCoordinates', e.lastCoord);
          })
        }")
     # End

另外添加了一个观察者（会做比打印更激动人心的事情）：

observeEvent(input$selectedArea, {
    print(paste0("area received:", input$selectedArea))
})

Answer 1

您可以利用onRender 函数将侦听器添加到插件事件。例如，您可以尝试：

leaflet() %>% addTiles() %>%
      fitBounds(-73.9, 40.75, -73.95,40.8) %>%
      addMeasure() %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
            function (e) {
              Shiny.onInputChange('selectedArea', e.area);
            })
        }")

这会在measurefinish 上添加一个侦听器，并将area 传递给selectedArea 闪亮输入。您可以将e.area 更改为提及here 的任何字段。

这是一个 MWE：

library(leaflet)
library(shiny)


ui <- fluidPage(
  leafletOutput("mymap"),
  br(),
  textOutput("areaText")
)

server <- function(input, output, session) {

  output$mymap <- renderLeaflet({
    leaflet() %>% addTiles() %>%
      fitBounds(-73.9, 40.75, -73.95,40.8) %>%
      addMeasure() %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
            function (e) {
              Shiny.onInputChange('selectedArea', e.area);
            })
        }")
    })

  output$areaText <- renderText({
    paste("Area",input$selectedArea)
  })
}

shinyApp(ui, server)

Answer 2

这是使用来自leaflet 的addMeasure() 函数和一些JavaScript 的方法。

JavaScript 部分当然可以通过一些事件委托进行优化，因为按钮是动态呈现的。因此，我使用了一个 setTimeout 函数，它每秒重新评估一次。我确信这可以以更顺畅的方式完成，但我不是 JS 专家。 ;)

JavaScript 代码等待点击 完成测量 按钮并从此 HTML 部分 $('.js-results').children()[2].innerText 获取结果。 然后使用Shiny.onInputChange 将其传递给measurefinish，以便您可以使用input$measurefinish 在服务器代码中访问此值。

一种可能的解决方案：

library(shiny)

library(leaflet)

js <- HTML("
$(document).on('shiny:connected', function(event) {
   setTimeout(function(){
    var fin = document.getElementsByClassName('js-finish');
    fin[0].addEventListener('click', function eventHandler(event) {
      var area = $('.js-results').children()[2].innerText;
      Shiny.onInputChange('measurefinish', area);
    });
  }, 1000);
});
")

ui <- fluidPage(
  tags$head(tags$script(js)),
  leafletOutput("map1"),
  verbatimTextOutput("area")
)

server <- function(input, output, session) {
  output$map1 <-renderLeaflet({
    m<-leaflet() %>%
      addMeasure() %>%
      addProviderTiles('Esri.WorldImagery')
    m
  })


  output$area <- renderText({
    req(input$measurefinish)
    area <- input$measurefinish
    area <- gsub(pattern = "\n", "", x = area, fixed = T)
    ## Convert to numeric value 
    # area <- regmatches(area, regexpr("\\(?[0-9,.]+", area))
    # area <- as.numeric(gsub(pattern = ",", "", area, fixed=T))
    area
  })
}

shinyApp(ui, server)

---

根据您对@NicE 回答的评论，我编辑了他的代码以总结所有面积测量值。我正在使用一个 reactiveValues 对象来汇总该区域。要将总面积重置为 0，我使用 actionButton 和 observeEvent 部分。

library(leaflet)
library(shiny)

ui <- fluidPage(
  leafletOutput("mymap"),
  br(),
  actionButton("resetArea", label = "Reset total area to 0"),
  textOutput("areaText"),
  textOutput("areaSumText")
)

server <- function(input, output, session) {

  output$mymap <- renderLeaflet({
    leaflet() %>% addTiles() %>%
      fitBounds(-73.9, 40.75, -73.95,40.8) %>%
      addMeasure() %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          myMap.on('measurefinish',
            function (e) {
              Shiny.onInputChange('selectedArea', e.area);
            })
        }")
  })

  totalArea <- reactiveValues(sum = NULL)

  observe({
    req(input$selectedArea)
    isolate({
      if (is.null(totalArea$sum)) {
        totalArea$sum = input$selectedArea
      } else {
        totalArea$sum = totalArea$sum + input$selectedArea
      }
    })
  })
  observeEvent(input$resetArea, {
    totalArea$sum = NULL
  })

  output$areaText <- renderText({
    paste("Area",input$selectedArea)
  })
  output$areaSumText <- renderText({
    req(totalArea$sum)
    paste("Sum of Area",totalArea$sum)
  })

}

shinyApp(ui, server)