facets: title and subtitle
This commit is contained in:
parent
f91a6c69c6
commit
67680c48f3
46
R/facets.R
46
R/facets.R
|
@ -93,11 +93,32 @@ set_scale <- function(ax, values, scales = c("fixed", "free", "free_y", "free_x"
|
|||
return(ax)
|
||||
}
|
||||
|
||||
|
||||
get_option <- function(ax, opt1, opt2 = NULL) {
|
||||
if (is.null(opt2)) {
|
||||
ax$x$ax_opts[[opt1]]
|
||||
} else {
|
||||
ax$x$ax_opts[[opt1]][[opt2]]
|
||||
}
|
||||
}
|
||||
remove_option <- function(ax, opt1, opt2 = NULL) {
|
||||
if (is.null(opt2)) {
|
||||
ax$x$ax_opts[[opt1]] <- NULL
|
||||
} else {
|
||||
ax$x$ax_opts[[opt1]][[opt2]] <- NULL
|
||||
}
|
||||
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
|
||||
title <- get_option(chart, "title")
|
||||
chart <- remove_option(chart, "title")
|
||||
subtitle <- get_option(chart, "subtitle")
|
||||
chart <- remove_option(chart, "subtitle")
|
||||
facets_list <- get_facets(
|
||||
data = data,
|
||||
rows = chart$x$facet$facets_row,
|
||||
|
@ -163,7 +184,9 @@ build_facets <- function(chart) {
|
|||
nrow = facets_list$nrow,
|
||||
ncol = facets_list$ncol,
|
||||
label_row = facets_list$label_row,
|
||||
label_col = facets_list$label_col
|
||||
label_col = facets_list$label_col,
|
||||
title = title,
|
||||
subtitle = subtitle
|
||||
)
|
||||
}
|
||||
|
||||
|
@ -302,6 +325,27 @@ build_facet_tag <- function(x) {
|
|||
} else {
|
||||
stop("Facetting must be wrap or grid", call. = FALSE)
|
||||
}
|
||||
if (!is.null(facets$subtitle)) {
|
||||
TAG <- tagList(
|
||||
tags$div(
|
||||
class = "apexcharter-facet-subtitle",
|
||||
facets$subtitle$text,
|
||||
style = make_styles(facets$subtitle$style)
|
||||
),
|
||||
TAG
|
||||
)
|
||||
}
|
||||
if (!is.null(facets$title)) {
|
||||
TAG <- tagList(
|
||||
tags$div(
|
||||
class = "apexcharter-facet-title",
|
||||
facets$title$text,
|
||||
style = make_styles(facets$title$style)
|
||||
),
|
||||
TAG
|
||||
)
|
||||
}
|
||||
return(TAG)
|
||||
}
|
||||
|
||||
|
||||
|
|
33
R/utils.R
33
R/utils.R
|
@ -42,6 +42,19 @@ to_posix <- function(x) {
|
|||
}
|
||||
|
||||
|
||||
to_hyphen <- function(x) {
|
||||
tolower(gsub("([A-Z])", "-\\1", x))
|
||||
}
|
||||
|
||||
make_styles <- function(styles) {
|
||||
styles <- dropNulls(styles)
|
||||
if (length(styles) < 1)
|
||||
return(NULL)
|
||||
styles <- sprintf("%s:%s", to_hyphen(names(styles)), unlist(styles, use.names = FALSE))
|
||||
paste(styles, collapse = ";")
|
||||
}
|
||||
|
||||
|
||||
|
||||
#' Utility function to create ApexChart parameters JSON
|
||||
#'
|
||||
|
@ -50,18 +63,18 @@ to_posix <- function(x) {
|
|||
#' @param ... Arguments for the slot
|
||||
#'
|
||||
#' @return A \code{apexcharts} \code{htmlwidget} object.
|
||||
#'
|
||||
#'
|
||||
#' @importFrom utils modifyList
|
||||
#'
|
||||
#' @noRd
|
||||
.ax_opt <- function(ax, name, ...) {
|
||||
|
||||
|
||||
if (is.null(ax$x$ax_opts[[name]])) {
|
||||
ax$x$ax_opts[[name]] <- list(...)
|
||||
} else {
|
||||
ax$x$ax_opts[[name]] <- modifyList(
|
||||
x = ax$x$ax_opts[[name]],
|
||||
val = list(...),
|
||||
x = ax$x$ax_opts[[name]],
|
||||
val = list(...),
|
||||
keep.null = TRUE
|
||||
)
|
||||
}
|
||||
|
@ -81,13 +94,13 @@ to_posix <- function(x) {
|
|||
#'
|
||||
#' @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]] <- modifyList(
|
||||
x = ax$x$ax_opts[[name]],
|
||||
val = l,
|
||||
x = ax$x$ax_opts[[name]],
|
||||
val = l,
|
||||
keep.null = TRUE
|
||||
)
|
||||
}
|
||||
|
@ -109,17 +122,17 @@ 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"),
|
||||
|
|
|
@ -11,18 +11,27 @@
|
|||
}
|
||||
|
||||
.apexcharter-facet-col-label {
|
||||
background:#E6E6E6;
|
||||
background:#E6E6E6;
|
||||
text-align: center;
|
||||
font-weight: bold;
|
||||
font-weight: bold;
|
||||
line-height: 30px;
|
||||
}
|
||||
|
||||
.apexcharter-facet-row-label {
|
||||
background:#E6E6E6;
|
||||
text-align: center;
|
||||
background:#E6E6E6;
|
||||
text-align: center;
|
||||
font-weight: bold;
|
||||
writing-mode: vertical-rl;
|
||||
text-orientation: mixed;
|
||||
writing-mode: vertical-rl;
|
||||
text-orientation: mixed;
|
||||
line-height: 30px;
|
||||
}
|
||||
|
||||
|
||||
.apexcharter-facet-subtitle {
|
||||
font-family: Helvetica, Arial, sans-serif;
|
||||
}
|
||||
|
||||
.apexcharter-facet-title {
|
||||
font-family: Helvetica, Arial, sans-serif;
|
||||
}
|
||||
|
||||
|
|
Loading…
Reference in New Issue