jbkunst / highcharter

R wrapper for highcharts
http://jkunst.com/highcharter/
Other
719 stars 148 forks source link

Could export_hc(hc) return the serialized javascript rather than always writing to a file? #371

Open drf5n opened 6 years ago

drf5n commented 6 years ago

Near the line:

https://github.com/jbkunst/highcharter/blob/0ed253196d33823e82fe4a73692450751534d81b/R/export_hc.R#L93

Could the code test if filename is NULL and otherwise return the string?

if (! is.null(filename))
    writeLines(jslns, filename)
else
    return(jsnls)

Note that the stopifnot() and .js appending code at the top of the function will abort the code before it gets to the writing stage.

drf5n commented 6 years ago

My use-case was trying to write a html file for use in iframes as in https://stackoverflow.com/questions/46869920/r-highcharter-save-charts-to-html-file-for-external-iframe

My workaround, for version 0.5.0, was this:

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

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

If export_hc() could emit a user-defined prefix and suffix, or could return the serialized object to the caller, it would be more useful. Maybe an as='html' option would be useful.

r-stata commented 3 years ago

My use-case was trying to write a html file for use in iframes as in https://stackoverflow.com/questions/46869920/r-highcharter-save-charts-to-html-file-for-external-iframe

My workaround, for version 0.5.0, was this:

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

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

If export_hc() could emit a user-defined prefix and suffix, or could return the serialized object to the caller, it would be more useful. Maybe an as='html' option would be useful.

I found my_ export_ hc sometimes has problems. The following code works better:

library(highcharter)
library(tidyverse)
library(jsonlite)
highcharts_demo() -> hc

hc$x$hc_opts %>% 
  toJSON(pretty = T, auto_unbox = T) %>% 
  str_replace_all('"(\\w+)":', "\\1:") %>% 
  paste0("Highcharts.chart('container', ", ., ");") %>% 
  writeLines("temp.js")

temp.js :

Highcharts.chart('container', {
  chart: {
    reflow: true
  },
  title: {
    text: "Monthly Average Temperature"
  },
  yAxis: {
    title: {
      text: "Temperature"
    }
  },
  credits: {
    enabled: true,
    text: "Made with highcharter",
    href: "http://jkunst.com/highcharter/"
  },
  exporting: {
    enabled: false
  },
  boost: {
    enabled: false
  },
  plotOptions: {
    series: {
      label: {
        enabled: false
      },
      turboThreshold: 0
    },
    treemap: {
      layoutAlgorithm: "squarified"
    }
  },
  subtitle: {
    text: "Source: WorldClimate.com"
  },
  caption: {
    text: "This is a caption text to show the style of this type of text"
  },
  xAxis: {
    title: {
      text: "Months"
    },
    categories: ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
  },
  series: [
    {
      data: [7, 6.9, 9.5, 14.5, 18.2, 21.5, 25.2, 26.5, 23.3, 18.3, 13.9, 9.6],
      name: "Tokyo"
    },
    {
      data: [3.9, 4.2, 5.7, 8.5, 11.9, 15.2, 17, 16.6, 14.2, 10.3, 6.6, 4.8],
      name: "London"
    },
    {
      data: [-0.9, 0.6, 3.5, 8.4, 13.5, 17, 18.6, 17.9, 14.3, 9, 3.9, 1],
      name: "Berlin"
    }
  ]
});
drf5n commented 3 months ago

Yes, my workaround above was a modified copy of and older version of export_hc.R. The newer version of export_hr.R is simplified and improved as in @r-stata's reply. See:

https://github.com/jbkunst/highcharter/blob/main/R/export_hc.R