196 lines
4.8 KiB
R
196 lines
4.8 KiB
R
|
|
#' Quick Apex Chart
|
|
#'
|
|
#' @param data Default dataset to use for chart. If not already a \code{data.frame}, it will be coerced to with \code{as.data.frame}.
|
|
#' @param mapping Default list of aesthetic mappings to use for chart
|
|
#' @param type Specify the chart type. Available Options: \code{"column"}, \code{"bar"}, \code{"line"},
|
|
#' \code{"area"}, \code{"spline"}, \code{"pie"}, \code{"donut"}, \code{"radialBar"}, \code{"radar"}, \code{"scatter"}, \code{"heatmap"}.
|
|
#' @param ... Other arguments passed on to methods. Not currently used.
|
|
#' @param auto_update In Shiny application, update existing chart rather than generating new one.
|
|
#' @param width A numeric input in pixels.
|
|
#' @param height A numeric input in pixels.
|
|
#' @param elementId Use an explicit element ID for the widget.
|
|
#'
|
|
#' @export
|
|
#'
|
|
#' @importFrom rlang eval_tidy as_label
|
|
#' @importFrom utils modifyList
|
|
#'
|
|
apex <- function(data, mapping, type = "column", ..., auto_update = TRUE, width = NULL, height = NULL, elementId = NULL) {
|
|
type <- match.arg(type, c("column", "bar", "line", "area", "spline", "area-spline",
|
|
"pie", "donut", "radialBar", "radar", "scatter", "heatmap"))
|
|
data <- as.data.frame(data)
|
|
mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
|
|
if (type %in% c("pie", "donut", "radialBar")) {
|
|
opts <- list(
|
|
chart = list(type = correct_type(type)),
|
|
series = list1(mapdata$y),
|
|
labels = list1(mapdata$x)
|
|
)
|
|
} else {
|
|
opts <- list(
|
|
chart = list(type = correct_type(type)),
|
|
series = make_series(mapdata, mapping, type)
|
|
)
|
|
}
|
|
opts <- modifyList(opts, choose_config(type, mapdata))
|
|
apexchart(
|
|
ax_opts = opts, width = width, height = height,
|
|
elementId = elementId, auto_update = auto_update
|
|
)
|
|
}
|
|
|
|
|
|
# Construct series
|
|
make_series <- function(mapdata, mapping, type) {
|
|
mapdata <- as.data.frame(mapdata)
|
|
series_names <- "Series"
|
|
if (is_x_datetime(mapdata)) {
|
|
add_names <- FALSE
|
|
} else {
|
|
add_names <- names(mapping)
|
|
}
|
|
if (!is.null(mapping$y))
|
|
series_names <- rlang::as_label(mapping$y)
|
|
series <- list(list(
|
|
name = series_names,
|
|
data = parse_df(mapdata, add_names = add_names)
|
|
))
|
|
if (is_grouped(names(mapping))) {
|
|
mapdata <- rename_aes(mapdata)
|
|
series <- lapply(
|
|
X = unique(mapdata$group),
|
|
FUN = function(x) {
|
|
data <- mapdata[mapdata$group %in% x, ]
|
|
data <- data[, setdiff(names(data), "group"), drop = FALSE]
|
|
list(
|
|
name = x,
|
|
data = parse_df(
|
|
data = data,
|
|
add_names = add_names
|
|
)
|
|
)
|
|
}
|
|
)
|
|
}
|
|
series
|
|
}
|
|
|
|
is_grouped <- function(x) {
|
|
any(c("colour", "fill", "group") %in% x)
|
|
}
|
|
|
|
rename_aes <- function(mapping) {
|
|
if ("colour" %in% names(mapping)) {
|
|
names(mapping)[names(mapping) == "colour"] <- "group"
|
|
}
|
|
if ("fill" %in% names(mapping)) {
|
|
names(mapping)[names(mapping) == "fill"] <- "group"
|
|
}
|
|
mapping
|
|
}
|
|
|
|
is_x_datetime <- function(mapdata) {
|
|
inherits(mapdata$x, what = c("Date", "POSIXt"))
|
|
}
|
|
list1 <- function(x) {
|
|
if (length(x) == 1) {
|
|
list(x)
|
|
} else {
|
|
x
|
|
}
|
|
}
|
|
|
|
|
|
# Change type of charts for helpers type
|
|
correct_type <- function(type) {
|
|
if (identical(type, "column")) {
|
|
"bar"
|
|
} else if (identical(type, "spline")) {
|
|
"line"
|
|
} else {
|
|
type
|
|
}
|
|
}
|
|
|
|
range_num <- function(x) {
|
|
if (is.numeric(x)) {
|
|
range(pretty(x))
|
|
} else {
|
|
NULL
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
# Switch between auto configs according to type & mapping
|
|
choose_config <- function(type, mapdata) {
|
|
datetime <- is_x_datetime(mapdata)
|
|
range_x <- range_num(mapdata$x)
|
|
range_y <- range_num(mapdata$y)
|
|
switch(
|
|
type,
|
|
"bar" = config_bar(horizontal = TRUE),
|
|
"column" = config_bar(horizontal = FALSE),
|
|
"line" = config_line(datetime = datetime),
|
|
"area" = config_line(datetime = datetime),
|
|
"spline" = config_line(curve = "smooth", datetime = datetime),
|
|
"scatter" = config_scatter(range_x = range_x, range_y = range_y),
|
|
list()
|
|
)
|
|
}
|
|
|
|
|
|
# Config for column & bar charts
|
|
config_bar <- function(horizontal = FALSE) {
|
|
config <- list(
|
|
dataLabels = list(enabled = FALSE),
|
|
plotOptions = list(
|
|
bar = list(
|
|
horizontal = horizontal
|
|
)
|
|
)
|
|
)
|
|
if (isTRUE(horizontal)) {
|
|
config <- c(config, list(
|
|
grid = list(
|
|
yaxis = list(lines = list(show = FALSE)),
|
|
xaxis = list(lines = list(show = TRUE))
|
|
)
|
|
))
|
|
}
|
|
config
|
|
}
|
|
|
|
# Config for line, spline, area, area-spline
|
|
config_line <- function(curve = "straight", datetime = FALSE) {
|
|
config <- list(
|
|
dataLabels = list(enabled = FALSE),
|
|
stroke = list(
|
|
curve = curve
|
|
)
|
|
)
|
|
if (isTRUE(datetime)) {
|
|
config <- c(config, list(
|
|
xaxis = list(type = "datetime")
|
|
))
|
|
}
|
|
config
|
|
}
|
|
|
|
|
|
config_scatter <- function(range_x, range_y) {
|
|
config <- list(
|
|
xaxis = list(
|
|
min = range_x[1], max = range_x[2]
|
|
),
|
|
yaxis = list(
|
|
min = range_y[1], max = range_y[2]
|
|
)
|
|
)
|
|
}
|
|
|
|
|
|
|