From 5729c29204bffb4972041ccb621ecc0b39069894 Mon Sep 17 00:00:00 2001 From: helgasoft Date: Tue, 4 Jun 2024 21:20:26 -0700 Subject: [PATCH] v.1.6.4 --- CRAN-SUBMISSION | 6 +-- DESCRIPTION | 4 +- NAMESPACE | 1 + NEWS.md | 12 +++-- R/echarty.R | 88 ++++++++++++++++------------------- R/util.R | 15 ++++-- README.md | 2 +- inst/htmlwidgets/echarty.js | 9 ++-- inst/plugins.csv | 5 ++ man/ec.data.Rd | 1 + man/ec.init.Rd | 4 +- tests/testthat/test-ec.util.R | 6 ++- tests/testthat/test-presets.R | 13 +++++- 13 files changed, 94 insertions(+), 72 deletions(-) create mode 100644 inst/plugins.csv diff --git a/CRAN-SUBMISSION b/CRAN-SUBMISSION index 4b2aae8..f9bffb4 100644 --- a/CRAN-SUBMISSION +++ b/CRAN-SUBMISSION @@ -1,3 +1,3 @@ -Version: 1.6.3 -Date: 2024-01-12 05:46:46 UTC -SHA: 57ef62df7605f7bbeff9750de5139f27ee8e1241 +Version: 1.6.4 +Date: 2024-06-05 02:55:49 UTC +SHA: 50e6559c12e380ccbb49f99d46228467dde8ec5e diff --git a/DESCRIPTION b/DESCRIPTION index 81c392b..2bf2dfc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: echarty Title: Minimal R/Shiny Interface to JavaScript Library 'ECharts' -Date: 2024-05-16 -Version: 1.6.3.03 +Date: 2024-06-04 +Version: 1.6.4 Author: Larry Helgason, with initial code from John Coene's library echarts4r Maintainer: Larry Helgason Description: Deliver the full functionality of 'ECharts' with minimal overhead. 'echarty' users build R lists for 'ECharts' API. Lean set of powerful commands. diff --git a/NAMESPACE b/NAMESPACE index 19bd449..a7202bb 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -29,5 +29,6 @@ importFrom(htmlwidgets,sizingPolicy) importFrom(stats,na.omit) importFrom(utils,askYesNo) importFrom(utils,download.file) +importFrom(utils,read.csv) importFrom(utils,tail) importFrom(utils,unzip) diff --git a/NEWS.md b/NEWS.md index ff83717..f440bfc 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,15 @@ # history of package _echarty_ -## v. 1.6.3.03 latest in development +## v. 1.6.4 latest in development - upgrade ECharts to v.5.5.0, built with R v.4.4.0 -- added _nasep_ parameter to ec.data('names') for easier setting of nested lists from a _data.frame_ -- tested web freedom [with WebR](https://helgasoft.github.io/echarty/test/coder.html) -- added explicit _leaflet_ dependency, not provided since leaflet v.2.2.0 -- added optional tooltip formatter (tipFmt) in _ecr.band_ +- add _nasep_ parameter to _ec.data('names')_ - easily set nested lists from a _data.frame_ +- add [WebR](https://docs.r-wasm.org/webr/latest/) support and [test](https://helgasoft.github.io/echarty/test/coder.html) +- add explicit _leaflet_ dependency since dependencies changed in leaflet v.2.2.0 +- add optional tooltip formatter (tipFmt) in _ecr.band_ - refactoring (leaflet, geo, geoJson, tests) +- add debug flags for messages in JS and R +- fix _crosstalk_ bug for checkboxes unselect ## v. 1.6.3 on CRAN diff --git a/R/echarty.R b/R/echarty.R index 836079e..9c2ff6c 100644 --- a/R/echarty.R +++ b/R/echarty.R @@ -30,8 +30,8 @@ noCoord <- c('polar','radar','singleAxis','parallelAxis','calendar') #' @param ctype Chart type, default is 'scatter'. #' @param preset Boolean (default TRUE). Build preset attributes like dataset, series, xAxis, yAxis, etc. #' @param series.param Additional attributes for preset series, default is NULL.\cr -#' Can be used for non-timeline and timeline series (instead of _tl.series_). A single list defines one series type only.\cr -#' One could also define all series directly with _series=list(list(...),list...)_ instead. +#' Defines a single series type. Can be used for both non-timeline and timeline series. \cr +#' Multiple series types need to be defined directly with _series=list(list(...),list...)_ or added with [ec.upd]. #' @param tl.series Deprecated, use _timeline_ and _series.param_ instead.\cr #' @param ... Optional widget attributes. See Details. \cr #' @param width,height Optional valid CSS unit (like \code{'100\%'}, @@ -120,6 +120,7 @@ noCoord <- c('polar','radar','singleAxis','parallelAxis','calendar') #' ) #' #' @importFrom htmlwidgets createWidget sizingPolicy getDependency JS shinyWidgetOutput shinyRenderWidget +#' @importFrom utils read.csv #' @import dplyr #' #' @export @@ -156,9 +157,11 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., useDirtyRect <- if (is.null(opt1$useDirtyRect)) FALSE else opt1$useDirtyRect xtKey <- if (is.null(opt1$xtKey)) 'XkeyX' else opt1$xtKey if (xtKey=='XkeyX') df$XkeyX <- dfKey # add new column for Xtalk filtering, if needed + # allow debug feedback thru cat() in JS and R code: + dbg <- if (is.null(opt1$dbg)) FALSE else opt1$dbg # remove the above attributes since they are not valid ECharts options opt1$ask <- opt1$js <- opt1$renderer <- opt1$locale <- NULL - opt1$useDirtyRect <- opt1$elementId <- opt1$xtKey <- NULL + opt1$useDirtyRect <- opt1$elementId <- opt1$xtKey <- opt1$dbg <- NULL axis2d <- c('pictorialBar','candlestick','boxplot','scatterGL') #'custom', # forward widget options using x @@ -168,7 +171,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., renderer = renderer, locale = locale, useDirtyRect = useDirtyRect, - jcode = js, + jcode = js, dbg = dbg, opts = opt1, settings = list( crosstalk_key = key, @@ -285,11 +288,11 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., return(list(x=xtem, y=ytem, z='z', c=ser$coordinateSystem)) } doVMap <- function(wid) { - # visualMap assist + # visualMap assist: auto add min/max/calculable (categories==piecewise) vm <- wid$opts$visualMap out <- NULL if (!is.null(df) && !is.null(vm) && - is.null(vm$min) && is.null(vm$max) && + is.null(vm$min) && is.null(vm$max) && is.null(vm$categories) && (is.null(vm$type) || (vm$type == 'continuous')) ) { xx <- length(colnames(df)) # last numeric column by default @@ -300,7 +303,6 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., ) xx <- 'value' if (!is.null(vm$dimension)) xx <- vm$dimension out <- list( - #dimension= xx, min= min(na.omit(df[,xx])), max= max(na.omit(df[,xx])), calculable= TRUE @@ -471,6 +473,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., ), dependencies = deps ) + #if (dbg) cat('\naxis2d=',axis2d) tmp <- getOption('echarty.font') if (!is.null(tmp)) @@ -482,8 +485,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., # ------------- plugins loading ----------------------------- opt1 <- wt$x$opts - load <- opt1$load; - wt$x$opts$load <- NULL + load <- opt1$load; wt$x$opts$load <- NULL if (length(load)==1 && grepl(',', load, fixed=TRUE)) load <- unlist(strsplit(load, ',')) @@ -491,11 +493,6 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., dep <- NULL if ('world' %in% load) { - dep <- htmltools::htmlDependency( - name = 'world', version = '1.0.0', - src = c(file = path), script= 'world.js') - wt$dependencies <- append(wt$dependencies, list(dep)) - if (preset) { wt$x$opts$xAxis <- wt$x$opts$yAxis <- NULL if (!is.null(df)) { # coordinateSystem='geo' needed for all series @@ -511,11 +508,14 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., # if (!is.null(df)) # cancelled: don't know if df first 2 cols are 'lng','lat' # wt$x$opts$geo$center= c(mean(unlist(df[,1])), mean(unlist(df[,2]))) } + dep <- htmltools::htmlDependency( + name = 'world', version = '1.0.0', + src = c(file = path), script= 'world.js') + wt$dependencies <- append(wt$dependencies, list(dep)) } - if ('leaflet' %in% load) { - # coveralls pops error, win/linux ok : - #stopifnot("ec.init: library 'leaflet' not installed"= file.exists(file.path(.libPaths(), 'leaflet')[[1]])) + # coveralls pops error, win/linux ok : + #stopifnot("ec.init: library 'leaflet' not installed"= file.exists(file.path(.libPaths(), 'leaflet')[[1]])) if (!file.exists(file.path(.libPaths(), 'leaflet')[[1]])) warning("ec.init: library 'leaflet' not installed") if (preset) { # customizations for leaflet @@ -572,9 +572,10 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., } # Plugins implemented as dynamic load on-demand - cdn <- 'https://cdn.jsdelivr.net/npm/' - if ('3D' %in% load) { - if (preset) { # replace 2D presets with 3D + if (any(load %in% c('3D','liquid','gmodular','wordcloud'))) { + plf <- read.csv(system.file('plugins.csv', package='echarty'), header=TRUE, stringsAsFactors=FALSE) + if ('3D' %in% load) { + if (preset) { # replace 2D presets with 3D isScatGL <- 'scatterGL' %in% unlist(lapply(opt1$series, \(k){k$type})) # scatterGL is 2D if (!isScatGL && is.null(opt1$globe) && is.null(opt1$geo3D) ) { wt$x$opts$xAxis <- wt$x$opts$yAxis <- NULL @@ -593,21 +594,12 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., \(s) { s$type= if (s$type=='scatter') 'scatter3D' else s$type; s }) } } - wt <- ec.plugjs(wt, - paste0(cdn,'echarts-gl@2.0.9/dist/echarts-gl.min.js'), ask) - } - if ('liquid' %in% load) - wt <- ec.plugjs(wt, - paste0(cdn,'echarts-liquidfill@latest/dist/echarts-liquidfill.min.js'), ask) - - if ('gmodular' %in% load) - wt <- ec.plugjs(wt, - paste0(cdn,'echarts-graph-modularity@latest/dist/echarts-graph-modularity.min.js'), ask) - - if ('wordcloud' %in% load) - wt <- ec.plugjs(wt, - paste0(cdn,'echarts-wordcloud@latest/dist/echarts-wordcloud.min.js'), ask) - + wt <- ec.plugjs(wt, plf[plf$name=='3D',]$url, ask) + } + if ('liquid' %in% load) wt <- ec.plugjs(wt, plf[plf$name=='liquid',]$url, ask) + if ('gmodular' %in% load) wt <- ec.plugjs(wt, plf[plf$name=='gmodular',]$url, ask) + if ('wordcloud' %in% load) wt <- ec.plugjs(wt, plf[plf$name=='wordcloud',]$url, ask) + } # load unknown plugins unk <- load[! load %in% c('leaflet','custom','world','lottie','ecStat', '3D','liquid','gmodular','wordcloud')] @@ -653,6 +645,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('\ntl=',tmp$x,' ',tmp$y,' ',tmp$c) if (any(c('geo','leaflet') %in% tl.series$coordinateSystem)) { klo <- 'lng'; kla <- 'lat' @@ -670,7 +663,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., if (tl.series$coordinateSystem=='leaflet') wt$x$opts$leaflet$center <- center } - } + } if (tl.series$type == 'map') { xtem <- 'name'; ytem <- 'value' @@ -1209,9 +1202,9 @@ ec.plugjs <- function(wt=NULL, source=NULL, ask=FALSE) { startsWith(source, 'http') || startsWith(source, 'file://')) fname <- basename(source) fname <- unlist(strsplit(fname, '?', fixed=TRUE))[1] # when 'X.js?key=Y' - # if (!endsWith(fname, '.js')) - # stop('ec.plugjs expecting .js suffix', call. = FALSE) + # if (!endsWith(fname, '.js')) stop('ec.plugjs expecting .js suffix', call. = FALSE) path <- system.file('js', package = 'echarty') + ffull <- paste0(path,'/',fname) if (!file.exists(ffull)) { if (ask) { @@ -1223,19 +1216,20 @@ ec.plugjs <- function(wt=NULL, source=NULL, ask=FALSE) { if (is.na(ans)) ans <- FALSE # was cancelled } else ans <- TRUE - if (ans) { - try(withCallingHandlers( - download.file(source, ffull, quiet=TRUE), # method = "libcurl"), - error = function(w) { ans <- FALSE }, - warning = function(w) { ans <- FALSE } - #cat('ec.plugjs Error:', sub(".+HTTP status was ", "", w, source)) - )) #,silent=TRUE) + if (ans && !exists('ec.webR')) { # WebR dislikes download.file + #try(withCallingHandlers( # function(w) { ans <- FALSE } + errw <- function(w) { ans <- FALSE + cat('ec.plugjs:', sub(".+HTTP status was ", "", w, source)) } + tryCatch({ + download.file(source, ffull, quiet=TRUE) }, # method = "libcurl"), + error = errw, warning = errw + ) } if (!ans) return(wt) # error } dep <- htmltools::htmlDependency( - name = fname, version = '1.0.0', src = c(file = path), - script = fname + name= fname, version= '1.1.1', src= c(file = path), + script= fname ) wt$dependencies <- append(wt$dependencies, list(dep)) return(wt) diff --git a/R/util.R b/R/util.R index f74aa60..0d37608 100644 --- a/R/util.R +++ b/R/util.R @@ -614,6 +614,7 @@ body { padding: 10px; } #' # attribute names separator (nasep) is "_" #' df <- data.frame(name= c('A','B','C'), value= c(1,2,3), #' itemStyle_color= c('chartreuse','lightblue','pink'), +#' itemStyle_decal_symbol= c('rect','diamond','none'), #' emphasis_itemStyle_color= c('darkgreen','blue','red') #' ) #' ec.init(series.param= list(type='pie', data= ec.data(df, 'names', nasep='_'))) @@ -879,19 +880,23 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) { stopifnot("data('names'): nasep should be 1 char"= nchar(args$nasep)==1) # names separator is present, replace compound names with nested lists tmp <- lapply(tmp, \(rr) { + lst <- rr for(cc in names(rr)) { if (grepl(args$nasep, cc, fixed=T)) { + lst[[cc]] <- NULL nlis <- strsplit(cc, args$nasep, fixed=T) out <- rr[[cc]]; for(nn in rev(nlis[[1]][-1])) { - cur <- list(); cur[[nn]] <- out; - out <- cur + cur <- list(); cur[[nn]] <- out; out <- cur } - rr[[cc]] <- NULL - rr[[ nlis[[1]][1] ]] <- out + col <- nlis[[1]][1] + if ( col %in% names(lst) ) + lst[[col]] <- .merlis(lst[[col]], out) + else + lst[[col]] <- out } } - rr + lst }) } datset <- tmp; diff --git a/README.md b/README.md index 0a5843d..93f2a88 100644 --- a/README.md +++ b/README.md @@ -54,7 +54,7 @@ Please consider granting a Github star ⭐ to show your support. ## Installation -Latest development build **1.6.3.03** +Latest development build **1.6.4** ``` r if (!requireNamespace('remotes')) install.packages('remotes') diff --git a/inst/htmlwidgets/echarty.js b/inst/htmlwidgets/echarty.js index 5f286dd..f82fe1a 100644 --- a/inst/htmlwidgets/echarty.js +++ b/inst/htmlwidgets/echarty.js @@ -1,5 +1,5 @@ /*global HTMLWidgets, echarts, Shiny*/ -/*eslint no-undef: "error"*/ +/* eslint no-undef: "error" */ // extra functions ecf = { @@ -9,6 +9,7 @@ ecf = { geoz2: 0, zoom: {s: 0, e: 100 }, // dataZoom values fs: false, // fullscreen flag Y/N + dbg: false, // debug flag: if (ecf.dbg) console.log(' change s:'+v) IsFullScreen: function() { var full_screen_element = document.fullscreenElement || document.webkitFullscreenElement || document.mozFullScreenElement || document.msFullscreenElement || null; @@ -154,6 +155,7 @@ HTMLWidgets.widget({ eva3 = x.jcode; } } + if (x.hasOwnProperty('dbg')) { ecf.dbg= x.dbg; } chart = echarts.init(document.getElementById(el.id), x.theme, { renderer: x.renderer, locale: x.locale, useDirtyRect: x.useDirtyRect } @@ -323,15 +325,14 @@ HTMLWidgets.widget({ ct_filter.on('change', function(e) { // external keys to filter if (e.sender == ct_filter) return; - if (e.value == undefined) e.value = []; // sent by filter_checkbox ?! + if (e.value == undefined) e.value = chart.akeys; // sent by filter_checkbox - rexp = (e.value.length == chart.akeys.length) //|| e.value.length == 0) + rexp = (e.value.length == chart.akeys.length) ? '^' : '^('+ e.value.join('|') +')$'; opt = chart.getOption(); dtf = opt.dataset.find(x => x.id === 'Xtalk'); //dtf.transform = {type:'filter', config: {dimension: 'XkeyX', reg: rexp } } dtf.transform.config.reg = rexp; - // chart.filk = e.value.map(x=>Number(x)).sort((a, b) => a - b); chart.filk = e.value.sort((a, b) => a - b); chart.setOption(opt, false); }); diff --git a/inst/plugins.csv b/inst/plugins.csv new file mode 100644 index 0000000..53a14cf --- /dev/null +++ b/inst/plugins.csv @@ -0,0 +1,5 @@ +name,url +3D,https://cdn.jsdelivr.net/npm/echarts-gl@2.0.9/dist/echarts-gl.min.js +liquid,https://cdn.jsdelivr.net/npm/echarts-liquidfill@latest/dist/echarts-liquidfill.min.js +gmodular,https://cdn.jsdelivr.net/npm/echarts-graph-modularity@latest/dist/echarts-graph-modularity.min.js +wordcloud,https://cdn.jsdelivr.net/npm/echarts-wordcloud@latest/dist/echarts-wordcloud.min.js diff --git a/man/ec.data.Rd b/man/ec.data.Rd index 85d22bc..a847aae 100644 --- a/man/ec.data.Rd +++ b/man/ec.data.Rd @@ -92,6 +92,7 @@ ec.init( # attribute names separator (nasep) is "_" df <- data.frame(name= c('A','B','C'), value= c(1,2,3), itemStyle_color= c('chartreuse','lightblue','pink'), + itemStyle_decal_symbol= c('rect','diamond','none'), emphasis_itemStyle_color= c('darkgreen','blue','red') ) ec.init(series.param= list(type='pie', data= ec.data(df, 'names', nasep='_'))) diff --git a/man/ec.init.Rd b/man/ec.init.Rd index 1d151ff..f57c80d 100644 --- a/man/ec.init.Rd +++ b/man/ec.init.Rd @@ -29,8 +29,8 @@ If grouping is on multiple columns, only the first one is used to determine sett \item{...}{Optional widget attributes. See Details. \cr} \item{series.param}{Additional attributes for preset series, default is NULL.\cr -Can be used for non-timeline and timeline series (instead of \emph{tl.series}). A single list defines one series type only.\cr -One could also define all series directly with \emph{series=list(list(...),list...)} instead.} +Defines a single series type. Can be used for both non-timeline and timeline series. \cr +Multiple series types need to be defined directly with \emph{series=list(list(...),list...)} or added with \link{ec.upd}.} \item{tl.series}{Deprecated, use \emph{timeline} and \emph{series.param} instead.\cr} diff --git a/tests/testthat/test-ec.util.R b/tests/testthat/test-ec.util.R index 376e12c..ce47e78 100644 --- a/tests/testthat/test-ec.util.R +++ b/tests/testthat/test-ec.util.R @@ -367,12 +367,16 @@ test_that("ec.data treeTK", { }) test_that("ec.data 'names' + nasep", { - df <- data.frame(name= c('A','B','C'), value= c(1,2,3), + df <- data.frame(name= c('A','B','C'), value= c(1,2,3), + itemStyle_color= c('chartreuse','lightblue','pink'), + itemStyle_decal_symbol= c('rect','diamond','none'), emphasis_itemStyle_color= c('green','blue','red') ) p <- ec.init(series.param= list( type='pie', data= ec.data(df, 'names', nasep='_'))) expect_equal(p$x$opts$series[[1]]$data[[1]]$emphasis$itemStyle$color, 'green') + expect_equal(p$x$opts$series[[1]]$data[[2]]$itemStyle$decal$symbol, 'diamond') + expect_equal(p$x$opts$series[[1]]$data[[3]]$itemStyle$color, 'pink') }) test_that("ec.inspect and ec.fromJson", { diff --git a/tests/testthat/test-presets.R b/tests/testthat/test-presets.R index 672f3e5..bbd5151 100644 --- a/tests/testthat/test-presets.R +++ b/tests/testthat/test-presets.R @@ -17,7 +17,7 @@ test_that("options preset", { expect_equal(p$x$theme, 'mine') options(echarty.theme=NULL) - p <- cars |> ec.init() + p <- cars |> ec.init(dbg=T) expect_equal(p$x$theme, '') options(echarty.font='monospace') @@ -26,6 +26,14 @@ test_that("options preset", { options(echarty.font=NULL) }) +test_that("webR works with plugins", { + lif <- paste0(system.file('js', package='echarty'), '/echarts-liquidfill.min.js') + ec.webR <<- TRUE + tmp <- ec.init(load= 'liquid') + expect_false(file.exists(lif)) + rm(ec.webR, envir=globalenv()) +}) + test_that("ec.init presets for non-grouped data.frame", { p <- df |> ec.init(xAxis= list(scale=TRUE)) expect_equal(p$x$opts$xAxis$type, 'category') @@ -195,13 +203,14 @@ lng,lat,name,date,place ' df <- read.csv(text=tmp, header=TRUE) p <- df |> ec.init( - load='leaflet', tooltip= list(ey=''), + load='leaflet', tooltip= list(show=TRUE), series= list(list( encode= list(tooltip=c(3,4,5)) )) ) expect_equal(p$x$opts$series[[1]]$coordinateSystem, 'leaflet') expect_equal(p$x$opts$series[[1]]$encode$tooltip, c(2,3,4)) + expect_equal(p$dependencies[[1]]$name, 'leaflet') p <- ec.init(quakes |> head(11), load='world', series.param= list( encode= list(lng=2, lat=1, value=3),