Sparkline in Leaflet popup/label within Shiny using leafletProxy

Question

I'm trying to add a sparkline in a leaflet label within a shiny app. I'm able to do this when not using leafletProxy, but can't figure out how to make it work when using leafletProxy (which need to use for my actual app).

See below example. For leaflet without proxy, the markers show up but the label is blank.

# 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)

Answer 1

The problem is that the onRender function is used to call Javascript code when the leaflet is rendered (that is in your renderLeaflet function). leafletProxy on the other hand does not re-render the leaflet, but allows to modify the existing leaflet. This is done in order to avoid re-running potentially heavy code.

One option is to put the onRender into the renderLeaflet function like this:

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