diff --git a/NAMESPACE b/NAMESPACE index d891882..3fa2164 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -9,6 +9,7 @@ export(add_line) export(add_point) export(add_shade) export(add_shade_weekend) +export(add_smooth_line) export(add_vline) export(aes) export(apex) @@ -72,11 +73,15 @@ importFrom(htmlwidgets,shinyWidgetOutput) importFrom(htmlwidgets,sizingPolicy) importFrom(jsonlite,fromJSON) importFrom(magrittr,"%>%") +importFrom(rlang,"!!") importFrom(rlang,as_label) importFrom(rlang,eval_tidy) importFrom(rlang,sym) importFrom(shiny,getDefaultReactiveDomain) importFrom(shiny,registerInputHandler) importFrom(shiny,shinyAppFile) +importFrom(stats,lm) +importFrom(stats,loess) +importFrom(stats,predict) importFrom(stats,setNames) importFrom(utils,modifyList) diff --git a/R/annotations.R b/R/annotations.R index 6bde72c..95ad572 100644 --- a/R/annotations.R +++ b/R/annotations.R @@ -345,7 +345,7 @@ add_event_marker <- function(ax, when, y, #' @return An \code{apexcharts} \code{htmlwidget} object. #' @export #' -#' @name add-lines +#' @name add-vh-lines #' #' @example examples/add-lines.R add_hline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) { @@ -362,7 +362,7 @@ add_hline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) { ) } #' @export -#' @rdname add-lines +#' @rdname add-vh-lines add_vline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) { add_annotation( ax = ax, diff --git a/R/apex.R b/R/apex.R index 982b704..857a7d9 100644 --- a/R/apex.R +++ b/R/apex.R @@ -95,6 +95,7 @@ apex <- function(data, mapping, type = "column", ..., ) } ax$x$data <- data + ax$x$mapping <- mapping class(ax) <- c(class(ax), "apex") return(ax) } diff --git a/R/apexcharter.R b/R/apexcharter.R index 612a473..b332067 100644 --- a/R/apexcharter.R +++ b/R/apexcharter.R @@ -37,6 +37,7 @@ apexchart <- function(ax_opts = list(), auto_update = TRUE, width = NULL, height elementId = elementId, preRenderHook = function(widget) { widget$x$data <- NULL + widget$x$mapping <- NULL add_locale_apex(widget) }, sizingPolicy = htmlwidgets::sizingPolicy( diff --git a/R/mixed-charts.R b/R/mixed-charts.R index c5248d0..5b5e155 100644 --- a/R/mixed-charts.R +++ b/R/mixed-charts.R @@ -1,5 +1,7 @@ -#' Add a line to a chart +#' @title Add a line to a chart +#' +#' @description On bar and scatter cherts add a line, on scatter charts add a smooth line. #' #' @param ax An \code{\link{apex}} \code{htmlwidget} object. #' @param mapping Default list of aesthetic mappings to use for chart. @@ -10,9 +12,15 @@ #' #' @return A \code{apexcharts} \code{htmlwidget} object. #' @export +#' +#' @name add-line #' #' @example examples/mixed-charts.R -add_line <- function(ax, mapping, data = NULL, type = c("line", "spline"), serie_name = NULL) { +add_line <- function(ax, + mapping, + data = NULL, + type = c("line", "spline"), + serie_name = NULL) { type <- match.arg(type) if (!inherits(ax, "apex")) stop("add_line: ax must have been created with apex() function.", call. = FALSE) @@ -47,7 +55,70 @@ add_line <- function(ax, mapping, data = NULL, type = c("line", "spline"), serie ax$x$ax_opts$stroke$width <- c(ax$x$ax_opts$stroke$width, 4) } } + if (identical(type, "line")) { + ax$x$ax_opts$stroke$curve <- "straight" + } else if (identical(type, "spline")) { + ax$x$ax_opts$stroke$curve <- "smooth" + } return(ax) } + + +#' @param formula Formula passed to the \code{method}, default to \code{y ~ x} from main aesthetics. +#' @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, + formula = y ~ x, + model = c("lm", "loess"), + n = 100, + ..., + type = c("line", "spline"), + serie_name = NULL) { + model <- match.arg(model) + type <- match.arg(type) + if (!inherits(ax, "apex")) + stop("add_smooth_line: ax must have been created with apex() function.", call. = FALSE) + if (is.null(ax$x$mixed_type)) { + apex_type <- ax$x$ax_opts$chart$type + ax$x$mixed_type <- apex_type + } else { + apex_type <- ax$x$mixed_type + } + if (!isTRUE(apex_type %in% c("scatter"))) + stop("add_smooth_line: apex() must be a scatter chart.", call. = FALSE) + ax$x$ax_opts$chart$type <- "line" + data <- as.data.frame(ax$x$data) + mapping <- ax$x$mapping + mapdata <- lapply(mapping, rlang::eval_tidy, data = data) + if (identical(model, "lm")) { + model_results <- lm(formula = formula, data = mapdata, ...) + } else if (identical(model, "loess")) { + model_results <- loess(formula = formula, data = mapdata, ...) + } + new_data <- data.frame(x = seq( + from = min(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, + type = type, + serie_name = serie_name + ) +} + + + diff --git a/examples/mixed-charts.R b/examples/mixed-charts.R index d95f079..4e0899a 100644 --- a/examples/mixed-charts.R +++ b/examples/mixed-charts.R @@ -33,6 +33,25 @@ apex(cars, aes(speed, dist), type = "scatter") %>% add_line(aes(x, y), data = lowess(cars), serie_name = "lowess") +# or directly +apex(cars, aes(speed, dist), type = "scatter") %>% + add_smooth_line() + +apex(cars, aes(speed, dist), type = "scatter") %>% + add_smooth_line(model = "loess", span = 1) + +apex(cars, aes(speed, dist), type = "scatter") %>% + add_smooth_line(model = "loess", degree = 1) + + +apex(cars, aes(speed, dist), type = "scatter") %>% + add_smooth_line(formula = y ~ poly(x, 2)) + +apex(cars, aes(speed, dist), type = "scatter") %>% + add_smooth_line(model = "lm", serie_name = "lm") %>% + add_smooth_line(model = "loess", serie_name = "loess") + + diff --git a/man/add_line.Rd b/man/add-line.Rd similarity index 57% rename from man/add_line.Rd rename to man/add-line.Rd index 65b1ed0..3da0969 100644 --- a/man/add_line.Rd +++ b/man/add-line.Rd @@ -1,7 +1,9 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/mixed-charts.R -\name{add_line} +\name{add-line} +\alias{add-line} \alias{add_line} +\alias{add_smooth_line} \title{Add a line to a chart} \usage{ add_line( @@ -11,6 +13,16 @@ add_line( type = c("line", "spline"), serie_name = NULL ) + +add_smooth_line( + ax, + formula = y ~ x, + model = c("lm", "loess"), + n = 100, + ..., + type = c("line", "spline"), + serie_name = NULL +) } \arguments{ \item{ax}{An \code{\link{apex}} \code{htmlwidget} object.} @@ -23,12 +35,20 @@ the \code{data.frame} provided in \code{apex()} will be used.} \item{type}{Type of line.} \item{serie_name}{Name for the serie displayed in tooltip and legend.} + +\item{formula}{Formula passed to the \code{method}, default to \code{y ~ x} from main aesthetics.} + +\item{model}{Model to use between \code{\link{lm}} or \code{\link{loess}}.} + +\item{n}{Number of points used for predictions.} + +\item{...}{Arguments passed to \code{model}.} } \value{ A \code{apexcharts} \code{htmlwidget} object. } \description{ -Add a line to a chart +On bar and scatter cherts add a line, on scatter charts add a smooth line. } \examples{ library(apexcharter) @@ -66,6 +86,25 @@ apex(cars, aes(speed, dist), type = "scatter") \%>\% add_line(aes(x, y), data = lowess(cars), serie_name = "lowess") +# or directly +apex(cars, aes(speed, dist), type = "scatter") \%>\% + add_smooth_line() + +apex(cars, aes(speed, dist), type = "scatter") \%>\% + add_smooth_line(model = "loess", span = 1) + +apex(cars, aes(speed, dist), type = "scatter") \%>\% + add_smooth_line(model = "loess", degree = 1) + + +apex(cars, aes(speed, dist), type = "scatter") \%>\% + add_smooth_line(formula = y ~ poly(x, 2)) + +apex(cars, aes(speed, dist), type = "scatter") \%>\% + add_smooth_line(model = "lm", serie_name = "lm") \%>\% + add_smooth_line(model = "loess", serie_name = "loess") + + diff --git a/man/add-lines.Rd b/man/add-vh-lines.Rd similarity index 97% rename from man/add-lines.Rd rename to man/add-vh-lines.Rd index 1227b41..a9f826d 100644 --- a/man/add-lines.Rd +++ b/man/add-vh-lines.Rd @@ -1,7 +1,7 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/annotations.R -\name{add-lines} -\alias{add-lines} +\name{add-vh-lines} +\alias{add-vh-lines} \alias{add_hline} \alias{add_vline} \title{Add horizontal or vertical line}