Robot
/
apexcharter
mirror of https://github.com/dreamRs/apexcharter.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

apex(): support for dumbbell charts

This commit is contained in:
Victor Perrier 2023-06-13 18:02:54 +02:00 committed by GitHub
parent 9baa753c3f
commit 44ead44178
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
1 changed files with 16 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
R/apex.R
View File

@ -14,7 +14,7 @@
#' `"pie"`, `"donut"`, #' `"pie"`, `"donut"`,
#' `"radialBar"`, `"radar"`, `"scatter"`, #' `"radialBar"`, `"radar"`, `"scatter"`,
#' `"heatmap"`, `"treemap"`, #' `"heatmap"`, `"treemap"`,
#' `"timeline"`. #' `"timeline"` and `"dumbbell"`.
#' @param ... Other arguments passed on to methods. Not currently used. #' @param ... Other arguments passed on to methods. Not currently used.
#' @param synchronize Give a common id to charts to synchronize them (tooltip and zoom). #' @param synchronize Give a common id to charts to synchronize them (tooltip and zoom).
#' @param serie_name Name for the serie displayed in tooltip, #' @param serie_name Name for the serie displayed in tooltip,
@ -43,6 +43,7 @@ apex <- function(data, mapping,
arg = type, arg = type,
choices = c( choices = c(
"column", "bar", "column", "bar",
"rangeBar", "dumbbell",
"line", "spline", "step", "line", "spline", "step",
"area", "area-spline", "area-step", "area", "area-spline", "area-step",
"rangeArea", "rangeArea",
@ -68,7 +69,8 @@ apex <- function(data, mapping,
type <- "bubble" type <- "bubble"
} }
mapdata <- lapply(mapping, rlang::eval_tidy, data = data) mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
if (is.null(mapdata$y) & !type %in% c("candlestick", "boxplot", "timeline", "heatmap", "rangeArea")) { type_no_compute <- c("candlestick", "boxplot", "timeline", "heatmap", "rangeArea", "rangeBar", "dumbbell")
if (is.null(mapdata$y) & !type %in% type_no_compute) {
mapdata <- compute_count(mapdata) mapdata <- compute_count(mapdata)
} }
if (type %in% c("pie", "donut", "radialBar", "polarArea")) { if (type %in% c("pie", "donut", "radialBar", "polarArea")) {
@ -134,6 +136,12 @@ make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL, force_
if (is.null(mapdata$group)) if (is.null(mapdata$group))
mapdata$group <- serie_name %||% rlang::as_label(mapping$x) mapdata$group <- serie_name %||% rlang::as_label(mapping$x)
series <- parse_timeline_data(mapdata) series <- parse_timeline_data(mapdata)
} else if (isTRUE(type %in% c("dumbbell"))) {
if (!all(c("y", "x", "xend") %in% names(mapping)))
stop("For dumbbell charts 'x', 'xend', and 'y' aesthetics must be provided.", call. = FALSE)
if (is.null(mapdata$group))
mapdata$group <- serie_name %||% rlang::as_label(mapping$x)
series <- parse_dumbbell_data(mapdata)
} else { } else {
mapdata <- as.data.frame(mapdata, stringsAsFactors = FALSE) mapdata <- as.data.frame(mapdata, stringsAsFactors = FALSE)
if (all(rlang::has_name(mapdata, c("ymin", "ymax")))) { if (all(rlang::has_name(mapdata, c("ymin", "ymax")))) {
@ -245,13 +253,13 @@ list1 <- function(x) {
# Change type of charts for helpers type # Change type of charts for helpers type
correct_type <- function(type) { correct_type <- function(type) {
if (identical(type, "column")) { if (isTRUE(type %in% c("column"))) {
"bar" "bar"
} else if (isTRUE(type %in% c("spline", "step"))) { } else if (isTRUE(type %in% c("spline", "step"))) {
"line" "line"
} else if (isTRUE(type %in% c("area-spline", "area-step"))) { } else if (isTRUE(type %in% c("area-spline", "area-step"))) {
"area" "area"
} else if (identical(type, "timeline")) { } else if (isTRUE(type %in% c("timeline", "dumbbell"))) {
"rangeBar" "rangeBar"
} else if (identical(type, "boxplot")) { } else if (identical(type, "boxplot")) {
"boxPlot" "boxPlot"
@ -319,6 +327,7 @@ choose_config <- function(type, mapdata) {
switch( switch(
type, type,
"bar" = config_bar(horizontal = TRUE), "bar" = config_bar(horizontal = TRUE),
"dumbbell" = config_bar(horizontal = TRUE, isDumbbell = TRUE),
"column" = config_bar(horizontal = FALSE, datetime = datetime), "column" = config_bar(horizontal = FALSE, datetime = datetime),
"line" = config_line(datetime = datetime), "line" = config_line(datetime = datetime),
"area" = config_line(datetime = datetime), "area" = config_line(datetime = datetime),
@ -338,12 +347,13 @@ choose_config <- function(type, mapdata) {
# Config for column & bar charts # Config for column & bar charts
config_bar <- function(horizontal = FALSE, datetime = FALSE) { config_bar <- function(horizontal = FALSE, datetime = FALSE, isDumbbell = FALSE) {
config <- list( config <- list(
dataLabels = list(enabled = FALSE), dataLabels = list(enabled = FALSE),
plotOptions = list( plotOptions = list(
bar = list( bar = list(
horizontal = horizontal horizontal = horizontal,
isDumbbell = isDumbbell
) )
), ),
tooltip = list( tooltip = list(