From 34ab93f3389ad592d885709ade73a0d7397e0422 Mon Sep 17 00:00:00 2001 From: Larry Helgason Date: Wed, 15 Jan 2025 13:42:47 -0800 Subject: [PATCH] 1.6.6 --- DESCRIPTION | 4 +- NEWS.md | 8 +- R/echarty.R | 30 ++--- R/util.R | 195 +++++++++++++++++--------------- README.md | 6 +- demo/examples.R | 56 +++++---- man/ec.data.Rd | 6 +- man/ec.fromJson.Rd | 8 +- man/ec.inspect.Rd | 6 +- man/ec.util.Rd | 128 ++++++++++----------- tests/testthat.R | 1 + tests/testthat/test-ec.util.R | 78 ++++++------- tests/testthat/test-other.R | 126 +++++++++++++++------ tests/testthat/test-presets.R | 33 +++--- tests/testthat/test-renderers.R | 23 ++-- 15 files changed, 391 insertions(+), 317 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 2cd4cbd..65d6929 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: echarty Title: Minimal R/Shiny Interface to JavaScript Library 'ECharts' -Date: 2024-12-29 -Version: 1.6.5 +Date: 2025-01-15 +Version: 1.6.6 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") ) diff --git a/NEWS.md b/NEWS.md index fa89f2a..150fa6c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,10 @@ # history of package _echarty_ -# echarty 1.6.5 latest in development +# echarty 1.6.6 latest in development + +* more tests to increase coverage without disturbing CRAN submission + +# echarty 1.6.5 on CRAN * upgrade ECharts to v.5.6.0, built with R v.4.4.2. * auto-load 3D plugin when 3D attributes present (xAxis3D, bar3D, etc.). @@ -12,7 +16,7 @@ * integrate website with library using _pkgdown_. * moved _examples.R_ into 'demo' folder, _ec.examples_ is no longer a command. -# echarty 1.6.4 on CRAN +# echarty 1.6.4 * upgrade ECharts to v.5.5.0, built with R v.4.4.0. * add _nasep_ parameter to _ec.data('names')_ to easily set nested lists from a _data.frame_. diff --git a/R/echarty.R b/R/echarty.R index e31cb3d..b8f8622 100644 --- a/R/echarty.R +++ b/R/echarty.R @@ -274,8 +274,8 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., 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 - for(xx in xx:1) if (is.numeric(df[,xx])) break + xx <- length(colnames(df)) # last numeric column (by default) + for(xx in xx:1) if (is.numeric(unlist(df[,xx]))) break # unlist for group_by if (any(names(df) == 'value') && ( (!is.null(tl.series) && tl.series$type=='map') || (!is.null(series.param) && series.param$type=='map')) @@ -659,7 +659,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 (dbg) cat('\ntimeline: x=',xtem,' y=',ytem,' cs=',tmp$c) if (any(c('geo','leaflet') %in% tl.series$coordinateSystem)) { klo <- 'lng'; kla <- 'lat' @@ -693,15 +693,9 @@ ec.init <- function( df= NULL, preset= TRUE, ctype= 'scatter', ..., }) } else { - if (is.null(unlist(tl.series$encode[xtem]))) { - # append col XcolX 1:max for each group - df <- df |> group_modify(~ { .x |> mutate(XcolX = 1:nrow(.)) }) - tl.series$encode[xtem] <- 'XcolX' # instead of relocate(XcolX) - # replace only source, transforms stay - wt$x$opts$dataset[[1]] <- list(source= ec.data(df, header=TRUE)) - } - stopifnot("timeline: bad second parameter name for encode"= !is.null(unlist(tl.series$encode[ytem]))) - + if (is.null(tl.series$encode[[xtem]]) || is.null(tl.series$encode[[ytem]])) + stop(paste0('for ',tl.series$type,' use encode=list(',xtem,'=..., ',ytem,'=...)'), call.=FALSE) + # dataset is already in, now loop group column(s) #gvar <- df |> group_vars() |> first() |> as.character() # convert if factor di <- 0 @@ -1114,12 +1108,12 @@ ecs.render <- function(wt, env=parent.frame(), quoted= FALSE) { #' @export ecs.proxy <- function(id) { sessi <- globalenv() - if (interactive()) { + #if (interactive()) { if (requireNamespace("shiny", quietly = TRUE)) { sessi <- shiny::getDefaultReactiveDomain() } else return(invisible(NULL)) - } + #} proxy <- list(id= id, session= sessi) class(proxy) <- 'ecsProxy' return(proxy) @@ -1164,13 +1158,13 @@ ecs.exec <- function(proxy, cmd= 'p_merge') { # create web dependencies for JS, if present if (!is.null(proxy$dependencies)) { - if (interactive()) { + #if (interactive()) { if (requireNamespace("shiny", quietly = TRUE)) { plist$deps <- list(shiny::createWebDependency( htmltools::resolveDependencies( proxy$dependencies )[[1]] )) } - } + #} } if (!is.null(proxy$session)) proxy$session$sendCustomMessage('kahuna', plist) @@ -1256,9 +1250,7 @@ ec.plugjs <- function(wt=NULL, source=NULL, ask=FALSE) { } # called by widget init -# .preRender <- function(wt) { -# wt -# } +# .preRender <- function(wt) { wt } # convert from R to JS numbering .renumber <- function(opa) { diff --git a/R/util.R b/R/util.R index f70ce80..f695390 100644 --- a/R/util.R +++ b/R/util.R @@ -12,71 +12,72 @@ #' for \emph{tabset} parameters should be in format \emph{name1=chart1, name2=chart2}, see example\cr #' @details #' **cmd = 'sf.series'**\cr -#'  Build _leaflet_ or \href{https://echarts.apache.org/en/option.html#geo.map}{geo} map series from shapefiles.\cr -#'  Supported types: POINT, MULTIPOINT, LINESTRING, MULTILINESTRING, POLYGON, MULTIPOLYGON \cr -#'  Coordinate system is _leaflet_(default), _geo_ or _cartesian3D_ (for POINT(xyz))\cr -#'  Limitations:\cr -#'     polygons can have only their name in tooltip, \cr -#'     assumes Geodetic CRS is WGS 84, for conversion use \link[sf]{st_transform} with _crs=4326_.\cr -#'  Parameters:\cr -#'     df - value from \link[sf]{st_read}\cr -#'     nid - optional column name for name-id used in tooltips\cr -#'     cs - optional _coordinateSystem_ value, default 'leaflet'\cr -#'     verbose - optional, print shapefile item names in console\cr -#'  Returns a list of chart series\cr +#' \verb{ }Build _leaflet_ or \href{https://echarts.apache.org/en/option.html#geo.map}{geo} map series from shapefiles.\cr +#' \verb{ }Supported types: POINT, MULTIPOINT, LINESTRING, MULTILINESTRING, POLYGON, MULTIPOLYGON \cr +#' \verb{ }Coordinate system is _leaflet_(default), _geo_ or _cartesian3D_ (for POINT(xyz))\cr +#' \verb{ }Limitations:\cr +#' \verb{ }polygons can have only their name in tooltip, \cr +#' \verb{ }assumes Geodetic CRS is WGS 84, for conversion use \link[sf]{st_transform} with _crs=4326_.\cr +#' \verb{ }Parameters:\cr +#' \verb{ }df - value from \link[sf]{st_read}\cr +#' \verb{ }nid - optional column name for name-id used in tooltips\cr +#' \verb{ }cs - optional _coordinateSystem_ value, default 'leaflet'\cr +#' \verb{ }verbose - optional, print shapefile item names in console\cr +#' \verb{ }Returns a list of chart series\cr #' **cmd = 'sf.bbox'**\cr -#'  Returns JavaScript code to position a map inside a bounding box from \link[sf]{st_bbox}, for leaflet only.\cr +#' \verb{ }Returns JavaScript code to position a map inside a bounding box from \link[sf]{st_bbox}, for leaflet only.\cr #' **cmd = 'sf.unzip'**\cr -#'  Unzips a remote file and returns local file name of the unzipped .shp file\cr -#'     url - URL of remote zipped shapefile\cr -#'     shp - optional name of .shp file inside ZIP file if multiple exist. Do not add file extension. \cr +#' \verb{ }Unzips a remote file and returns local file name of the unzipped .shp file\cr +#' \verb{ }url - URL of remote zipped shapefile\cr +#' \verb{ }shp - optional name of .shp file inside ZIP file if multiple exist. Do not add file extension. \cr +#' \verb{ }Returns full name of unzipped .shp file, or error string starting with 'ERROR'\cr #' **cmd = 'geojson'** \cr -#'  Custom series list from geoJson objects\cr -#'     geojson - object from \link[jsonlite]{fromJSON}\cr -#'     cs - optional _coordinateSystem_ value, default 'leaflet'\cr -#'     ppfill - optional fill color like '#F00', OR NULL for no-fill, for all Points and Polygons\cr -#'     nid - optional feature property for item name used in tooltips\cr -#'     ... - optional custom series attributes like _itemStyle_\cr -#'  Can display also geoJson _feature properties_: color; lwidth, ldash (lines); ppfill, radius (points)\cr +#' \verb{ }Custom series list from geoJson objects\cr +#' \verb{ }geojson - object from \link[jsonlite]{fromJSON}\cr +#' \verb{ }cs - optional _coordinateSystem_ value, default 'leaflet'\cr +#' \verb{ }ppfill - optional fill color like '#F00', OR NULL for no-fill, for all Points and Polygons\cr +#' \verb{ }nid - optional feature property for item name used in tooltips\cr +#' \verb{ }... - optional custom series attributes like _itemStyle_\cr +#' \verb{ }Can display also geoJson _feature properties_: color; lwidth, ldash (lines); ppfill, radius (points)\cr #' **cmd = 'layout'** \cr -#'  Multiple charts in table-like rows/columns format\cr -#'     ... - List of charts\cr -#'     title - optional title for the entire set\cr -#'     rows - optional number of rows\cr -#'     cols - optional number of columns\cr -#'  Returns a container \link[htmltools]{div} in rmarkdown, otherwise \link[htmltools]{browsable}.\cr -#'  For 3-4 charts one would use multiple series within a \href{https://echarts.apache.org/en/option.html#grid}{grid}. \cr -#'  For greater number of charts _ec.util(cmd='layout')_ comes in handy\cr +#' \verb{ }Multiple charts in table-like rows/columns format\cr +#' \verb{ }... - List of charts\cr +#' \verb{ }title - optional title for the entire set\cr +#' \verb{ }rows - optional number of rows\cr +#' \verb{ }cols - optional number of columns\cr +#' \verb{ }Returns a container \link[htmltools]{div} in rmarkdown, otherwise \link[htmltools]{browsable}.\cr +#' \verb{ }For 3-4 charts one would use multiple series within a \href{https://echarts.apache.org/en/option.html#grid}{grid}. \cr +#' \verb{ }For greater number of charts _ec.util(cmd='layout')_ comes in handy\cr #' **cmd = 'tabset'** \cr -#'     ... - a list name/chart pairs like \emph{n1=chart1, n2=chart2}, each tab may contain a chart.\cr -#'     tabStyle - tab style string, see default \emph{tabStyle} variable in the code\cr -#'  Returns A) \link[htmltools]{tagList} of tabs when in a pipe without '...' params, see example\cr -#'  Returns B) \link[htmltools]{browsable} when '...' params are provided by user\cr -#'  Please note that sometimes those tabsets do not merge well inside advanced web pages.\cr +#' \verb{ }... - a list name/chart pairs like \emph{n1=chart1, n2=chart2}, each tab may contain a chart.\cr +#' \verb{ }tabStyle - tab style string, see default \emph{tabStyle} variable in the code\cr +#' \verb{ }Returns A) \link[htmltools]{tagList} of tabs when in a pipe without '...' params, see example\cr +#' \verb{ }Returns B) \link[htmltools]{browsable} when '...' params are provided by user\cr +#' \verb{ }Please note that sometimes those tabsets do not merge well inside advanced web pages.\cr #' **cmd = 'button'** \cr -#'  UI button to execute a JS function,\cr -#'     text - the button label\cr -#'     js - the JS function string\cr -#'     ... - optional parameters for the \href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element\cr -#'  Returns a graphic.elements-\href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element.\cr +#' \verb{ }UI button to execute a JS function,\cr +#' \verb{ }text - the button label\cr +#' \verb{ }js - the JS function string\cr +#' \verb{ }... - optional parameters for the \href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element\cr +#' \verb{ }Returns a graphic.elements-\href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element.\cr #' **cmd = 'morph'** \cr -#'     ... - a list of charts or chart option lists\cr -#'     event - name of event for switching charts. Default is \emph{click}.\cr -#'  Returns a chart with ability to morph into other charts\cr +#' \verb{ }... - a list of charts or chart option lists\cr +#' \verb{ }event - name of event for switching charts. Default is \emph{click}.\cr +#' \verb{ }Returns a chart with ability to morph into other charts\cr #' **cmd = 'fullscreen'** \cr -#'  A toolbox feature to toggle fullscreen on/off. Works in a browser, not in RStudio.\cr +#' \verb{ }A toolbox feature to toggle fullscreen on/off. Works in a browser, not in RStudio.\cr #' **cmd = 'rescale'** \cr -#'     v - input vector of numeric values to rescale\cr -#'     t - target range c(min,max), numeric vector of two\cr +#' \verb{ }v - input vector of numeric values to rescale\cr +#' \verb{ }t - target range c(min,max), numeric vector of two\cr #' **cmd = 'level'** \cr -#'  Calculate vertical levels for timeline \emph{line} charts, returns a numeric vector\cr -#'     df - data.frame with _from_ and _to_ columns\cr -#'     from - name of 'from' column\cr -#'     to - name of 'to' column\cr +#' \verb{ }Calculate vertical levels for timeline \emph{line} charts, returns a numeric vector\cr +#' \verb{ }df - data.frame with _from_ and _to_ columns\cr +#' \verb{ }from - name of 'from' column\cr +#' \verb{ }to - name of 'to' column\cr #' #' @examples #' library(dplyr) -#' if (interactive()) { # comm.out: Fedora errors about some 'browser' +#' if (interactive()) { # comm.out: Cran Fedora errors about some 'browser' #' library(sf) #' fname <- system.file("shape/nc.shp", package="sf") #' nc <- as.data.frame(st_read(fname)) @@ -97,19 +98,20 @@ #' p1 <- cars |> ec.init(grid= list(top=26), height=333) # move chart up #' p2 <- mtcars |> arrange(mpg) |> ec.init(height=333, ctype='line') #' ec.util(cmd= 'tabset', cars= p1, mtcars= p2) -#' } #' -#' cars |> ec.init( -#' graphic = list( -#' ec.util(cmd='button', text='see type', right='center', top=20, -#' js="function(a) {op=ec_option(echwid); alert(op.series[0].type);}") -#' ) -#' ) #' -#' lapply(list('dark','macarons','gray','jazz','dark-mushroom'), -#' function(x) cars |> ec.init(grid= list(bottom=0)) |> ec.theme(x) ) |> -#' ec.util(cmd='layout', cols= 2, title= 'my layout') -#' +#' cars |> ec.init( +#' graphic = list( +#' ec.util(cmd='button', text='see type', right='center', top=20, +#' js="function(a) {op=ec_option(echwid); alert(op.series[0].type);}") +#' ) +#' ) +#' +#' lapply(list('dark','macarons','gray','jazz','dark-mushroom'), +#' function(x) cars |> ec.init(grid= list(bottom=0)) |> ec.theme(x) ) |> +#' ec.util(cmd='layout', cols= 2, title= 'my layout') +#' } +#' #' colors <- c("blue","red","green") #' cyls <- as.character(sort(unique(mtcars$cyl))) #' sers <- lapply(mtcars |> group_by(cyl) |> group_split(), \(x) { @@ -280,18 +282,23 @@ ec.util <- function( ..., cmd='sf.series', js=NULL, event='click') { }, 'sf.unzip'= { stopifnot('ec.util: expecting url of zipped shapefile'= !is.null(opts$url)) - stopifnot('ec.util: invalid zip url'= .valid.url(opts$url)) - destfile <- tempfile('shapefile') - download.file(opts$url, destfile, mode='wb') #, method='curl') - # get name only, use as folder name to unzip to - fldr <- sub(pattern = "(.*)\\..*$", replacement = "\\1", basename(opts$url)) - unzip(destfile, exdir=fldr) # new folder under getwd() - # find name - pat <- ifelse (is.null(opts$shp), '*.shp', paste0(opts$shp,'.shp')) - tmp <- list.files(path= fldr, pattern= pat) - if (length(tmp)==0) - stop(paste('ec.util:',pat,'file not found in folder',fldr), call. = FALSE) - out <- paste0(getwd(),'/',fldr,'/',tmp[1]) + #stopifnot('ec.util: invalid zip url'= .valid.url(opts$url)) + if (!.valid.url(opts$url)) { out <- 'ERROR invalid zip url' } + else { + destfile <- tempfile('shapefile') + download.file(opts$url, destfile, mode='wb') #, method='curl') + # get name only, use as folder name to unzip to + fldr <- sub(pattern = "(.*)\\..*$", replacement = "\\1", basename(opts$url)) + unzip(destfile, exdir=fldr) # new folder under getwd() + # find name + pat <- ifelse (is.null(opts$shp), '*.shp', paste0(opts$shp,'.shp')) + tmp <- list.files(path= fldr, pattern= pat) + if (length(tmp)==0) + # stop(paste('ec.util:',pat,'file not found in folder',fldr), call. = FALSE) + out <- 'ERROR unzipped file not found' + else + out <- paste0(getwd(),'/',fldr,'/',tmp[1]) + } }, 'geojson'= { @@ -595,13 +602,13 @@ body { padding: 10px; } #' #' @details #' `format='boxplot'` requires the first two _df_ columns as: \cr -#'     column for the non-computational categorical axis\cr -#'     column with (numeric) data to compute the five boxplot values\cr +#' \verb{ }column for the non-computational categorical axis\cr +#' \verb{ }column with (numeric) data to compute the five boxplot values\cr #' Additional grouping is supported on a column after the second. Groups will show in the legend, if enabled.\cr #' Returns a `list(dataset, series, xAxis, yAxis)` to set params in [ec.init]. #' Make sure there is enough data for computation, 4+ values per boxplot.\cr #' `format='treeTT'` expects data.frame _df_ columns _pathString,value,(optional itemStyle)_ for \link[data.tree]{FromDataFrameTable}.\cr -#' It will add column 'pct' with value percentage for each node. See Details. +#' It will add column 'pct' with value percentage for each node. See example below. #' @seealso some live \href{https://rpubs.com/echarty/data-models}{code samples} #' #' @examples @@ -750,15 +757,7 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) { n <- seq_along(df[[1]]) # all df columns have the same length tmp <- lapply(n, \(i) lapply(df, "[[", i)) # preserve column types - if (format=='dataset') { - datset <- lapply(tmp, unname) - if (header) - datset <- c(list(colnames(df)), datset) - } - else if (format=='values' || isTRUE(format)) { - datset <- lapply(tmp, \(x) list(value=unlist(x, use.names=FALSE))) - } - else if (format=='boxplot') { + 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 @@ -902,6 +901,14 @@ ec.data <- function(df, format='dataset', header=FALSE, ...) { } return(list(dataset= dataset, series= series, xAxis=xaxis, yAxis=yaxis)) } + else if (format=='dataset') { + datset <- lapply(tmp, unname) + if (header) + datset <- c(list(colnames(df)), datset) + } + else if (format=='values' || isTRUE(format)) { + datset <- lapply(tmp, \(x) list(value=unlist(x, use.names=FALSE))) + } else { # format=='names' args <- list(...) if ('nasep' %in% names(args)) { @@ -1213,9 +1220,9 @@ ec.theme <- function (wt, name='custom', code= NULL) #' #' @param wt An \code{echarty} widget as returned by [ec.init] #' @param target type of resulting value: \cr -#'     'opts' - the htmlwidget _options_ as JSON (default)\cr -#'     'full' - the _entire_ htmlwidget as JSON\cr -#'     'data' - info about chart's embedded data (char vector) +#' \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}\cr #' 'file' - optional file name to save to when target='full'\cr #' @return A JSON string, except when \code{target} is 'data' - then @@ -1292,10 +1299,10 @@ ec.inspect <- function(wt, target='opts', ...) { #' Convert JSON string or file to chart #' #' @param txt Could be one of the following:\cr -#'     class _url_, like \code{url('https://serv.us/cars.txt')}\cr -#'     class _file_, like \code{file('c:/temp/cars.txt','rb')}\cr -#'     class _json_, like \code{ec.inspect(p)}, for options or full\cr -#'     class _character_, JSON string with options only, see example below\cr +#' \verb{ }class _url_, like \code{url('https://serv.us/cars.txt')}\cr +#' \verb{ }class _file_, like \code{file('c:/temp/cars.txt','rb')}\cr +#' \verb{ }class _json_, like \code{ec.inspect(p)}, for options or full\cr +#' \verb{ }class _character_, JSON string with options only, see example below\cr #' @param ... Any attributes to pass to internal [ec.init] when _txt_ is options only #' @return An _echarty_ widget. #' diff --git a/README.md b/README.md index 55bfa49..3a3fcd2 100644 --- a/README.md +++ b/README.md @@ -4,10 +4,10 @@ [![R-CMD-check](https://github.com/helgasoft/echarty/workflows/R-CMD-check/badge.svg)](https://github.com/helgasoft/echarty/actions) -[![coverage](https://coveralls.io/repos/github/helgasoft/echarty/badge.svg)](https://coveralls.io/r/helgasoft/echarty?branch=main) +[![coverage](https://coveralls.io/repos/github/helgasoft/echarty/badge.svg)](https://coveralls.io/github/helgasoft/echarty) [![size](https://img.shields.io/github/languages/code-size/helgasoft/echarty)](https://github.com/helgasoft/echarty/releases/) [![website](https://img.shields.io/badge/Website-Visit-blue)](https://helgasoft.github.io/echarty) -[![twitter](https://img.shields.io/twitter/follow/echarty.svg?style=social&label=Follow)](https://twitter.com/echarty_R) +[![twitter](https://img.shields.io/twitter/follow/echarty.svg?style=social&label=Follow)](https://x.com/echarty_R) -Latest development build **1.6.5** +Latest development build **1.6.6** ``` r if (!requireNamespace('remotes')) install.packages('remotes') diff --git a/demo/examples.R b/demo/examples.R index 9cd581e..be63f61 100644 --- a/demo/examples.R +++ b/demo/examples.R @@ -98,38 +98,36 @@ #' color = c("#387e78","#eeb422","#d9534f",'magenta')) #' tmp <- head(flights,10) |> inner_join(tmp) # add color by airport #' ec.init(load= 'world', -#' geo= list(center= c(mean(flights$start_lon), mean(flights$start_lat)), -#' zoom= 7, map='world' ), -#' series= list(list( -#' type= 'lines', coordinateSystem= 'geo', +#' geo= list(center= c(mean(flights$start_lon), mean(flights$start_lat)), zoom=7, map='world'), +#' series.param= list( type= 'lines', #' data= lapply(ec.data(tmp, 'names'), function(x) -#' list(coords = list(c(x$start_lon,x$start_lat), -#' c(x$end_lon,x$end_lat)), +#' list(coords = list(c(x$start_lon, x$start_lat), +#' c(x$end_lon, x$end_lat)), #' colr = x$color) #' ), #' lineStyle= list(curveness=0.3, width=3, color=ec.clmn('colr')) -#' )) +#' ) #' ) #' } } #' #' #------ registerMap JSON #' # registerMap supports also maps in SVG format, see website gallery -#' #if (interactive()) { -#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json") -#' dusa <- USArrests -#' dusa$states <- row.names(dusa) -#' p <- ec.init(preset= FALSE, -#' series= list(list(type= 'map', map= 'USA', roam= TRUE, zoom= 3, left= -100, top= -30, -#' data= lapply(ec.data(dusa, 'names'), -#' function(x) list(name=x$states, value=x$UrbanPop)) -#' )), -#' visualMap= list(type='continuous', calculable=TRUE, -#' inRange= list(color = rainbow(8)), -#' min= min(dusa$UrbanPop), max= max(dusa$UrbanPop)) -#' ) -#' p$x$registerMap <- list(list(mapName= 'USA', geoJSON= json)) -#' p -#' #} +#' if (interactive()) { +#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json") +#' dusa <- USArrests +#' dusa$states <- row.names(dusa) +#' p <- ec.init( +#' series.param= list(type= 'map', map= 'USA', roam= TRUE, zoom= 3, left= -100, top= -30, +#' data= lapply(ec.data(dusa, 'names'), +#' function(x) list(name=x$states, value=x$UrbanPop)) +#' ), +#' visualMap= list(type='continuous', calculable=TRUE, +#' inRange= list(color = rainbow(8)), +#' min= min(dusa$UrbanPop), max= max(dusa$UrbanPop)) +#' ) +#' p$x$registerMap <- list(list(mapName= 'USA', geoJSON= json)) +#' p +#' } #' #' #------ locale #' mo <- seq.Date(Sys.Date() - 444, Sys.Date(), by= "month") @@ -199,12 +197,12 @@ #' if (interactive()) { #' iris |> group_by(Species) |> #' mutate(size= log(Petal.Width*10)) |> # add size as 6th column -#' ec.init(load= '3D', -#' xAxis3D= list(name= 'Petal.Length'), -#' yAxis3D= list(name= 'Sepal.Width'), -#' zAxis3D= list(name= 'Sepal.Length'), -#' legend= list(show= TRUE), -#' series.param= list(symbolSize= ec.clmn(6, scale=10)) +#' ec.init( +#' xAxis3D= list(name= 'Petal.Length'), +#' yAxis3D= list(name= 'Sepal.Width'), +#' zAxis3D= list(name= 'Sepal.Length'), +#' legend= list(show= TRUE), +#' series.param= list(type='scatter3D', symbolSize= ec.clmn(6, scale=10)) #' ) #' } #' diff --git a/man/ec.data.Rd b/man/ec.data.Rd index 443d1fc..3d6f980 100644 --- a/man/ec.data.Rd +++ b/man/ec.data.Rd @@ -46,13 +46,13 @@ Make data lists from a data.frame } \details{ \code{format='boxplot'} requires the first two \emph{df} columns as: \cr -    column for the non-computational categorical axis\cr -    column with (numeric) data to compute the five boxplot values\cr +\verb{ }column for the non-computational categorical axis\cr +\verb{ }column with (numeric) data to compute the five boxplot values\cr Additional grouping is supported on a column after the second. Groups will show in the legend, if enabled.\cr Returns a \code{list(dataset, series, xAxis, yAxis)} to set params in \link{ec.init}. Make sure there is enough data for computation, 4+ values per boxplot.\cr \code{format='treeTT'} expects data.frame \emph{df} columns \emph{pathString,value,(optional itemStyle)} for \link[data.tree]{FromDataFrameTable}.\cr -It will add column 'pct' with value percentage for each node. See Details. +It will add column 'pct' with value percentage for each node. See example below. } \examples{ library(dplyr) diff --git a/man/ec.fromJson.Rd b/man/ec.fromJson.Rd index 62a3151..032eec2 100644 --- a/man/ec.fromJson.Rd +++ b/man/ec.fromJson.Rd @@ -8,10 +8,10 @@ ec.fromJson(txt, ...) } \arguments{ \item{txt}{Could be one of the following:\cr -    class \emph{url}, like \code{url('https://serv.us/cars.txt')}\cr -    class \emph{file}, like \code{file('c:/temp/cars.txt','rb')}\cr -    class \emph{json}, like \code{ec.inspect(p)}, for options or full\cr -    class \emph{character}, JSON string with options only, see example below\cr} +\verb{ }class \emph{url}, like \code{url('https://serv.us/cars.txt')}\cr +\verb{ }class \emph{file}, like \code{file('c:/temp/cars.txt','rb')}\cr +\verb{ }class \emph{json}, like \code{ec.inspect(p)}, for options or full\cr +\verb{ }class \emph{character}, JSON string with options only, see example below\cr} \item{...}{Any attributes to pass to internal \link{ec.init} when \emph{txt} is options only} } diff --git a/man/ec.inspect.Rd b/man/ec.inspect.Rd index 081d648..44fedce 100644 --- a/man/ec.inspect.Rd +++ b/man/ec.inspect.Rd @@ -10,9 +10,9 @@ ec.inspect(wt, target = "opts", ...) \item{wt}{An \code{echarty} widget as returned by \link{ec.init}} \item{target}{type of resulting value: \cr -    'opts' - the htmlwidget \emph{options} as JSON (default)\cr -    'full' - the \emph{entire} htmlwidget as JSON\cr -    'data' - info about chart's embedded data (char vector)} +\verb{ }'opts' - the htmlwidget \emph{options} as JSON (default)\cr +\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}\cr 'file' - optional file name to save to when target='full'\cr} diff --git a/man/ec.util.Rd b/man/ec.util.Rd index 498e2ac..6bf111f 100644 --- a/man/ec.util.Rd +++ b/man/ec.util.Rd @@ -22,71 +22,72 @@ tabset, table layout, support for GIS shapefiles through library 'sf' } \details{ \strong{cmd = 'sf.series'}\cr - Build \emph{leaflet} or \href{https://echarts.apache.org/en/option.html#geo.map}{geo} map series from shapefiles.\cr - Supported types: POINT, MULTIPOINT, LINESTRING, MULTILINESTRING, POLYGON, MULTIPOLYGON \cr - Coordinate system is \emph{leaflet}(default), \emph{geo} or \emph{cartesian3D} (for POINT(xyz))\cr - Limitations:\cr -    polygons can have only their name in tooltip, \cr -    assumes Geodetic CRS is WGS 84, for conversion use \link[sf]{st_transform} with \emph{crs=4326}.\cr - Parameters:\cr -    df - value from \link[sf]{st_read}\cr -    nid - optional column name for name-id used in tooltips\cr -    cs - optional \emph{coordinateSystem} value, default 'leaflet'\cr -    verbose - optional, print shapefile item names in console\cr - Returns a list of chart series\cr +\verb{ }Build \emph{leaflet} or \href{https://echarts.apache.org/en/option.html#geo.map}{geo} map series from shapefiles.\cr +\verb{ }Supported types: POINT, MULTIPOINT, LINESTRING, MULTILINESTRING, POLYGON, MULTIPOLYGON \cr +\verb{ }Coordinate system is \emph{leaflet}(default), \emph{geo} or \emph{cartesian3D} (for POINT(xyz))\cr +\verb{ }Limitations:\cr +\verb{ }polygons can have only their name in tooltip, \cr +\verb{ }assumes Geodetic CRS is WGS 84, for conversion use \link[sf]{st_transform} with \emph{crs=4326}.\cr +\verb{ }Parameters:\cr +\verb{ }df - value from \link[sf]{st_read}\cr +\verb{ }nid - optional column name for name-id used in tooltips\cr +\verb{ }cs - optional \emph{coordinateSystem} value, default 'leaflet'\cr +\verb{ }verbose - optional, print shapefile item names in console\cr +\verb{ }Returns a list of chart series\cr \strong{cmd = 'sf.bbox'}\cr - Returns JavaScript code to position a map inside a bounding box from \link[sf]{st_bbox}, for leaflet only.\cr +\verb{ }Returns JavaScript code to position a map inside a bounding box from \link[sf]{st_bbox}, for leaflet only.\cr \strong{cmd = 'sf.unzip'}\cr - Unzips a remote file and returns local file name of the unzipped .shp file\cr -    url - URL of remote zipped shapefile\cr -    shp - optional name of .shp file inside ZIP file if multiple exist. Do not add file extension. \cr +\verb{ }Unzips a remote file and returns local file name of the unzipped .shp file\cr +\verb{ }url - URL of remote zipped shapefile\cr +\verb{ }shp - optional name of .shp file inside ZIP file if multiple exist. Do not add file extension. \cr +\verb{ }Returns full name of unzipped .shp file, or error string starting with 'ERROR'\cr \strong{cmd = 'geojson'} \cr - Custom series list from geoJson objects\cr -    geojson - object from \link[jsonlite]{fromJSON}\cr -    cs - optional \emph{coordinateSystem} value, default 'leaflet'\cr -    ppfill - optional fill color like '#F00', OR NULL for no-fill, for all Points and Polygons\cr -    nid - optional feature property for item name used in tooltips\cr -    ... - optional custom series attributes like \emph{itemStyle}\cr - Can display also geoJson \emph{feature properties}: color; lwidth, ldash (lines); ppfill, radius (points)\cr +\verb{ }Custom series list from geoJson objects\cr +\verb{ }geojson - object from \link[jsonlite]{fromJSON}\cr +\verb{ }cs - optional \emph{coordinateSystem} value, default 'leaflet'\cr +\verb{ }ppfill - optional fill color like '#F00', OR NULL for no-fill, for all Points and Polygons\cr +\verb{ }nid - optional feature property for item name used in tooltips\cr +\verb{ }... - optional custom series attributes like \emph{itemStyle}\cr +\verb{ }Can display also geoJson \emph{feature properties}: color; lwidth, ldash (lines); ppfill, radius (points)\cr \strong{cmd = 'layout'} \cr - Multiple charts in table-like rows/columns format\cr -    ... - List of charts\cr -    title - optional title for the entire set\cr -    rows - optional number of rows\cr -    cols - optional number of columns\cr - Returns a container \link[htmltools]{div} in rmarkdown, otherwise \link[htmltools]{browsable}.\cr - For 3-4 charts one would use multiple series within a \href{https://echarts.apache.org/en/option.html#grid}{grid}. \cr - For greater number of charts \emph{ec.util(cmd='layout')} comes in handy\cr +\verb{ }Multiple charts in table-like rows/columns format\cr +\verb{ }... - List of charts\cr +\verb{ }title - optional title for the entire set\cr +\verb{ }rows - optional number of rows\cr +\verb{ }cols - optional number of columns\cr +\verb{ }Returns a container \link[htmltools]{div} in rmarkdown, otherwise \link[htmltools]{browsable}.\cr +\verb{ }For 3-4 charts one would use multiple series within a \href{https://echarts.apache.org/en/option.html#grid}{grid}. \cr +\verb{ }For greater number of charts \emph{ec.util(cmd='layout')} comes in handy\cr \strong{cmd = 'tabset'} \cr -    ... - a list name/chart pairs like \emph{n1=chart1, n2=chart2}, each tab may contain a chart.\cr -    tabStyle - tab style string, see default \emph{tabStyle} variable in the code\cr - Returns A) \link[htmltools]{tagList} of tabs when in a pipe without '...' params, see example\cr - Returns B) \link[htmltools]{browsable} when '...' params are provided by user\cr - Please note that sometimes those tabsets do not merge well inside advanced web pages.\cr +\verb{ }... - a list name/chart pairs like \emph{n1=chart1, n2=chart2}, each tab may contain a chart.\cr +\verb{ }tabStyle - tab style string, see default \emph{tabStyle} variable in the code\cr +\verb{ }Returns A) \link[htmltools]{tagList} of tabs when in a pipe without '...' params, see example\cr +\verb{ }Returns B) \link[htmltools]{browsable} when '...' params are provided by user\cr +\verb{ }Please note that sometimes those tabsets do not merge well inside advanced web pages.\cr \strong{cmd = 'button'} \cr - UI button to execute a JS function,\cr -    text - the button label\cr -    js - the JS function string\cr -    ... - optional parameters for the \href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element\cr - Returns a graphic.elements-\href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element.\cr +\verb{ }UI button to execute a JS function,\cr +\verb{ }text - the button label\cr +\verb{ }js - the JS function string\cr +\verb{ }... - optional parameters for the \href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element\cr +\verb{ }Returns a graphic.elements-\href{https://echarts.apache.org/en/option.html#graphic.elements-rect.type}{rect} element.\cr \strong{cmd = 'morph'} \cr -    ... - a list of charts or chart option lists\cr -    event - name of event for switching charts. Default is \emph{click}.\cr - Returns a chart with ability to morph into other charts\cr +\verb{ }... - a list of charts or chart option lists\cr +\verb{ }event - name of event for switching charts. Default is \emph{click}.\cr +\verb{ }Returns a chart with ability to morph into other charts\cr \strong{cmd = 'fullscreen'} \cr - A toolbox feature to toggle fullscreen on/off. Works in a browser, not in RStudio.\cr +\verb{ }A toolbox feature to toggle fullscreen on/off. Works in a browser, not in RStudio.\cr \strong{cmd = 'rescale'} \cr -    v - input vector of numeric values to rescale\cr -    t - target range c(min,max), numeric vector of two\cr +\verb{ }v - input vector of numeric values to rescale\cr +\verb{ }t - target range c(min,max), numeric vector of two\cr \strong{cmd = 'level'} \cr - Calculate vertical levels for timeline \emph{line} charts, returns a numeric vector\cr -    df - data.frame with \emph{from} and \emph{to} columns\cr -    from - name of 'from' column\cr -    to - name of 'to' column\cr +\verb{ }Calculate vertical levels for timeline \emph{line} charts, returns a numeric vector\cr +\verb{ }df - data.frame with \emph{from} and \emph{to} columns\cr +\verb{ }from - name of 'from' column\cr +\verb{ }to - name of 'to' column\cr } \examples{ library(dplyr) -if (interactive()) { # comm.out: Fedora errors about some 'browser' +if (interactive()) { # comm.out: Cran Fedora errors about some 'browser' library(sf) fname <- system.file("shape/nc.shp", package="sf") nc <- as.data.frame(st_read(fname)) @@ -107,19 +108,20 @@ if (interactive()) { # comm.out: Fedora errors about some 'browser' p1 <- cars |> ec.init(grid= list(top=26), height=333) # move chart up p2 <- mtcars |> arrange(mpg) |> ec.init(height=333, ctype='line') ec.util(cmd= 'tabset', cars= p1, mtcars= p2) -} -cars |> ec.init( - graphic = list( - ec.util(cmd='button', text='see type', right='center', top=20, - js="function(a) {op=ec_option(echwid); alert(op.series[0].type);}") - ) -) -lapply(list('dark','macarons','gray','jazz','dark-mushroom'), - function(x) cars |> ec.init(grid= list(bottom=0)) |> ec.theme(x) ) |> -ec.util(cmd='layout', cols= 2, title= 'my layout') - + cars |> ec.init( + graphic = list( + ec.util(cmd='button', text='see type', right='center', top=20, + js="function(a) {op=ec_option(echwid); alert(op.series[0].type);}") + ) + ) + + lapply(list('dark','macarons','gray','jazz','dark-mushroom'), + function(x) cars |> ec.init(grid= list(bottom=0)) |> ec.theme(x) ) |> + ec.util(cmd='layout', cols= 2, title= 'my layout') +} + colors <- c("blue","red","green") cyls <- as.character(sort(unique(mtcars$cyl))) sers <- lapply(mtcars |> group_by(cyl) |> group_split(), \(x) { diff --git a/tests/testthat.R b/tests/testthat.R index fe330ca..2c13225 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,4 +1,5 @@ library(testthat) library(echarty) +library(dplyr) test_check("echarty") diff --git a/tests/testthat/test-ec.util.R b/tests/testthat/test-ec.util.R index d505853..5b31242 100644 --- a/tests/testthat/test-ec.util.R +++ b/tests/testthat/test-ec.util.R @@ -1,20 +1,22 @@ -#' tests for ec.util() -library(dplyr) +#' tests for ec.util() +isCovr <- Sys.getenv("R_COVR")!='' test_that("serie from ec.util with cartesian3D", { expect_error(ec.util(cmd= 'dummy')) - # usage for LIDAR data - library(sf) - tmp <- st_as_sf(data.frame( - x=c(-60,-40,-20), y=c(45, 35, 25), z=c(1,2,3), name=c('p1','p2','p3')), - coords= c('x','y','z'), crs= st_crs(4326)) - p <- ec.init(load='3D', tooltip= list(formatter='{c}'), - series= ec.util(df= tmp, cs='cartesian3D') - ) - expect_s3_class(p$x$opts$series[[1]]$data[[2]]$value, 'sfg') - expect_equal(as.numeric(p$x$opts$series[[1]]$data[[2]]$value), c(-40,35,2)) - expect_type( p$x$opts$xAxis3D, 'list') + if (isCovr) { + # usage for LIDAR data + library(sf) + tmp <- st_as_sf(data.frame( + x=c(-60,-40,-20), y=c(45, 35, 25), z=c(1,2,3), name=c('p1','p2','p3')), + coords= c('x','y','z'), crs= st_crs(4326)) + p <- ec.init(load='3D', tooltip= list(formatter='{c}'), + series= ec.util(df= tmp, cs='cartesian3D') + ) + expect_s3_class(p$x$opts$series[[1]]$data[[2]]$value, 'sfg') + expect_equal(as.numeric(p$x$opts$series[[1]]$data[[2]]$value), c(-40,35,2)) + expect_type( p$x$opts$xAxis3D, 'list') + } }) test_that("shapefiles with multi-POLYGONS", { @@ -22,9 +24,9 @@ test_that("shapefiles with multi-POLYGONS", { fname <- system.file("shape/nc.shp", package="sf") nc <- as.data.frame(st_read(fname, quiet=TRUE)) p <- ec.init(load= c('leaflet', 'custom'), # load custom for polygons - js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)), - series= ec.util(cmd= 'sf.series', df= nc, nid= 'NAME', itemStyle= list(opacity= 0.3)), - tooltip= list(formatter= '{a}') + js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)), + series= ec.util(cmd='sf.series', df=nc, nid= 'NAME', itemStyle= list(opacity= 0.3), verbose=T), + tooltip= list(formatter= '{a}') ) expect_true(p$x$opts$leaflet$roam) expect_equal(p$x$opts$series[[108]]$name, 'Brunswick') @@ -32,7 +34,7 @@ test_that("shapefiles with multi-POLYGONS", { }) test_that("shapefile LINES from ZIP", { - if (interactive()) { # creates a subfolder 'railways' + if (isCovr) { # creates a subfolder 'railways' library(sf) fname <- ec.util(cmd= 'sf.unzip', url= 'https://helgasoft.github.io/echarty/test/sl.shape.railways.zip') @@ -53,28 +55,29 @@ test_that("shapefile LINES from ZIP", { expect_equal(p$x$opts$series[[6]]$lineStyle$color, 'red') } - else expect_equal(1,1) # bypass + else expect_false(interactive()) #expect_equal(1,1) # bypass }) test_that("shapefile LINESTRING and MULTILINESTRING", { p <- ec.init(load= 'leaflet') #js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)), ls <- st_linestring(rbind(c(0,0),c(1,1),c(2,1))) nc <- ls %>% st_sfc %>% st_sf %>% st_cast(to='LINESTRING') - p$x$opts$series= ec.util(cmd= 'sf.series', df= nc, lineStyle= list(width=5)) + p$x$opts$series= ec.util(cmd= 'sf.series', df= nc, lineStyle= list(width=5), verbose=T) expect_equal(p$x$opts$series[[1]]$name, 1) mls <- st_multilinestring(list(rbind(c(2,2),c(1,3)), rbind(c(0,0),c(1,1),c(2,1)))) nc <- mls %>% st_sfc %>% st_sf %>% st_cast(to='MULTILINESTRING') - p$x$opts$series= ec.util(cmd= 'sf.series', df= nc, lineStyle= list(width=5)) + p$x$opts$series= ec.util(cmd= 'sf.series', df= nc, lineStyle= list(width=5), verbose=T) expect_equal(length(p$x$opts$series[[1]]$data[[2]]), 3) }) test_that("shapefile POINTS from ZIP", { - if (interactive()) { # creates a subfolder 'points' + fn <- ec.util(cmd= 'sf.unzip', + url= 'https://helgasoft.github.io/echarty/test/sl.shape.points.zip') + if (!startsWith(fn, 'ERROR')) { + expect_true(endsWith(fn, 'points.shp')) # creates a subfolder 'points' + library(sf) - fn <- ec.util(cmd= 'sf.unzip', - url= 'https://helgasoft.github.io/echarty/test/sl.shape.points.zip') - expect_true(endsWith(fn, 'points.shp')) nc <- as.data.frame(st_read(fn, quiet=TRUE)) |> head(10) p <- ec.init(load= c('leaflet'), js= ec.util(cmd= 'sf.bbox', bbox= st_bbox(nc$geometry)), @@ -85,7 +88,8 @@ test_that("shapefile POINTS from ZIP", { expect_equal(round(as.numeric(p$x$opts$series[[1]]$data[[2]]$value),1), c(-13.3,8.5)) expect_true( p$x$opts$leaflet$roam) } - else expect_equal(1,1) + fn <- ec.util(cmd= 'sf.unzip', url= 'https://nada.zip') + expect_equal(fn, 'ERROR invalid zip url') }) test_that("layout", { @@ -99,7 +103,7 @@ test_that("layout", { list(cars |> ec.init()) |> ec.util(cmd='layout', title= 'coveralls') }) -test_that("tabset with pairs", { +test_that("tabset with pairs and with pipe", { p1 <- cars |> ec.init(grid= list(top= 20), height=333) p2 <- mtcars |> ec.init(height=333) r <- ec.util(cmd='tabset', cars=p1, mtcars=p2) @@ -108,16 +112,13 @@ test_that("tabset with pairs", { expect_equal(r[[2]]$children[[5]]$children[[1]]$children[[1]][[1]]$x$opts$dataset[[1]]$dimensions, c("speed", "dist")) expect_equal(r[[2]]$children[[5]]$children[[1]]$name, "section") expect_equal(r[[2]]$children[[5]]$children[[1]]$children[[1]][[1]]$height, 333) -}) -test_that("tabset with pipe", { - r <- htmltools::browsable( - lapply(iris |> group_by(Species) |> group_split(), function(x) { - x |> ec.init(ctype= 'scatter', title= list(text= unique(x$Species))) - }) |> ec.util(cmd='tabset') - ) - expect_equal(r[[2]]$children[[7]]$children[[2]]$children[[1]][[1]]$width, NULL) - expect_equal(as.character(r[[2]]$children[[6]]$children[[1]]), "virginica") + p <- lapply(iris |> group_by(Species) |> group_split(), function(x) { + x |> ec.init(ctype= 'scatter', title= list(text= unique(x$Species))) + }) |> ec.util(cmd='tabset') + expect_equal(length(p[[2]]$children), 7) + expect_equal(p[[2]]$children[[7]]$children[[2]]$children[[1]][[1]]$width, NULL) + expect_equal(as.character(p[[2]]$children[[6]]$children[[1]]), "virginica") }) test_that("morph 1", { @@ -298,6 +299,7 @@ test_that("ec.data boxlpot", { ec.data(format='boxplot', outliers=TRUE, layout= 'v') #ec.init(dataset= ds$dataset, series= ds$series, xAxis= ds$xAxis, yAxis= ds$yAxis) expect_equal(ds$series[[1]]$type, 'boxplot') + ds <- mtcars |> select(cyl, drat) |> ec.data(format='boxplot', jitter=0.11) # without grouping ------------------- p <- mtcars |> relocate(cyl,mpg) |> ec.data(format='boxplot', outliers=TRUE) @@ -331,18 +333,18 @@ test_that("ec.data boxlpot", { # with grouping ------------------- ds <- airquality |> mutate(Day=round(Day/10)) |> relocate(Day,Wind,Month) |> group_by(Month) |> - ec.data(format='boxplot', jitter=0.1, outliers=TRUE) + ec.data(format='boxplot', jitter=0.1, outliers=TRUE, layout= 'v') p <- ec.init(load='custom', # for outliers dataset= ds$dataset, series= ds$series,xAxis= ds$xAxis, yAxis= ds$yAxis, legend= list(show= TRUE), tooltip= list(show=TRUE) ) expect_equal(length(p$x$opts$dataset), 15) - expect_equal(p$x$opts$yAxis[[1]]$type, 'category') + expect_equal(p$x$opts$xAxis[[1]]$type, 'category') expect_equal(p$x$opts$series[[5]]$type, 'boxplot') expect_equal(p$x$opts$series[[5]]$datasetIndex, 9) expect_equal(p$x$opts$series[[10]]$type, 'custom') expect_equal(as.character(p$x$opts$series[[10]]$renderItem), 'riOutliers') - expect_equal(p$x$opts$series[[10]]$encode$x, 1) + expect_equal(p$x$opts$series[[10]]$encode$x, 0) expect_equal(p$x$opts$series[[14]]$type, 'scatter') expect_equal(p$x$opts$series[[14]]$name, '3') }) diff --git a/tests/testthat/test-other.R b/tests/testthat/test-other.R index b7e9525..4951bd1 100644 --- a/tests/testthat/test-other.R +++ b/tests/testthat/test-other.R @@ -1,4 +1,7 @@ -# expect_silent() +#isCovr <- interactive() +#isCovr <- Sys.getenv("COVERALLS_TOKEN")!='' +isCovr <- Sys.getenv("R_COVR")!='' +cat('\n isCovr=',Sys.getenv("R_COVR"),'\n') test_that("registerMap", { # similar in ec.examples, with USA map @@ -155,32 +158,40 @@ test_that("ec.data treeTK", { expect_equal(p$x$opts$series[[1]]$data[[1]]$children[[2]]$pct, 32.3) }) -test_that("load 3D surface", { - #if (interactive()) { # first time will load echarts-gl.js in source folder 'js' - data <- list() - for(y in 1:dim(volcano)[2]) for(x in 1:dim(volcano)[1]) - data <- append(data, list(c(x, y, volcano[x,y]))) - p <- ec.init(load= '3D', series.param= list(type= 'surface', data= data) ) - - expect_equal(length(p$x$opts$series[[1]]$data), 5307) -}) - test_that("3D globe & autoload 3D", { - p <- ec.init( #load='3D', # test autoload - globe= list(viewControl= list(autoRotate= FALSE)), - series.param= list(type= 'scatter3D', - data= list(c(32,-117,11), c(2,44,22)) , - symbolSize= 40, itemStyle= list(color= 'red') + + if (isCovr) { + # first time will load echarts-gl.js in source folder 'js' + p <- ec.init( #load='3D', # test autoload + globe= list(viewControl= list(autoRotate= FALSE)), + series.param= list(type= 'scatter3D', + data= list(c(32,-117,11), c(2,44,22)) , + symbolSize= 40, itemStyle= list(color= 'red') + ) ) - ) - 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') + 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') + + data <- list() # volcano is a lot of data ==slow + for(y in 1:dim(volcano)[2]) for(x in 1:dim(volcano)[1]) + data <- append(data, list(c(x, y, volcano[x,y]))) + p <- ec.init(load= '3D', series.param= list(type= 'surface', data= data) ) + expect_equal(length(p$x$opts$series[[1]]$data), 5307) + cat('\n load 3D + volcano') - 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') + 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') + + p <- mtcars |> ec.init(ctype='scatterGL') + expect_equal(p$dependencies[[1]]$name, 'echarts-gl.min.js') + } + else { + lif <- paste0(system.file('js', package='echarty'), '/echarts-gl.min.js') + expect_false(file.exists(lif)) + } }) test_that("radar and polar", { # for coverage @@ -190,11 +201,17 @@ test_that("radar and polar", { # for coverage 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)) + + args <- list( df= data.frame(x= 1:10, y= seq(1, 20, by=2)), + polar= list(show=TRUE), series.param= list(type='line', polarIndex=1) ) + p <- do.call(ec.init, args) expect_equal(p$x$opts$series[[1]]$polarIndex, 0) + expect_equal(p$x$opts$series[[1]]$coordinateSystem, "polar") + args$series.param$polarIndex <- NULL + args$series.param$coordinateSystem <- "polar" + p <- do.call(ec.init, args) + expect_equal(p$x$opts$radiusAxis$type, 'category') }) test_that("calendar", { @@ -210,13 +227,26 @@ test_that("calendar", { }) test_that("ec.plugjs", { + # .valid.url exits gracefully + p <- ec.init() |> ec.plugjs('http://does.not.exist.com') + expect_true(startsWith(p$x$opts$title$text, 'ERROR')) + + if (isCovr) { p <- ec.init() |> ec.plugjs( 'https://raw.githubusercontent.com/apache/echarts/master/test/data/map/js/china-contour.js') expect_equal(p$dependencies[[1]]$name, "china-contour.js") - # .valid.url exits gracefully - p <- ec.init() |> ec.plugjs('http://does.not.exist.com') - expect_true(startsWith(p$x$opts$title$text, 'ERROR')) + p <- ec.init( preset=FALSE, # for covr + load= c('https://maps.googleapis.com/maps/api/js', + 'https://cdn.jsdelivr.net/npm/echarts-extension-gmap@latest/dist/echarts-extension-gmap.min.js'), + gmap= list( center= c(108.39, 39.9), zoom= 3), + series= list(list(type='scatter', coordinateSystem='gmap', data= list( + list(name='岳阳', value=c(113.09,29.37)), + list(name='吉林', value=c(126.57,43.87)) + ))) + ) + expect_equal(p$x$opts$gmap$zoom, 3) + } }) test_that("Shiny commands", { @@ -238,11 +268,17 @@ test_that("Shiny commands", { expect_equal(attributes(p)$class, 'ecsProxy') # works in interactive only (+Shiny session), else "attempt to apply non-function" - #sendCustomMessage <- \(name,plist) {a <- 1} + # #sendCustomMessage <- \(name,plist) {a <- 1} + # p$session <- NULL # disable p$session$sendCustomMessage + # p$x$opts$test <- 'sankey' + # tmp <- ecs.exec(p) + # expect_equal(tmp$x$opts$test, 'sankey') + tmp <- attributes(ecs.output('sash')) p$session <- NULL # disable p$session$sendCustomMessage - p$x$opts$test <- 'sankey' - tmp <- ecs.exec(p) - expect_equal(tmp$x$opts$test, 'sankey') + p$x$opts$renderer <- 'canvas' + p$x$opts$series <- list(list(type='gauge')) + p$dependencies <- tmp$html_dependencies + ecs.exec(p) }) test_that(".merlis", { @@ -294,9 +330,29 @@ test_that('stops are working in echarty.R', { expect_silent(ecr.ebars(ec.init(load='custom'), cars, encode=list(x=1,y=c(2,3,4)))) expect_silent(ec.init(load='lottie')) expect_silent(ec.init(load='ecStat')) + expect_silent(ec.init(load='lottie,ecStat')) #expect_silent(ec.init(load='liquid')) # Debian throws warnings in CRAN check #expect_silent(ec.init(load='gmodular')) #expect_silent(ec.init(load='wordcloud')) expect_error(mtcars |> group_by(cyl) |> ec.init(ctype='parallel')) - + expect_error(data.frame(name= c('A','B','C','D'), value= c(1,2,3,1), cat=c(1,1,2,2)) |> + group_by(cat) |> ec.init(timeline= list(s=T), dbg=T, series.param= list(type='pie')) + ) +}) + +test_that('for coverage only', { + args <- list( + df= data.frame(name=c('Brazil','Australia'), value=c(111,222)) |> group_by(name), + load= 'world', visualMap=list(s=TRUE), + timeline= list(data= list("Australia", "Brazil"), axisType= "category"), + geo= list(map='world'), + options= list( + list(series=list(type='map', datasetIndex=1, geoIndex=0)), + list(series=list(type='map', datasetIndex=2, geoIndex=0))) + ) + p <- do.call(ec.init, args) + expect_false(is.null(p$x$opts$legend)) + args$preset <- FALSE + p <- do.call(ec.init, args) + expect_true(is.null(p$x$opts$legend)) }) diff --git a/tests/testthat/test-presets.R b/tests/testthat/test-presets.R index 8750ef0..2d35f67 100644 --- a/tests/testthat/test-presets.R +++ b/tests/testthat/test-presets.R @@ -1,5 +1,5 @@ +isCovr <- Sys.getenv("R_COVR")!='' -library(dplyr) set.seed(2021) df <- data.frame( name = sample(LETTERS, 10), @@ -113,17 +113,19 @@ test_that("ec.init presets for timeline groupBy, geo", { expect_equal(p$x$opts$options[[4]]$series[[1]]$encode$y, 'y') expect_equal(p$x$opts$yAxis$name, 'y') - p <- dat |> group_by(x1) |> ec.init( #load='3D', - xAxis3D=list(s=T),yAxis3D=list(s=T),zAxis3D=list(s=T),grid3D=list(s=T), - timeline=list(s=T), legend= list(show=TRUE), - series.param= list(type='scatter3D', groupBy= 'x2', - encode= list(x='x', y='y', z='z'), - symbolSize= ec.clmn('x4', scale=30) ) - ) - expect_equal(p$x$opts$options[[1]]$series[[1]]$coordinateSystem, 'cartesian3D') - expect_equal(length(p$x$opts$options[[1]]$series), 2) - expect_equal(p$x$opts$options[[4]]$series[[2]]$datasetIndex, 8) - expect_equal(p$x$opts$options[[4]]$series[[2]]$name, 'B') + if (isCovr) { + p <- dat |> group_by(x1) |> ec.init( #load='3D', + xAxis3D=list(s=T),yAxis3D=list(s=T),zAxis3D=list(s=T),grid3D=list(s=T), + timeline=list(s=T), legend= list(show=TRUE), + series.param= list(type='scatter3D', groupBy= 'x2', + encode= list(x='x', y='y', z='z'), + symbolSize= ec.clmn('x4', scale=30) ) + ) + expect_equal(p$x$opts$options[[1]]$series[[1]]$coordinateSystem, 'cartesian3D') + expect_equal(length(p$x$opts$options[[1]]$series), 2) + expect_equal(p$x$opts$options[[4]]$series[[2]]$datasetIndex, 8) + expect_equal(p$x$opts$options[[4]]$series[[2]]$name, 'B') + } cns <- data.frame( value = c(22, 99, 33), @@ -171,6 +173,11 @@ test_that("presets for parallel chart", { expect_equal(length(p$x$opts$dataset), 4) expect_equal(p$x$opts$series[[3]]$datasetIndex, 3) expect_equal(p$x$opts$parallelAxis[[2]]$name, 'disp') + + p <- iris |> dplyr::group_by(Species) |> # chained + ec.init(ctype= 'parallel', series.param= list(lineStyle= list(width=3))) |> + ec.paxis(cols= c('Petal.Length','Petal.Width','Sepal.Width')) + expect_equal(p$x$opts$parallelAxis[[3]]$max, 4.4) }) test_that("presets for crosstalk", { @@ -285,8 +292,6 @@ test_that('polar, pie, radar, themeRiver, parallel, etc.', { type='gauge', data= list(list(name='score',value=44)))) expect_equal(names(p$x$opts), 'series') - p <- mtcars |> ec.init(ctype='scatterGL') - expect_equal(p$dependencies[[1]]$name, 'echarts-gl.min.js') }) test_that('polar presets', { diff --git a/tests/testthat/test-renderers.R b/tests/testthat/test-renderers.R index e968431..041cbd0 100644 --- a/tests/testthat/test-renderers.R +++ b/tests/testthat/test-renderers.R @@ -35,18 +35,25 @@ test_that("ecr.ebars", { expect_equal(p$x$opts$xAxis$type, 'category') # data + name + char.encode - p <- ec.init(load= 'custom', legend= list(show=T), tooltip= list(show=T), - xAxis=list(type='category'), - series= list(list(type='bar', name= 'data', - encode= list(x='gear',y='yy'), - dimensions= c('cyl','gear','yy','low','high'), - data= ec.data(df |> filter(cyl==4)) - ))) |> + 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)) |> ungroup() + args <- list(df=df, load= 'custom', xAxis= list(type='category'), + series.param= list(type='bar', name= 'data', + encode= list(x='gear', y='yy'), + dimensions= c('cyl','gear','yy','low','high'), + data= ec.data(df |> filter(cyl==4)) + )) + p <- do.call(ec.init, args) |> ecr.ebars(encode= list(x='gear', y=c('yy','low','high')), hwidth=12, name='err', - itemStyle= list(borderWidth= 2.5, color= "red") + 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) + + args$series.param$type <- 'line' # coverage + p <- do.call(ec.init, args) |> ecr.ebars(encode= list(x='gear', y=c('yy','low','high'))) + args$series.param$type <- 'pie' # coverage + p <- do.call(ec.init, args) |> ecr.ebars(encode= list(x='gear', y=c('yy','low','high'))) df <- Orange |> arrange(Tree) |> mutate(up= circumference+runif(5)*6, lo= circumference-runif(5)*6 ) |> filter(age==1231)