Question

我正在尝试获取用户在RShiny Leaflet地图上使用测量工具时的结果（特别是区域）。根据{{3}}，您可以在名为 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

这是一种使用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)

RShiny Leaflet-从测量工具获取数据

2 个答案: