facets: fix add_line usage

This commit is contained in:
pvictor 2022-12-01 15:24:57 +01:00
parent 1e3ad8fcc8
commit 4cbf760e29
3 changed files with 53 additions and 12 deletions

View File

@ -42,6 +42,7 @@ apexchart <- function(ax_opts = list(),
preRenderHook = function(widget) {
widget$x$data <- NULL
widget$x$mapping <- NULL
widget$x$add_line <- NULL
add_locale_apex(widget)
},
sizingPolicy = htmlwidgets::sizingPolicy(

View File

@ -155,6 +155,14 @@ build_facets <- function(chart) {
byrow = TRUE
)
lrow <- get_last_row(grid)
facet_data_add_line <- if (!is.null(chart$x$add_line)) {
get_facets(
data = chart$x$add_line$data,
rows = chart$x$facet$facets_row,
cols = chart$x$facet$facets_col,
type = chart$x$facet$type
)$facets
}
facets <- lapply(
X = nums,
FUN = function(i) {
@ -187,6 +195,32 @@ build_facets <- function(chart) {
if (!is.null(new$x$colors_manual)) {
new <- ax_colors_manual(ax = new, values = new$x$colors_manual)
}
if (!is.null(facet_data_add_line)) {
maplinedata <- lapply(chart$x$add_line$mapping, eval_tidy, data = facet_data_add_line[[i]])
if (chart$x$facet$scales %in% c("fixed", "free_y") & chart$x$type %in% c("bar")) {
maplinedata <- complete_mapdata(maplinedata, mapall)
}
if (chart$x$facet$scales %in% c("fixed", "free_x") & chart$x$type %in% c("column")) {
maplinedata <- complete_mapdata(maplinedata, mapall)
}
new$x$ax_opts$series <- c(
new$x$ax_opts$series,
make_series(
mapdata = maplinedata,
mapping = chart$x$add_line$mapping,
type = chart$x$add_line$type,
serie_name = chart$x$add_line$serie_name,
force_datetime_names = c("x", "y")
)
)
# new <- add_line(
# ax = new,
# mapping = chart$x$add_line$mapping,
# data = facet_data_add_line[[i]],
# type = chart$x$add_line$type,
# serie_name = chart$x$add_line$serie_name
# )
}
new$height <- chart$x$facet$chart_height
new$x$facet <- NULL
class(new) <- setdiff(class(new), "apex_facet")

View File

@ -1,6 +1,6 @@
#' @title Add a line to a chart
#'
#'
#' @description Add a line to an existing chart (bar, scatter and line types supported).
#' On scatter charts you can also add a smooth line.
#'
@ -12,14 +12,14 @@
#' @param serie_name Name for the serie displayed in tooltip and legend.
#'
#' @export
#'
#'
#' @name add-line
#'
#' @example examples/mixed-charts.R
add_line <- function(ax,
mapping,
add_line <- function(ax,
mapping,
data = NULL,
type = c("line", "spline"),
type = c("line", "spline"),
serie_name = NULL) {
type <- match.arg(type)
if (!inherits(ax, "apex"))
@ -42,6 +42,12 @@ add_line <- function(ax,
ax$x$ax_opts$series,
make_series(mapdata, mapping, type, serie_name, force_datetime_names = c("x", "y"))
)
ax$x$add_line <- list(
data = data,
mapping = mapping,
type = type,
serie_name = serie_name
)
if (identical(apex_type, "scatter")) {
if (is.null(ax$x$ax_opts$markers$size)) {
ax$x$ax_opts$markers$size <- c(6, 0)
@ -78,14 +84,14 @@ add_line <- function(ax,
#' @param model Model to use between \code{\link{lm}} or \code{\link{loess}}.
#' @param n Number of points used for predictions.
#' @param ... Arguments passed to \code{model}.
#'
#'
#' @export
#'
#'
#' @importFrom stats lm loess predict
#' @importFrom rlang !! sym
#'
#'
#' @name add-line
add_smooth_line <- function(ax,
add_smooth_line <- function(ax,
formula = y ~ x,
model = c("lm", "loess"),
n = 100,
@ -115,14 +121,14 @@ add_smooth_line <- function(ax,
}
new_data <- data.frame(x = seq(
from = min(mapdata$x, na.rm = TRUE),
to = max(mapdata$x, na.rm = TRUE),
to = max(mapdata$x, na.rm = TRUE),
length.out = n
))
new_data$smooth <- predict(model_results, new_data)
add_line(
ax = ax,
mapping = aes(x = `!!`(sym("x")), y = `!!`(sym("smooth"))),
data = new_data,
mapping = aes(x = `!!`(sym("x")), y = `!!`(sym("smooth"))),
data = new_data,
type = type,
serie_name = serie_name
)