minor changes for v.0.3.1.3

Author: helgasoft

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: echarty
 Title: Minimal R/Shiny Interface to JavaScript Library 'ECharts'
 Date: 2021-09-15
-Version: 0.3.1.2
+Version: 0.3.1.3
 Authors@R: c( 
   person("Larry", "Helgason", email = "larry@helgasoft.com", role = c("aut", "cre", "cph")),
   person("John", "Coene", email = "jcoenep@gmail.com", role = c("aut", "cph"))

NEWS.md

@@ -1,5 +1,13 @@
 # history of echarty package development
 
+## v. 0.3.1.3
+
+- _ec.init_: fix '3D' presets for groups and 'world' presets
+- _ec.clmn_: added new parameter _scale_
+- _echarty.js_ add resize parameter [resizeOpts](https://echarts.apache.org/en/api.html#echartsInstance.resize)
+- updates to examples.R
+- upgrade ECharts to v.5.2.1, liquidfill to v.3.1.0
+
 ## v. 0.3.1.2
 
 - _ec.init_ added ECharts parameters _locale_ and _useDirtyRect_

R/echarty.R

@@ -228,14 +228,19 @@ ec.init <- function( df=NULL, preset=TRUE, group1='scatter', load=NULL,
 
   # Plugins implemented as dynamic load on-demand
   if ('3D' %in% load) {
-    if (preset) {
-      wt$x$opts$xAxis <- NULL   # replace 2D presets with 3D
+    if (preset) {       # replace 2D presets with 3D
+      wt$x$opts$xAxis <- NULL   
       wt$x$opts$yAxis <- NULL
-      wt$x$opts$series[[1]] <- list(type='scatter3D')  #NULL
       wt$x$opts$grid3D  <- list(list())
       wt$x$opts$xAxis3D <- list(list())
       wt$x$opts$yAxis3D <- list(list())
       wt$x$opts$zAxis3D <- list(list())
+      if (!is.null(group1) && dplyr::is.grouped_df(df)) {
+        # make all series scatter3D
+        wt$x$opts$series <- lapply(wt$x$opts$series,
+          function(s) { s$type='scatter3D'; s })
+      } else
+        wt$x$opts$series[[1]] <- list(type='scatter3D')  
     }
     wt <- ec.plugjs(wt, 'https://cdn.jsdelivr.net/npm/echarts-gl@2.0.8/dist/echarts-gl.min.js', ask)
   }
@@ -244,13 +249,14 @@ ec.init <- function( df=NULL, preset=TRUE, group1='scatter', load=NULL,
     if (preset) {
       wt$x$opts$xAxis <- NULL
       wt$x$opts$yAxis <- NULL
-      wt$x$opts$geo = list(map='world', roam=TRUE, zoom=6)
+      wt$x$opts$series <- list(list(type='map', map='world', roam=TRUE))
+      #wt$x$opts$geo = list(map='world', roam=TRUE)  # duplicate of series
       # if (!is.null(df))  # cancelled: dont know if first 2 cols are lng,lat
       #   wt$x$opts$geo$center= c(mean(unlist(df[,1])), mean(unlist(df[,2])))
     }
   }
   if ('liquid' %in% load) 
-    wt <- ec.plugjs(wt, 'https://cdn.jsdelivr.net/npm/echarts-liquidfill@3.0.0/dist/echarts-liquidfill.min.js', ask)
+    wt <- ec.plugjs(wt, 'https://cdn.jsdelivr.net/npm/echarts-liquidfill@3.1.0/dist/echarts-liquidfill.min.js', ask)
 
   if ('gmodular' %in% load) 
     wt <- ec.plugjs(wt, 'https://cdn.jsdelivr.net/npm/echarts-graph-modularity@2.0.0/dist/echarts-graph-modularity.min.js', ask)
@@ -448,7 +454,8 @@ ec.data <- function(df, format='dataset', header=TRUE) {
 #' 
 #' Helper function to address data column(s) by index or name
 #' 
-#' @param col A column index(number), column name(string) or a \code{\link[base]{sprintf}} format string. \cr
+#' @param col A column index(number), column name(string) or a \code{\link[base]{sprintf}} format string. 
+#' @param scale A decimal/integer number to multiply the column value by. Only when \emph{col} is a single index.
 #' @param ... Comma separated list of column indexes or names, when \emph{col} is \emph{sprintf}. This allows formatting of multiple columns, as for a tooltip.
 #' 
 #' @details Column indexes are counted in R and start at 1.\cr
@@ -469,11 +476,12 @@ ec.data <- function(df, format='dataset', header=TRUE) {
 #' p
 #' 
 #' @export
-ec.clmn <- function(col=NULL, ...) {
+ec.clmn <- function(col=NULL, scale=1, ...) {
   if (is.null(col)) stop('col is required', call.=FALSE)
+  if (is.null(scale)) scale=1
   args <- list(...)
   if (is.na(suppressWarnings(as.numeric(col)))) {   # col is string
-    if (length(args)==0)
+    if (length(args)==0) 
       ret <- paste0('return x.data.',col,';')
     else {          # col a sprintf
       spf <- paste("var sprintf = (str, argv) => !argv.length ? str :",
@@ -488,23 +496,22 @@ ec.clmn <- function(col=NULL, ...) {
       else {   #  multiple numeric, they could be in x, x.data, x.value
         tmp <- paste(tmp, collapse=',')
         ret <- paste0(sub('@','%d',spf), 
-          "let ss=[",tmp,"]; ",
-          "ss=ss.map(e => x.value!=null ? x.value[e] : x.data!=null ? x.data[e] : x[e]);",
-          "let c = sprintf(`",col,"`, ss); return c; ")
+                      "let ss=[",tmp,"]; ",
+                      "ss=ss.map(e => x.value!=null ? x.value[e] : x.data!=null ? x.data[e] : x[e]);",
+                      "let c = sprintf(`",col,"`, ss); return c; ")
       }
     }
   }
-  else {  # col is numeric thus solitary parameter
+  else {  # col is solitary numeric
     if (length(args) > 0) # { cat(length(args));
       warning('col is numeric, others are ignored', call.=FALSE)
     col <- as.numeric(col) - 1   # from R to JavaScript counting
-    ret <- paste0('let c = (x.data) ? x.data[',col,'] : x[',col,']; return c;')
+    scl <- if (scale==1) 'return c;' else paste0('return (parseFloat(c)*',scale,');')
+    ret <- paste0('let c = (x.data) ? x.data[',col,'] : x[',col,']; ',scl)
   }
-  #cat(ret)
   htmlwidgets::JS(paste0('function(x) {', ret, '}'))
 }
 
-
 #' Charts layout
 #' 
 #' Set multiple charts in rows/columns format

R/examples.R

@@ -91,11 +91,23 @@
 #' 
 #' 
 #' #------ Plugin leaflet
-#' tmp <- quakes %>% dplyr::relocate('long')  # set in lon,lat order
+#' tmp <- quakes %>% dplyr::relocate('long') %>%  # set order to lon,lat
+#'   dplyr::mutate(size= exp(mag)/20)             # add accented size
 #' p <- tmp %>% ec.init(load='leaflet')
-#' p$x$opts$legend = list(data=list(list(name='quakes')))
 #' p$x$opts$series[[1]]$name = 'quakes'
-#' p$x$opts$series[[1]]$symbolSize = ec.clmn(4)
+#' p$x$opts$series[[1]]$symbolSize = ec.clmn(6)   # size column
+#' p$x$opts$legend = list(zz='')
+#' p
+#'
+#'
+#' #------ Plugin 'world' with visualMap
+#' cns <- data.frame(
+#'   country = c('United States','China','Russia','Brazil','Canada','Algeria','Sudan','Australia'),
+#'   value = runif(8, 1, 100) 
+#' )
+#' p <- cns %>% ec.init(load= 'world')
+#' p$x$opts$visualMap <- list(calculable= TRUE, max= 100)
+#' p$x$opts$toolbox <- list(feature= list(restore= list()))
 #' p
 #'
 #'
@@ -122,6 +134,22 @@
 #' }
 #' 
 #' 
+#' #------ registerMap JSON
+#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json")
+#' dusa <- USArrests %>% dplyr::mutate(states = row.names(.))
+#' p <- ec.init(preset=FALSE)
+#' p$x$registerMap <- list(list(mapName = 'USA', geoJSON = json))
+#' #   registerMap supports also maps in SVG format, see website gallery
+#' p$x$opts <- list(
+#'   visualMap = list(type='continuous', calculable=TRUE, 
+#'                    min=min(dusa$UrbanPop), max=max(dusa$UrbanPop))
+#'   ,series = list( list(type='map', map='USA', name='UrbanPop', roam=TRUE,
+#'        data = lapply(ec.data(dusa,'names'), function(x) list(name=x$states, value=x$UrbanPop))
+#'    ))
+#' )
+#' p  
+#' 
+#' 
 #' #------ Plugin 3D
 #' if (interactive()) {
 #'  data <- list()
@@ -197,7 +225,7 @@
 #'             #encode=list(x='day', y='CAC')   # *2
 #'   ))
 #' )
-#' p$x$opts$legend <- list(ey='') 
+#' p$x$opts$legend <- list(zz='') 
 #' p$x$opts$dataZoom <- list(type='slider', end=50)
 #' p
 #' 
@@ -215,14 +243,19 @@
 #' 
 #'
 #' #------ Boxplot
-#' bdf <- data.frame(vx = sample(LETTERS[1:3], size=20, replace=TRUE), 
-#'                   vy = rnorm(20)) %>% group_by(vx) %>% group_split()
-#' dats <- lapply(bdf, function(x) boxplot.stats(x$vy)$stats )
+#' library(dplyr)
+#' bdf <- data.frame(vx= sample(LETTERS[1:3], size= 20, replace= TRUE), 
+#' 		     vy= rnorm(20)) %>% group_by(vx) %>% group_split()
+#' dats <- lapply(bdf, function(x) round(boxplot.stats(x$vy)$stats, 4) )
 #' p <- ec.init()
 #' p$x$opts <- list(     # overwrite presets
-#'   xAxis = list(ey=''),
-#'   yAxis = list(type = 'category', data = unique(unlist(lapply(bdf, `[`, , 1))) ),
-#'   series = list(list(type = 'boxplot', data = dats))
+#' 	xAxis = list(zz=''),
+#' 	yAxis = list(type = 'category', data= unique(unlist(lapply(bdf, `[`, , 1))) ),
+#' 	series = list(list(type= 'boxplot', data= dats, 
+#' 			itemStyle= list(color= '#b8c5f2'),
+#' 			encode= list(tooltip= c('min', 'Q1', 'median', 'Q3', 'max'))
+#'	))
+#' 	,tooltip = list(trigger= 'item')
 #' )
 #' p
 #' 
@@ -301,22 +334,6 @@
 #' p
 #' 
 #' 
-#' #------ registerMap JSON
-#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json")
-#' dusa <- USArrests %>% dplyr::mutate(states = row.names(.))
-#' p <- ec.init(preset=FALSE)
-#' p$x$registerMap <- list(list(mapName = 'USA', geoJSON = json))
-#' # registerMap supports also maps in SVG format, see website gallery
-#' p$x$opts <- list(
-#'   visualMap = list(type='continuous', calculable=TRUE, 
-#'                    min=min(dusa$UrbanPop), max=max(dusa$UrbanPop))
-#'   ,series = list( list(type='map', map='USA', name='UrbanPop', roam=TRUE,
-#'        data = lapply(ec.data(dusa,'names'), function(x) list(name=x$states, value=x$UrbanPop))
-#'    ))
-#' )
-#' p  
-#' 
-#' 
 #' #------ Error Bars on grouped data
 #' library(dplyr)
 #' df <- mtcars %>% group_by(cyl,gear) %>% summarise(yy=round(mean(mpg),2)) %>%
@@ -325,7 +342,7 @@
 #' p <- df %>% ec.init(group1='bar', load='custom') %>%
 #'   ecr.ebars(df, name = 'eb'
 #'      ,tooltip = list(formatter=ec.clmn('high <b>%d</b><br>low <b>%d</b>', 4,3)))
-#' p$x$opts$tooltip <- list(ey='')
+#' p$x$opts$tooltip <- list(zz='')
 #' p
 #' 
 #'