在闪亮的传单中叠加图像观察事件

时间:2018-01-02 01:59:24

标签: r shiny

我有一个闪亮的应用程序,我需要在一个观察事件的实例中添加一个png图像。

我可以在Shiny之外实现这一点,但不是在观察功能中。我认为它与已经渲染的地图有关?

我已经简化了示例(因此只有一个png),但理想情况下我希望能够快速插入额外的png(即雷达图像)

library(shiny)
library(leaflet)
library(htmlwidgets)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "80%"),
  p(),
  actionButton("recalc", "Action")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    # Use leaflet() here, and only include aspects of the map that
    # won't need to change dynamically (at least, not unless the
    # entire map is being torn down and recreated).
    leaflet() %>%
      setView(lng = 153.240001, lat = -27.717732, zoom = 7) %>%
      addProviderTiles(providers$OpenStreetMap) %>% 
      addTiles() %>%  # Add default OpenStreetMap map tiles
      addMarkers(lng=153.240001, lat=-27.717732, popup="Mt Stapylton") 
    })
     points2 <- eventReactive(input$recalc, {
        TRUE
      }, ignoreNULL = FALSE)

  # Use the onRender function to add a png
  observe({
    points <- points2()
    leafletProxy("map") %>%
      htmlwidgets::onRender("
          function(el, x) {
            console.log(this);
            var myMap = this;
            var imageUrl = 'https://www.google.com.au/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png';
            var imageBounds = [[-25.58,150.71], [-30,155.88]];
            L.imageOverlay(imageUrl, imageBounds).addTo(myMap);
          }
        ")
      print("pass")
  })
}
shinyApp(ui, server)

### Working outside of leaflet
leaflet() %>%
  setView(lng = 153.240001, lat = -27.717732, zoom = 7) %>%
  addProviderTiles(providers$OpenStreetMap) %>% 
  addTiles() %>%  # Add default OpenStreetMap map tiles
  addMarkers(lng=153.240001, lat=-27.717732, popup="Mt Stapylton") %>%
    htmlwidgets::onRender("
    function(el, x) {
      console.log(this);
      var myMap = this;
      var imageUrl = 'https://www.google.com.au/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png';
      var imageBounds = [[-25.58,150.71], [-30,155.88]];
      L.imageOverlay(imageUrl, imageBounds).addTo(myMap);
    }
  ")

1 个答案:

答案 0 :(得分:1)

看来,leafletProxy没有提供从R方访问Leaflet Api的方法。

onRender肯定不起作用,因为leafletProxy的重点是不要重新渲染地图。

我找到的解决方案是使用onRender在创建传单时添加自定义事件处理程序,以便我们稍后可以访问Leaflet Api。

使用消息当然有点限制,但如果你想渲染图像的方式(给出src和bounds)总是相同的,那就足够了。

library(shiny)
library(leaflet)
library(htmlwidgets)

ui <- bootstrapPage(
  tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
  leafletOutput("map", width = "100%", height = "80%"),
  actionButton("recalc", "Action")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = 153.240001, lat = -27.717732, zoom = 7) %>%
      addProviderTiles(providers$OpenStreetMap) %>% 
      addTiles() %>%  # Add default OpenStreetMap map tiles
      addMarkers(lng=153.240001, lat=-27.717732, popup="Mt Stapylton") %>%
      htmlwidgets::onRender("
        function(el, x) {
          var myMap = this;
          // Saving a copy of the overlay to remove it when the next one comes.
          var overlay;

          Shiny.addCustomMessageHandler('setOverlay', function(message) {
            if (myMap.hasLayer(overlay)) myMap.removeLayer(overlay);

            overlay = L.imageOverlay(message.src, message.bounds);

            overlay.addTo(myMap);
          });
        }
      ")
  })

  observeEvent(input$recalc, {
    session$sendCustomMessage("setOverlay", list(
      src = 'https://www.google.com.au/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png',
      bounds = list(list(-25.58,150.71), list(-30,155.88))
    ))
  })
}

shinyApp(ui, server)