R - 傳單 - highcharter 工具提示

Question

我想在我的leaflet彈出窗口中包含一個highcharter圖。 在這篇文章的幫助下，我能夠包含一個sparkline圖。 但是，由於我缺乏 html 技能，我不知道如何修改代碼以使用highcharter 。 這個關於 SO 的答案（來自答案的例子）正是我想要的。 我只是不知道如何在R實現。

library(leaflet)
library(tidyverse)
library(htmlwidgets)
library(htmltools)
library(sparkline)
library(highcharter)

# Step 1 convert htmlwidget to character representation of HTML components
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)
  )
}

這工作正常：

leaflet() %>% 
  addTiles() %>% 
  addCircleMarkers(lat = 45.4, lng = 14.9,
                   popup = list(paste(as.character(sparkline(1:19))))) %>%
  onRender(
    "
function(el,x) {
  this.on('popupopen', function() {HTMLWidgets.staticRender();})
}
") %>%
  add_deps("sparkline") %>%
  browsable()

不幸的是，它不僅僅是將add_deps更改為highcharter

leaflet() %>% 
  addTiles() %>% 
  addCircleMarkers(lat = 45.4, lng = 14.9,
                   popup = list(paste(as.character(
                     hchart(data.frame(x = 1:10, y = 1:10), type = "line", hcaes(x = x, y = y)) %>% hc_size(width = 300, height = 200)
                     ))),
                   popupOptions = popupOptions(minWidth = 300, maxHeight = 200)) %>%
  onRender(
    "
function(el,x) {
  this.on('popupopen', function() {HTMLWidgets.staticRender();})
}
") %>%
  add_deps("highcharter") %>%
  browsable()

我曾嘗試修改“popupopen”功能但沒有成功。

Answer 1

一、解決辦法：

leaflet() %>% 
  addTiles() %>% 
  addCircleMarkers(lat = 45.4, lng = 14.9,
                   popup = list(paste(as.character(
                     hchart(data.frame(x = 1:10, y = 1:10), type = "line", hcaes(x = x, y = y)) %>% hc_size(width = 300, height = 200)
                   ))),
                   popupOptions = popupOptions(minWidth = 300, maxHeight = 200)) %>%
  onRender(
    "
function(el,x) {
  this.on('popupopen', function() {HTMLWidgets.staticRender();})
}
") %>%
  add_deps("highchart", 'highcharter') %>%
  browsable()

而現在，為什么？

這是由於add_deps函數：

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

如您所見，它在內部使用htmlwidgets::getDependency 。 如果我們嘗試使用leaflet包：

library(htmlwidgets)
getDependency('leaflet')[1:3]
#> [[1]]
#> List of 10
#>  $ name      : chr "htmlwidgets"
#>  $ version   : chr "1.5.1"
#>  $ src       :List of 1
#>   ..$ file: chr "/home/malditobarbudo/R/x86_64-pc-linux-gnu-library/3.6/htmlwidgets/www"
#>  $ meta      : NULL
#>  $ script    : chr "htmlwidgets.js"
#>  $ stylesheet: NULL
#>  $ head      : NULL
#>  $ attachment: NULL
#>  $ package   : NULL
#>  $ all_files : logi TRUE
#>  - attr(*, "class")= chr "html_dependency"
#> 
#> [[2]]
#> List of 10
#>  $ name      : chr "jquery"
#>  $ version   : chr "1.12.4"
#>  $ src       :List of 1
#>   ..$ file: chr "/home/malditobarbudo/R/x86_64-pc-linux-gnu-library/3.6/leaflet/htmlwidgets/lib/jquery"
#>  $ meta      : NULL
#>  $ script    : chr "jquery.min.js"
#>  $ stylesheet: NULL
#>  $ head      : NULL
#>  $ attachment: NULL
#>  $ package   : NULL
#>  $ all_files : logi TRUE
#>  - attr(*, "class")= chr "html_dependency"
#> 
#> [[3]]
#> List of 10
#>  $ name      : chr "leaflet"
#>  $ version   : chr "1.3.1"
#>  $ src       :List of 1
#>   ..$ file: chr "/home/malditobarbudo/R/x86_64-pc-linux-gnu-library/3.6/leaflet/htmlwidgets/lib/leaflet"
#>  $ meta      : NULL
#>  $ script    : chr "leaflet.js"
#>  $ stylesheet: chr "leaflet.css"
#>  $ head      : NULL
#>  $ attachment: NULL
#>  $ package   : NULL
#>  $ all_files : logi TRUE
#>  - attr(*, "class")= chr "html_dependency"

^{由reprex 包(v0.3.0) 於 2019 年 12 月 5 日創建}

我們可以看到它返回了一個leaflet js依賴項列表（截斷為前三個）。 如果我們對highcharter嘗試相同的highcharter它不會返回任何依賴項（除了強制性的 htmlwidgets 依賴項）

library(htmlwidgets)
getDependency('highcharter')
#> [[1]]
#> List of 10
#>  $ name      : chr "htmlwidgets"
#>  $ version   : chr "1.5.1"
#>  $ src       :List of 1
#>   ..$ file: chr "/home/malditobarbudo/R/x86_64-pc-linux-gnu-library/3.6/htmlwidgets/www"
#>  $ meta      : NULL
#>  $ script    : chr "htmlwidgets.js"
#>  $ stylesheet: NULL
#>  $ head      : NULL
#>  $ attachment: NULL
#>  $ package   : NULL
#>  $ all_files : logi TRUE
#>  - attr(*, "class")= chr "html_dependency"
#> 
#> [[2]]
#> NULL

^{由reprex 包(v0.3.0) 於 2019 年 12 月 5 日創建}

這是因為highcharter是 R 包名，而不是 js 庫名。 您可以查看list.files(system.file('htmlwidgets', package = 'highcharter'))以查看該庫名為highchart ，因此在此位使用正確的名稱：

{...} %>%
  add_deps("highchart", 'highcharter') %>%
  {...}

會做的伎倆;)

Answer 2

你好@Pierre 和@MalditoBarbudo，我試圖在一個閃亮的應用程序中調整你的例子，但我無法正確運行它

請問我有什么幫助嗎？

library(shiny)
library(tidyverse)
library(htmlwidgets)
library(htmltools)
library(leaflet)
library(highcharter)

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


ui = fluidPage(
  leafletOutput("map")
)

#server.r
server = function(input, output, session) {


  output$map <- renderLeaflet({
    leaflet() %>% 
      addTiles() %>% 
      addCircleMarkers(lat = 45.4, lng = 14.9,
                       popup = list(paste(as.character(
                         hchart(data.frame(x = 1:10, y = 1:10), type = "line", hcaes(x = x, y = y)) %>% hc_size(width = 300, height = 200)
                       ))),
                       popupOptions = popupOptions(minWidth = 300, maxHeight = 200)) %>%
      onRender(
        "
function(el,x) {
  this.on('popupopen', function() {HTMLWidgets.staticRender();})
}
") %>%
      add_deps("highchart", 'highcharter') %>%
      browsable()

    })
}

shinyApp(ui = ui, server = server)