From 8731596004c5c6ed3e9fe684ad5dd83e672baac2 Mon Sep 17 00:00:00 2001 From: helgasoft Date: Wed, 20 Sep 2023 09:13:55 -0700 Subject: [PATCH] improvements to 1.6.0 --- R/echarty.R | 8 +++++--- R/examples.R | 31 +++++++++++++------------------ R/util.R | 33 ++++++++++++++++----------------- inst/htmlwidgets/echarty.js | 8 ++++---- man/ec.examples.Rd | 31 +++++++++++++------------------ man/ec.fromJson.Rd | 3 ++- man/ec.init.Rd | 8 +++++--- man/ec.inspect.Rd | 5 +++-- tests/testthat/test-ec.util.R | 15 ++++++++------- 9 files changed, 69 insertions(+), 73 deletions(-) diff --git a/R/echarty.R b/R/echarty.R index 62febf7..065a1da 100644 --- a/R/echarty.R +++ b/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} diff --git a/R/examples.R b/R/examples.R index 0e753dd..3b56676 100644 --- a/R/examples.R +++ b/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 diff --git a/R/util.R b/R/util.R index 5ba22cc..b182d64 100644 --- a/R/util.R +++ b/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,7 +1163,7 @@ 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 @@ -1162,7 +1171,8 @@ ec.inspect <- function(wt, target='opts', ...) { #' "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))) diff --git a/inst/htmlwidgets/echarty.js b/inst/htmlwidgets/echarty.js index d94ac3c..36832c3 100644 --- a/inst/htmlwidgets/echarty.js +++ b/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; } } diff --git a/man/ec.examples.Rd b/man/ec.examples.Rd index 7decb7d..4a0aa93 100644 --- a/man/ec.examples.Rd +++ b/man/ec.examples.Rd @@ -433,18 +433,16 @@ ec.init(preset= FALSE, js= jcode, #------ 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 )) ) @@ -469,20 +467,17 @@ ec.init(preset= FALSE, #------ 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 diff --git a/man/ec.fromJson.Rd b/man/ec.fromJson.Rd index 1646e83..306192c 100644 --- a/man/ec.fromJson.Rd +++ b/man/ec.fromJson.Rd @@ -23,7 +23,7 @@ Convert JSON string or file to chart } \details{ \emph{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 \emph{htmlwidget} generated thru \code{ec.inspect(target='full')}.\cr +OR an entire \emph{htmlwidget} generated thru \link{ec.inspect} when \emph{target='full'}.\cr The latter imports all JavaScript functions defined by the user. } \examples{ @@ -32,4 +32,5 @@ txt <- '{ "series": { "type": "line", "data": [150, 230, 224] } }' ec.fromJson(txt) +# ec.fromJson('https://helgasoft.github.io/echarty/test/pfull.json') } diff --git a/man/ec.init.Rd b/man/ec.init.Rd index 44f2449..2eb7452 100644 --- a/man/ec.init.Rd +++ b/man/ec.init.Rd @@ -33,9 +33,11 @@ Custom echarty widget attributes include: \cr \item load - name(s) of plugin(s) to load. A character vector or comma-delimited string. default NULL. \item ask - prompt user before downloading plugins when \emph{load} is present, FALSE by default \item 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 \emph{opts}. \cr -Third is evaluated with exposed \emph{chart} object after \emph{opts} have been set. +single: exposed \emph{chart} object (most common)\cr +vector:\cr +\verb{ }First expression is evaluated before chart initialization. \cr +\verb{ }Second is evaluated with exposed object \emph{opts}. \cr +\verb{ }Third is evaluated with exposed \emph{chart} object after \emph{opts} set. \item renderer - 'canvas'(default) or 'svg' \item locale - 'EN'(default) or 'ZH'. Use predefined or custom \href{https://gist.github.com/helgasoft/0618c6537c45bfd9e86d3f9e1da497b8}{like so}. \item useDirtyRect - enable dirty rectangle rendering or not, FALSE by default, see \href{https://echarts.apache.org/en/api.html#echarts.init}{here} diff --git a/man/ec.inspect.Rd b/man/ec.inspect.Rd index 37a258f..af21657 100644 --- a/man/ec.inspect.Rd +++ b/man/ec.inspect.Rd @@ -14,10 +14,11 @@ ec.inspect(wt, target = "opts", ...) \verb{ }'full' - the \emph{entire} htmlwidget as JSON\cr \verb{ }'data' - info about chart's embedded data (char vector)} -\item{...}{Additional attributes to pass to \link[jsonlite]{toJSON}} +\item{...}{Additional attributes to pass to \link[jsonlite]{toJSON}\cr +'file' - optional file name to save to when target='full'\cr} } \value{ -A JSON string, except when \code{target} is 'data' then +A JSON string, except when \code{target} is 'data' - then a character vector. } \description{ diff --git a/tests/testthat/test-ec.util.R b/tests/testthat/test-ec.util.R index 155fddc..1d0d714 100644 --- a/tests/testthat/test-ec.util.R +++ b/tests/testthat/test-ec.util.R @@ -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')) })