improvements to 1.6.0

Author: helgasoft

R/echarty.R

@@ -47,9 +47,11 @@ NULL
 #'  * load - name(s) of plugin(s) to load. A character vector or comma-delimited string. default NULL.
 #'  * ask - prompt user before downloading plugins when _load_ is present, FALSE by default
 #'  * js - single string or a vector with JavaScript expressions to evaluate.\cr 
-#'      First expression is evaluated before chart initialization. \cr
-#'      Second is evaluated with exposed object _opts_. \cr
-#'      Third is evaluated with exposed _chart_ object after _opts_ have been set.
+#'    single: exposed _chart_ object (most common)\cr
+#'    vector:\cr
+#'  \verb{     }First expression is evaluated before chart initialization. \cr
+#'  \verb{     }Second is evaluated with exposed object _opts_. \cr
+#'  \verb{     }Third is evaluated with exposed _chart_ object after _opts_ set.
 #'  * renderer - 'canvas'(default) or 'svg'
 #'  * locale - 'EN'(default) or 'ZH'. Use predefined or custom \href{https://gist.github.com/helgasoft/0618c6537c45bfd9e86d3f9e1da497b8}{like so}.
 #'  * useDirtyRect - enable dirty rectangle rendering or not, FALSE by default, see \href{https://echarts.apache.org/en/api.html#echarts.init}{here}

R/examples.R

@@ -429,18 +429,16 @@
 #' 
 #' #------ Sankey and graph plots
 #' sankey <- data.frame(
-#'   node   = c("a","b", "c", "d", "e"),
+#'   name   = c("a","b", "c", "d", "e"),
 #'   source = c("a", "b", "c", "d", "c"),
 #'   target = c("b", "c", "d", "e", "e"),
 #'   value  = c(5, 6, 2, 8, 13)
 #' )
 #' data <- ec.data(sankey, 'names')
-#' 
 #' ec.init(preset= FALSE,
-#'         series= list(list(
-#'           type= 'sankey',
-#'           data= lapply(data, function(x) list(name= x$node)),
-#'           edges= data ))
+#'   series= list(list( type= 'sankey',
+#'     data= data,
+#'     edges= data ))
 #' )
 #'
 #'
@@ -465,20 +463,17 @@
 #' 
 #' #------ group connect 
 #' main <- mtcars |> ec.init(height= 200, legend= list(show=FALSE),
-#'   series.param= list(name= "this legend is shared"))
+#' 		 tooltip= list(axisPointer= list(axis='x')),
+#'     series.param= list(name= "this legend is shared"))
 #' main$x$group <- 'group1' # same group name for all charts
-#' 
-#' q1 <- main |> ec.upd({ series[[1]]$encode <- list(y='hp', x='mpg')
-#'                    legend <- list(show=TRUE)  # show first legend to share
+#' main$x$connect <- 'group1'
+#' q1 <- main |> ec.upd({ series[[1]]$encode <- list(y='hp'); yAxis$name <- 'hp'
+#'        legend <- list(show=TRUE)  # show first legend to share
 #' })
-#' q2 <- main |> ec.upd({ series[[1]]$encode <- list(y='wt', x='mpg') })
-#' q3 <- main |> ec.upd({ series[[1]]$encode <- list(y='drat', x='mpg') })
-#' q4 <- main |> ec.upd({ series[[1]]$encode <- list(y='qsec', x='mpg')})
-#' q4$x$connect <- 'group1'
-#' # q4$x$disconnect <- 'group1'
-#' if (interactive()) {   # browsable
-#'   ec.util(cmd='layout', list(q1,q2,q3,q4), cols=2, title='group connect')
-#' }
+#' q2 <- main |> ec.upd({ series[[1]]$encode <- list(y='wt'); yAxis$name <- 'wt' })
+#' #if (interactive()) {   # browsable
+#'   ec.util(cmd='layout', list(q1,q2), cols=2, title='group connect')
+#' #}
 #' 
 #' 
 #' #------ Events in Shiny

R/util.R

@@ -1080,8 +1080,9 @@ ec.theme <- function (wt, name, code= NULL)
 #' \verb{   }'opts' - the htmlwidget _options_ as JSON (default)\cr
 #' \verb{   }'full' - the _entire_ htmlwidget as JSON\cr
 #' \verb{   }'data' - info about chart's embedded data (char vector)
-#' @param ... Additional attributes to pass to \link[jsonlite]{toJSON}
-#' @return A JSON string, except when \code{target} is 'data' then
+#' @param ... Additional attributes to pass to \link[jsonlite]{toJSON}\cr
+#' 'file' - optional file name to save to when target='full'\cr
+#' @return A JSON string, except when \code{target} is 'data' - then
 #'  a character vector.
 #'
 #' @details Must be invoked or chained as last command.\cr
@@ -1099,8 +1100,16 @@ ec.theme <- function (wt, name, code= NULL)
 ec.inspect <- function(wt, target='opts', ...) {
 
   stopifnot("ec.inspect: target only 'opts', 'data' or 'full'"= target %in% c('opts','data','full'))
-	if (target=='full')
-		return(jsonlite::serializeJSON(wt))
+	if (target=='full') {
+	  jjwt <- jsonlite::serializeJSON(wt)
+	  opts <- list(...)
+	  if ('file' %in% names(opts)) {
+	    fn <- opts$file
+      con <- file(fn,'wb'); write(jjwt, con); close(con)
+      return(paste('saved in',fn))
+	  } else
+	    return(jjwt)
+	}
   opts <- wt$x$opts
 
   if (target=='data') {
@@ -1154,15 +1163,16 @@ ec.inspect <- function(wt, target='opts', ...) {
 #' @return An _echarty_ widget.
 #' 
 #' @details _txt_ could be either a list of options (x$opts) to be set by \href{https://echarts.apache.org/en/api.html#echartsInstance.setOption}{setOption},\cr
-#'  OR an entire _htmlwidget_ generated thru \code{ec.inspect(target='full')}.\cr
+#'  OR an entire _htmlwidget_ generated thru [ec.inspect] when _target='full'_.\cr
 #'  The latter imports all JavaScript functions defined by the user.
 #' 
 #' @examples
 #' txt <- '{
 #'    "xAxis": { "data": ["Mon", "Tue", "Wed"]}, "yAxis": { },
 #'    "series": { "type": "line", "data": [150, 230, 224] } }'
 #' ec.fromJson(txt)
-#'
+#' 
+#' # ec.fromJson('https://helgasoft.github.io/echarty/test/pfull.json')
 #' @export
 ec.fromJson <- function(txt, ...) {
 	recur <- \(opts) {
@@ -1185,17 +1195,6 @@ ec.fromJson <- function(txt, ...) {
 
 	if (inherits(txt, c('url','file')))
   		return(jsonlite::unserializeJSON(txt))
-	if (inherits(txt, 'XXjson')) {
-		tmp <- jsonlite::parse_json(txt, FALSE)
-		if (!is.null(tmp$attributes$package)) {
-	   	badge <- tmp$attributes$package$value[[1]]
-	  		if (badge=='echarty') {
-	  			obj <- jsonlite::unserializeJSON(txt)
-	  			return(obj)
-	  		}
-	   	stop(paste('ec.fromJson: unknown input',badge))
-		}
-	}
 	if (inherits(txt, 'character')) {
 		if (any(startsWith(txt, c('http://','https://'))))
 			return(jsonlite::unserializeJSON(url(txt)))

inst/htmlwidgets/echarty.js

@@ -40,13 +40,13 @@ HTMLWidgets.widget({
           let tmp = null;
           if (Array.isArray(x.jcode)) {
             tmp = x.jcode[0];   // #1 run before init
+            try {
+              eval(tmp);
+            } catch(err) { console.log('eva1: ' + err.message) }
             eva2 = x.jcode[1];
             eva3 = x.jcode[2];
           } else
-            tmp = x.jcode;
-          try {
-            eval(tmp);
-          } catch(err) { console.log('eva1: ' + err.message) }
+            eva3 = x.jcode;
         }
       }
 

man/ec.examples.Rd

@@ -340,17 +340,16 @@ test_that("ec.data treePC", {
 
 test_that("ec.data treeTK", {
   # see example https://helgasoft.github.io/echarty/uc3.html
-  df <- as.data.frame(Titanic) |> 
-      group_by(Survived,Age,Sex,Class) |> 
-      summarise(value= sum(Freq), .groups= 'drop') |> 
-      rowwise() |>
-      mutate(pathString= paste('Survive', Survived, Age, Sex, Class, sep='/')) |>
-      select(pathString, value)
+  df <- as.data.frame(Titanic) |> rename(value= Freq) |>
+    mutate(pathString= paste('Survive', Survived, Age, Sex, Class, sep='/'),
+		  itemStyle= case_when(Survived=='Yes' ~ "color='green'", TRUE ~ "color='pink'")) |>
+	  select(pathString, value, itemStyle)
+
   p <- ec.init(preset= FALSE,
   	title= list(text= 'Titanic: Survival by Class'),
   	tooltip= list(formatter= ec.clmn('%@ (%@%)', 'value','pct')),
   	series= list(list(
-  	  type= 'tree', symbolSize= ec.clmn(scale=0.08),
+  	  type= 'tree', symbolSize= htmlwidgets::JS("x => {return Math.log(x)*10}"),
   	  data= ec.data(df, format='treeTK') 
   	))
   )
@@ -403,5 +402,7 @@ test_that("ec.inspect and ec.fromJson", {
 
   v <- ec.fromJson(tmp)
   expect_equal(v$x$opts$xAxis$type, 'category')
+  p <- echarty::ec.fromJson('https://helgasoft.github.io/echarty/test/pfull.json')
+  expect_true(inherits(p, 'echarty'))
 })