Merge pull request #36 from dreamRs/facets
Adding facets with ax_facet_wrap()
This commit is contained in:
Victor Perrier
GitHub
commit
35472372cd
|
|
@ -1,5 +1,5 @@
|
|||
Package: apexcharter
|
||||
Version: 0.1.8
|
||||
Version: 0.1.8.900
|
||||
Title: Create Interactive Chart with the JavaScript 'ApexCharts' Library
|
||||
Description: Provides an 'htmlwidgets' interface to 'apexcharts.js'.
|
||||
'Apexcharts' is a modern JavaScript charting library to build interactive charts and visualizations with simple API.
|
||||
|
|
@ -15,6 +15,7 @@ LazyData: true
|
|||
ByteCompile: true
|
||||
Depends: R (>= 2.10)
|
||||
Imports:
|
||||
htmltools,
|
||||
htmlwidgets,
|
||||
magrittr,
|
||||
rlang,
|
||||
|
|
|
|||
21
NAMESPACE
21
NAMESPACE
|
|
@ -1,5 +1,6 @@
|
|||
# Generated by roxygen2: do not edit by hand
|
||||
|
||||
S3method(print,apex_facet)
|
||||
export("%>%")
|
||||
export(JS)
|
||||
export(add_event)
|
||||
|
|
@ -16,11 +17,13 @@ export(apex)
|
|||
export(apexchart)
|
||||
export(apexchartOutput)
|
||||
export(apexchartProxy)
|
||||
export(apexfacetOutput)
|
||||
export(ax_annotations)
|
||||
export(ax_chart)
|
||||
export(ax_colors)
|
||||
export(ax_colors_manual)
|
||||
export(ax_dataLabels)
|
||||
export(ax_facet_wrap)
|
||||
export(ax_fill)
|
||||
export(ax_grid)
|
||||
export(ax_labels)
|
||||
|
|
@ -52,10 +55,12 @@ export(format_date)
|
|||
export(format_num)
|
||||
export(heatmap_opts)
|
||||
export(label)
|
||||
export(label_value)
|
||||
export(parse_df)
|
||||
export(pie_opts)
|
||||
export(radialBar_opts)
|
||||
export(renderApexchart)
|
||||
export(renderApexfacet)
|
||||
export(renderSparkBox)
|
||||
export(run_demo_input)
|
||||
export(run_demo_sparkbox)
|
||||
|
|
@ -67,9 +72,17 @@ export(set_input_zoom)
|
|||
export(set_tooltip_fixed)
|
||||
export(sparkBoxOutput)
|
||||
export(spark_box)
|
||||
export(vars)
|
||||
importFrom(ggplot2,aes)
|
||||
importFrom(ggplot2,label_value)
|
||||
importFrom(ggplot2,vars)
|
||||
importFrom(htmltools,renderTags)
|
||||
importFrom(htmltools,resolveDependencies)
|
||||
importFrom(htmltools,tagList)
|
||||
importFrom(htmltools,tags)
|
||||
importFrom(htmlwidgets,JS)
|
||||
importFrom(htmlwidgets,createWidget)
|
||||
importFrom(htmlwidgets,getDependency)
|
||||
importFrom(htmlwidgets,shinyRenderWidget)
|
||||
importFrom(htmlwidgets,shinyWidgetOutput)
|
||||
importFrom(htmlwidgets,sizingPolicy)
|
||||
|
|
@ -78,11 +91,19 @@ importFrom(magrittr,"%>%")
|
|||
importFrom(rlang,"!!")
|
||||
importFrom(rlang,as_label)
|
||||
importFrom(rlang,eval_tidy)
|
||||
importFrom(rlang,is_function)
|
||||
importFrom(rlang,is_named)
|
||||
importFrom(rlang,is_null)
|
||||
importFrom(rlang,quos)
|
||||
importFrom(rlang,sym)
|
||||
importFrom(rlang,syms)
|
||||
importFrom(shiny,createRenderFunction)
|
||||
importFrom(shiny,createWebDependency)
|
||||
importFrom(shiny,exprToFunction)
|
||||
importFrom(shiny,getDefaultReactiveDomain)
|
||||
importFrom(shiny,registerInputHandler)
|
||||
importFrom(shiny,shinyAppFile)
|
||||
importFrom(shiny,uiOutput)
|
||||
importFrom(stats,complete.cases)
|
||||
importFrom(stats,lm)
|
||||
importFrom(stats,loess)
|
||||
|
|
|
|||
22
R/apex.R
22
R/apex.R
|
|
@ -105,6 +105,8 @@ apex <- function(data, mapping, type = "column", ...,
|
|||
}
|
||||
ax$x$data <- data
|
||||
ax$x$mapping <- mapping
|
||||
ax$x$type <- type
|
||||
ax$x$serie_name <- serie_name
|
||||
class(ax) <- c(class(ax), "apex")
|
||||
return(ax)
|
||||
}
|
||||
|
|
@ -253,7 +255,12 @@ multi_type <- function(x) {
|
|||
|
||||
range_num <- function(x) {
|
||||
if (is.numeric(x) & length(x) > 0) {
|
||||
range(pretty(x))
|
||||
p <- pretty(x)
|
||||
list(
|
||||
values = p,
|
||||
n = length(p) - 1,
|
||||
range = range(p)
|
||||
)
|
||||
} else {
|
||||
NULL
|
||||
}
|
||||
|
|
@ -340,17 +347,20 @@ config_scatter <- function(range_x, range_y, datetime = FALSE) {
|
|||
dataLabels = list(enabled = FALSE),
|
||||
xaxis = list(
|
||||
type = "numeric",
|
||||
min = range_x[1],
|
||||
max = range_x[2],
|
||||
min = range_x$range[1],
|
||||
max = range_x$range[2],
|
||||
tickAmount = range_x$n,
|
||||
# labels = list(formatter = format_num("~r")),
|
||||
crosshairs = list(
|
||||
show = TRUE,
|
||||
stroke = list(dashArray = 0)
|
||||
)
|
||||
),
|
||||
yaxis = list(
|
||||
min = range_y[1],
|
||||
max = range_y[2],
|
||||
decimalsInFloat = 3,
|
||||
min = range_y$range[1],
|
||||
max = range_y$range[2],
|
||||
tickAmount = range_y$n,
|
||||
labels = list(formatter = format_num("~r")),
|
||||
tooltip = list(
|
||||
enabled = TRUE
|
||||
)
|
||||
|
|
|
|||
|
|
@ -30,6 +30,18 @@ NULL
|
|||
#' @rdname apexcharter-exports
|
||||
NULL
|
||||
|
||||
#' @importFrom ggplot2 vars
|
||||
#' @name vars
|
||||
#' @export
|
||||
#' @rdname apexcharter-exports
|
||||
NULL
|
||||
|
||||
#' @importFrom ggplot2 label_value
|
||||
#' @name label_value
|
||||
#' @export
|
||||
#' @rdname apexcharter-exports
|
||||
NULL
|
||||
|
||||
#' @importFrom htmlwidgets JS
|
||||
#' @name JS
|
||||
#' @export
|
||||
|
|
|
|||
|
|
@ -0,0 +1,347 @@
|
|||
|
||||
#' @importFrom rlang eval_tidy
|
||||
get_facets <- function(data, vars) {
|
||||
byvars <- lapply(X = vars, FUN = eval_tidy, data = data)
|
||||
facets <- split(x = data, f = byvars, sep = "|__|")
|
||||
lapply(
|
||||
X = seq_along(facets),
|
||||
FUN = function(i) {
|
||||
facet <- facets[[i]]
|
||||
attr(facet, "keys") <- strsplit(
|
||||
x = names(facets)[i],
|
||||
split = "|__|", fixed = TRUE
|
||||
)[[1]]
|
||||
facet
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"), axis = c("x", "y")) {
|
||||
if (is.null(scales))
|
||||
return(ax)
|
||||
scales <- match.arg(scales)
|
||||
axis <- match.arg(axis)
|
||||
if (is.null(values))
|
||||
return(ax)
|
||||
if (inherits(values, c("numeric", "integer", "Date", "POSIXt"))) {
|
||||
range_vals <- range(pretty(values), na.rm = TRUE)
|
||||
} else {
|
||||
range_vals <- NULL
|
||||
}
|
||||
|
||||
fmt <- function(x, time = inherits(values, c("Date", "POSIXt"))) {
|
||||
if (is.null(x))
|
||||
return(NULL)
|
||||
if (time)
|
||||
x <- format_date(x)
|
||||
x
|
||||
}
|
||||
|
||||
fun_axis <- switch(
|
||||
axis,
|
||||
"x" = ax_xaxis,
|
||||
"y" = ax_yaxis
|
||||
)
|
||||
|
||||
if (scales == "fixed") {
|
||||
ax <- fun_axis(
|
||||
ax = ax,
|
||||
min = fmt(range_vals[1]),
|
||||
max = fmt(range_vals[2])
|
||||
)
|
||||
} else if (scales == "free") {
|
||||
ax <- fun_axis(
|
||||
ax = ax,
|
||||
min = character(0),
|
||||
max = character(0)
|
||||
)
|
||||
} else {
|
||||
ax <- fun_axis(
|
||||
ax = ax,
|
||||
min = fmt(range_vals[1]),
|
||||
max = fmt(range_vals[2])
|
||||
)
|
||||
if (scales == "free_x" & axis == "x") {
|
||||
ax <- fun_axis(
|
||||
ax = ax,
|
||||
min = character(0),
|
||||
max = character(0)
|
||||
)
|
||||
}
|
||||
if (scales == "free_y" & axis == "y") {
|
||||
ax <- fun_axis(
|
||||
ax = ax,
|
||||
min = character(0),
|
||||
max = character(0)
|
||||
)
|
||||
}
|
||||
}
|
||||
|
||||
return(ax)
|
||||
}
|
||||
|
||||
#' @importFrom rlang eval_tidy is_null is_function
|
||||
build_facets <- function(chart) {
|
||||
data <- chart$x$data
|
||||
mapall <- lapply(chart$x$mapping, eval_tidy, data = data)
|
||||
labeller <- chart$x$facet$labeller
|
||||
facets_data <- get_facets(data, chart$x$facet$facets)
|
||||
nums <- seq_along(facets_data)
|
||||
dims <- get_grid_dims(nums, nrow = chart$x$facet$nrow, ncol = chart$x$facet$ncol)
|
||||
grid <- matrix(
|
||||
data = c(
|
||||
nums,
|
||||
rep(NA, times = (dims$nrow * dims$ncol) - length(nums))
|
||||
),
|
||||
nrow = dims$nrow,
|
||||
ncol = dims$ncol,
|
||||
byrow = TRUE
|
||||
)
|
||||
lrow <- get_last_row(grid)
|
||||
lapply(
|
||||
X = nums,
|
||||
FUN = function(i) {
|
||||
new <- chart
|
||||
facet <- facets_data[[i]]
|
||||
if (!is_null(labeller) && is_function(labeller)) {
|
||||
keys <- attr(facet, "keys")
|
||||
new <- ax_title(new, text = labeller(keys))
|
||||
}
|
||||
mapdata <- lapply(chart$x$mapping, eval_tidy, data = facet)
|
||||
if (chart$x$facet$scales %in% c("fixed", "free_y") & chart$x$type %in% c("bar")) {
|
||||
mapdata <- complete_mapdata(mapdata, mapall)
|
||||
}
|
||||
if (chart$x$facet$scales %in% c("fixed", "free_x") & chart$x$type %in% c("column")) {
|
||||
mapdata <- complete_mapdata(mapdata, mapall)
|
||||
}
|
||||
new$x$ax_opts$series <- make_series(mapdata, chart$x$mapping, chart$x$type, chart$x$serie_name)
|
||||
new <- set_scale(new, mapall$x, scales = chart$x$facet$scales, axis = "x")
|
||||
new <- set_scale(new, mapall$y, scales = chart$x$facet$scales, axis = "y")
|
||||
if (chart$x$facet$scales %in% c("fixed", "free_x")) {
|
||||
new <- ax_yaxis(new, show = i %in% grid[, 1])
|
||||
}
|
||||
# if (chart$x$facet$scales %in% c("fixed", "free_y")) {
|
||||
# new <- ax_xaxis(new, labels = list(show = i %in% lrow), axisTicks = list(show = TRUE))
|
||||
# }
|
||||
if (chart$x$facet$scales %in% c("fixed", "free_y") & chart$x$type %in% c("bar", "column")) {
|
||||
new <- ax_xaxis(new, labels = list(show = i %in% lrow))
|
||||
}
|
||||
new$height <- chart$x$facet$chart_height
|
||||
new$x$facet <- NULL
|
||||
class(new) <- setdiff(class(new), "apex_facet")
|
||||
return(new)
|
||||
}
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
get_grid_dims <- function(content, nrow, ncol) {
|
||||
n <- length(content)
|
||||
if (is.null(nrow) & !is.null(ncol))
|
||||
nrow <- ceiling(n / ncol)
|
||||
if (!is.null(nrow) & is.null(ncol))
|
||||
ncol <- ceiling(n / nrow)
|
||||
if (is.null(nrow) & is.null(ncol)) {
|
||||
if (n %% 3 < 1) {
|
||||
ncol <- 3
|
||||
nrow <- ceiling(n / ncol)
|
||||
} else {
|
||||
ncol <- 2
|
||||
nrow <- ceiling(n / ncol)
|
||||
}
|
||||
}
|
||||
list(nrow = nrow, ncol = ncol)
|
||||
}
|
||||
|
||||
get_last_row <- function(mat) {
|
||||
apply(X = mat, MARGIN = 2, FUN = function(x) {
|
||||
x <- x[!is.na(x)]
|
||||
x[length(x)]
|
||||
})
|
||||
}
|
||||
|
||||
#' @importFrom htmltools tags
|
||||
build_grid <- function(content, nrow = NULL, ncol = NULL, col_gap = "0px", row_gap = "10px") {
|
||||
d <- get_grid_dims(content, nrow, ncol)
|
||||
tags$div(
|
||||
class = "apexcharter-facet-container",
|
||||
style = "display:-ms-grid; display: grid;",
|
||||
style = sprintf("-ms-grid-columns: repeat(%1$s, 1fr); grid-template-columns: repeat(%1$s, 1fr);", d$ncol),
|
||||
style = sprintf("-ms-grid-rows: repeat(%1$s, 1fr); grid-template-rows: repeat(%1$s, 1fr);", d$nrow),
|
||||
style = sprintf("grid-column-gap: %s;", col_gap),
|
||||
style = sprintf("grid-row-gap: %s;", row_gap),
|
||||
content
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Facet wrap for ApexCharts
|
||||
#'
|
||||
#' @param ax An \code{apexcharts} \code{htmlwidget} object.
|
||||
#' @param facets Variable(s) to use for facetting, wrapped in \code{vars(...)}.
|
||||
#' @param nrow,ncol Number of row and column in output matrix.
|
||||
#' @param scales Should scales be fixed (\code{"fixed"}, the default),
|
||||
#' free (\code{"free"}), or free in one dimension (\code{"free_x"}, \code{"free_y"})?
|
||||
#' @param labeller A function with one argument containing for each facet the value of the faceting variable.
|
||||
#' @param chart_height Individual chart height.
|
||||
#'
|
||||
#' @return An \code{apexcharts} \code{htmlwidget} object.
|
||||
#' @export
|
||||
#'
|
||||
#' @importFrom rlang quos syms
|
||||
#'
|
||||
#' @example examples/facet_wrap.R
|
||||
ax_facet_wrap <- function(ax,
|
||||
facets,
|
||||
nrow = NULL,
|
||||
ncol = NULL,
|
||||
scales = c("fixed", "free", "free_y", "free_x"),
|
||||
labeller = label_value,
|
||||
chart_height = "300px") {
|
||||
if (!inherits(ax, "apex"))
|
||||
stop("ax_facet_wrap only works with charts generated with apex()", call. = FALSE)
|
||||
scales <- match.arg(scales)
|
||||
if (is.character(facets))
|
||||
facets <- quos(!!!syms(facets))
|
||||
ax$x$facet <- list(
|
||||
facets = facets,
|
||||
nrow = nrow,
|
||||
ncol = ncol,
|
||||
scales = scales,
|
||||
labeller = labeller,
|
||||
chart_height = chart_height
|
||||
)
|
||||
class(ax) <- c("apex_facet", class(ax))
|
||||
return(ax)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Shiny -------------------------------------------------------------------
|
||||
|
||||
|
||||
#' @title Shiny bindings for faceting with apexcharter
|
||||
#'
|
||||
#' @description Output and render functions for using apexcharter faceting within Shiny
|
||||
#' applications and interactive Rmd documents.
|
||||
#'
|
||||
#' @param outputId output variable to read from
|
||||
#'
|
||||
#' @return An Apexcharts output that can be included in the application UI.
|
||||
#' @export
|
||||
#'
|
||||
#' @name apexcharter-shiny-facets
|
||||
#'
|
||||
#' @importFrom htmltools tagList
|
||||
#' @importFrom shiny uiOutput
|
||||
#' @importFrom htmlwidgets getDependency
|
||||
#'
|
||||
#' @example examples/facet-shiny.R
|
||||
apexfacetOutput <- function(outputId) {
|
||||
tagList(
|
||||
uiOutput(outputId = outputId),
|
||||
getDependency(name = "apexcharter", package = "apexcharter")
|
||||
)
|
||||
}
|
||||
|
||||
#' @param expr An expression that generates a apexcharter
|
||||
#' @param env The environment in which to evaluate \code{expr}.
|
||||
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
|
||||
#' is useful if you want to save an expression in a variable.
|
||||
#'
|
||||
#' @export
|
||||
#'
|
||||
#' @rdname apexcharter-shiny-facets
|
||||
#'
|
||||
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency
|
||||
#' @importFrom htmltools renderTags resolveDependencies
|
||||
renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) {
|
||||
func <- exprToFunction(expr, env, quoted)
|
||||
createRenderFunction(
|
||||
func = func,
|
||||
transform = function(result, shinysession, name, ...) {
|
||||
if (is.null(result) || length(result) == 0)
|
||||
return(NULL)
|
||||
if (!inherits(result, "apex_facet")) {
|
||||
stop(
|
||||
"renderApexfacet: 'expr' must return an apexcharter facet object.",
|
||||
call. = FALSE
|
||||
)
|
||||
}
|
||||
facets_charts <- build_facets(result)
|
||||
TAG <- build_grid(
|
||||
content = facets_charts,
|
||||
nrow = result$x$facet$nrow,
|
||||
ncol = result$x$facet$ncol
|
||||
)
|
||||
rendered <- renderTags(TAG)
|
||||
deps <- lapply(
|
||||
X = resolveDependencies(rendered$dependencies),
|
||||
FUN = createWebDependency
|
||||
)
|
||||
list(
|
||||
html = rendered$html,
|
||||
deps = deps
|
||||
)
|
||||
}, apexfacetOutput, list()
|
||||
)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Print methods -----------------------------------------------------------
|
||||
|
||||
#' @export
|
||||
print.apex_facet <- function(x, ...) {
|
||||
facets_charts <- build_facets(x)
|
||||
TAG <- build_grid(facets_charts, nrow = x$x$facet$nrow, ncol = x$x$facet$ncol)
|
||||
print(htmltools::browsable(TAG))
|
||||
}
|
||||
|
||||
knit_print.apex_facet <- function(x, ..., options = NULL) {
|
||||
facets_charts <- build_facets(x)
|
||||
TAG <- build_grid(facets_charts, nrow = x$x$facet$nrow, ncol = x$x$facet$ncol)
|
||||
knitr::knit_print(htmltools::browsable(TAG), options = options, ...)
|
||||
}
|
||||
|
||||
|
||||
|
||||
|
||||
# Complete ----------------------------------------------------------------
|
||||
|
||||
complete_mapdata <- function(mapdata, mapall) {
|
||||
data <- as.data.frame(mapdata)
|
||||
full_data <- data.frame(x = unique(mapall$x), stringsAsFactors = FALSE)
|
||||
full_data <- merge(
|
||||
x = full_data,
|
||||
y = data,
|
||||
by = "x",
|
||||
all.x = TRUE,
|
||||
sort = TRUE
|
||||
)
|
||||
full_data$y[is.na(full_data$y)] <- 0
|
||||
return(as.list(full_data))
|
||||
}
|
||||
|
||||
complete_data <- function(data, vars, fill_var, fill_value = 0) {
|
||||
full_data <- expand.grid(lapply(
|
||||
X = data[, vars],
|
||||
FUN = unique
|
||||
))
|
||||
full_data <- merge(
|
||||
x = full_data,
|
||||
y = data,
|
||||
by = vars,
|
||||
all.x = TRUE,
|
||||
sort = FALSE
|
||||
)
|
||||
full_data[[fill_var]][is.na(full_data[[fill_var]])] <- fill_value
|
||||
return(full_data)
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -15,7 +15,7 @@
|
|||
}
|
||||
return(value)
|
||||
}
|
||||
})
|
||||
}, force = TRUE)
|
||||
shiny::registerInputHandler("apex_datetime", function(data, ...) {
|
||||
if (is.null(data)) {
|
||||
NULL
|
||||
|
|
@ -35,4 +35,5 @@
|
|||
}
|
||||
}
|
||||
}, force = TRUE)
|
||||
register_s3_method("knitr", "knit_print", "apex_facet")
|
||||
}
|
||||
|
|
|
|||
35
R/utils.R
35
R/utils.R
|
|
@ -59,13 +59,13 @@ to_posix <- function(x) {
|
|||
if (is.null(ax$x$ax_opts[[name]])) {
|
||||
ax$x$ax_opts[[name]] <- list(...)
|
||||
} else {
|
||||
ax$x$ax_opts[[name]] <- utils::modifyList(
|
||||
ax$x$ax_opts[[name]] <- modifyList(
|
||||
x = ax$x$ax_opts[[name]],
|
||||
val = list(...),
|
||||
keep.null = TRUE
|
||||
)
|
||||
}
|
||||
|
||||
ax$x$ax_opts[[name]] <- dropNullsOrEmpty(ax$x$ax_opts[[name]])
|
||||
return(ax)
|
||||
}
|
||||
|
||||
|
|
@ -77,19 +77,21 @@ to_posix <- function(x) {
|
|||
#'
|
||||
#' @return A \code{apexcharts} \code{htmlwidget} object.
|
||||
#'
|
||||
#' @importFrom utils modifyList
|
||||
#'
|
||||
#' @noRd
|
||||
.ax_opt2 <- function(ax, name, l) {
|
||||
|
||||
if (is.null(ax$x$ax_opts[[name]])) {
|
||||
ax$x$ax_opts[[name]] <- l
|
||||
} else {
|
||||
ax$x$ax_opts[[name]] <- utils::modifyList(
|
||||
ax$x$ax_opts[[name]] <- modifyList(
|
||||
x = ax$x$ax_opts[[name]],
|
||||
val = l,
|
||||
keep.null = TRUE
|
||||
)
|
||||
}
|
||||
|
||||
ax$x$ax_opts[[name]] <- dropNullsOrEmpty(ax$x$ax_opts[[name]])
|
||||
return(ax)
|
||||
}
|
||||
|
||||
|
|
@ -100,4 +102,29 @@ to_posix <- function(x) {
|
|||
|
||||
|
||||
|
||||
# From vignette('knit_print', package = 'knitr')
|
||||
# and https://github.com/rstudio/htmltools/pull/108/files
|
||||
|
||||
register_s3_method <- function(pkg, generic, class, fun = NULL) { # nocov start
|
||||
stopifnot(is.character(pkg), length(pkg) == 1)
|
||||
stopifnot(is.character(generic), length(generic) == 1)
|
||||
stopifnot(is.character(class), length(class) == 1)
|
||||
|
||||
if (is.null(fun)) {
|
||||
fun <- get(paste0(generic, ".", class), envir = parent.frame())
|
||||
} else {
|
||||
stopifnot(is.function(fun))
|
||||
}
|
||||
|
||||
if (pkg %in% loadedNamespaces()) {
|
||||
registerS3method(generic, class, fun, envir = asNamespace(pkg))
|
||||
}
|
||||
|
||||
# Always register hook in case package is later unloaded & reloaded
|
||||
setHook(
|
||||
packageEvent(pkg, "onLoad"),
|
||||
function(...) {
|
||||
registerS3method(generic, class, fun, envir = asNamespace(pkg))
|
||||
}
|
||||
)
|
||||
} # nocov end
|
||||
|
|
|
|||
|
|
@ -0,0 +1,35 @@
|
|||
|
||||
library(shiny)
|
||||
library(htmltools)
|
||||
library(apexcharter)
|
||||
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts %>%
|
||||
subset(population_type == "Refugees (incl. refugee-like situations)") %>%
|
||||
transform(date = as.Date(paste0(year, "-01-01")))
|
||||
|
||||
|
||||
ui <- fluidPage(
|
||||
|
||||
tags$h2("Apexcharts Facets Example"),
|
||||
|
||||
apexfacetOutput("myfacet")
|
||||
|
||||
)
|
||||
|
||||
server <- function(input, output, session) {
|
||||
|
||||
output$myfacet <- renderApexfacet({
|
||||
apex(refugees, aes(date, n), type = "line") %>%
|
||||
ax_yaxis(tickAmount = 5) %>%
|
||||
ax_facet_wrap(vars(continent_origin))
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
if (interactive())
|
||||
shinyApp(ui, server)
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,90 @@
|
|||
library(apexcharter)
|
||||
|
||||
# Scatter ----
|
||||
|
||||
data("mpg", package = "ggplot2")
|
||||
|
||||
# Create facets
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(vars(drv))
|
||||
|
||||
# Change number of columns
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(vars(drv), ncol = 2)
|
||||
|
||||
# Free axis
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(vars(drv), ncol = 2, scales = "free")
|
||||
|
||||
# labels
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(
|
||||
vars(drv), ncol = 2,
|
||||
labeller = function(x) {
|
||||
switch(
|
||||
x,
|
||||
"f" = "front-wheel drive",
|
||||
"r" = "rear wheel drive",
|
||||
"4" = "4wd"
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
# Multiple variables
|
||||
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(vars(year, drv))
|
||||
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(
|
||||
vars(year, drv),
|
||||
labeller = function(x) {
|
||||
paste(x, collapse = " / ")
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Lines ----
|
||||
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts %>%
|
||||
subset(population_type == "Refugees (incl. refugee-like situations)") %>%
|
||||
transform(date = as.Date(paste0(year, "-01-01")))
|
||||
|
||||
|
||||
apex(refugees, aes(date, n), type = "line") %>%
|
||||
ax_yaxis(tickAmount = 5) %>%
|
||||
ax_facet_wrap(vars(continent_origin))
|
||||
|
||||
|
||||
|
||||
# Free y-axis and synchronize
|
||||
apex(refugees, aes(date, n), type = "line", synchronize = "my-id") %>%
|
||||
ax_yaxis(tickAmount = 5) %>%
|
||||
ax_xaxis(tooltip = list(enabled = FALSE)) %>%
|
||||
ax_tooltip(x = list(format = "yyyy")) %>%
|
||||
ax_facet_wrap(vars(continent_origin), scales = "free_y")
|
||||
|
||||
|
||||
|
||||
|
||||
# Bars ----
|
||||
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts %>%
|
||||
subset(year == 2017)
|
||||
|
||||
apex(refugees, aes(continent_origin, n), type = "column") %>%
|
||||
ax_yaxis(
|
||||
labels = list(
|
||||
formatter = format_num("~s")
|
||||
),
|
||||
tickAmount = 5
|
||||
) %>%
|
||||
ax_facet_wrap(vars(population_type), ncol = 2)
|
||||
|
||||
|
||||
|
|
@ -6,3 +6,6 @@
|
|||
box-shadow: 0 1px 28px -12px #3B4252;
|
||||
}
|
||||
|
||||
.apexcharter-facet-container > div {
|
||||
min-width: 0;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
dependencies:
|
||||
- name: apexcharts
|
||||
version: 3.22.2
|
||||
version: 3.22.3
|
||||
src: htmlwidgets/lib/apexcharts-3.22
|
||||
script: apexcharts.min.js
|
||||
- name: apexcharter-css
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -4,6 +4,8 @@
|
|||
\alias{apexcharter-exports}
|
||||
\alias{\%>\%}
|
||||
\alias{aes}
|
||||
\alias{vars}
|
||||
\alias{label_value}
|
||||
\alias{JS}
|
||||
\title{apexcharter exported operators and S3 methods}
|
||||
\description{
|
||||
|
|
|
|||
|
|
@ -0,0 +1,66 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/facets.R
|
||||
\name{apexcharter-shiny-facets}
|
||||
\alias{apexcharter-shiny-facets}
|
||||
\alias{apexfacetOutput}
|
||||
\alias{renderApexfacet}
|
||||
\title{Shiny bindings for faceting with apexcharter}
|
||||
\usage{
|
||||
apexfacetOutput(outputId)
|
||||
|
||||
renderApexfacet(expr, env = parent.frame(), quoted = FALSE)
|
||||
}
|
||||
\arguments{
|
||||
\item{outputId}{output variable to read from}
|
||||
|
||||
\item{expr}{An expression that generates a apexcharter}
|
||||
|
||||
\item{env}{The environment in which to evaluate \code{expr}.}
|
||||
|
||||
\item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This
|
||||
is useful if you want to save an expression in a variable.}
|
||||
}
|
||||
\value{
|
||||
An Apexcharts output that can be included in the application UI.
|
||||
}
|
||||
\description{
|
||||
Output and render functions for using apexcharter faceting within Shiny
|
||||
applications and interactive Rmd documents.
|
||||
}
|
||||
\examples{
|
||||
|
||||
library(shiny)
|
||||
library(htmltools)
|
||||
library(apexcharter)
|
||||
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts \%>\%
|
||||
subset(population_type == "Refugees (incl. refugee-like situations)") \%>\%
|
||||
transform(date = as.Date(paste0(year, "-01-01")))
|
||||
|
||||
|
||||
ui <- fluidPage(
|
||||
|
||||
tags$h2("Apexcharts Facets Example"),
|
||||
|
||||
apexfacetOutput("myfacet")
|
||||
|
||||
)
|
||||
|
||||
server <- function(input, output, session) {
|
||||
|
||||
output$myfacet <- renderApexfacet({
|
||||
apex(refugees, aes(date, n), type = "line") \%>\%
|
||||
ax_yaxis(tickAmount = 5) \%>\%
|
||||
ax_facet_wrap(vars(continent_origin))
|
||||
})
|
||||
|
||||
}
|
||||
|
||||
if (interactive())
|
||||
shinyApp(ui, server)
|
||||
|
||||
|
||||
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,128 @@
|
|||
% Generated by roxygen2: do not edit by hand
|
||||
% Please edit documentation in R/facets.R
|
||||
\name{ax_facet_wrap}
|
||||
\alias{ax_facet_wrap}
|
||||
\title{Facet wrap for ApexCharts}
|
||||
\usage{
|
||||
ax_facet_wrap(
|
||||
ax,
|
||||
facets,
|
||||
nrow = NULL,
|
||||
ncol = NULL,
|
||||
scales = c("fixed", "free", "free_y", "free_x"),
|
||||
labeller = label_value,
|
||||
chart_height = "300px"
|
||||
)
|
||||
}
|
||||
\arguments{
|
||||
\item{ax}{An \code{apexcharts} \code{htmlwidget} object.}
|
||||
|
||||
\item{facets}{Variable(s) to use for facetting, wrapped in \code{vars(...)}.}
|
||||
|
||||
\item{nrow, ncol}{Number of row and column in output matrix.}
|
||||
|
||||
\item{scales}{Should scales be fixed (\code{"fixed"}, the default),
|
||||
free (\code{"free"}), or free in one dimension (\code{"free_x"}, \code{"free_y"})?}
|
||||
|
||||
\item{labeller}{A function with one argument containing for each facet the value of the faceting variable.}
|
||||
|
||||
\item{chart_height}{Individual chart height.}
|
||||
}
|
||||
\value{
|
||||
An \code{apexcharts} \code{htmlwidget} object.
|
||||
}
|
||||
\description{
|
||||
Facet wrap for ApexCharts
|
||||
}
|
||||
\examples{
|
||||
library(apexcharter)
|
||||
|
||||
# Scatter ----
|
||||
|
||||
data("mpg", package = "ggplot2")
|
||||
|
||||
# Create facets
|
||||
apex(mpg, aes(displ, cty), type = "scatter") \%>\%
|
||||
ax_facet_wrap(vars(drv))
|
||||
|
||||
# Change number of columns
|
||||
apex(mpg, aes(displ, cty), type = "scatter") \%>\%
|
||||
ax_facet_wrap(vars(drv), ncol = 2)
|
||||
|
||||
# Free axis
|
||||
apex(mpg, aes(displ, cty), type = "scatter") \%>\%
|
||||
ax_facet_wrap(vars(drv), ncol = 2, scales = "free")
|
||||
|
||||
# labels
|
||||
apex(mpg, aes(displ, cty), type = "scatter") \%>\%
|
||||
ax_facet_wrap(
|
||||
vars(drv), ncol = 2,
|
||||
labeller = function(x) {
|
||||
switch(
|
||||
x,
|
||||
"f" = "front-wheel drive",
|
||||
"r" = "rear wheel drive",
|
||||
"4" = "4wd"
|
||||
)
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
# Multiple variables
|
||||
|
||||
apex(mpg, aes(displ, cty), type = "scatter") \%>\%
|
||||
ax_facet_wrap(vars(year, drv))
|
||||
|
||||
apex(mpg, aes(displ, cty), type = "scatter") \%>\%
|
||||
ax_facet_wrap(
|
||||
vars(year, drv),
|
||||
labeller = function(x) {
|
||||
paste(x, collapse = " / ")
|
||||
}
|
||||
)
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
# Lines ----
|
||||
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts \%>\%
|
||||
subset(population_type == "Refugees (incl. refugee-like situations)") \%>\%
|
||||
transform(date = as.Date(paste0(year, "-01-01")))
|
||||
|
||||
|
||||
apex(refugees, aes(date, n), type = "line") \%>\%
|
||||
ax_yaxis(tickAmount = 5) \%>\%
|
||||
ax_facet_wrap(vars(continent_origin))
|
||||
|
||||
|
||||
|
||||
# Free y-axis and synchronize
|
||||
apex(refugees, aes(date, n), type = "line", synchronize = "my-id") \%>\%
|
||||
ax_yaxis(tickAmount = 5) \%>\%
|
||||
ax_xaxis(tooltip = list(enabled = FALSE)) \%>\%
|
||||
ax_tooltip(x = list(format = "yyyy")) \%>\%
|
||||
ax_facet_wrap(vars(continent_origin), scales = "free_y")
|
||||
|
||||
|
||||
|
||||
|
||||
# Bars ----
|
||||
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts \%>\%
|
||||
subset(year == 2017)
|
||||
|
||||
apex(refugees, aes(continent_origin, n), type = "column") \%>\%
|
||||
ax_yaxis(
|
||||
labels = list(
|
||||
formatter = format_num("~s")
|
||||
),
|
||||
tickAmount = 5
|
||||
) \%>\%
|
||||
ax_facet_wrap(vars(population_type), ncol = 2)
|
||||
|
||||
|
||||
}
|
||||
|
|
@ -0,0 +1,69 @@
|
|||
---
|
||||
title: "Facets: grid of charts"
|
||||
output: rmarkdown::html_vignette
|
||||
vignette: >
|
||||
%\VignetteIndexEntry{facets}
|
||||
%\VignetteEngine{knitr::rmarkdown}
|
||||
%\VignetteEncoding{UTF-8}
|
||||
---
|
||||
|
||||
```{r, include = FALSE}
|
||||
options(rmarkdown.html_vignette.check_title = FALSE)
|
||||
knitr::opts_chunk$set(
|
||||
collapse = TRUE,
|
||||
comment = "#>"
|
||||
)
|
||||
```
|
||||
|
||||
```{r setup}
|
||||
library(apexcharter)
|
||||
```
|
||||
|
||||
|
||||
[](https://www.tidyverse.org/lifecycle/#experimental)
|
||||
|
||||
Create grid of charts with ApexCharts, currently it's possible to:
|
||||
|
||||
- create grids according to one or more variables
|
||||
- define number of columns and rows
|
||||
- define type of scale for x-axis and y-axis (fixed or free)
|
||||
- synchronize charts within the grid
|
||||
|
||||
Current limitations are :
|
||||
|
||||
- need specific render and output function in Shiny (`apexfacetOutput()` and `renderApexfacet()`)
|
||||
- x-axis always appear for scatter and line charts
|
||||
- x-axis labels can differ between charts even with fixed scale depending on the width of the chart and the formatter applied to labels
|
||||
- when scale on an axis is fixed, the chart with the axis don't have the exact same size than the other since the axis take space in the plotting area
|
||||
|
||||
|
||||
## Facet wrap
|
||||
|
||||
Create a grid of charts with `ax_facet_wrap()` :
|
||||
|
||||
```{r}
|
||||
data("mpg", package = "ggplot2")
|
||||
apex(mpg, aes(displ, cty), type = "scatter") %>%
|
||||
ax_facet_wrap(vars(drv), ncol = 2)
|
||||
```
|
||||
|
||||
|
||||
Synchronized line charts with free y-axis :
|
||||
|
||||
```{r}
|
||||
data("unhcr_ts")
|
||||
refugees <- unhcr_ts %>%
|
||||
subset(population_type == "Refugees (incl. refugee-like situations)") %>%
|
||||
transform(date = as.Date(paste0(year, "-01-01")))
|
||||
|
||||
apex(refugees, aes(date, n), type = "line", synchronize = "sync-it") %>%
|
||||
ax_yaxis(tickAmount = 5, labels = list(formatter = format_num("~s"))) %>%
|
||||
ax_xaxis(tooltip = list(enabled = FALSE)) %>%
|
||||
ax_tooltip(x = list(format = "yyyy")) %>%
|
||||
ax_facet_wrap(vars(continent_origin), scales = "free_y")
|
||||
```
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue