From 74e76f8cabbe1e5ecb2fe5ce2d7e750a2b5ba32c Mon Sep 17 00:00:00 2001 From: helgasoft Date: Sun, 1 Nov 2020 18:50:52 -0800 Subject: [PATCH] updated e_error_bar added support in e_error_bar for grouped bars. --- DESCRIPTION | 3 +- R/add.R | 6 +- R/add_.R | 40 +++++--- docs/reference/errorbar.html | 2 +- .../lib/echarts-4.8.0/custom/renderers.js | 91 +++++++++++++++++++ man/errorbar.Rd | 4 +- 6 files changed, 127 insertions(+), 19 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 3b9a7d82..9ae2b31c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -4,7 +4,8 @@ Date: 2020-10-15 Version: 0.3.4 Authors@R: c( person("John", "Coene", email = "jcoenep@gmail.com", role = c("aut", "cre", "cph")), - person(given = "Wei", family = "Su", email = "swsoyee@gmail.com", role = "ctb")) + person(given = "Wei", family = "Su", email = "swsoyee@gmail.com", role = "ctb"), + person("Helgasoft", ".com", email="contact@helgasoft.com", role = "ctb")) Description: Easily create interactive charts by leveraging the 'Echarts Javascript' library which includes 36 chart types, themes, 'Shiny' proxies and animations. License: Apache License (>= 2.0) diff --git a/R/add.R b/R/add.R index 02e3b29c..5a724862 100644 --- a/R/add.R +++ b/R/add.R @@ -3625,14 +3625,14 @@ e_correlations.echarts4rProxy <- function(e, order = NULL, visual_map = TRUE, .. #' e_error_bar(lower, upper) #' @rdname errorbar #' @export -e_error_bar <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = 0, x_index = 0, +e_error_bar <- function(e, lower, upper, name = NULL, legend = FALSE, y_index = 0, x_index = 0, coord_system = "cartesian2d", ...) { UseMethod("e_error_bar") } #' @export #' @method e_error_bar echarts4r -e_error_bar.echarts4r <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = 0, x_index = 0, +e_error_bar.echarts4r <- function(e, lower, upper, name = NULL, legend = FALSE, y_index = 0, x_index = 0, coord_system = "cartesian2d", ...) { if (missing(e)) { stop("must pass e", call. = FALSE) @@ -3651,7 +3651,7 @@ e_error_bar.echarts4r <- function(e, lower, upper, name = NULL, legend = TRUE, y #' @export #' @method e_error_bar echarts4rProxy -e_error_bar.echarts4rProxy <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = 0, x_index = 0, +e_error_bar.echarts4rProxy <- function(e, lower, upper, name = NULL, legend = FALSE, y_index = 0, x_index = 0, coord_system = "cartesian2d", ...) { if (missing(e)) { stop("must pass e", call. = FALSE) diff --git a/R/add_.R b/R/add_.R index 3ebc2bdf..0421bbf5 100644 --- a/R/add_.R +++ b/R/add_.R @@ -2128,8 +2128,17 @@ e_band_ <- function(e, min, max, stack = "confidence-band", symbol = c("none", " #' @rdname errorbar #' @export -e_error_bar_ <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = 0, x_index = 0, - coord_system = "cartesian2d", ...) { +#' comments on changes, by helgasoft.com +#' It's convenient to "attach" error bars to their related main bars +#' so they'll show/hide together when user clicks on the legend buttons. +#' This is done by having the same name for error and main bars. +#' Default legend = FALSE, since we'll have only main bars in legend. +#' Error bars will inherit color from their main bars, so it is preferable +#' to set a specific color, like e_error_bar(..., color='black'), which +#' is now set as default. See test code in renderer.js. + +e_error_bar_ <- function(e, lower, upper, name=NULL, legend=FALSE, y_index=0, x_index=0, + coord_system="cartesian2d", ...) { if (missing(e)) { stop("must pass e", call. = FALSE) } @@ -2139,8 +2148,12 @@ e_error_bar_ <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = } args <- list(...) - names(args) <- names(args) - + + # save series to be read by renderErrorBar2 + # renderers.js works in a very isolated environment, so we send data thru sessionStorage + renderJS <- htmlwidgets::JS(paste0("sessionStorage.setItem('ErrorBar.oss','", + jsonlite::toJSON(e$x$opts$series),"'); renderErrorBar2")) + for (i in 1:length(e$x$data)) { .build_data2(e$x$data[[i]], e$x$mapping$x, lower, upper) -> vector @@ -2168,7 +2181,7 @@ e_error_bar_ <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = nm <- name } else { nm <- .name_it(e, NULL, name, i) - nm <- paste(nm, "error") + # nm <- paste(nm, "error") # comm.out: now adopts main bar's name nm <- trimws(nm) } @@ -2177,21 +2190,23 @@ e_error_bar_ <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = type = "custom", yAxisIndex = y_index, xAxisIndex = x_index, - z = ifelse("z" %in% names(args), args$z, 3), + # z = ifelse("z" %in% names(args), args$z, 3), # comm.out: bug - adds extra 'z' coordinateSystem = coord_system, itemStyle = list( normal = list( borderWidth = 1.5 ) ), - renderItem = htmlwidgets::JS("renderErrorBar"), + renderItem = renderJS, encode = list( x = 0, y = list(1, 2) ), ... ) - + if (!("z" %in% names(args))) opts$z <- 3 # keep error bar in front + if (!("color" %in% names(args))) opts$color <- 'black' # set, or it will blend with main bar + e_serie <- append(e_serie, opts) if (isTRUE(legend)) { @@ -2214,21 +2229,22 @@ e_error_bar_ <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = type = "custom", yAxisIndex = y_index, xAxisIndex = x_index, - z = ifelse("z" %in% names(args), args$z, 3), coordinateSystem = coord_system, itemStyle = list( normal = list( borderWidth = 1.5 ) ), - renderItem = htmlwidgets::JS("renderErrorBar"), + renderItem = renderJS, encode = list( x = 0, y = list(1, 2) ), ... ) - + if (!("z" %in% names(args))) series_opts$z <- 3 + if (!("color" %in% names(args))) series_opts$color <- 'black' + if (isTRUE(legend)) { e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name)) } @@ -2240,7 +2256,7 @@ e_error_bar_ <- function(e, lower, upper, name = NULL, legend = TRUE, y_index = path <- system.file("htmlwidgets/lib/echarts-4.8.0/custom", package = "echarts4r") dep <- htmltools::htmlDependency( name = "echarts-renderers", - version = "1.0.0", + version = "1.0.1", src = c(file = path), script = "renderers.js" ) diff --git a/docs/reference/errorbar.html b/docs/reference/errorbar.html index 38e70251..79c17c3a 100644 --- a/docs/reference/errorbar.html +++ b/docs/reference/errorbar.html @@ -314,7 +314,7 @@

Error bar

lower, upper, name = NULL, - legend = TRUE, + legend = FALSE, y_index = 0, x_index = 0, coord_system = "cartesian2d", diff --git a/inst/htmlwidgets/lib/echarts-4.8.0/custom/renderers.js b/inst/htmlwidgets/lib/echarts-4.8.0/custom/renderers.js index 0334c784..a02597ae 100644 --- a/inst/htmlwidgets/lib/echarts-4.8.0/custom/renderers.js +++ b/inst/htmlwidgets/lib/echarts-4.8.0/custom/renderers.js @@ -1,4 +1,5 @@ // render error bars +// the original - works for non-grouped bars only function renderErrorBar(params, api) { var xValue = api.value(0); var highPoint = api.coord([xValue, api.value(1)]); @@ -35,3 +36,93 @@ function renderErrorBar(params, api) { }] }; } + + +/* + added support for grouped bars, barGap and barCategoryGap by helgasoft.com + To test in R: + grps <- 5; 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)) + df %>% group_by(Category) %>% + e_charts(Xaxis) %>% + e_bar(Yaxis) %>% #, barGap ='22%', barCategoryGap='55%') %>% + e_error_bar(Lower, Upper) %>% + e_datazoom(start = 50) +*/ +function renderErrorBar2(params, api) { + let oss = JSON.parse(sessionStorage.getItem('ErrorBar.oss')); + if (oss===null || !Object.keys(oss).length) return null; // cant work without it + + function findMax(xx) { + // find max barGap or barCategoryGap + // if caller is e_bar they are all the same, but could be different if caller is e_list + let out = null; + let tmp = oss.map(d => d[xx]).filter(d => d); + if (tmp.length > 0) { + tmp = Math.max(...tmp.map(d => Number(d[0].replace('%', ''))) ); + if (isFinite(tmp)) out = tmp + '%'; + } + return out; + } + + let xValue = api.value(0); + let highPoint = api.coord([xValue, api.value(1)]); + let lowPoint = api.coord([xValue, api.value(2)]); + let halfWidth = api.size([1, 0])[0] * 0.1; + + let csil = api.currentSeriesIndices().length; // always even + if (csil > 2) { + let bgm = findMax('barGap'); + let bcgm = findMax('barCategoryGap'); + let olay = { count: csil/2 }; + olay.barGap = bgm!==null ? bgm : '30%'; // '30%' is default for e_bar + olay.barCategoryGap = bcgm!==null ? bcgm : '20%'; + let barLayouts = api.barLayout(olay); + + let idx = params.seriesIndex - (params.seriesIndex { + if (item == idx) { + highPoint[0] += barLayouts[mbar].offsetCenter; + halfWidth = barLayouts[mbar].width /2; + } + mbar++; + }); + } + lowPoint[0] = highPoint[0]; + + var style = api.style({ + stroke: api.visual('color'), + fill: null + }); + return { + type: 'group', + children: [{ + type: 'line', + shape: { + x1: highPoint[0] - halfWidth, y1: highPoint[1], + x2: highPoint[0] + halfWidth, y2: highPoint[1] + }, + style: style + }, { + type: 'line', // vertical + shape: { + x1: highPoint[0], y1: highPoint[1], + x2: lowPoint[0], y2: lowPoint[1] + }, + style: style + }, { + type: 'line', + shape: { + x1: lowPoint[0] - halfWidth, y1: lowPoint[1], + x2: lowPoint[0] + halfWidth, y2: lowPoint[1] + }, + style: style + }] + }; +} diff --git a/man/errorbar.Rd b/man/errorbar.Rd index d10df811..416551e1 100644 --- a/man/errorbar.Rd +++ b/man/errorbar.Rd @@ -10,7 +10,7 @@ e_error_bar( lower, upper, name = NULL, - legend = TRUE, + legend = FALSE, y_index = 0, x_index = 0, coord_system = "cartesian2d", @@ -22,7 +22,7 @@ e_error_bar_( lower, upper, name = NULL, - legend = TRUE, + legend = FALSE, y_index = 0, x_index = 0, coord_system = "cartesian2d",