Листовка RShiny - Получение данных из инструмента измерения - PullRequest
Новая
       10

Листовка RShiny - Получение данных из инструмента измерения

3 голосов
/ 05 июня 2019

Я пытаюсь получить результаты (в частности, области), когда пользователь использует инструмент измерения на карте листовки RShiny.Согласно документации листовка-мера , вы можете подписаться на 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))
})

Ответы [ 2 ]

4 голосов
/ 11 июня 2019

Вы можете использовать функцию 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)
3 голосов
/ 11 июня 2019

Вот способ сделать это с помощью функции 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)
...