1.7.2

Author: Larry Helgason

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: echarty
 Title: Minimal R/Shiny Interface to JavaScript Library 'ECharts'
-Date: 2025-10-27
-Version: 1.7.1
+Date: 2026-01-10
+Version: 1.7.2
 Authors@R: c(
   person(given= "Larry", family= "Helgason", role= c("aut", "cre"), email= "larry@helgasoft.com", comment="initial code from John Coene's library echarts4r")
   )

NEWS.md

@@ -1,12 +1,17 @@
 # history of package _echarty_
 
-# echarty 1.7.1  latest in development
+# echarty 1.7.2  in development
 
-* fixes to 1.7.0, updated coder.R
+* added _matrixIndex_ in .renumber
 
-# echarty 1.7.0  on CRAN
+# echarty 1.7.1  on CRAN
 
-* _ec.init_ support for _on_,_off_,_register*_,etc. chart instance and echarts API
+* fixes: updated demos code; check for empty df; custom charts .js file names
+* enhance flame chart with vertical labels (ec$vlevel)
+
+# echarty 1.7.0
+
+* new _ec.init_ parameter 'iniOpts' to support _on_,_off_,_register*_,etc. for chart instance
 * new value 'loadRemote' for parameter _ask_ to serve new v.6 custom-series
 * ability to attach data columns to item styles through _encode$data_
 * new flame (or icicle) hierarchical chart support as custom series

R/echarty.R

@@ -10,7 +10,7 @@ NULL
 lenv <- new.env(parent = emptyenv())
 lenv$coNames <- '' 
 # assign('aa', 11, envir=.ecv.colnames); get('aa', envir=.ecv.colnames)
-noAxisXY <- c('radar','parallel','themeRiver','map','gauge','pie','funnel','polar',  
+noAxisXY <- c('radar','parallel','themeRiver','map','gauge','pie','funnel','polar','chord',  
     'sunburst','tree','treemap','sankey','lines', 'liquidFill','wordCloud') # series
 noCoord <- c('polar','radar','singleAxis','parallelAxis','calendar')
 # using list(show=TRUE) or list(list()) is to create empty object{} in JS
@@ -24,11 +24,10 @@ noCoord <- c('polar','radar','singleAxis','parallelAxis','calendar')
 #'   Best practice is to have the grouping column placed last. Grouping column cannot be used as axis.\cr
 #'   Timeline requires a _grouped data.frame_ to build its \href{https://echarts.apache.org/en/option.html#options}{options}.\cr
 #'   If grouping is on multiple columns, only the first one is used to determine settings.
-#  ' REM @param ctype Chart type, default is 'scatter'. Could be set in _series.param_ instead.
 #' @param preset Boolean (default TRUE). Build preset attributes like dataset, series, xAxis, yAxis, etc.\cr
 #'   When preset is FALSE, these attributes need to be set explicitly.\cr
 #' @param series.param  Additional attributes for single preset series, default is NULL.\cr
-#'  Defines a **single** series for both non-timeline and timeline charts. \cr
+#'  Defines a **single** series for both non-timeline and timeline charts. Default type is 'scatter'. \cr
 #'  **Multiple** series need to be defined directly with _series=list(list(type=...),list(type=...))_ or added with [ec.upd].
 #' @param tl.series Deprecated, use _timeline_ and _series.param_ instead.\cr
 #' @param ...  Optional widget attributes. See Details. \cr
@@ -153,7 +152,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
   opt1 <- list(...)  
   lenv$coNames <- '' 
   # treacherous R does "partial matching of argument names" (like a bug): 
-  #   if 'series.param' is before ... and 'series' is added, the latter is ignored!
+  #   if 'series.param' is before '...' and 'series' is added, the latter is ignored!
   elementId <- opt1$elementId;  js <- opt1$js
   ask <- if (is.null(opt1$ask)) FALSE else opt1$ask
   ctype <- if (is.null(opt1$ctype)) 'scatter' else opt1$ctype
@@ -277,7 +276,6 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
   if (!is.null(df)) {
     stopifnot('ec.init: df should be data.frame or SharedData'= 
               inherits(df, c("SharedData", "data.frame")))
-    lenv$coNames <- colnames(df)   # must execute before first ec.clmn
 
     ct.key <- ct.group <- ct.dfKey <- NULL
     if (requireNamespace("crosstalk", quietly= TRUE)) {
@@ -295,6 +293,11 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
       crosstalk_key = ct.key,
       crosstalk_group = ct.group
     )
+    stopifnot('ec.init: df is empty'= length(colnames(df)) > 0)
+    # silently auto-add extra column for some charts and for colX/colY
+    if (length(colnames(df)) == 1 && !is.grouped_df(df)) 
+      df <- df |> mutate(duplicate= 1:nrow(df))   
+    lenv$coNames <- colnames(df)   # must execute before first ec.clmn
     # if data.frame given, build dataset regardless of 'preset' or 'dataset'
 
     # column-to-style with encode, replaces dataset column names, then creates series.data
@@ -315,8 +318,8 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
         df$value <- list(list(rep('', length(vv))))
         for(i in 1:nrow(df)) {
           tmp <- list()
-          for(k in 1:length(vv)) tmp <- c(tmp, unlist(df[i,vv[k]], use.names=F))
-          df[i,]$value <- list(tmp) #list(list(unlist(df[i,vv[1]], use.names=F), unlist(df[i,vv[2]], use.names=F)))
+          for(k in seq_along(vv)) tmp <- c(tmp, unlist(df[i,vv[k]], use.names=F))
+          df[i,]$value <- list(tmp) 
         }
         # TODO: remove vv columns from df or not?
         sedval <- series.param$encode$data$value  # save for axes
@@ -487,7 +490,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
   if (!is.null(series.param)) {
     x$opts$series <- .merlis(x$opts$series, series.param)
   }
-  axad <- 1;
+  axad <- 1; isSname <- FALSE
   x$opts$series <- lapply(x$opts$series, function(ss) {
     tmp <- xyNamesCS(ss)
     if (!is.null(tmp$c)) ss$coordinateSystem <- tmp$c
@@ -505,6 +508,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
       }
       # else don't overwrite user's encode
     }
+    if (!is.null(ss$name)) isSname <<- TRUE
 
     # renderItem helper only for our custom functions ri* 
     # new ECharts custom series, like segmentedDoughnut, want a character string
@@ -518,6 +522,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
     if (!'yAxis' %in% namop) x$opts$yAxis <- list(show=TRUE)
   }
   if (dbg) cat('\n axad=',axad)
+  if ((!'legend' %in% namop) && isSname) cat("\nNote: Some series have names, could add legend with 'legend= list(show=T)'") 
 
   # reading from encode set above  # TODO: when names not 'x','y' ?
   tmp <- series.param$encode
@@ -620,7 +625,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
 
       if (dbg) cat('\n colp=',unlist(colp),' ctyp=',unlist(ctyp))
     }   # end isAxes
-
+    
   }   # end preset
 
   x$opts <- .renumber(x$opts)
@@ -810,9 +815,10 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
           nops <- names(opt1)   # add defaults 3D
           for(x in c('xAxis3D','yAxis3D','zAxis3D','grid3D')) {
             a2d <- sub('3D','',x)
-            if (!(x %in% nops)) 
+            if (!(x %in% nops)) {
               wt$x$opts[[x]] <- if (!is.null(wt$x$opts[[a2d]])) wt$x$opts[[a2d]]
                                 else list(show=TRUE)
+            }
           }
         }
         wt$x$opts$xAxis <- wt$x$opts$yAxis <- NULL
@@ -870,7 +876,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
   tmp <- xyNamesCS(tl.series)
   xtem <- tmp$x; ytem <- tmp$y
   if (!is.null(tmp$c)) tl.series$coordinateSystem <- tmp$c
-  if (dbg) cat('\ntimeline: x=',xtem,' y=',ytem,' cs=',tmp$c)
+  if (dbg) cat('\ntimeline: x=',xtem,' y=',ytem,' cs=',tmp$c, ' encode=',unlist(tl.series$encode))
 
   if (any(c('geo','leaflet') %in% tl.series$coordinateSystem)) {
       klo <- 'lng'; kla <- 'lat'
@@ -940,7 +946,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
     # define additional filter transforms and option series based on groupBy
     dsf <- optm <- list()  # new filters and options
     filterIdx <- 0
-    for (ii in 1:length(unlist(unique(df[[grnm]]))) ) {   #unlist(unique(
+    for (ii in seq_along(unlist(unique(df[[grnm]]))) ) {   #unlist(unique(
       snames <- c()
       for (x2 in unlist(unique(df[tgrpBy]), use.names=FALSE) ) {
         dst <- opt1$dataset[[ii+1]]  # skip source-dataset 1st
@@ -997,7 +1003,7 @@ ec.init <- function( df= NULL, preset= TRUE, ...,  #ctype= 'scatter',
 #'       mutate(lwr= y-runif(30, 1, 3), upr= y+runif(30, 2, 4))
 #' band.df <- df  |> group_by(cat) |> group_split()
 #' sband <- list()
-#' for(ii in 1:length(band.df))   # build all bands
+#' for(ii in seq_along(band.df))   # build all bands
 #'   sband <- append(sband,
 #'     ecr.band(band.df[[ii]], 'lwr', 'upr', type='stack', smooth=FALSE,
 #'        name= unique(band.df[[ii]]$cat), areaStyle= list(color=c('blue','green','yellow')[ii]))
@@ -1434,7 +1440,8 @@ ec.plugjs <- function(wt=NULL, source=NULL, ask=FALSE) {
 
   if (ask=='loadRemote' && startsWith(source, 'http')) {
     name <- regmatches(source, regexpr("custom-series/(.*?)/dist", source, perl=TRUE))
-    name <- gsub("custom-series/|/dist", "", name)
+    if (length(name)>0) name <- gsub("custom-series/|/dist", "", name)
+    else name <- fname
     dep <- htmltools::htmlDependency(
       name= name, version= '1.1.1', 
       src= list(href= dirname(source)), script= fname
@@ -1479,54 +1486,47 @@ ec.plugjs <- function(wt=NULL, source=NULL, ask=FALSE) {
 
 # convert from R to JS numbering
 .renumber <- function(opa) {
-  doEncode <- function(el) {
-    for(i in 1:length(el$encode)) {
+  decro <- function(x, params) {   # decrement all elements of x
+    for(el in params) {
+      if (!is.null(x[[el]])) {
+        stopifnot('Some index is not numeric'= is.numeric(x[[el]]))
+        x[[el]] <- x[[el]] -1
+      }
+    }
+    x
+  }
+  doEncode <- function(el) {  # for tooltip, seriesName, itemId, itemName, itemGroupId, itemChildGroupId
+    for(i in seq_along(el$encode)) {
       if (!is.numeric(el$encode[[i]])) next
       el$encode[[i]] <- el$encode[[i]] -1
     }
     el
   }
-  r2jsEncode <- function(ss) {
-  
+  r2js <- function(ss) {
     if (any(names(ss)=='encode') && length(ss$encode)>0) ss <- doEncode(ss)
-
-    #if (!is.null(ss$type) && !ss$type %in% noAxisXY) {
-      if (!is.null(ss$xAxisIndex)) ss$xAxisIndex <- ss$xAxisIndex -1
-      if (!is.null(ss$yAxisIndex)) ss$yAxisIndex <- ss$yAxisIndex -1
-    #}
-    if (!is.null(ss$datasetIndex)) ss$datasetIndex <- ss$datasetIndex -1
-    if (!is.null(ss$geoIndex)) ss$geoIndex <- ss$geoIndex -1
-    if (!is.null(ss$polarIndex)) ss$polarIndex <- ss$polarIndex -1
-    if (!is.null(ss$calendarIndex)) ss$calendarIndex <- ss$calendarIndex -1
-    if (!is.null(ss$radarIndex)) ss$radarIndex <- ss$radarIndex -1
-    ss
+    decro(ss, c('xAxisIndex','yAxisIndex','singleAxisIndex','datasetIndex','geoIndex','polarIndex','calendarIndex','radarIndex')) 
   }
 
-  if (!is.null(opa$series)) opa$series <- lapply(opa$series, r2jsEncode)
+  if (!is.null(opa$series)) opa$series <- lapply(opa$series, r2js)
   if (!is.null(opa$dataZoom)) {
-    if (all(sapply(opa$dataZoom, is.list))) opa$dataZoom <- lapply(opa$dataZoom, r2jsEncode)
-    else opa$dataZoom <- r2jsEncode(opa$dataZoom)
+    if (all(sapply(opa$dataZoom, is.list))) opa$dataZoom <- lapply(opa$dataZoom, r2js)
+    else opa$dataZoom <- r2js(opa$dataZoom)
   }
 
-  decro <- function(x) {
-    if (!is.null(x$dimension) && is.numeric(x$dimension)) x$dimension <- x$dimension -1
-    if (!is.null(x$seriesIndex)) x$seriesIndex <- x$seriesIndex -1   # vMap
-    if (!is.null(x$gridIndex)) x$gridIndex <- x$gridIndex -1  # x/y Axis
-    x
-  }
   decType <- \(typ) {   # handle single or multiple items
-    item <- opa[[typ]]
+    item <- opa[[typ]]; pars <- c('gridIndex','calendarIndex', 'dimension','seriesIndex','categories')
     if (!is.null(item)) {
       if (all(sapply(item, is.list)))
-        opa[[typ]] <<- lapply(item, decro)
-      else
-        opa[[typ]] <<- decro(item)
+        opa[[typ]] <<- lapply(item, decro, pars)  #...
+      else  # last 3 are vMap
+        opa[[typ]] <<- decro(item, pars)
     }
   }
   decType('xAxis')
   decType('yAxis')
   decType('visualMap')
-  opa
+  # some top elements may have matrixIndex
+  opa <- lapply(opa, \(xx) { if (any(names(xx)=='matrixIndex')) xx$matrixIndex <- xx$matrixIndex -1; xx })
 }
 
 # merge named lists: list OR list.of.lists like series

R/util.R

@@ -519,11 +519,11 @@ ec.util <- function(cmd='sf.series', ..., js=NULL, event='click') {
 #'  \item **values** = list for customized \href{https://echarts.apache.org/en/option.html#series-scatter.data}{series.data} \cr
 #'  \item **names** = named lists useful for named data like \href{https://echarts.apache.org/en/option.html#series-sankey.links}{sankey links}.
 #'  \item **dendrogram** = build series data for Hierarchical Clustering dendrogram
+#'  \item **flame** = build series data (lists of name,id,value) for hierarchy display by _renderItem_
 #'  \item **treePC** = build series data for tree charts from parent/children data.frame
-#'  \item **treeTT** = build series data for tree charts from data.frame like Titanic.\cr
+#'  \item **treeTT** = build series data for tree charts from data.frame like Titanic.
 #'  \item **boxplot** = build dataset and source lists, see Details
 #'  \item **borders** = build geoJson string from map_data region borders, see Details
-#'  \item **flame** = list of hierarchical series data to be presented by _renderItem_\cr
 #' }
 #' @param header for dataset, to include the column names or not, default TRUE. Set it to FALSE for \href{https://echarts.apache.org/en/option.html#series-scatter.data}{series.data}.\cr
 #' @param ... optional parameters\cr
@@ -607,6 +607,7 @@ ec.util <- function(cmd='sf.series', ..., js=NULL, event='click') {
 #' @export
 ec.data <- function(df, format='dataset', header=FALSE, ...) {
   stopifnot('ec.data: expecting parameter df'= !missing(df))
+  args <- list(...)
 
   if (format=='dendrogram') { 
     stopifnot('ec.data: df should be hclust for dendrogram'= inherits(df, 'hclust'))
@@ -646,7 +647,7 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) {
   }
   if (format=='flame') { 
     stopifnot('ec.data: df should be a list for flame chart'= inherits(df, 'list'))
-    filter_json <- function(json, id) {
+    filter_json <- function(json, id=NULL) {
       if (is.null(id)) return(json)
 
       recur <- function(item, id) {
@@ -667,21 +668,22 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) {
       return(recur(json, id))
     }
     root_val <- 1000
-    recursion_json <- function(json_obj, id) {
+    recursion_json <- function(json_obj, id=NULL) {
       data <- list()
       filtered_json <- filter_json(json_obj, id)  # Note: R doesn't have structuredClone by default
       recur <- function(item, start = 0, level = 0, wit = NULL) {
-        temp <- list(
-          name = item$name,
-          id = item$name,
-          value = c(
+        val <- c(
             level,
             start,
             start + wit,
             item$name,
-            round(wit / root_val * 100, 2),
-            item$value
-          )
+            round(wit / root_val * 100, 2)
+        )
+        if (!is.null(item$value)) val <- c(val, item$value)
+        temp <- list(
+          name = item$name,
+          id = item$name,
+          value = val
         )
         data <<- c(data, list(temp))  # Use <<- to modify parent scope
 
@@ -701,7 +703,6 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) {
       return(data)
     }
 
-    args <- list(...)
     out <- recursion_json(df, args$name)
     return(out)
   }
@@ -788,7 +789,6 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) {
   tmp <- lapply(n, \(i) lapply(df, "[[", i))  # rows to lists, preserve column types
 
   if (format=='boxplot') {
-    args <- list(...)
     rady <- if ('ol.radius' %in% names(args)) args$ol.radius else NULL
     jitter <- if ('jitter' %in% names(args)) args$jitter else 0
     layout <- if ('layout' %in% names(args)) args$layout else 'h'
@@ -940,7 +940,6 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) {
     datset <- lapply(tmp, \(x) list(value=unlist(x, use.names=FALSE)))
   } 
   else { # format=='names'
-    args <- list(...)
     if ('nasep' %in% names(args)) {
       stopifnot("data('names'): nasep should be 1 char"= nchar(args$nasep)==1)
       # names separator is present, replace compound names with nested lists

demo/coder.R

@@ -5,7 +5,7 @@
 devAskNewPage(ask = FALSE)
 if (interactive()) {
   # this stopped working - "cannot open URL"
-  #library(shiny)
+  library(shiny)
   #shiny::runGist('https://gist.github.com/helgasoft/02b257429e78e138f87aefce14f7aebc')
 
   # this loads, but gist cannot be edited