added add_smooth_line()
This commit is contained in:
parent
b487e92b70
commit
5aff3524a2
|
@ -9,6 +9,7 @@ export(add_line)
|
||||||
export(add_point)
|
export(add_point)
|
||||||
export(add_shade)
|
export(add_shade)
|
||||||
export(add_shade_weekend)
|
export(add_shade_weekend)
|
||||||
|
export(add_smooth_line)
|
||||||
export(add_vline)
|
export(add_vline)
|
||||||
export(aes)
|
export(aes)
|
||||||
export(apex)
|
export(apex)
|
||||||
|
@ -72,11 +73,15 @@ importFrom(htmlwidgets,shinyWidgetOutput)
|
||||||
importFrom(htmlwidgets,sizingPolicy)
|
importFrom(htmlwidgets,sizingPolicy)
|
||||||
importFrom(jsonlite,fromJSON)
|
importFrom(jsonlite,fromJSON)
|
||||||
importFrom(magrittr,"%>%")
|
importFrom(magrittr,"%>%")
|
||||||
|
importFrom(rlang,"!!")
|
||||||
importFrom(rlang,as_label)
|
importFrom(rlang,as_label)
|
||||||
importFrom(rlang,eval_tidy)
|
importFrom(rlang,eval_tidy)
|
||||||
importFrom(rlang,sym)
|
importFrom(rlang,sym)
|
||||||
importFrom(shiny,getDefaultReactiveDomain)
|
importFrom(shiny,getDefaultReactiveDomain)
|
||||||
importFrom(shiny,registerInputHandler)
|
importFrom(shiny,registerInputHandler)
|
||||||
importFrom(shiny,shinyAppFile)
|
importFrom(shiny,shinyAppFile)
|
||||||
|
importFrom(stats,lm)
|
||||||
|
importFrom(stats,loess)
|
||||||
|
importFrom(stats,predict)
|
||||||
importFrom(stats,setNames)
|
importFrom(stats,setNames)
|
||||||
importFrom(utils,modifyList)
|
importFrom(utils,modifyList)
|
||||||
|
|
|
@ -345,7 +345,7 @@ add_event_marker <- function(ax, when, y,
|
||||||
#' @return An \code{apexcharts} \code{htmlwidget} object.
|
#' @return An \code{apexcharts} \code{htmlwidget} object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
#' @name add-lines
|
#' @name add-vh-lines
|
||||||
#'
|
#'
|
||||||
#' @example examples/add-lines.R
|
#' @example examples/add-lines.R
|
||||||
add_hline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) {
|
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
|
#' @export
|
||||||
#' @rdname add-lines
|
#' @rdname add-vh-lines
|
||||||
add_vline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) {
|
add_vline <- function(ax, value, color = "#000", dash = 0, label = NULL, ...) {
|
||||||
add_annotation(
|
add_annotation(
|
||||||
ax = ax,
|
ax = ax,
|
||||||
|
|
1
R/apex.R
1
R/apex.R
|
@ -95,6 +95,7 @@ apex <- function(data, mapping, type = "column", ...,
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
ax$x$data <- data
|
ax$x$data <- data
|
||||||
|
ax$x$mapping <- mapping
|
||||||
class(ax) <- c(class(ax), "apex")
|
class(ax) <- c(class(ax), "apex")
|
||||||
return(ax)
|
return(ax)
|
||||||
}
|
}
|
||||||
|
|
|
@ -37,6 +37,7 @@ apexchart <- function(ax_opts = list(), auto_update = TRUE, width = NULL, height
|
||||||
elementId = elementId,
|
elementId = elementId,
|
||||||
preRenderHook = function(widget) {
|
preRenderHook = function(widget) {
|
||||||
widget$x$data <- NULL
|
widget$x$data <- NULL
|
||||||
|
widget$x$mapping <- NULL
|
||||||
add_locale_apex(widget)
|
add_locale_apex(widget)
|
||||||
},
|
},
|
||||||
sizingPolicy = htmlwidgets::sizingPolicy(
|
sizingPolicy = htmlwidgets::sizingPolicy(
|
||||||
|
|
|
@ -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 ax An \code{\link{apex}} \code{htmlwidget} object.
|
||||||
#' @param mapping Default list of aesthetic mappings to use for chart.
|
#' @param mapping Default list of aesthetic mappings to use for chart.
|
||||||
|
@ -11,8 +13,14 @@
|
||||||
#' @return A \code{apexcharts} \code{htmlwidget} object.
|
#' @return A \code{apexcharts} \code{htmlwidget} object.
|
||||||
#' @export
|
#' @export
|
||||||
#'
|
#'
|
||||||
|
#' @name add-line
|
||||||
|
#'
|
||||||
#' @example examples/mixed-charts.R
|
#' @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)
|
type <- match.arg(type)
|
||||||
if (!inherits(ax, "apex"))
|
if (!inherits(ax, "apex"))
|
||||||
stop("add_line: ax must have been created with apex() function.", call. = FALSE)
|
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)
|
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)
|
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
|
||||||
|
)
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -33,6 +33,25 @@ apex(cars, aes(speed, dist), type = "scatter") %>%
|
||||||
add_line(aes(x, y), data = lowess(cars), serie_name = "lowess")
|
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")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,9 @@
|
||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/mixed-charts.R
|
% Please edit documentation in R/mixed-charts.R
|
||||||
\name{add_line}
|
\name{add-line}
|
||||||
|
\alias{add-line}
|
||||||
\alias{add_line}
|
\alias{add_line}
|
||||||
|
\alias{add_smooth_line}
|
||||||
\title{Add a line to a chart}
|
\title{Add a line to a chart}
|
||||||
\usage{
|
\usage{
|
||||||
add_line(
|
add_line(
|
||||||
|
@ -11,6 +13,16 @@ add_line(
|
||||||
type = c("line", "spline"),
|
type = c("line", "spline"),
|
||||||
serie_name = NULL
|
serie_name = NULL
|
||||||
)
|
)
|
||||||
|
|
||||||
|
add_smooth_line(
|
||||||
|
ax,
|
||||||
|
formula = y ~ x,
|
||||||
|
model = c("lm", "loess"),
|
||||||
|
n = 100,
|
||||||
|
...,
|
||||||
|
type = c("line", "spline"),
|
||||||
|
serie_name = NULL
|
||||||
|
)
|
||||||
}
|
}
|
||||||
\arguments{
|
\arguments{
|
||||||
\item{ax}{An \code{\link{apex}} \code{htmlwidget} object.}
|
\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{type}{Type of line.}
|
||||||
|
|
||||||
\item{serie_name}{Name for the serie displayed in tooltip and legend.}
|
\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{
|
\value{
|
||||||
A \code{apexcharts} \code{htmlwidget} object.
|
A \code{apexcharts} \code{htmlwidget} object.
|
||||||
}
|
}
|
||||||
\description{
|
\description{
|
||||||
Add a line to a chart
|
On bar and scatter cherts add a line, on scatter charts add a smooth line.
|
||||||
}
|
}
|
||||||
\examples{
|
\examples{
|
||||||
library(apexcharter)
|
library(apexcharter)
|
||||||
|
@ -66,6 +86,25 @@ apex(cars, aes(speed, dist), type = "scatter") \%>\%
|
||||||
add_line(aes(x, y), data = lowess(cars), serie_name = "lowess")
|
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")
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -1,7 +1,7 @@
|
||||||
% Generated by roxygen2: do not edit by hand
|
% Generated by roxygen2: do not edit by hand
|
||||||
% Please edit documentation in R/annotations.R
|
% Please edit documentation in R/annotations.R
|
||||||
\name{add-lines}
|
\name{add-vh-lines}
|
||||||
\alias{add-lines}
|
\alias{add-vh-lines}
|
||||||
\alias{add_hline}
|
\alias{add_hline}
|
||||||
\alias{add_vline}
|
\alias{add_vline}
|
||||||
\title{Add horizontal or vertical line}
|
\title{Add horizontal or vertical line}
|
Loading…
Reference in New Issue