使用 LeafletProxy 在 Shiny 中的 Leaflet 弹出/标签中的迷你图答案

【问题标题】：Sparkline in Leaflet popup/label within Shiny using leafletProxy使用 LeafletProxy 在 Shiny 中的 Leaflet 弹出/标签中的迷你图
【发布时间】：2021-01-17 19:14:20
【问题描述】：

我正在尝试在闪亮应用中的传单标签中添加迷你图。我可以在不使用leafletProxy 时做到这一点，但在使用leafletProxy 时不知道如何让它工作（这需要用于我的实际应用程序）。

见下面的例子。对于没有代理的传单，标记显示但标签为空白。

# Some code adapted from here:
# http://bl.ocks.org/timelyportfolio/33db1fb9e64257ef7149754bdff0b2e0
library(leaflet)
library(htmlwidgets)
library(htmltools)
library(shiny)
library(dplyr)
library(sparkline)

as.character.htmlwidget <- function(x, ...) {
  htmltools::HTML(
    htmltools:::as.character.shiny.tag.list(
      htmlwidgets:::as.tags.htmlwidget(
        x
      ),
      ...
    )
  )
}

add_deps <- function(dtbl, name, pkg = name) {
  tagList(
    dtbl,
    htmlwidgets::getDependency(name, pkg)
  )
}

# Make dummy data --------------------------------------------------------------
data <- data.frame(lat = runif(100),
                   lon = runif(100),
                   value = runif(100),
                   id = rep(1:10, 10)) %>%
  group_by(id) %>%
  summarize(l_spark = spk_chr(value,
                              lineColor = 'orange', 
                              fillColor = 'orange',
                              chartRangeMin = 0,
                              chartRangeMax = 8,
                              tooltipChartTitle = "COVID-19 Cases",
                              highlightLineColor = 'orange', 
                              highlightSpotColor = 'orange'),
            lat = mean(lat),
            lon = mean(lon))


# UI ---------------------------------------------------------------------------
ui <- fluidPage(
  
  fluidRow(
    column(6, align = "center",
           strong("No Proxy"),
           uiOutput("map_no_proxy")
    ),
    column(6, align = "center",
           strong("With Proxy"),
           leafletOutput("map_with_proxy")
    )
  )
)

# Server ---------------------------------------------------------------------------
server <- (function(input, output, session) {
  
  # Map with Proxy --------------------------------------
  output$map_with_proxy <- renderLeaflet({
    
    leaflet() %>%
      addTiles()
    
  })
  
  observe({
    
    leafletProxy("map_with_proxy", data = data) %>% 
      addTiles() %>%
      addMarkers(
        ~lon, ~lat,
        label = ~lapply(l_spark, HTML)
      ) %>%
      onRender(
        "function(el,x) {
         this.on('tooltipopen', function() {HTMLWidgets.staticRender();})
         }
      ") %>%
      add_deps("sparkline") %>%
      browsable()
    
  })
  
  # Map without Proxy --------------------------------------
  output$map_no_proxy <- renderUI({
    
    leaflet(data = data) %>% 
      addTiles() %>%
      addMarkers(
        ~lon, ~lat,
        label = ~lapply(l_spark, HTML)
      ) %>%
      onRender(
        "function(el,x) {
         this.on('tooltipopen', function() {HTMLWidgets.staticRender();})
         }
      ") %>%
      add_deps("sparkline") %>%
      browsable()
    
  })
  
  
})

shinyApp(ui, server)

【问题讨论】：

标签： r shiny leaflet popup sparklines

【解决方案1】：

问题在于 onRender 函数用于在渲染传单时调用 Javascript 代码（即在您的 renderLeaflet 函数中）。另一方面，leafletProxy 不会重新渲染传单，但允许修改现有传单。这样做是为了避免重新运行可能很繁重的代码。

一种选择是将onRender 放入renderLeaflet 函数中，如下所示：

output$map_with_proxy <- renderLeaflet({
    
    leaflet() %>%
      addTiles() %>%
      onRender(
        "function(el,x) {
         this.on('tooltipopen', function() {HTMLWidgets.staticRender();})
         }
      ")
    
  })

【讨论】：