R highcharter——将图表保存到外部 iframe 的 html 文件?

R highcharter -- save charts to html file for external iframe?

如果您有 R highcharter 对象,如何将其导出到可以包含在 iframe 中的独立 html 文件中:

例如:

library(highcharter)
hc <- hchart(cbind(fdeaths, mdeaths), separate = FALSE)

然后,我正在寻找类似的东西:

 save_as_html(hc,filename)

Matlab 的 HighChart 代码是这样工作的:

hc = HighChart('datetime');
hc.series{1}.data = [ttt(ii3day), -vd(ii3day)];
hc.save('plot_hc.html');

生成的 plot_hc.html 代码类似于:

<!DOCTYPE html> 
<html> 
<body> 
<div id="con_8rHh7YjNg4" class="HighChart" style="width:800px; height:400px;"></div></body> 
<footer> 
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.8.2/jquery.min.js"></script> 
<script src="https://code.highcharts.com/highcharts.js"></script> 
<script src="https://code.highcharts.com/highcharts-more.js"></script> 
<script src="https://code.highcharts.com/modules/exporting.js"></script> 
<script src="https://code.highcharts.com/modules/heatmap.js"></script> 
<script> 
$(function () { 
 $('#con_8rHh7YjNg4').highcharts({ 
chart:{type:'line',zoomType:'x',panning:'true',panKey:'shift'}, 
title:{text:'observations'}, 
xAxis:{title:{text:'UTC Time'},type:'datetime'}, 
yAxis:{title:{text:'feet'}}, 
series:[{name:'Observations',data:[[1508371860000,-1.089000e+01],[1508371920000,-1.086000e+01],[1508371980000,-1.085000e+01],[1508372040000,-1.085000e+01],[1508372100000,-1.084000e+01],[1508372160000,-1.083000e+01],[1508372220000,-1.081000e+01],[1508372280000,-1.082000e+01],[1508372340000,-1.081000e+01],[1508372400000,-1.080000e+01],[1508372460000,-1.080000e+01],[1508372520000,-1.078000e+01],[1508372580000,-1.078000e+01],[1508372640000,-1.077000e+01],[1508372700000,-1.077000e+01],[1508372760000,-1.075000e+01],[1508372820000,-1.075000e+01],[1508372880000,-1.076000e+01],[1508372940000,-1.073000e+01],[1508373000000,-1.070000e+01],[1508373060000,-1.071000e+01],[1508373120000,-1.072000e+01],[1508373180000,-1.071000e+01],[1508373240000,-1.069000e+01],[1508373300000,-1.068000e+01],[1508373360000,-1.068000e+01],[1508373420000,-1.067000e+01],[1508373480000,-1.066000e+01],[1508373540000,-1.067000e+01],[1508373600000,-1.064000e+01],[1508373660000,-1.063000e+01],[1508373720000,-1.062000e+01],[1508373780000,-1.062000e+01],
}); 
}); 
</script> 
</footer> 
</html> 

这种 html 文件很容易在我所在机构的内容管理系统中用作 iframe,我想用 R 做类似的事情。

我试过 export_hc(hc,"plot_hc.html"),但似乎只有 javascript。 ?export_hc() 帮助似乎难以理解。我如何处理输出?我是否像 matlab 结果一样将它直接插入到模板中?

我试过 highchartOutput(hc)highchartOutput2(hc) 但我不确定如何使用 return 值。

预计到达时间:

我使用的是 0.5.0 版 https://github.com/jbkunst/highcharter/blob/v0.5.0/R/export_hc.R

使用 matlab 模板进行实验,如果我更改 div id 以匹配 export_hc 默认容器,它似乎工作正常,如 :

<!DOCTYPE html>
<html>
<body>
<div id="container" class="HighChart" style="width:800px; height:400px;"></div></body>
<footer>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.8.2/jquery.min.js"></script>
<script src="https://code.highcharts.com/highcharts.js"></script>
<script src="https://code.highcharts.com/highcharts-more.js"></script>
<script src="https://code.highcharts.com/modules/exporting.js"></script>
<script src="https://code.highcharts.com/modules/heatmap.js"></script>
<script>

.... export_hc() output pasted here

</script>
</footer>
</html>

看起来 github 版本的 highcharter::export_hc() 包括用于命名容器和格式化结果的附加选项,这些选项在 v0.5.0 版本中不可用。

预计到达时间:

如果我重新编写 export_hc 函数并添加一个丑陋的辅助函数,如下所示:

library(highcharter)

my_export_hc <- function (hc, filename = NULL) 
{
    . <- NULL
    jslns <- hc$x$hc_opts %>% toJSON(pretty = TRUE, auto_unbox = TRUE, 
        force = TRUE, null = "null") %>% str_split("\n") %>% 
        head(1) %>% unlist() %>% str_replace("\"", "") %>% str_replace("\":", 
        ":")
    fflag <- str_detect(jslns, "function()")
    if (any(fflag)) {
        jslns <- ifelse(fflag, str_replace(jslns, "\"function", 
            "function"), jslns)
        jslns <- ifelse(fflag, str_replace(jslns, "\",$", ","), 
            jslns)
        jslns <- ifelse(fflag, str_replace(jslns, "\"$", ""), 
            jslns)
        jslns <- ifelse(fflag, str_replace_all(jslns, "\\n", 
            str_c("\\n", str_extract(jslns, "^\s+"))), jslns)
    }
    jslns <- jslns %>% unlist() %>% tail(-1) %>% str_c("    ", 
        ., collapse = "\n") %>% str_replace_all("\n\s{4,}\]\,\n\s{4,}\[\n\s{4,}", 
        "],[") %>% sprintf("$(function () {\n  $('#container').highcharts({\n%s\n  );\n});", 
        .)
    if(length(filename)>0) { 
      if (!str_detect(filename, ".js$")) 
        filename <- str_c(filename, ".js")
      writeLines(jslns, filename) 
     } 
     else return(jslns)

}
environment(my_export_hc) <- asNamespace('highcharter')

my_save_hc <- function(hc,filename){

prefix_hc = '<!DOCTYPE html>
<html>
<body>
<div id="container" class="HighChart" style="width:800px; height:400px;"></div></body>
<footer>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.8.2/jquery.min.js"></script>
<script src="https://code.highcharts.com/highcharts.js"></script>
<script src="https://code.highcharts.com/highcharts-more.js"></script>
<script src="https://code.highcharts.com/modules/exporting.js"></script>
<script src="https://code.highcharts.com/modules/heatmap.js"></script>
<script>
'

suffix_hc = '</script>
</footer>
</html>
'

cat(prefix_hc,my_export_hc(hc),suffix_hc,file=filename)
}

那么这样的代码就可以工作了:

library(highcharter)
hc <- hchart(cbind(fdeaths, mdeaths), separate = FALSE)
my_save_hc(hc,"junk.html")

生产

<!DOCTYPE html>
<html>
<body>
<div id="container" class="HighChart" style="width:800px; height:400px;"></div></body>
<footer>
<script src="https://ajax.googleapis.com/ajax/libs/jquery/1.8.2/jquery.min.js"></script>
<script src="https://code.highcharts.com/highcharts.js"></script>
<script src="https://code.highcharts.com/highcharts-more.js"></script>
<script src="https://code.highcharts.com/modules/exporting.js"></script>
<script src="https://code.highcharts.com/modules/heatmap.js"></script>
<script>
 $(function () {
  $('#container').highcharts({
      title: {
        text: null
      },
      yAxis: {
        title: {
          text: null
        }
      },
      credits: {
        enabled: false
      },
      exporting: {
        enabled: false
      },
      plotOptions: {
        series: {
          turboThreshold: 0
        },
        treemap: {
          layoutAlgorithm: "squarified"
        },
        bubble: {
          minSize: 5,
          maxSize: 25
        }
      },
      annotationsOptions: {
        enabledButtons: false
      },
      tooltip: {
        delayForDisplay: 10
      },
      xAxis: {
        type: "datetime"
      },
      series: [
        {
          data: [
            [
              126230400000,
              901],[128908800000,
              689],[131328000000,
              827],[134006400000,
              677],[136598400000,
              522],[139276800000,
              406],[141868800000,
              441],[144547200000,
              393],[147225600000,
              387],[149817600000,
              582],[152496000000,
         //....
              940],[307584000000,
              1081],[310262400000,
              1294],[312854400000,
              1341
            ]
          ],
          name: "mdeaths",
          id: "mdeaths"
        }
      ]
    }
  );
}); </script>
</footer>
</html>

尝试使用 htmlwidgets::saveWidget:

library(highcharter)
library(htmlwidgets)

hc <- hchart(cbind(fdeaths, mdeaths), separate = FALSE)
saveWidget(hc, file="highchart.html")

输出为: