diff --git a/.gitignore b/.gitignore index 68ac729..4d2d806 100644 --- a/.gitignore +++ b/.gitignore @@ -7,4 +7,6 @@ inst/doc .vscode .DS_Store .Rbuildignore +*.Rmd CRAN-RELEASE +cran-comments.md diff --git a/DESCRIPTION b/DESCRIPTION index 9b9bd18..35053f6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: echarty Title: Minimal R/Shiny Interface to Library 'Echarts JavaScript' Date: 2021-02-20 -Version: 0.1.1 +Version: 0.1.2 Authors@R: c( person("Larry", "Helgason", email = "larry@helgasoft.com", role = c("aut", "cre", "cph")), person("John", "Coene", email = "jcoenep@gmail.com", role = c("aut", "cph")) @@ -9,7 +9,7 @@ Authors@R: c( Author: Larry Helgason [aut, cre, cph], John Coene [aut, cph] Maintainer: Larry Helgason -Description: The goal is to deliver the full functionality of 'Echarts JavaScript' Version 5 with minimal overhead. 'Echarts JavaScript' is based on data structures. 'echarty' users build R lists for these same data structures. In general one to three 'echarty' commands are sufficient to produce any chart. +Description: The goal is to deliver the full functionality of 'Echarts JavaScript' with minimal overhead. 'Echarts JavaScript' is based on data structures. 'echarty' users build R lists for these same data structures. In general one to three 'echarty' commands are sufficient to produce any chart. Depends: R (>= 3.0.0) License: Apache License (>= 2.0) LazyData: true @@ -20,8 +20,7 @@ Imports: magrittr, shiny, purrr, - jsonlite, - rstudioapi + jsonlite Suggests: rmarkdown, knitr diff --git a/NAMESPACE b/NAMESPACE index 8bfe616..3273194 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,7 +1,6 @@ # Generated by roxygen2: do not edit by hand export("%>%") -export(ec.band) export(ec.data) export(ec.examples) export(ec.fromJson) @@ -11,11 +10,14 @@ export(ec.inspect) export(ec.js2r) export(ec.plugjs) export(ec.theme) +export(ecr.band) +export(ecr.ebars) export(ecs.exec) export(ecs.output) export(ecs.proxy) export(ecs.render) import(htmlwidgets) +import(shiny) importFrom(magrittr,"%>%") importFrom(utils,askYesNo) importFrom(utils,download.file) diff --git a/NEWS.md b/NEWS.md index 1d1dc1b..4af977a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,13 +1,22 @@ # log history of echarty package development -## echarty 0.1.1 +## v. 0.1.2 + +- ec.data now with three format values +- ec.fromJson has now "..." (additional arguments) +- ecr.band has new parameter 'two' for alternative rendering +- error bars added as ecr.ebars with support for grouped data +- more examples in ec.examples +- some code optimization + +## v. 0.1.1 - added ec.plugjs - install unknown plugins, like JS maps - added ec.js2r - a JS to R translation assistant, a Shiny app - ec.init update: one-time install for all plugins except built-in leaflet/custom - GL merged with 3D as plugin '3D' -- more plugins: liquidfill, world, wordcloud, gmodularity +- more plugins: liquidfill, world, wordcloud, gmodular - ec.sband renamed to ec.band -## echarty 0.1.0 +## v. 0.1.0 - initial release, approved by CRAN Feb 16, 2021 diff --git a/R/echarty.R b/R/echarty.R index 8a06036..d9c2dff 100644 --- a/R/echarty.R +++ b/R/echarty.R @@ -7,11 +7,11 @@ #' @param df A data.frame to be preset as \href{https://echarts.apache.org/en/option.html#dataset}{dataset}, default NULL #' @param group1 Type of grouped series, default 'scatter'. Set to NULL to disable. \cr #' If the grouping is on multiple columns, only the first one is used. -#' @param preset Enable (TRUE, default) or disable(FALSE) presets xAxis, yAxis and first serie. +#' @param preset Disable(FALSE) or enable (TRUE, default) presets for xAxis, yAxis and first serie. #' @param load Name(s) of plugin(s) to load. Could be a character vector or comma-delimited string. default NULL.\cr #' Built-in plugins: \cr \itemize{ #' \item leaflet - Leaflet maps with customizable tiles, see \href{https://github.com/gnijuohz/echarts-leaflet#readme}{source}\cr -#' \item custom - renderers for [ec.band] and ec.ebars \cr +#' \item custom - renderers for [ecr.band] and ecr.ebars \cr #' } Plugins with one-time installation (popup prompt): \cr \itemize{ #' \item 3D - 3D charts and WebGL acceleration, see \href{https://github.com/ecomfe/echarts-gl}{source} and \href{https://echarts.apache.org/en/option-gl.html#series}{docs} \cr #' \item world - world map with country boundaries, see \href{https://github.com/apache/echarts/tree/master/test/data/map/js}{source} \cr @@ -29,8 +29,10 @@ #' @return A widget to plot, or to save and expand with more features. #' #' @details Widgets are defined in \href{https://www.htmlwidgets.org/develop_intro.html}{htmlwidgets}. -#' This command creates one with \code{\link[htmlwidgets]{createWidget}}, then adds some EchartsJS features to it.\cr -#' It may preset values for xAxis,yAxis,series and dataset, which user can overwrite if needed. +#' This command creates one with \code{\link[htmlwidgets]{createWidget}}, then adds some EChartsJS features to it.\cr +#' When [ec.init] is chained after a data.frame, a \href{https://echarts.apache.org/en/option.html#dataset}{dataset} is preset. \cr +#' When the data.frame is grouped and \emph{group1} is not null, more datasets with legend and series are also preset. Grouped series are of type \code{scatter}. \cr +#' Users can delete or overwrite any presets as needed. #' #' @examples #' # basic scatter chart from a data.frame, using presets @@ -44,12 +46,15 @@ ec.init <- function( df = NULL, group1 = 'scatter', preset = TRUE, load = NULL, renderer = 'canvas', js = NULL, ...) { opts <- list(...) - if (preset) - opts <- append(opts, list( - xAxis = list(ec=''), - yAxis = list(ec=''), - series = list(list()) - )) + + # presets are used as default for examples and testing + # user can also ignore or replace them + if (preset) { + if (!('xAxis' %in% names(opts))) opts$xAxis <- list(ey='') + if (!('yAxis' %in% names(opts))) opts$yAxis <- list(ey='') + if (!('series' %in% names(opts))) opts$series <- list(list()) + opts$series[[1]] <- list(type='scatter') + } # forward widget options using x x <- list( @@ -63,20 +68,15 @@ ec.init <- function( df = NULL, group1 = 'scatter', preset = TRUE, load = NULL, opts = opts ) - # user will most probably replace this preset - # we use it as default for examples and testing - if (preset) - x$opts$series[[1]] <- list(type='scatter') - if (!is.null(df)) { - # if data.frame given, assign to dataset regardless of parameter preset + # if data.frame given, assign to dataset regardless of parameter 'preset' if (!'data.frame' %in% class(df)) stop('df must be a data.frame', call. = FALSE) # grouping uses transform - a v.5 feature if (!is.null(group1) && dplyr::is.grouped_df(df)) { grnm <- dplyr::group_vars(df)[[1]] # group1 means just 1st one - df <- df %>% dplyr::relocate(grnm, .after = dplyr::last_col()) + #df <- df %>% dplyr::relocate(grnm, .after = dplyr::last_col()) x$opts$dataset <- list(list(source = ec.data(df))) grvals <- unname(unlist(dplyr::group_data(df)[grnm])) txfm <- list(); k <- 0 @@ -88,8 +88,8 @@ ec.init <- function( df = NULL, group1 = 'scatter', preset = TRUE, load = NULL, txfm <- append(txfm, list(list(transform = list( type='filter', config=list(dimension=grnm, '='=srch4))))) x$opts$series[[k]] <- list( - type=group1, datasetIndex=k, name=i) - x$opts$legend$data <- append(x$opts$legend$data, list(list(name=i))) + type=group1, datasetIndex=k, name=as.character(i)) + x$opts$legend$data <- append(x$opts$legend$data, list(list(name=as.character(i)))) } x$opts$dataset <- append(x$opts$dataset, txfm) } @@ -142,7 +142,7 @@ ec.init <- function( df = NULL, group1 = 'scatter', preset = TRUE, load = NULL, # leaflet user data should be ordered (lon,lat)! if (!is.null(df)) - wt$x$opts$series[[1]]$data <- ec.data(df, TRUE) + wt$x$opts$series[[1]]$data <- ec.data(df, 'values') wt$x$opts$series[[1]]$coordinateSystem <- 'leaflet' } @@ -166,7 +166,7 @@ ec.init <- function( df = NULL, group1 = 'scatter', preset = TRUE, load = NULL, wt$x$opts$xAxis <- NULL # replace 2D presets with 3D wt$x$opts$yAxis <- NULL wt$x$opts$series[[1]] <- NULL - wt$x$opts$grid3D <- list(list()) # todo list(ec='')? + wt$x$opts$grid3D <- list(list()) # todo list(ey='')? wt$x$opts$xAxis3D <- list(list()) wt$x$opts$yAxis3D <- list(list()) wt$x$opts$zAxis3D <- list(list()) @@ -257,78 +257,228 @@ ec.plugjs <- function(wt=NULL, source=NULL) { } -#' Get an EchartsJS dataset from a data.frame +#' Get an EChartsJS dataset from a data.frame #' #' @param df Chart data in data.frame format, required -#' @param series If FALSE, data is prepared for \href{https://echarts.apache.org/en/option.html#dataset.source}{dataset} (default),\cr -#' if TRUE, data is for \href{https://echarts.apache.org/en/option.html#series-scatter.data}{series} -#' @return A list for \emph{dataset.source} or \emph{series.data}. The latter does not include column names. +#' @param format A key on how to format the output list \cr \itemize{ +#' \item 'dataset' list used in \href{https://echarts.apache.org/en/option.html#dataset.source}{dataset} (default),\cr +#' \item 'values' list for \href{https://echarts.apache.org/en/option.html#series-scatter.data}{series.data} \cr +#' \item 'names' creates named lists useful for named data like \href{https://echarts.apache.org/en/option.html#series-sankey.links}{sankey links} +#' } +#' @return A list for \emph{dataset.source}, \emph{series.data} or a list of named lists. #' #' @export -ec.data <- function(df, series=FALSE) { +ec.data <- function(df, format='dataset') { if (missing(df)) stop('expecting df as data.frame', call. = FALSE) if (!'data.frame' %in% class(df)) stop('df has to be data.frame', call. = FALSE) # TODO: replace purrr with something simpler - tmp <- lapply(lapply(purrr::transpose(df), unname), - function(x) unlist(purrr::flatten(x)) ) - datset <- c(list(colnames(df)), tmp) - - if (isTRUE(series)) { # change format - datset <- lapply(tmp, function(x) list(value=x)) - } + tmp <- purrr::transpose(df) # named lists + if (format=='dataset') { + datset <- c(list(colnames(df)), lapply(tmp, unname)) + } else if (format=='values' || isTRUE(format)) { + datset <- lapply(tmp, function(x) list(value=unlist(unname(x)))) + } else # ='names' + datset <- tmp + return(datset) } -#' Band +#' Area band #' -#' Add a new 'custom' serie with coordinates of a polygon. +#' A 'custom' serie with lower and upper boundaries #' #' @param df A data.frame with lower and upper numerical columns. #' @param lower The column name of band's lower boundary, a string. #' @param upper The column name of band's upper boundary, a string. +#' @param two Type of rendering - by polygon (FALSE,default), or by two stacked lines (TRUE) #' @param ... More parameters for \href{https://echarts.apache.org/en/option.html#series-line.type}{serie} -#' @return One serie list +#' @return One list serie when two=FALSE, or a list of two list series when two=TRUE #' -#' @details The coordinates of the two boundaries are merged into a polygon and displayed as one. +#' @details When two=FALSE, the coordinates of the two boundaries are chained into a polygon and displayed as one. Uses absolute cartesian coordinates. \cr +#' When two=TRUE, two smooth \emph{stacked} lines are drawn, one with customizable areaStyle. The upper boundary coordinates represent values on top of the lower boundary coordinates. +#' +#' @examples +#' myList <- list(x=LETTERS[1:7], +#' d=c(140, 232, 101, 264, 90, 340, 250), +#' u=c(120, 282, 111, 234, 220, 340, 310), +#' l=c(200, 332, 151, 400, 190, 540, 450)) +#' data <- as.data.frame(do.call(cbind, myList)) +#' colnames(data) <- c('x','down','up','coord') +#' p <- ec.init(load='custom') +#' p$x$opts <- list( +#' xAxis=list(list(type='category', boundaryGap=FALSE, data=data$x)), +#' yAxis=list(list(scale=TRUE)), +#' legend=list(ey=''), +#' series = ecr.band(data, 'down', 'up', two=TRUE, name='band') # two=TRUE +#' #series = list(ecr.band(data, 'down', 'up', name='polyBand')) # two=FALSE +#' ) +#' p$x$opts$series <- append(p$x$opts$series, +#' list(list(name='line',type='line', lineStyle=list(width=2), data=data$coord)) ) +#' p +#' #' @export -ec.band <- function(df=NULL, lower=NULL, upper=NULL, ...) { +ecr.band <- function(df=NULL, lower=NULL, upper=NULL, two=FALSE, ...) { if (is.null(df) || is.null(lower) || is.null(upper)) stop('df, lower and upper are all required', call. = FALSE) if (!'data.frame' %in% class(df)) stop('df must be a data.frame', call. = FALSE) + args <- list(...) - ld <- nrow(df[upper]) - l2 <- unname(unlist(df[upper])[order(ld:1)]) # reverse - tmp <- data.frame(x=c(df[1:ld,1],df[ld:1,1]), y=c(df[lower][[1]], l2)) - - serie <- list( - type = 'custom', - renderItem = htmlwidgets::JS('riPolygon'), - data = ec.data(tmp, TRUE), - ... - ) - if (is.null(serie$itemStyle)) - serie$itemStyle = list(borderWidth=0.5) + if (two) { # as two stacked areas + colr <- paste("new echarts.graphic.LinearGradient(0, 0, 0, 1, [", + "{offset: 0, color: 'rgba(255, 0, 135)'},", + "{offset: 1, color: 'rgba(135, 0, 157)'}])") + astyle <- list(opacity=0.8, color=htmlwidgets::JS(colr)) # default color + if ('areaStyle' %in% names(args)) astyle <- args$areaStyle + smooth <- if ('smooth' %in% names(args)) args$smooth else TRUE + lineStyle <- if ('lineStyle' %in% names(args)) args$lineStyle else list(width=0) + boundaryGap <- if ('boundaryGap' %in% names(args)) args$boundaryGap else FALSE + serie <- list( + list(type='line', stack='band', + showSymbol=FALSE, lineStyle=lineStyle, smooth=smooth, + data=unname(unlist(df[lower])), tooltip=list(show=FALSE), color='#fff0'), + list(type='line', stack='band', + showSymbol=FALSE, lineStyle=lineStyle, smooth=smooth, + data=unname(unlist(df[upper])), tooltip=list(show=FALSE), areaStyle=astyle, ...) + ) + } else { # as polygon + ld <- nrow(df[upper]) + l2 <- unname(unlist(df[upper])[order(ld:1)]) # reverse + tmp <- data.frame(x=c(df[1:ld,1],df[ld:1,1]), y=c(df[lower][[1]], l2)) + + serie <- list( + type = 'custom', + renderItem = htmlwidgets::JS('riPolygon'), + data = ec.data(tmp, 'values'), # only this format works + ... + ) + if (is.null(serie$itemStyle)) + serie$itemStyle = list(borderWidth=0.5) + } serie } +#' Error bars +#' +#' Custom series to display error bars for scatter,bar or line series +#' +#' @param wt A widget to add error bars to, see \code{\link[htmlwidgets]{createWidget}} +#' @param df A data.frame with three or more columns in order x,low,high,etc. +#' @param hwidth Half-width of error bar in pixels, default is 6. +#' @param ... More parameters for \href{https://echarts.apache.org/en/option.html#series-custom.type}{custom serie} +#' @return A widget with error bars added if successful, otherwise input wt +#' +#' @details Grouped bars are supported, but require the group column to be included in df. \cr +#' Complete data frame df could be chained to ec.init to auto-populate the bar series.\cr +#' ecr.ebars will add a legend if none is found.\cr +#' ecr.ebars are custom series, so \emph{ec.init(load='custom')} is required. +#' ecr.ebars should be set at the end, after all other series. \cr +#' +#' @examples +#' +#' df <- mtcars %>% dplyr::group_by(cyl,gear) %>% dplyr::summarise(mmm=mean(mpg)) %>% +#' dplyr::mutate(low=mmm*(1-0.2*runif(1)), high=mmm*(1+0.2*runif(1))) %>% +#' dplyr::relocate(cyl, .after = last_col()) # move group column away from first three cols +#' p <- df %>% ec.init(group1='bar', load='custom') +#' # since this is grouped data, must include the group column 'cyl' +#' ecr.ebars(p, df[,c('gear','low','high','cyl')]) +#' +#' @export +ecr.ebars <- function(wt, df, hwidth=6, ...) { + # alternating bar with custom series doesn't work, first bars then customs + if (missing(wt)) stop('ecr.ebars expecting widget', call. = FALSE) + if (missing(df)) stop('df is required', call. = FALSE) + if (!inherits(df, "data.frame")) stop('df must be data.frame', call. = FALSE) + ser <- wt$x$opts$series # all series + if (is.null(ser)) stop('series are missing', call. = FALSE) + args <- list(...) + + # look for barGap(s), barCategoryGap(s) + allBarGaps <- lapply(ser, function(x) { x$barGap }) + allBarCgGaps <- lapply(ser, function(x) { x$barCategoryGap }) + lbg <- utils::tail(unlist(allBarGaps),1); lbg <- if (is.null(lbg)) '' else lbg + lcg <- utils::tail(unlist(allBarCgGaps),1); lcg <- if (is.null(lcg)) '' else lcg + + cntr <- function(x, typ) { grep(typ, x) } + name <- args$name; + tmp <- NULL # count number of similar (grouped) series + if (!is.null(name)) + tmp <- unlist(lapply(ser, function(x) { + if (length(grep(name,x))>0) x$type else NULL }))[1] + if (!is.null(tmp)) # attached by name, count same-type series + info <- length(unlist(lapply(ser, function(x) grep(tmp, x)))) + else { # no name or not found - choose first of type bar/line/scatter, count how many + info <- length(unlist(lapply(ser, cntr, typ='bar'))) + if (info==0) info <- length(unlist(lapply(ser, cntr, typ='line'))) + if (info==0) info <- length(unlist(lapply(ser, cntr, typ='scatter'))) + } + + if (info==0) return(wt) # no bars/lines/scatter, nothing to attach to + + # set minimal info to be read by the renderer + # renderers.js works in a very isolated environment, so we send data thru sessionStorage + # info = last barGap, last barCategoryGap, number of bars, bar half-width in pixels + info <- c(lbg, lcg, as.character(info), hwidth) + + info <- paste0("sessionStorage.setItem('ErrorBar.oss','" + ,jsonlite::toJSON(info),"'); riErrorBar;") #renderErrorBar2;") + # no groups + if (!dplyr::is.grouped_df(df)) { + if (is.null(name)) name <- colnames(df)[1] + c <- list(type='custom', name=name, renderItem = htmlwidgets::JS(info), + data=ec.data(df, 'values'), ...) + if (!("z" %in% names(args))) c$z <- 3 + if (!("itemStyle" %in% names(args))) c$itemStyle <- list() + if (is.null(c$itemStyle$borderWidth)) c$itemStyle$borderWidth <- 1.5 + if (is.null(c$itemStyle$color)) c$itemStyle$color <- 'black' # set, or it will blend with main bar + cser <- list(c) + } + else { + grnm <- dplyr::group_vars(df)[[1]] # group1 means just 1st one + tmp <- df %>% dplyr::group_split() + cser <- lapply(tmp, function(s) { + name <- unlist(unique(unname(s[,grnm]))) + c <- list(type='custom', name=name, renderItem = htmlwidgets::JS(info), + data=ec.data(s, 'values'), ...) + if (!("z" %in% names(args))) c$z <- 3 + if (!("color" %in% names(args))) c$color <- 'black' # set, or it will blend with main bar + if (!("itemStyle" %in% names(args))) c$itemStyle <- list(borderWidth = 1.5) + c + }) + } + wt$x$opts$series <- append(wt$x$opts$series, cser) + if (!("legend" %in% names(wt$x$opts))) wt$x$opts$legend <- list(ey='') + wt$x$opts$xAxis$type <- 'category' + wt +} + + #' Translator Assistant #' #' Translate Javascript data objects to R #' #' @return none #' -#' @details To learn by examples in Javascript from \href{https://echarts.apache.org/examples/en/}{Echarts} +#' @details Learn from Javascript examples of \href{https://echarts.apache.org/examples/en/}{ECharts} +#' @import shiny #' @export ec.js2r <- function() { - if (interactive()) - shiny::runGist('https://gist.github.com/helgasoft/819035e853d9889ba02cb69ecc587f34',quiet=TRUE) + if (interactive()) { + prompt <- paste0('Ready to launch Translation Assistant\n Would you like to proceed ?') + ans <- FALSE + if (interactive()) + ans <- askYesNo(prompt) + if (is.na(ans)) ans <- FALSE # was cancelled + if (ans) { + shiny::runGist('https://gist.github.com/helgasoft/819035e853d9889ba02cb69ecc587f34',quiet=TRUE) + } + } return(NULL) } @@ -414,76 +564,107 @@ ecs.proxy <- function(id) { #' #' library(shiny) #' runApp( list( -#' ui = fluidPage( -#' ecs.output('plot'), -#' actionButton('addm', 'Add marks'), -#' actionButton('delm', 'Del area+line marks'), HTML('       '), -#' actionButton('adds', 'Add serie'), -#' actionButton('dels', 'Del serie'), HTML('       '), -#' actionButton('hilit', 'Highlight'), -#' actionButton('dnplay', 'Downplay') -#' ), -#' server = function(input, output, session){ -#' -#' output$plot <- ecs.render({ -#' e <- mtcars %>% group_by(cyl) %>% ec.init() -#' e$x$opts$tooltip <- list(list(show=TRUE)) -#' e$x$opts$series[[1]]$emphasis <- list(focus='series', blurScope='coordinateSystem') -#' e -#' }) -#' -#' observeEvent(input$addm, { -#' e <- ecs.proxy('plot') -#' e$x$opts$series[[1]] = list( -#' markPoint = list(data = list( -#' list(coord = c(22.5, 140.8)), -#' list(coord = c(30.5, 95.1)) -#' ), itemStyle = list(color='lightblue') -#' ) -#' ,markArea = list(data = list(list( -#' list(xAxis = 15), -#' list(xAxis = 25) -#' )) -#' ,silent=TRUE -#' ,itemStyle = list(color='pink', opacity=0.2) -#' ,label = list(formatter='X-area', position='insideTop') -#' ) -#' ,markLine = list(data = list(list(type='average'))) +#' ui = fluidPage( +#' ecs.output('plot'), +#' fluidRow( +#' column(4, actionButton('addm', 'Add marks'), +#' actionButton('delm', 'Delete marks'), +#' br(),span('mark points stay, area/line deletable') +#' ), +#' column(3, actionButton('adds', 'Add serie'), +#' actionButton('dels', 'Del serie')), +#' column(5, actionButton('adata', 'Add data'), +#' actionButton('hilit', 'Highlight'), +#' actionButton('dnplay', 'Downplay') ) +#' ) +#' ), +#' server = function(input, output, session) { +#' +#' output$plot <- ecs.render({ +#' p <- ec.init() +#' p$x$opts$series <- lapply(mtcars %>% relocate(disp, .after=mpg) +#' %>% group_by(cyl) %>% group_split(), function(s) { +#' list(type='scatter', name=unique(s$cyl), data=ec.data(s, 'values')) +#' }) +#' p$x$opts$legend <- list(ey='') +#' p$x$opts$xAxis <- list(type="value"); p$x$opts$yAxis <- list(ec='') +#' p$x$opts$tooltip <- list(list(show=TRUE)) +#' p$x$opts$series[[1]]$emphasis <- list(focus='series', blurScope='coordinateSystem') +#' p +#' }) +#' +#' observeEvent(input$addm, { +#' p <- ecs.proxy('plot') +#' p$x$opts$series = list( list( +#' markPoint = list(data = list( +#' list(coord = c(22.5, 140.8)), +#' list(coord = c(30.5, 95.1)) +#' ), +#' itemStyle = list(color='lightblue') +#' ) +#' ,markArea = list(data = list(list( +#' list(xAxis = 15), +#' list(xAxis = 25) +#' )) +#' ,silent=TRUE +#' ,itemStyle = list(color='pink', opacity=0.2) +#' ,label = list(formatter='X-area', position='insideTop') #' ) -#' e %>% ecs.exec() #' ='p_merge' -#' }) -#' observeEvent(input$adds, { -#' e <- ecs.proxy('plot') -#' e$x$opts$series[[1]] <- list( -#' type = 'line', name = 'newLine', -#' encode = list(x='mpg', y='disp') +#' ,markLine = list(data = list(list(type='average'))) +#' ), list( +#' markPoint = list(data = list( +#' list(coord = c(25.5, 143.8)), +#' list(coord = c(33.5, 98.1)) +#' ), +#' itemStyle = list(color='forestgreen') #' ) -#' e %>% ecs.exec('p_update') -#' }) -#' observeEvent(input$dels, { -#' e <- ecs.proxy('plot') -#' e$x$opts$seriesName <- 'newLine' -#' #'e$x$opts$seriesIndex <- 4 #' alternative ok -#' e %>% ecs.exec('p_del_serie') -#' }) -#' observeEvent(input$delm, { -#' e <- ecs.proxy('plot') -#' e$x$opts$seriesIndex <- 1 -#' e$x$opts$delMarks <- c('markArea','markLine') -#' e %>% ecs.exec('p_del_marks') -#' }) -#' observeEvent(input$hilit, { -#' e <- ecs.proxy('plot') -#' e$x$opts <- list(type='highlight', seriesName='4') -#' e %>% ecs.exec('p_dispatch') -#' }) -#' observeEvent(input$dnplay, { -#' e <- ecs.proxy('plot') -#' e$x$opts <- list(type='downplay', seriesName='4') -#' e %>% ecs.exec('p_dispatch') -#' }) -#' } -#' )) +#' )) +#' p %>% ecs.exec() # ='p_merge' +#' }) +#' observeEvent(input$adds, { +#' p <- ecs.proxy('plot') +#' p$x$opts$series <- list(list( +#' type = 'line', name = 'newLine', +#' #encode = list(x='mpg', y='disp') # for dataset only +#' data=list(list(10,100),list(5,200),list(10,400),list(10,200),list(15,150),list(5,300)) +#' )) +#' p %>% ecs.exec('p_update') +#' }) +#' +#' observeEvent(input$adata, { +#' set.seed(sample(1:444, 1)) +#' tmp <- apply(unname(data.frame(rnorm(5, 10, 3), rnorm(5, 200, 33))), +#' 1, function(x) { list(value=x) }) +#' p <- ecs.proxy('plot') +#' p$x$opts$seriesIndex <- 1 +#' p$x$opts$data <- tmp +#' p %>% ecs.exec('p_append_data') +#' }) +#' +#' observeEvent(input$dels, { +#' p <- ecs.proxy('plot') +#' p$x$opts$seriesName <- 'newLine' +#' #'p$x$opts$seriesIndex <- 4 # ok too +#' p %>% ecs.exec('p_del_serie') +#' }) +#' observeEvent(input$delm, { +#' p <- ecs.proxy('plot') +#' p$x$opts$seriesIndex <- 1 +#' p$x$opts$delMarks <- c('markArea','markLine') +#' p %>% ecs.exec('p_del_marks') +#' }) +#' observeEvent(input$hilit, { +#' p <- ecs.proxy('plot') +#' p$x$opts <- list(type='highlight', seriesName='4') +#' p %>% ecs.exec('p_dispatch') +#' }) +#' observeEvent(input$dnplay, { +#' p <- ecs.proxy('plot') +#' p$x$opts <- list(type='downplay', seriesName='4') +#' p %>% ecs.exec('p_dispatch') +#' }) +#' } )) +#' #' } #' #' @export @@ -589,7 +770,7 @@ ec.theme <- function (e, name, code = NULL) #' #' @param e An \code{echarty} widget as returned by [ec.init] #' @param json Whether to return a JSON, or a \code{list}, default TRUE -#' @param ... Additional options to pass to \code{\link[jsonlite]{toJSON}} +#' @param ... Additional arguments to pass to \code{\link[jsonlite]{toJSON}} #' @return A JSON string if \code{json} is \code{TRUE} and #' a \code{list} otherwise. #' @@ -623,16 +804,28 @@ ec.inspect <- function(e, json=TRUE, ...) { #' Convert JSON string to chart #' #' @param txt JSON character string, url, or file, see \code{\link[jsonlite]{fromJSON}} +#' @param ... Any arguments to pass to internal ec.init #' @return An \code{echarty} widget. #' #' @details \code{txt} should contain the full list of options required to build a chart. -#' It is subsequently passed to EchartsJS function \href{https://echarts.apache.org/en/api.html#echartsInstance.setOption}{setOption}. +#' It is subsequently passed to EChartsJS function \href{https://echarts.apache.org/en/api.html#echartsInstance.setOption}{setOption}. #' +#' @examples +#' txt <- '{ +#' "xAxis": { "type": "category", +#' "data": ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"] +#' }, +#' "yAxis": { "type": "value" }, +#' "series": { "type": "line", +#' "data": [150, 230, 224, 218, 135, 147, 260] +#' } }' +#' ec.fromJson(txt) +#' #' @export -ec.fromJson <- function(txt) { +ec.fromJson <- function(txt, ...) { json <- jsonlite::fromJSON(txt, simplifyVector = FALSE) - e <- ec.init() + e <- ec.init(...) e$x$opts <- json e } diff --git a/R/examples.R b/R/examples.R index 7446005..e269253 100644 --- a/R/examples.R +++ b/R/examples.R @@ -28,14 +28,16 @@ #' json <- tmp %>% ec.inspect() #' ec.fromJson(json) %>% ec.theme("dark") #' +#' #' #------ Data grouping #' iris %>% dplyr::group_by(Species) %>% ec.init() # by factor column +#' #' p <- Orange %>% dplyr::group_by(Tree) %>% ec.init() # no factor column -#' p$x$opts$series[[1]] <- append(p$x$opts$series[[1]], list( -#' symbolSize = 10 -#' )) # further customization added +#' p$x$opts$series <- lapply(p$x$opts$series, function(x) { +#' x$symbolSize=10; x$encode=list(x='age', y='circumference'); x } ) #' p #' +#' #' #------ Pie #' i<-0; data<-list(); for(v in islands[which(islands>60)]) { i<-i+1; #' data <- append(data, list(list(value=v, name=names(islands)[i]))) } @@ -48,12 +50,14 @@ #' p #' #' #------ Liquidfill plugin +#' if (interactive()) { #' p <- ec.init(load=c('liquid'), preset=FALSE) #' p$x$opts$series[[1]] <- list( #' type='liquidFill', data=c(0.6, 0.5, 0.4, 0.3), # amplitude=0, #' waveAnimation=FALSE, animationDuration=0, animationDurationUpdate=0 #' ) #' p +#' } #' #' #------ Heatmap #' times <- c(5,1,0,0,0,0,0,0,0,0,0,2,4,1,1,3,4,6,4,4,3,3,2,5,7,0,0,0,0,0, @@ -87,15 +91,17 @@ #' p #' #' #------ Plugin 3D +#' if (interactive()) { #' p <- ec.init(load = '3D') -#' p$x$opts$series[[1]] <- list( +#' p$x$opts$series <- list( #' type = 'surface', -#' data = ec.data(as.data.frame(as.table(volcano)), TRUE) +#' data = ec.data(as.data.frame(as.table(volcano)), 'values') #' ) -#' p +#' p +#' } #' #' #------ 3D chart with custom coloring -#' # [4] is the JS index of column Species +#' if (interactive()) { #' p <- iris %>% ec.init(load = '3D') #' p$x$opts$series[[1]] <- list( #' type='scatter3D', symbolSize=7, @@ -104,11 +110,13 @@ #' if (params.value[4] == 1) { return '#FE8463'; } #' else if(params.value[4] == 2){ return '#27727B'; } #' return '#9BCA63'; -#' }") ) +#' }") ) # [4] is the JS index of column Species #' ) #' p +#' } #' #' #------ Surface data equation with JS code +#' if (interactive()) { #' p <- ec.init(load='3D') #' p$x$opts$series[[1]] <- list( #' type = 'surface', @@ -120,8 +128,10 @@ #' ) #' ) #' p +#' } #' #' #------ Surface with data from a data.frame +#' if (interactive()) { #' library(dplyr) #' data <- expand.grid( #' x = seq(0, 2, by = 0.1), @@ -130,8 +140,9 @@ #' p <- ec.init(load='3D') #' p$x$opts$series[[1]] <- list( #' type = 'surface', -#' data = ec.data(data, TRUE)) +#' data = ec.data(data, 'values')) #' p +#' } #' #' #------ Band serie with customization #' # first column ('day') usually goes to the X-axis @@ -146,10 +157,10 @@ #' xAxis = list(list()), #' yAxis = list(list()), #' series = list( -#' append( ec.band(dats, 'DAX','FTSE'), list( +#' append( ecr.band(dats, 'DAX','FTSE'), list( #' name='band', color='lemonchiffon')), # band + customize #' list(type='line', name='CAC', color='red', symbolSize=1, -#' data = ec.data(dats %>% select(day,CAC), TRUE) ) # @2 +#' data = ec.data(dats %>% select(day,CAC), 'values') ) # @2 #' ), #' legend = list(data=list( #' list(name='band'), list(name='CAC') )), @@ -305,7 +316,7 @@ #' visualMap = list(type='continuous', calculable=TRUE, #' min=min(dusa$UrbanPop), max=max(dusa$UrbanPop)) #' ,series = list( list(type='map', map='USA', name='UrbanPop', roam=TRUE, -#' data = lapply(ec.data(dusa,TRUE), function(x) list(name=x$value[5], value=x$value[3])) +#' data = lapply(ec.data(dusa,'names'), function(x) list(name=x$states, value=x$UrbanPop)) #' )) #' ) #' p @@ -347,11 +358,8 @@ #' #' p <- ec.init(preset=FALSE) #' p$x$opts$series[[1]] <- list( type='sankey', -#' data = lapply(ec.data(sankey,TRUE), -#' function(x) list(name=x$value[1])), -#' edges = lapply(ec.data(sankey,TRUE), function(x) -#' list(source=as.character(x$value[2]), -#' target=as.character(x$value[3]), value=x$value[4]) ) +#' data = lapply(ec.data(sankey,'names'), function(x) list(name=x$node)), +#' edges = ec.data(sankey,'names') #' ) #' p #' @@ -359,12 +367,10 @@ #' p <- ec.init(preset=FALSE, title=list(text="Graph")) #' p$x$opts$series[[1]] <- list( type='graph', #' layout = 'force', # try 'circular' too -#' data = lapply(ec.data(sankey,TRUE), -#' function(x) list(name=x$value[1], tooltip = list(show=FALSE))), -#' edges = lapply(ec.data(sankey,TRUE), -#' function(x) list(source=x$value[2], -#' target=x$value[3], value=x$value[4], -#' lineStyle = list(width=x$value[4]))), +#' data = lapply(ec.data(sankey,'names'), +#' function(x) list(name=x$node, tooltip = list(show=FALSE))), +#' edges = lapply(ec.data(sankey,'names'), +#' function(x) { x$lineStyle <- list(width=x$value); x }), #' emphasis = list(focus='adjacency', #' label=list( position='right', show=TRUE)), #' label = list(show=TRUE), roam = TRUE, zoom = 4, @@ -392,7 +398,7 @@ #' server = function(input, output, session){ #' #' output$plot <- ecs.render({ -#' p <- mtcars %>% group_by(cyl) %>% ec.init() +#' p <- mtcars %>% relocate(disp, .after=mpg) %>% group_by(cyl) %>% ec.init() #' p$x$opts$tooltip <- list(list(show=TRUE)) #' p$x$opts$series[[1]]$emphasis <- list(focus='series', blurScope='coordinateSystem') #' p diff --git a/README.Rmd b/README.Rmd index c19b176..f4cfe25 100644 --- a/README.Rmd +++ b/README.Rmd @@ -13,28 +13,29 @@ knitr::opts_chunk$set( ) ``` -# Echarty +# echarty -This package is a thin R wrapper around Javascript library [Echarts.js](https://echarts.apache.org/en/index.html) v.5. The focus is on simplicity and efficiency. The R list parameters come directly from [Echarts' documentation](https://echarts.apache.org/en/option.html). There are just a few extra commands. Users can build elaborate interactive charts in R and Shiny with minimal coding. +This package is a thin R wrapper around Javascript library [ECharts.js](https://echarts.apache.org/en/index.html) v.5. The R list parameters come directly from [ECharts' documentation](https://echarts.apache.org/en/option.html). There are just a few extra commands. +Users can benefit from the **full functionality** of ECharts to build elaborate interactive charts in R and Shiny with minimal coding. ## Installation -Released version from [CRAN](https://CRAN.R-project.org): -```r -install.packages("echarty") # v.0.1.0 -``` - -We recommend the development version. It has important additions, see [NEWS.md](NEWS.md). +We recommend the latest development version. It has important [additions](NEWS.md). ```r # install.packages("remotes") -remotes::install_github("helgasoft/echarty") # v.0.1.1 +remotes::install_github("helgasoft/echarty") # v.0.1.2 +``` +Older released version from [CRAN](https://CRAN.R-project.org): +```r +install.packages("echarty") # v.0.1.0 ``` + ## Examples ```r @@ -44,24 +45,27 @@ library(echarty) cars %>% ec.init() # chart with plugin 3D, will prompt for one-time installation -e <- ec.init(load = '3D') -e$x$opts$series[[1]] <- list( - type = 'surface', - data = ec.data(as.data.frame(as.table(volcano)), TRUE) -) -e +if (interactive()) { + p <- ec.init(load = '3D') + p$x$opts$series <- list( + type = 'surface', + data = ec.data(as.data.frame(as.table(volcano)), TRUE) + ) + p +} ``` ## Get help -There are plenty of code examples in RStudio Help. -Type **?ec.examples** in the Console, then copy/paste any code from Help to see the result. +Check the [**WEBSITE**](https://helgasoft.github.io/echarty) for detailed tutorials and tips. +There are plenty of [code examples](https://github.com/helgasoft/echarty/blob/main/R/examples.R) included in the package. +The easiest way to run them in RStudio is to type **?ec.examples** in the Console, then copy/paste any code from Help to see the result. Or run all examples at once with **example('ec.examples')** and they will show in the Viewer. -We are adding tutorials and tips on the [website](https://helgasoft.github.io/echarty). + Do not hesitate to ask questions in [Discussions](https://github.com/helgasoft/echarty/discussions) or report problems in [Issues](https://github.com/helgasoft/echarty/issues). Now you can start building [**beautiful charts**](https://echarts.apache.org/examples/en/index.html) (and [**more**](https://www.makeapie.com)) with R and Shiny! - 

Polar Stack

Made with Echarty. Powered by Echarts.

+ 

Polar Stack

Made with echarty. Powered by ECharts.

diff --git a/README.md b/README.md index 12ee26a..daa9701 100644 --- a/README.md +++ b/README.md @@ -1,32 +1,33 @@ -# Echarty +# echarty This package is a thin R wrapper around Javascript library -[Echarts.js](https://echarts.apache.org/en/index.html) v.5. The focus is -on simplicity and efficiency. The R list parameters come directly from -[Echarts’ documentation](https://echarts.apache.org/en/option.html). -There are just a few extra commands. Users can build elaborate -interactive charts in R and Shiny with minimal coding. +[ECharts.js](https://echarts.apache.org/en/index.html) v.5. The R list +parameters come directly from [ECharts’ +documentation](https://echarts.apache.org/en/option.html). There are +just a few extra commands. +Users can benefit from the **full functionality** of ECharts to build +elaborate interactive charts in R and Shiny with minimal coding. ## Installation -Released version from [CRAN](https://CRAN.R-project.org): +We recommend the latest development version. It has important +[additions](NEWS.md). ``` r -install.packages("echarty") # v.0.1.0 +# install.packages("remotes") +remotes::install_github("helgasoft/echarty") # v.0.1.2 ``` -We recommend the development version. It has important additions, see -[NEWS.md](NEWS.md). +Older released version from [CRAN](https://CRAN.R-project.org): ``` r -# install.packages("remotes") -remotes::install_github("helgasoft/echarty") # v.0.1.1 +install.packages("echarty") # v.0.1.0 ``` ## Examples @@ -38,23 +39,28 @@ library(echarty) cars %>% ec.init() # chart with plugin 3D, will prompt for one-time installation -e <- ec.init(load = '3D') -e$x$opts$series[[1]] <- list( - type = 'surface', - data = ec.data(as.data.frame(as.table(volcano)), TRUE) -) -e +if (interactive()) { + p <- ec.init(load = '3D') + p$x$opts$series <- list( + type = 'surface', + data = ec.data(as.data.frame(as.table(volcano)), TRUE) + ) + p +} ``` ## Get help -There are plenty of code examples in RStudio Help. -Type **?ec.examples** in the Console, then copy/paste any code from Help +Check the [**WEBSITE**](https://helgasoft.github.io/echarty) for +detailed tutorials and tips. +There are plenty of [code +examples](https://github.com/helgasoft/echarty/blob/main/R/examples.R) +included in the package. The easiest way to run them in RStudio is to +type **?ec.examples** in the Console, then copy/paste any code from Help to see the result. Or run all examples at once with **example(‘ec.examples’)** and they -will show in the Viewer. -We are adding tutorials and tips on the -[website](https://helgasoft.github.io/echarty). +will show in the Viewer. + Do not hesitate to ask questions in [Discussions](https://github.com/helgasoft/echarty/discussions) or report problems in @@ -74,5 +80,5 @@ charts**](https://echarts.apache.org/examples/en/index.html) (and
Made with -Echarty. Powered by Echarts. +echarty. Powered by ECharts.

diff --git a/inst/htmlwidgets/echarty.js b/inst/htmlwidgets/echarty.js index 77ab914..44af9f7 100644 --- a/inst/htmlwidgets/echarty.js +++ b/inst/htmlwidgets/echarty.js @@ -279,23 +279,72 @@ if (HTMLWidgets.shinyMode) { chart.setOption(data.opts); break; - case 'p_replace': + case 'p_replace': // replace entire chart chart.setOption(data.opts, true); break; - - case 'p_append_data': - chart.appendData({ - seriesIndex: cpts.seriesIndex, - data: cpts.data - }); + + case 'p_update': // more like 'append serie' + + if(!cpts.series) // add series array if none + cpts.series = []; + + data.opts.series.forEach(function(serie){ + // for JS_EVAL and renderItem + if (typeof serie.renderItem == 'string') + serie.renderItem = eval(serie.renderItem); + cpts.series.push(serie); + }) + + if (data.opts.legend) { // legend + if(cpts.legend.length > 0) + if(data.opts.legend.data) + cpts.legend[0].data = cpts.legend[0].data.concat(data.opts.legend.data); + } + if (data.opts.xAxis) { // x Axis + if(cpts.xAxis){ + if(cpts.xAxis[0].data){ + let xaxis = cpts.xAxis[0].data.concat(data.opts.xAxis[0].data); + xaxis = xaxis.filter(distinct); + cpts.xAxis[0].data = xaxis; + } + } else + cpts.xAxis = data.opts.xAxis; + } + if (data.opts.yAxis) { // y Axis + if(cpts.yAxis){ + if(cpts.yAxis[0].data){ + let yaxis = cpts.yAxis[0].data.concat(data.opts.yAxis[0].data); + yaxis = yaxis.filter(distinct); + cpts.yAxis[0].data = yaxis; + } + } + } + if (data.opts.dataset) + cpts.dataset = data.opts.dataset; +console.log('user.opts='+Object.keys(data.opts)) + chart.setOption(cpts, true); break; - case 'p_dispatch': - chart.dispatchAction(data.opts); + case 'p_append_data': // add data to one serie + if (!cpts.series) break; + if (data.opts.seriesName) { + // find index by name + var idx = 0; + cpts.series.forEach(function(serie) { + if (serie.name==data.opts.seriesName) data.opts.seriesIndex = idx; + idx++; + }) + //console.log('appd ',data.opts.seriesName,'=',data.opts.seriesIndex) + } + if (data.opts.seriesIndex) + chart.appendData({ + seriesIndex: data.opts.seriesIndex, + data: data.opts.data + }); break; case 'p_del_serie': - if(data.opts.seriesName){ + if (data.opts.seriesName) { let series = cpts.series; series.forEach( function(s, index) { if(s.name == data.opts.seriesName){ @@ -304,7 +353,7 @@ if (HTMLWidgets.shinyMode) { }, series) cpts.series = series; } - else if(data.opts.seriesIndex) + else if (data.opts.seriesIndex) cpts.series = cpts.series.splice(data.opts.seriesIndex, 1); chart.setOption(cpts, true); break; @@ -330,43 +379,8 @@ if (HTMLWidgets.shinyMode) { chart.setOption(cpts, true); break; - case 'p_update': - - if(!cpts.series) // add series if none - cpts.series = []; - - data.opts.series.forEach(function(serie){ - // for JS_EVAL and renderItem - if (typeof serie.renderItem == 'string') - serie.renderItem = eval(serie.renderItem); - cpts.series.push(serie); - }) - - if (data.opts.legend) { // legend - if(cpts.legend.length > 0) - if(data.opts.legend.data) - cpts.legend[0].data = cpts.legend[0].data.concat(data.opts.legend.data); - } - if (data.opts.xAxis) { // x Axis - if(cpts.xAxis){ - if(cpts.xAxis[0].data){ - let xaxis = cpts.xAxis[0].data.concat(data.opts.xAxis[0].data); - xaxis = xaxis.filter(distinct); - cpts.xAxis[0].data = xaxis; - } - } - } - if (data.opts.yAxis) { // y Axis - if(cpts.yAxis){ - if(cpts.yAxis[0].data){ - let yaxis = cpts.yAxis[0].data.concat(data.opts.yAxis[0].data); - yaxis = yaxis.filter(distinct); - cpts.yAxis[0].data = yaxis; - } - } - } - - chart.setOption(cpts, true); + case 'p_dispatch': + chart.dispatchAction(data.opts); break; default: diff --git a/inst/htmlwidgets/echarty.yaml b/inst/htmlwidgets/echarty.yaml index 0891e4d..7bcc4be 100644 --- a/inst/htmlwidgets/echarty.yaml +++ b/inst/htmlwidgets/echarty.yaml @@ -1,6 +1,6 @@ dependencies: - name: echarty - version: 0.1.0 + version: 0.1.2 src: js script: - echarts.min.js diff --git a/inst/js/renderers.js b/inst/js/renderers.js index 40b9ffc..bd3f4d2 100644 --- a/inst/js/renderers.js +++ b/inst/js/renderers.js @@ -1,37 +1,24 @@ // JS renderers for error bars, bands, etc. +// Prefix 'ri' stands for 'renderItem' - the calling origin. /* Error Bar support for grouped bars, barGap and barCategoryGap Notes: - Prefix 'ri' stands for 'renderItem' function. Error bars can have chart bars, lines and scatter points as "hosts". - It's convenient to "attach" error bars to their related chart bars - so they'll show/hide together when user clicks on a legend button. - This is done by having the same name for error and chart bars. - Default legend = FALSE, since we'll have only chart bars in legend. - Error bars will inherit color from their chart bar, blending with them. - Therefore it is preferable to set a different color, like so - - ec.ebars(..., color='blue'). Black is now set as default color. - ec.ebars are set at the end, after all other series. - - To test in R: - grps <- 5 # customizable number of groups - rpt <- grps*2 - df <- data.frame('Category' = c(rep(LETTERS[1:grps], each=rpt)), - 'Xaxis' = rep(paste(rep(LETTERS[1:grps], each=2), 1:grps*2, sep='.'), grps*rpt/(grps*2)), - 'Yaxis' = 50 * abs(rnorm(grps*rpt))) %>% - mutate(Lower = Yaxis - 5 * runif(grps*rpt), - Upper = Yaxis + 5 * runif(grps*rpt)) - p <- df %>% group_by(Category) %>% ec.init() - p$x$opts$xAxis <- list(type='category') - p$x$opts$series[[1]] <- list( type='bar', barGap ='22%', barCategoryGap='55%') - p$x$opts$dataZoom <- list(start = 50) - p <- ec.ebars(p, Lower, Upper) + Error bars will "attach" to their host series and show/hide + together when user clicks on a legend button. + Attaching is done automatically (by type), or by name. + Error bars will inherit color from their host bar, blending with them. + Therefore it is preferable to use a different color, default is 'black'. + ecr.ebars will add a legend if none is found. + ecr.ebars should be set at the end, after all other series. + ecr.ebars are custom series, so ec.init(load='custom') is required. + */ function riErrorBar(params, api) { // input oss contains - // [last.barGap, last.barCategoryGap, series.count, ends.width] + // [last.barGap, last.barCategoryGap, series.count, ends.half.width] let oss = JSON.parse(sessionStorage.getItem('ErrorBar.oss')); if (oss===null || !Object.keys(oss).length) return null; // needs 4 input values @@ -101,8 +88,8 @@ function riErrorBar(params, api) { } /* - renderItem function for Polygon - used also by ec.band + renderItem function for polygons + used by ecr.band */ function riPolygon(params, api) { if (params.context.rendered) return; diff --git a/man/ec.band.Rd b/man/ec.band.Rd deleted file mode 100644 index 08e1a3a..0000000 --- a/man/ec.band.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/echarty.R -\name{ec.band} -\alias{ec.band} -\title{Band} -\usage{ -ec.band(df = NULL, lower = NULL, upper = NULL, ...) -} -\arguments{ -\item{df}{A data.frame with lower and upper numerical columns.} - -\item{lower}{The column name of band's lower boundary, a string.} - -\item{upper}{The column name of band's upper boundary, a string.} - -\item{...}{More parameters for \href{https://echarts.apache.org/en/option.html#series-line.type}{serie}} -} -\value{ -One serie list -} -\description{ -Add a new 'custom' serie with coordinates of a polygon. -} -\details{ -The coordinates of the two boundaries are merged into a polygon and displayed as one. -} diff --git a/man/ec.data.Rd b/man/ec.data.Rd index b4d3f4d..cf75f89 100644 --- a/man/ec.data.Rd +++ b/man/ec.data.Rd @@ -2,19 +2,22 @@ % Please edit documentation in R/echarty.R \name{ec.data} \alias{ec.data} -\title{Get an EchartsJS dataset from a data.frame} +\title{Get an EChartsJS dataset from a data.frame} \usage{ -ec.data(df, series = FALSE) +ec.data(df, format = "dataset") } \arguments{ \item{df}{Chart data in data.frame format, required} -\item{series}{If FALSE, data is prepared for \href{https://echarts.apache.org/en/option.html#dataset.source}{dataset} (default),\cr -if TRUE, data is for \href{https://echarts.apache.org/en/option.html#series-scatter.data}{series}} +\item{format}{A key on how to format the output list \cr \itemize{ +\item 'dataset' list used in \href{https://echarts.apache.org/en/option.html#dataset.source}{dataset} (default),\cr +\item 'values' list for \href{https://echarts.apache.org/en/option.html#series-scatter.data}{series.data} \cr +\item 'names' creates named lists useful for named data like \href{https://echarts.apache.org/en/option.html#series-sankey.links}{sankey links} +}} } \value{ -A list for \emph{dataset.source} or \emph{series.data}. The latter does not include column names. +A list for \emph{dataset.source}, \emph{series.data} or a list of named lists. } \description{ -Get an EchartsJS dataset from a data.frame +Get an EChartsJS dataset from a data.frame } diff --git a/man/ec.examples.Rd b/man/ec.examples.Rd index a9243d5..3467133 100644 --- a/man/ec.examples.Rd +++ b/man/ec.examples.Rd @@ -35,14 +35,16 @@ tmp json <- tmp \%>\% ec.inspect() ec.fromJson(json) \%>\% ec.theme("dark") + #------ Data grouping iris \%>\% dplyr::group_by(Species) \%>\% ec.init() # by factor column + p <- Orange \%>\% dplyr::group_by(Tree) \%>\% ec.init() # no factor column -p$x$opts$series[[1]] <- append(p$x$opts$series[[1]], list( - symbolSize = 10 -)) # further customization added +p$x$opts$series <- lapply(p$x$opts$series, function(x) { + x$symbolSize=10; x$encode=list(x='age', y='circumference'); x } ) p + #------ Pie i<-0; data<-list(); for(v in islands[which(islands>60)]) { i<-i+1; data <- append(data, list(list(value=v, name=names(islands)[i]))) } @@ -55,12 +57,14 @@ p$x$opts <- list(title=list( p #------ Liquidfill plugin +if (interactive()) { p <- ec.init(load=c('liquid'), preset=FALSE) p$x$opts$series[[1]] <- list( type='liquidFill', data=c(0.6, 0.5, 0.4, 0.3), # amplitude=0, waveAnimation=FALSE, animationDuration=0, animationDurationUpdate=0 ) p +} #------ Heatmap times <- c(5,1,0,0,0,0,0,0,0,0,0,2,4,1,1,3,4,6,4,4,3,3,2,5,7,0,0,0,0,0, @@ -94,15 +98,17 @@ p$x$opts$series[[1]]$symbolSize = htmlwidgets::JS("function(x){ return x[3];}") p #------ Plugin 3D +if (interactive()) { p <- ec.init(load = '3D') -p$x$opts$series[[1]] <- list( +p$x$opts$series <- list( type = 'surface', - data = ec.data(as.data.frame(as.table(volcano)), TRUE) + data = ec.data(as.data.frame(as.table(volcano)), 'values') ) -p +p +} #------ 3D chart with custom coloring -# [4] is the JS index of column Species +if (interactive()) { p <- iris \%>\% ec.init(load = '3D') p$x$opts$series[[1]] <- list( type='scatter3D', symbolSize=7, @@ -111,11 +117,13 @@ p$x$opts$series[[1]] <- list( if (params.value[4] == 1) { return '#FE8463'; } else if(params.value[4] == 2){ return '#27727B'; } return '#9BCA63'; - }") ) + }") ) # [4] is the JS index of column Species ) p +} #------ Surface data equation with JS code +if (interactive()) { p <- ec.init(load='3D') p$x$opts$series[[1]] <- list( type = 'surface', @@ -127,8 +135,10 @@ p$x$opts$series[[1]] <- list( ) ) p +} #------ Surface with data from a data.frame +if (interactive()) { library(dplyr) data <- expand.grid( x = seq(0, 2, by = 0.1), @@ -137,8 +147,9 @@ data <- expand.grid( p <- ec.init(load='3D') p$x$opts$series[[1]] <- list( type = 'surface', - data = ec.data(data, TRUE)) + data = ec.data(data, 'values')) p +} #------ Band serie with customization # first column ('day') usually goes to the X-axis @@ -153,10 +164,10 @@ p$x$opts <- list( xAxis = list(list()), yAxis = list(list()), series = list( - append( ec.band(dats, 'DAX','FTSE'), list( + append( ecr.band(dats, 'DAX','FTSE'), list( name='band', color='lemonchiffon')), # band + customize list(type='line', name='CAC', color='red', symbolSize=1, - data = ec.data(dats \%>\% select(day,CAC), TRUE) ) # @2 + data = ec.data(dats \%>\% select(day,CAC), 'values') ) # @2 ), legend = list(data=list( list(name='band'), list(name='CAC') )), @@ -312,7 +323,7 @@ p$x$opts <- list( visualMap = list(type='continuous', calculable=TRUE, min=min(dusa$UrbanPop), max=max(dusa$UrbanPop)) ,series = list( list(type='map', map='USA', name='UrbanPop', roam=TRUE, - data = lapply(ec.data(dusa,TRUE), function(x) list(name=x$value[5], value=x$value[3])) + data = lapply(ec.data(dusa,'names'), function(x) list(name=x$states, value=x$UrbanPop)) )) ) p @@ -354,11 +365,8 @@ sankey <- data.frame( p <- ec.init(preset=FALSE) p$x$opts$series[[1]] <- list( type='sankey', - data = lapply(ec.data(sankey,TRUE), - function(x) list(name=x$value[1])), - edges = lapply(ec.data(sankey,TRUE), function(x) - list(source=as.character(x$value[2]), - target=as.character(x$value[3]), value=x$value[4]) ) + data = lapply(ec.data(sankey,'names'), function(x) list(name=x$node)), + edges = ec.data(sankey,'names') ) p @@ -366,12 +374,10 @@ p p <- ec.init(preset=FALSE, title=list(text="Graph")) p$x$opts$series[[1]] <- list( type='graph', layout = 'force', # try 'circular' too - data = lapply(ec.data(sankey,TRUE), - function(x) list(name=x$value[1], tooltip = list(show=FALSE))), - edges = lapply(ec.data(sankey,TRUE), - function(x) list(source=x$value[2], - target=x$value[3], value=x$value[4], - lineStyle = list(width=x$value[4]))), + data = lapply(ec.data(sankey,'names'), + function(x) list(name=x$node, tooltip = list(show=FALSE))), + edges = lapply(ec.data(sankey,'names'), + function(x) { x$lineStyle <- list(width=x$value); x }), emphasis = list(focus='adjacency', label=list( position='right', show=TRUE)), label = list(show=TRUE), roam = TRUE, zoom = 4, @@ -399,7 +405,7 @@ runApp( list( server = function(input, output, session){ output$plot <- ecs.render({ - p <- mtcars \%>\% group_by(cyl) \%>\% ec.init() + p <- mtcars \%>\% relocate(disp, .after=mpg) \%>\% group_by(cyl) \%>\% ec.init() p$x$opts$tooltip <- list(list(show=TRUE)) p$x$opts$series[[1]]$emphasis <- list(focus='series', blurScope='coordinateSystem') p diff --git a/man/ec.fromJson.Rd b/man/ec.fromJson.Rd index f222e42..f7ae707 100644 --- a/man/ec.fromJson.Rd +++ b/man/ec.fromJson.Rd @@ -4,10 +4,12 @@ \alias{ec.fromJson} \title{Convert JSON string to chart} \usage{ -ec.fromJson(txt) +ec.fromJson(txt, ...) } \arguments{ \item{txt}{JSON character string, url, or file, see \code{\link[jsonlite]{fromJSON}}} + +\item{...}{Any arguments to pass to internal ec.init} } \value{ An \code{echarty} widget. @@ -17,5 +19,17 @@ Convert JSON string to chart } \details{ \code{txt} should contain the full list of options required to build a chart. -It is subsequently passed to EchartsJS function \href{https://echarts.apache.org/en/api.html#echartsInstance.setOption}{setOption}. +It is subsequently passed to EChartsJS function \href{https://echarts.apache.org/en/api.html#echartsInstance.setOption}{setOption}. +} +\examples{ +txt <- '{ + "xAxis": { "type": "category", + "data": ["Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun"] + }, + "yAxis": { "type": "value" }, + "series": { "type": "line", + "data": [150, 230, 224, 218, 135, 147, 260] + } }' +ec.fromJson(txt) + } diff --git a/man/ec.init.Rd b/man/ec.init.Rd index d48c7a1..face9cf 100644 --- a/man/ec.init.Rd +++ b/man/ec.init.Rd @@ -23,12 +23,12 @@ ec.init( \item{group1}{Type of grouped series, default 'scatter'. Set to NULL to disable. \cr If the grouping is on multiple columns, only the first one is used.} -\item{preset}{Enable (TRUE, default) or disable(FALSE) presets xAxis, yAxis and first serie.} +\item{preset}{Disable(FALSE) or enable (TRUE, default) presets for xAxis, yAxis and first serie.} \item{load}{Name(s) of plugin(s) to load. Could be a character vector or comma-delimited string. default NULL.\cr Built-in plugins: \cr \itemize{ \item leaflet - Leaflet maps with customizable tiles, see \href{https://github.com/gnijuohz/echarts-leaflet#readme}{source}\cr -\item custom - renderers for \link{ec.band} and ec.ebars \cr +\item custom - renderers for \link{ecr.band} and ecr.ebars \cr } Plugins with one-time installation (popup prompt): \cr \itemize{ \item 3D - 3D charts and WebGL acceleration, see \href{https://github.com/ecomfe/echarts-gl}{source} and \href{https://echarts.apache.org/en/option-gl.html#series}{docs} \cr \item world - world map with country boundaries, see \href{https://github.com/apache/echarts/tree/master/test/data/map/js}{source} \cr @@ -57,8 +57,10 @@ Initialize a chart. } \details{ Widgets are defined in \href{https://www.htmlwidgets.org/develop_intro.html}{htmlwidgets}. -This command creates one with \code{\link[htmlwidgets]{createWidget}}, then adds some EchartsJS features to it.\cr -It may preset values for xAxis,yAxis,series and dataset, which user can overwrite if needed. +This command creates one with \code{\link[htmlwidgets]{createWidget}}, then adds some EChartsJS features to it.\cr +When \link{ec.init} is chained after a data.frame, a \href{https://echarts.apache.org/en/option.html#dataset}{dataset} is preset. \cr +When the data.frame is grouped and \emph{group1} is not null, more datasets with legend and series are also preset. Grouped series are of type \code{scatter}. \cr +Users can delete or overwrite any presets as needed. } \examples{ # basic scatter chart from a data.frame, using presets diff --git a/man/ec.inspect.Rd b/man/ec.inspect.Rd index cfce989..f576b7d 100644 --- a/man/ec.inspect.Rd +++ b/man/ec.inspect.Rd @@ -11,7 +11,7 @@ ec.inspect(e, json = TRUE, ...) \item{json}{Whether to return a JSON, or a \code{list}, default TRUE} -\item{...}{Additional options to pass to \code{\link[jsonlite]{toJSON}}} +\item{...}{Additional arguments to pass to \code{\link[jsonlite]{toJSON}}} } \value{ A JSON string if \code{json} is \code{TRUE} and diff --git a/man/ec.js2r.Rd b/man/ec.js2r.Rd index 4133de2..e320bfe 100644 --- a/man/ec.js2r.Rd +++ b/man/ec.js2r.Rd @@ -13,5 +13,5 @@ none Translate Javascript data objects to R } \details{ -To learn by examples in Javascript from \href{https://echarts.apache.org/examples/en/}{Echarts} +Learn from Javascript examples of \href{https://echarts.apache.org/examples/en/}{ECharts} } diff --git a/man/ecr.band.Rd b/man/ecr.band.Rd new file mode 100644 index 0000000..c355e85 --- /dev/null +++ b/man/ecr.band.Rd @@ -0,0 +1,49 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/echarty.R +\name{ecr.band} +\alias{ecr.band} +\title{Area band} +\usage{ +ecr.band(df = NULL, lower = NULL, upper = NULL, two = FALSE, ...) +} +\arguments{ +\item{df}{A data.frame with lower and upper numerical columns.} + +\item{lower}{The column name of band's lower boundary, a string.} + +\item{upper}{The column name of band's upper boundary, a string.} + +\item{two}{Type of rendering - by polygon (FALSE,default), or by two stacked lines (TRUE)} + +\item{...}{More parameters for \href{https://echarts.apache.org/en/option.html#series-line.type}{serie}} +} +\value{ +One list serie when two=FALSE, or a list of two list series when two=TRUE +} +\description{ +A 'custom' serie with lower and upper boundaries +} +\details{ +When two=FALSE, the coordinates of the two boundaries are chained into a polygon and displayed as one. Uses absolute cartesian coordinates. \cr +When two=TRUE, two smooth \emph{stacked} lines are drawn, one with customizable areaStyle. The upper boundary coordinates represent values on top of the lower boundary coordinates. +} +\examples{ +myList <- list(x=LETTERS[1:7], + d=c(140, 232, 101, 264, 90, 340, 250), + u=c(120, 282, 111, 234, 220, 340, 310), + l=c(200, 332, 151, 400, 190, 540, 450)) +data <- as.data.frame(do.call(cbind, myList)) +colnames(data) <- c('x','down','up','coord') +p <- ec.init(load='custom') +p$x$opts <- list( + xAxis=list(list(type='category', boundaryGap=FALSE, data=data$x)), + yAxis=list(list(scale=TRUE)), + legend=list(ey=''), + series = ecr.band(data, 'down', 'up', two=TRUE, name='band') # two=TRUE + #series = list(ecr.band(data, 'down', 'up', name='polyBand')) # two=FALSE +) +p$x$opts$series <- append(p$x$opts$series, + list(list(name='line',type='line', lineStyle=list(width=2), data=data$coord)) ) +p + +} diff --git a/man/ecr.ebars.Rd b/man/ecr.ebars.Rd new file mode 100644 index 0000000..96e4832 --- /dev/null +++ b/man/ecr.ebars.Rd @@ -0,0 +1,40 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/echarty.R +\name{ecr.ebars} +\alias{ecr.ebars} +\title{Error bars} +\usage{ +ecr.ebars(wt, df, hwidth = 6, ...) +} +\arguments{ +\item{wt}{A widget to add error bars to, see \code{\link[htmlwidgets]{createWidget}}} + +\item{df}{A data.frame with three or more columns in order x,low,high,etc.} + +\item{hwidth}{Half-width of error bar in pixels, default is 6.} + +\item{...}{More parameters for \href{https://echarts.apache.org/en/option.html#series-custom.type}{custom serie}} +} +\value{ +A widget with error bars added if successful, otherwise input wt +} +\description{ +Custom series to display error bars for scatter,bar or line series +} +\details{ +Grouped bars are supported, but require the group column to be included in df. \cr +Complete data frame df could be chained to ec.init to auto-populate the bar series.\cr +ecr.ebars will add a legend if none is found.\cr +ecr.ebars are custom series, so \emph{ec.init(load='custom')} is required. +ecr.ebars should be set at the end, after all other series. \cr +} +\examples{ + +df <- mtcars \%>\% dplyr::group_by(cyl,gear) \%>\% dplyr::summarise(mmm=mean(mpg)) \%>\% + dplyr::mutate(low=mmm*(1-0.2*runif(1)), high=mmm*(1+0.2*runif(1))) \%>\% + dplyr::relocate(cyl, .after = last_col()) # move group column away from first three cols +p <- df \%>\% ec.init(group1='bar', load='custom') +# since this is grouped data, must include the group column 'cyl' +ecr.ebars(p, df[,c('gear','low','high','cyl')]) + +} diff --git a/man/ecs.exec.Rd b/man/ecs.exec.Rd index d92a3dd..e0b2858 100644 --- a/man/ecs.exec.Rd +++ b/man/ecs.exec.Rd @@ -29,76 +29,107 @@ if (interactive()) { library(shiny) runApp( list( - ui = fluidPage( - ecs.output('plot'), - actionButton('addm', 'Add marks'), - actionButton('delm', 'Del area+line marks'), HTML('       '), - actionButton('adds', 'Add serie'), - actionButton('dels', 'Del serie'), HTML('       '), - actionButton('hilit', 'Highlight'), - actionButton('dnplay', 'Downplay') - ), - server = function(input, output, session){ +ui = fluidPage( + ecs.output('plot'), + fluidRow( + column(4, actionButton('addm', 'Add marks'), + actionButton('delm', 'Delete marks'), + br(),span('mark points stay, area/line deletable') + ), + column(3, actionButton('adds', 'Add serie'), + actionButton('dels', 'Del serie')), + column(5, actionButton('adata', 'Add data'), + actionButton('hilit', 'Highlight'), + actionButton('dnplay', 'Downplay') ) + ) +), +server = function(input, output, session) { - output$plot <- ecs.render({ - e <- mtcars \%>\% group_by(cyl) \%>\% ec.init() - e$x$opts$tooltip <- list(list(show=TRUE)) - e$x$opts$series[[1]]$emphasis <- list(focus='series', blurScope='coordinateSystem') - e - }) + output$plot <- ecs.render({ + p <- ec.init() + p$x$opts$series <- lapply(mtcars \%>\% relocate(disp, .after=mpg) + \%>\% group_by(cyl) \%>\% group_split(), function(s) { + list(type='scatter', name=unique(s$cyl), data=ec.data(s, 'values')) + }) + p$x$opts$legend <- list(ey='') + p$x$opts$xAxis <- list(type="value"); p$x$opts$yAxis <- list(ec='') + p$x$opts$tooltip <- list(list(show=TRUE)) + p$x$opts$series[[1]]$emphasis <- list(focus='series', blurScope='coordinateSystem') + p + }) - observeEvent(input$addm, { - e <- ecs.proxy('plot') - e$x$opts$series[[1]] = list( - markPoint = list(data = list( - list(coord = c(22.5, 140.8)), - list(coord = c(30.5, 95.1)) - ), itemStyle = list(color='lightblue') - ) - ,markArea = list(data = list(list( - list(xAxis = 15), - list(xAxis = 25) - )) - ,silent=TRUE - ,itemStyle = list(color='pink', opacity=0.2) - ,label = list(formatter='X-area', position='insideTop') - ) - ,markLine = list(data = list(list(type='average'))) + observeEvent(input$addm, { + p <- ecs.proxy('plot') + p$x$opts$series = list( list( + markPoint = list(data = list( + list(coord = c(22.5, 140.8)), + list(coord = c(30.5, 95.1)) + ), + itemStyle = list(color='lightblue') ) - e \%>\% ecs.exec() #' ='p_merge' - }) - observeEvent(input$adds, { - e <- ecs.proxy('plot') - e$x$opts$series[[1]] <- list( - type = 'line', name = 'newLine', - encode = list(x='mpg', y='disp') + ,markArea = list(data = list(list( + list(xAxis = 15), + list(xAxis = 25) + )) + ,silent=TRUE + ,itemStyle = list(color='pink', opacity=0.2) + ,label = list(formatter='X-area', position='insideTop') ) - e \%>\% ecs.exec('p_update') - }) - observeEvent(input$dels, { - e <- ecs.proxy('plot') - e$x$opts$seriesName <- 'newLine' - #'e$x$opts$seriesIndex <- 4 #' alternative ok - e \%>\% ecs.exec('p_del_serie') - }) - observeEvent(input$delm, { - e <- ecs.proxy('plot') - e$x$opts$seriesIndex <- 1 - e$x$opts$delMarks <- c('markArea','markLine') - e \%>\% ecs.exec('p_del_marks') - }) - observeEvent(input$hilit, { - e <- ecs.proxy('plot') - e$x$opts <- list(type='highlight', seriesName='4') - e \%>\% ecs.exec('p_dispatch') - }) - observeEvent(input$dnplay, { - e <- ecs.proxy('plot') - e$x$opts <- list(type='downplay', seriesName='4') - e \%>\% ecs.exec('p_dispatch') - }) - } -)) + ,markLine = list(data = list(list(type='average'))) + ), list( + markPoint = list(data = list( + list(coord = c(25.5, 143.8)), + list(coord = c(33.5, 98.1)) + ), + itemStyle = list(color='forestgreen') + ) + )) + p \%>\% ecs.exec() # ='p_merge' + }) + observeEvent(input$adds, { + p <- ecs.proxy('plot') + p$x$opts$series <- list(list( + type = 'line', name = 'newLine', + #encode = list(x='mpg', y='disp') # for dataset only + data=list(list(10,100),list(5,200),list(10,400),list(10,200),list(15,150),list(5,300)) + )) + p \%>\% ecs.exec('p_update') + }) + + observeEvent(input$adata, { + set.seed(sample(1:444, 1)) + tmp <- apply(unname(data.frame(rnorm(5, 10, 3), rnorm(5, 200, 33))), + 1, function(x) { list(value=x) }) + p <- ecs.proxy('plot') + p$x$opts$seriesIndex <- 1 + p$x$opts$data <- tmp + p \%>\% ecs.exec('p_append_data') + }) + + observeEvent(input$dels, { + p <- ecs.proxy('plot') + p$x$opts$seriesName <- 'newLine' + #'p$x$opts$seriesIndex <- 4 # ok too + p \%>\% ecs.exec('p_del_serie') + }) + observeEvent(input$delm, { + p <- ecs.proxy('plot') + p$x$opts$seriesIndex <- 1 + p$x$opts$delMarks <- c('markArea','markLine') + p \%>\% ecs.exec('p_del_marks') + }) + observeEvent(input$hilit, { + p <- ecs.proxy('plot') + p$x$opts <- list(type='highlight', seriesName='4') + p \%>\% ecs.exec('p_dispatch') + }) + observeEvent(input$dnplay, { + p <- ecs.proxy('plot') + p$x$opts <- list(type='downplay', seriesName='4') + p \%>\% ecs.exec('p_dispatch') + }) +} )) + } }