facets: fix add_line usage
This commit is contained in:
parent
1e3ad8fcc8
commit
4cbf760e29
|
@ -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(
|
||||
|
|
34
R/facets.R
34
R/facets.R
|
@ -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")
|
||||
|
|
|
@ -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
|
||||
)
|
||||
|
|
Loading…
Reference in New Issue