diff --git a/DESCRIPTION b/DESCRIPTION index b8b68ad..e40f865 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: echarty Title: Minimal R/Shiny Interface to JavaScript Library 'ECharts' -Date: 2024-10-05 +Date: 2024-11-24 Version: 1.6.4.1 Author: Larry Helgason, with initial code from John Coene's library echarts4r Maintainer: Larry Helgason diff --git a/NEWS.md b/NEWS.md index 3d909a4..0f2c6ee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,11 +2,12 @@ ## v. 1.6.4.1 latest in development -- upgrade ECharts to v.5.5.1, built with R v.4.4.1 +- upgrade ECharts to v.5.5.1, built with R v.4.4.2 - auto-load 3D plugin when 3D attributes present (xAxis3D, bar3D, etc.) - auto-set 3D axes from data (name, type) - change in dataset: store column names in _dimensions_ instead of _source_ - fixed bug in ecr.ebars for single series +- add optional placeholder '%@' in title$text for timeline ## v. 1.6.4 on CRAN diff --git a/R/echarty.R b/R/echarty.R index 9a3e27b..fce21ec 100644 --- a/R/echarty.R +++ b/R/echarty.R @@ -83,9 +83,10 @@ noCoord <- c('polar','radar','singleAxis','parallelAxis','calendar') #' Defined by _series.param_ for the \href{https://echarts.apache.org/en/option.html#series}{options series} and a _timeline_ list for the \href{https://echarts.apache.org/en/option.html#timeline}{actual control}. #' A grouped _df_ is required, each group providing data for one option serie. #' Timeline \href{https://echarts.apache.org/en/option.html#timeline.data}{data} and \href{https://echarts.apache.org/en/option.html#options}{options} will be preset for the chart.\cr +#' Each option title can include the current timeline item by adding a placeholder '%@' in title$text. See example below.\cr #' Another preset is _encode(x=1,y=2,z=3)_, which are the first 3 columns of _df_. Parameter _z_ is ignored in 2D. See Details below.\cr #' Optional attribute _groupBy_, a _df_ column name, can create series groups inside each timeline option.\cr -#' Timeline cannot be used for hierarchical charts like graph,tree,treemap,sankey. Chart options/timeline have to be built directly, see \href{https://helgasoft.github.io/echarty/uc4.html}{example}. +#' Options/timeline for hierarchical charts like graph,tree,treemap,sankey have to be built directly, see \href{https://helgasoft.github.io/echarty/uc4.html}{example}. #' #' **\href{https://echarts.apache.org/en/option.html#series-line.encode}{Encode}** \cr #' A series attribute to define which columns to use for the axes, depending on chart type and coordinate system: \cr @@ -113,6 +114,7 @@ noCoord <- c('polar','radar','singleAxis','parallelAxis','calendar') #' ) #' #' data.frame(n=1:5) |> dplyr::group_by(n) |> ec.init( +#' title= list(text= "gauge #%@"), #' timeline= list(show=TRUE, autoPlay=TRUE), #' series.param= list(type='gauge', max=5) #' ) @@ -329,7 +331,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., for(nm in grvals) { k <- k+1 txfm <- append(txfm, list(list(transform= list( - type= 'filter', config= list(dimension= grnm, '='=nm), id= nm)))) + type= 'filter', config= list(dimension= grnm, '='=nm)), id= nm))) sers <- append(sers, list(list( # datasetIndex will be decremented later type= ctype, datasetIndex= k+1, name= as.character(nm)))) # if (colnames(df)[1]==grnm) # grouping by 1st column - breaks prll,map,etc. @@ -490,8 +492,8 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., # autoload 3D cnd1 <- any(c('xAxis3D','yAxis3D','zAxis3D','grid3D','globe','geo3D') %in% names(opt1)) styp <- ctype - if ('series.param' %in% names(opt1) && !is.null(opt1$series.param$type)) - styp <- opt1$series.param$type + if (!is.null(series.param) && !is.null(series.param$type)) + styp <- series.param$type cnd2 <- any(endsWith(styp, c('3D','GL'))) if ((cnd1 || cnd2) && !'3D' %in% load) load <- c(load, '3D') @@ -505,7 +507,7 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., wt$x$opts$series <- .merlis(wt$x$opts$series, list(coordinateSystem='geo')) } # WARN: duplicate maps if series have map='world' too - if (!'geo' %in% names(opt1)) + if (!'geo' %in% names(opt1) && !'3D' %in% load) wt$x$opts$geo = list(map='world', roam=TRUE) # else { # wt$x$opts$geo = .merlis(wt$x$opts$geo, list(map='world')) @@ -583,19 +585,23 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., if ('3D' %in% load) { if (preset) { # replace 2D presets with 3D isGL <- any(unlist(lapply(opt1$series, \(k){ endsWith(k$type, 'GL') }))) # all GL are 2D - if (!is.null(opt1$series.param)) isGL <- endsWith(opt1$series.param$type, 'GL') - if (!is.null(opt1$globe) || !is.null(opt1$geo3D) ) isGL <- FALSE + if (!isGL) isGL <- endsWith(styp, 'GL') + isMap3d <- !is.null(opt1$globe) || !is.null(opt1$geo3D) + if (isMap3d) isGL <- FALSE if (!isGL) { # check for series types ending in 3D or GL - stypes <- ifelse(!is.null(opt1$series.param), opt1$series.param$type, + stypes <- ifelse(!is.null(series.param), styp, unlist(lapply(opt1$series, \(k){k$type})) ) stypes <- stypes[stypes!='surface'] if (!is.null(stypes)) stopifnot("Non-3D series type detected"= all(endsWith(stypes, '3D')) ) - - nops <- names(opt1) # add defaults 3D - for(x in c('xAxis3D','yAxis3D','zAxis3D','grid3D')) { - a2d <- sub('3D','',x) - if (!(x %in% nops)) wt$x$opts[[x]] <- if (!is.null(wt$x$opts[[a2d]])) wt$x$opts[[a2d]] else list(show=T) + if (!isMap3d) { + nops <- names(opt1) # add defaults 3D + for(x in c('xAxis3D','yAxis3D','zAxis3D','grid3D')) { + a2d <- sub('3D','',x) + 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 } @@ -679,8 +685,9 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., di <<- di+1 steps <<- c(steps, unique(unlist(lapply(gp[grnm], as.character)))) series <- list(list(type= 'map', geoIndex= 1, datasetIndex= di +1)) - tmp <- list( #title= list(text= as.character(unique(gp[grnm]))), - series= series) + tmp <- list(series= series) + if (!is.null(opt1$title$text) && grepl('%@', opt1$title$text)) + tmp$title= list(text= sub('%@', as.character(unique(gp[grnm])), opt1$title$text) ) tmp <- .renumber(tmp) }) } @@ -709,8 +716,9 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., append(list(datasetIndex= di +1), tl.series) # , name= sname }) - tmp <- list( #title= list(text= unique(unlist(lapply(gp[grnm], as.character)))), - series= unname(series)) + tmp <- list(series= unname(series)) + if (!is.null(opt1$title$text) && grepl('%@', opt1$title$text)) + tmp$title= list(text= sub('%@', as.character(unique(gp[grnm])), opt1$title$text) ) tmp <- .renumber(tmp) }) } @@ -932,20 +940,29 @@ str='high '+(lo+hi)+''+lin+'
low '+lo+''; return str;}" # stac #' #' @examples #' library(dplyr) -#' df <- mtcars |> group_by(cyl,gear) |> summarise(yy= round(mean(mpg),2)) |> -#' mutate(low= round(yy-cyl*runif(1),2), high= round(yy+cyl*runif(1),2)) -#' ec.init(df, load= 'custom', ctype= 'bar', tooltip= list(show=TRUE), -#' xAxis= list(type='category')) |> -#' ecr.ebars(encode= list(y=c(3,4,5), x=2)) -#' +#' df <- mtcars |> group_by(cyl,gear) |> summarise(avg.mpg= round(mean(mpg),2)) |> +#' mutate(low = round(avg.mpg-cyl*runif(1),2), +#' high= round(avg.mpg+cyl*runif(1),2)) +#' ec.init(df, load= 'custom', ctype= 'bar', +#' xAxis= list(type='category'), tooltip= list(show=TRUE)) |> +#' ecr.ebars(encode= list(y=c('avg.mpg','low','high'), x='gear')) +#' #ecr.ebars(encode= list(y=c(3,4,5), x=2)) # ok: data indexes +#' +#' # same but horizontal +#' ec.init(df, load= 'custom', +#' yAxis= list(type='category'), tooltip= list(show=TRUE), +#' series.param= list(type='bar', encode= list(x='avg.mpg', y='gear') )) |> +#' ecr.ebars(encode= list(x=c('avg.mpg','low','high'), y='gear')) +#' #' # ----- riErrBarSimple ------ -#' df <- mtcars |> mutate(x=1:nrow(mtcars),hi=hp-drat*3, lo=hp+wt*3) |> select(x,hp,hi,lo) -#' ec.init(df, load= 'custom', legend= list(show= TRUE)) |> +#' df <- mtcars |> mutate(name= row.names(mtcars), hi= hp-drat*3, lo= hp+wt*3) |> +#' filter(cyl==4) |> select(name,hp,hi,lo) +#' ec.init(df, load= 'custom', legend= list(show=TRUE)) |> #' ec.upd({ series <- append(series, list( -#' list(type= 'custom', name= 'error', -#' data= ec.data(df |> select(x,hi,lo)), -#' renderItem= htmlwidgets::JS('riErrBarSimple') -#' ))) +#' list(type= 'custom', name= 'error', +#' data= ec.data(df |> select(name,hi,lo)), +#' renderItem= htmlwidgets::JS('riErrBarSimple') +#' ))) #' }) #' #' @export @@ -1008,17 +1025,6 @@ ecr.ebars <- function(wt, encode=list(x=1, y=c(2,3,4)), hwidth=6, ...) { # assuming all attached series from same dataset encode$y <- enc2num(encode$y, tmp[[1]]) encode$x <- enc2num(encode$x, tmp[[1]]) - # # set correct axis to type 'category' (char or factor) - # enc <- wt$x$opts$dataset[[1]]$source[[2]]$encode - # if (!is.null(enc)) { - # if (length(encode$y)==1) { - # if (is.character(enc$y) || is.factor(enc$y)) - # wt$x$opts$yAxis <- .merlis(wt$x$opts$yAxis, list(type='category')) - # } else { - # if (is.character(enc$x) || is.factor(enc$x)) - # wt$x$opts$xAxis <- .merlis(wt$x$opts$xAxis, list(type='category')) - # } - # } rim <- if (!is.null(args$renderItem)) args$renderItem else 'riErrBars' decds <- ifelse(length(tmp)>1, 0, 1) # single or grouped diff --git a/man/ec.init.Rd b/man/ec.init.Rd index bdc43a9..346483c 100644 --- a/man/ec.init.Rd +++ b/man/ec.init.Rd @@ -98,9 +98,10 @@ Enabling \emph{crosstalk} will also generate an additional dataset called \emph{ Defined by \emph{series.param} for the \href{https://echarts.apache.org/en/option.html#series}{options series} and a \emph{timeline} list for the \href{https://echarts.apache.org/en/option.html#timeline}{actual control}. A grouped \emph{df} is required, each group providing data for one option serie. Timeline \href{https://echarts.apache.org/en/option.html#timeline.data}{data} and \href{https://echarts.apache.org/en/option.html#options}{options} will be preset for the chart.\cr +Each option title can include the current timeline item by adding a placeholder '\%@' in title$text. See example below.\cr Another preset is \emph{encode(x=1,y=2,z=3)}, which are the first 3 columns of \emph{df}. Parameter \emph{z} is ignored in 2D. See Details below.\cr Optional attribute \emph{groupBy}, a \emph{df} column name, can create series groups inside each timeline option.\cr -Timeline cannot be used for hierarchical charts like graph,tree,treemap,sankey. Chart options/timeline have to be built directly, see \href{https://helgasoft.github.io/echarty/uc4.html}{example}. +Options/timeline for hierarchical charts like graph,tree,treemap,sankey have to be built directly, see \href{https://helgasoft.github.io/echarty/uc4.html}{example}. \strong{\href{https://echarts.apache.org/en/option.html#series-line.encode}{Encode}} \cr A series attribute to define which columns to use for the axes, depending on chart type and coordinate system: \cr @@ -128,6 +129,7 @@ ec.init( # init with presets ) data.frame(n=1:5) |> dplyr::group_by(n) |> ec.init( + title= list(text= "gauge #\%@"), timeline= list(show=TRUE, autoPlay=TRUE), series.param= list(type='gauge', max=5) ) diff --git a/man/ecr.ebars.Rd b/man/ecr.ebars.Rd index 29b1aa1..107e032 100644 --- a/man/ecr.ebars.Rd +++ b/man/ecr.ebars.Rd @@ -35,20 +35,29 @@ Other limitations:\cr } \examples{ library(dplyr) -df <- mtcars |> group_by(cyl,gear) |> summarise(yy= round(mean(mpg),2)) |> - mutate(low= round(yy-cyl*runif(1),2), high= round(yy+cyl*runif(1),2)) -ec.init(df, load= 'custom', ctype= 'bar', tooltip= list(show=TRUE), - xAxis= list(type='category')) |> -ecr.ebars(encode= list(y=c(3,4,5), x=2)) - +df <- mtcars |> group_by(cyl,gear) |> summarise(avg.mpg= round(mean(mpg),2)) |> + mutate(low = round(avg.mpg-cyl*runif(1),2), + high= round(avg.mpg+cyl*runif(1),2)) +ec.init(df, load= 'custom', ctype= 'bar', + xAxis= list(type='category'), tooltip= list(show=TRUE)) |> +ecr.ebars(encode= list(y=c('avg.mpg','low','high'), x='gear')) +#ecr.ebars(encode= list(y=c(3,4,5), x=2)) # ok: data indexes + +# same but horizontal +ec.init(df, load= 'custom', + yAxis= list(type='category'), tooltip= list(show=TRUE), + series.param= list(type='bar', encode= list(x='avg.mpg', y='gear') )) |> +ecr.ebars(encode= list(x=c('avg.mpg','low','high'), y='gear')) + # ----- riErrBarSimple ------ -df <- mtcars |> mutate(x=1:nrow(mtcars),hi=hp-drat*3, lo=hp+wt*3) |> select(x,hp,hi,lo) -ec.init(df, load= 'custom', legend= list(show= TRUE)) |> +df <- mtcars |> mutate(name= row.names(mtcars), hi= hp-drat*3, lo= hp+wt*3) |> + filter(cyl==4) |> select(name,hp,hi,lo) +ec.init(df, load= 'custom', legend= list(show=TRUE)) |> ec.upd({ series <- append(series, list( - list(type= 'custom', name= 'error', - data= ec.data(df |> select(x,hi,lo)), - renderItem= htmlwidgets::JS('riErrBarSimple') - ))) + list(type= 'custom', name= 'error', + data= ec.data(df |> select(name,hi,lo)), + renderItem= htmlwidgets::JS('riErrBarSimple') + ))) }) } diff --git a/tests/testthat/test-other.R b/tests/testthat/test-other.R index b47c175..cbdbee1 100644 --- a/tests/testthat/test-other.R +++ b/tests/testthat/test-other.R @@ -33,14 +33,13 @@ test_that("registerMap", { test_that("tl.series, timeline options, groupBy", { # also in test-presets p <- Orange |> dplyr::group_by(age) |> ec.init( - timeline= list(autoPlay=TRUE), + timeline= list(autoPlay=TRUE), title= list(text='age %@ days'), series.param= list(type='bar', encode=list(x='Tree', y='circumference')) - ) |> ec.upd({ - options <- lapply(seq_along(options), - \(i) { - options[[i]]$title$text <- paste('age',timeline$data[[i]],'days'); - options[[i]] }) - }) + ) # |> ec.upd({ + # options <- lapply(seq_along(options), \(i) { + # options[[i]]$title$text <- paste('age',timeline$data[[i]],'days'); + # options[[i]] }) + # }) expect_equal(p$x$opts$options[[5]]$title$text, "age 1231 days") expect_equal(p$x$opts$options[[5]]$series[[1]]$datasetIndex, 5) expect_equal(p$x$opts$options[[7]]$series[[1]]$encode$x, "Tree") @@ -60,6 +59,13 @@ test_that("tl.series, timeline options, groupBy", { # also in test-presets ) expect_equal(p$x$opts$options[[4]]$series[[2]]$name, 'B') expect_true(p$x$opts$dataset[[9]]$transform$config$and[[2]]$dimension=='x2') + + p <- data.frame(name=c('Brazil','Australia'), value=c(111,222)) |> group_by(name) |> + ec.init(load= 'world', title= list(text='map %@'), visualMap=list(show=T), + timeline= list(show=T), series.param= list(type='map') ) + expect_equal(p$x$opts$options[[2]]$title$text, "map Brazil") + expect_equal(p$x$opts$visualMap$min, 111) + }) test_that("leaflet with ec.clmn and timeline", { @@ -170,6 +176,25 @@ test_that("3D globe & autoload 3D", { lif <- paste0(system.file('js', package='echarty'), '/echarts-gl.min.js') expect_true(file.exists(lif)) expect_equal(p$x$opts$series[[1]]$coordinateSystem, 'globe') + + p <- ec.init(load='world', geo3D= list(map= 'world', roam=T), + series.param= list(type= 'scatter3D', data=list(c(115, 22, 10), c(-116, 32, -11))) + ) + expect_equal(p$x$opts$series[[1]]$coordinateSystem, 'geo3D') +}) + +test_that("radar and polar", { # for coverage + p <- ec.init( + radar= list(indicator= lapply(LETTERS[1:5], \(x) { list(name=x)} ) ), + series= list(list(type='radar', radarIndex=1, + data= list(c(10,22,5,9,11), c(12,18,15,15,7)))) + ) + expect_equal(p$x$opts$series[[1]]$radarIndex, 0) + + p <- data.frame(x = 1:10, y = seq(1, 20, by = 2)) |> + ec.init(polar= list(show=T), series.param= list(type='line', polarIndex=1)) + expect_equal(p$x$opts$series[[1]]$polarIndex, 0) + }) test_that("calendar", { @@ -178,9 +203,10 @@ test_that("calendar", { p <- df |> ec.init( visualMap= list(show= FALSE, min= 0, max= 100), calendar = list(range= c('2023-01','2023-04')), - series.param= list(type= 'scatter', name='scat', symbolSize=11) + series.param= list(type= 'scatter', name='scat', symbolSize=11, calendarIndex=1) ) expect_equal(p$x$opts$series[[1]]$coordinateSystem, "calendar") + expect_equal(p$x$opts$series[[1]]$calendarIndex, 0) }) test_that("ec.plugjs", { @@ -243,7 +269,7 @@ test_that('stops are working in echarty.R', { expect_silent(ec.init(mtcars |> group_by(gear), tl.series= list(type='map'))) # no name/value, can use encode expect_silent(ec.init(df |> group_by(y), series.param= list(type='bar'))) expect_silent(ec.init(df |> group_by(y), series.param= list(type='bar'), - timeline= list(s=T))) + timeline= list(show=T))) # expect_error(cars |> group_by(speed) |> ec.init()) # 3 cols min # expect_error(ec.init(data.frame(name='n',value=1) |> group_by(name), # tl.series= list(type='bar'))) # 3 cols min diff --git a/tests/testthat/test-presets.R b/tests/testthat/test-presets.R index ff6dc12..ea6f864 100644 --- a/tests/testthat/test-presets.R +++ b/tests/testthat/test-presets.R @@ -57,7 +57,7 @@ test_that("ec.init presets for grouped data.frame", { expect_equal(po$xAxis$type, 'category') expect_equal(po$yAxis$name, 'yaxe') expect_equal(length(po$dataset[[1]]$source), 10) - expect_equal(po$dataset[[4]]$transform$id, "triangle") + expect_equal(po$dataset[[4]]$id, "triangle") expect_equal(length(po$legend$data), 3) expect_equal(po$series[[1]]$type, 'scatter') expect_equal(po$series[[1]]$name, 'circle') diff --git a/tests/testthat/test-renderers.R b/tests/testthat/test-renderers.R index 7c00fb8..e968431 100644 --- a/tests/testthat/test-renderers.R +++ b/tests/testthat/test-renderers.R @@ -48,6 +48,24 @@ test_that("ecr.ebars", { expect_equal(p$x$opts$series[[2]]$encode$y, c(2,3,4)) expect_equal(p$x$opts$series[[2]]$itemStyle$borderDashOffset, 12) + df <- Orange |> arrange(Tree) |> mutate(up= circumference+runif(5)*6, + lo= circumference-runif(5)*6 ) |> filter(age==1231) + tmp <- ec.init(df, load= 'custom', legend= list(show=T), tooltip= list(show=T), + xAxis=list(type='category'), + series= list(list(type='bar', name='data', encode= list(x='Tree',y='circumference') + ))) + p <- ecr.ebars(tmp, encode= list(x='Tree', y=c('circumference','lo','up')), hwidth=12, name='err', + itemStyle= list(borderWidth= 2.5, color= "red") + ) + expect_equal(p$x$opts$series[[2]]$encode$y, c(2,3,4)) + expect_equal(p$x$opts$series[[2]]$itemStyle$borderDashOffset, 12) + p <- tmp |> ec.upd({ # for cov only + dataset[[1]]$source[[1]] <- dataset[[1]]$dimensions + dataset[[1]]$dimensions <- NULL + dataset[[1]]$sourceHeader <- T # TODO: should work without it too + }) |> ecr.ebars( encode= list(x='Tree', y=c('circumference','lo','up')), hwidth=12 ) + expect_equal(p$x$opts$dataset[[1]]$source[[1]][1], 'Tree') + # grouped + non-categorical tmp <- round(rnorm(24, sin(1:24/2)*10, .5)) df <- data.frame(x = 1:24, val = tmp,