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) {
|
preRenderHook = function(widget) {
|
||||||
widget$x$data <- NULL
|
widget$x$data <- NULL
|
||||||
widget$x$mapping <- NULL
|
widget$x$mapping <- NULL
|
||||||
|
widget$x$add_line <- NULL
|
||||||
add_locale_apex(widget)
|
add_locale_apex(widget)
|
||||||
},
|
},
|
||||||
sizingPolicy = htmlwidgets::sizingPolicy(
|
sizingPolicy = htmlwidgets::sizingPolicy(
|
||||||
|
|
34
R/facets.R
34
R/facets.R
|
@ -155,6 +155,14 @@ build_facets <- function(chart) {
|
||||||
byrow = TRUE
|
byrow = TRUE
|
||||||
)
|
)
|
||||||
lrow <- get_last_row(grid)
|
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(
|
facets <- lapply(
|
||||||
X = nums,
|
X = nums,
|
||||||
FUN = function(i) {
|
FUN = function(i) {
|
||||||
|
@ -187,6 +195,32 @@ build_facets <- function(chart) {
|
||||||
if (!is.null(new$x$colors_manual)) {
|
if (!is.null(new$x$colors_manual)) {
|
||||||
new <- ax_colors_manual(ax = new, values = 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$height <- chart$x$facet$chart_height
|
||||||
new$x$facet <- NULL
|
new$x$facet <- NULL
|
||||||
class(new) <- setdiff(class(new), "apex_facet")
|
class(new) <- setdiff(class(new), "apex_facet")
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
|
|
||||||
#' @title Add a line to a chart
|
#' @title Add a line to a chart
|
||||||
#'
|
#'
|
||||||
#' @description Add a line to an existing chart (bar, scatter and line types supported).
|
#' @description Add a line to an existing chart (bar, scatter and line types supported).
|
||||||
#' On scatter charts you can also add a smooth line.
|
#' 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.
|
#' @param serie_name Name for the serie displayed in tooltip and legend.
|
||||||
#'
|
#'
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @name add-line
|
#' @name add-line
|
||||||
#'
|
#'
|
||||||
#' @example examples/mixed-charts.R
|
#' @example examples/mixed-charts.R
|
||||||
add_line <- function(ax,
|
add_line <- function(ax,
|
||||||
mapping,
|
mapping,
|
||||||
data = NULL,
|
data = NULL,
|
||||||
type = c("line", "spline"),
|
type = c("line", "spline"),
|
||||||
serie_name = NULL) {
|
serie_name = NULL) {
|
||||||
type <- match.arg(type)
|
type <- match.arg(type)
|
||||||
if (!inherits(ax, "apex"))
|
if (!inherits(ax, "apex"))
|
||||||
|
@ -42,6 +42,12 @@ add_line <- function(ax,
|
||||||
ax$x$ax_opts$series,
|
ax$x$ax_opts$series,
|
||||||
make_series(mapdata, mapping, type, serie_name, force_datetime_names = c("x", "y"))
|
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 (identical(apex_type, "scatter")) {
|
||||||
if (is.null(ax$x$ax_opts$markers$size)) {
|
if (is.null(ax$x$ax_opts$markers$size)) {
|
||||||
ax$x$ax_opts$markers$size <- c(6, 0)
|
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 model Model to use between \code{\link{lm}} or \code{\link{loess}}.
|
||||||
#' @param n Number of points used for predictions.
|
#' @param n Number of points used for predictions.
|
||||||
#' @param ... Arguments passed to \code{model}.
|
#' @param ... Arguments passed to \code{model}.
|
||||||
#'
|
#'
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @importFrom stats lm loess predict
|
#' @importFrom stats lm loess predict
|
||||||
#' @importFrom rlang !! sym
|
#' @importFrom rlang !! sym
|
||||||
#'
|
#'
|
||||||
#' @name add-line
|
#' @name add-line
|
||||||
add_smooth_line <- function(ax,
|
add_smooth_line <- function(ax,
|
||||||
formula = y ~ x,
|
formula = y ~ x,
|
||||||
model = c("lm", "loess"),
|
model = c("lm", "loess"),
|
||||||
n = 100,
|
n = 100,
|
||||||
|
@ -115,14 +121,14 @@ add_smooth_line <- function(ax,
|
||||||
}
|
}
|
||||||
new_data <- data.frame(x = seq(
|
new_data <- data.frame(x = seq(
|
||||||
from = min(mapdata$x, na.rm = TRUE),
|
from = min(mapdata$x, na.rm = TRUE),
|
||||||
to = max(mapdata$x, na.rm = TRUE),
|
to = max(mapdata$x, na.rm = TRUE),
|
||||||
length.out = n
|
length.out = n
|
||||||
))
|
))
|
||||||
new_data$smooth <- predict(model_results, new_data)
|
new_data$smooth <- predict(model_results, new_data)
|
||||||
add_line(
|
add_line(
|
||||||
ax = ax,
|
ax = ax,
|
||||||
mapping = aes(x = `!!`(sym("x")), y = `!!`(sym("smooth"))),
|
mapping = aes(x = `!!`(sym("x")), y = `!!`(sym("smooth"))),
|
||||||
data = new_data,
|
data = new_data,
|
||||||
type = type,
|
type = type,
|
||||||
serie_name = serie_name
|
serie_name = serie_name
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue