从测量工具获取数据

Question

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

我尝试了很多不同的方法来订阅该事件，但没有一种方法被地图触发。

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

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

更改为此处提到的任何字段。

这是一个 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

这是一种使用

addMeasure()

中的

leaflet

函数和一些 JavaScript 来完成此操作的方法。

JavaScript 部分当然可以通过一些事件委托进行优化，因为按钮是动态呈现的。因此，我使用

setTimeout

函数每秒重新评估一次。我确信这可以以更顺利的方式完成，但我不是 JS 专家。 ;)

JavaScript 代码等待单击 完成测量 按钮并从此 HTML 部分

$('.js-results').children()[2].innerText

获取结果。 然后使用

measurefinish

将其传递给

Shiny.onInputChange

，以便您可以使用

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)