echarts_build <- function(e) {
e$x$data <- NULL
e$x$mapping <- NULL
ff <- getOption("ECHARTS4R_FONT_FAMILY")
if (!is.null(ff)) {
e <- e_text_style(e, fontFamily = ff)
}
e
}
#' Initialise
#'
#' Initialise a chart.
#'
#' @param data A \code{data.frame}.
#' @param e An object of class \code{echarts4r} as returned by \code{e_charts}.
#' @param x Column name containing x axis.
#' @param draw Whether to draw the chart, intended to be used with \code{\link{e_draw_p}}.
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
#' \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
#' string and have \code{'px'} appended.
#' @param elementId Id of element.
#' @param dispose Set to \code{TRUE} to force redraw of chart, set to \code{FALSE} to update.
#' @param renderer Renderer, takes \code{canvas} (default) or \code{svg}.
#' @param timeline Set to \code{TRUE} to build a timeline, see timeline section.
#' @param ... Any other argument.
#' @param reorder Set to \code{FALSE} to not reorder numeric x axis values.
#'
#' @section Details: The chart is created inside a parent \code{'<div>'}
#' element, the dimensions of which are controlled by the \code{'width'} and
#' \code{'height'} arguments. When these dimensions are small, it is possible
#' that the chart \code{'grid'} resizes to a size larger than the parent,
#' which might result in unexpected size given the input arguments. To disable
#' this automatic readjustment, define a static \code{\link{e_grid}} like the
#' following: \code{'e_grid(e = current_chart, top = 0, left = 20, right = 0,
#' bottom = 20)'}.
#'
#' @section Timeline: The timeline feature currently supports the following
#' chart types.
#' \itemize{
#' \item{\code{\link{e_bar}}}
#' \item{\code{\link{e_line}}}
#' \item{\code{\link{e_step}}}
#' \item{\code{\link{e_area}}}
#' \item{\code{\link{e_scatter}}}
#' \item{\code{\link{e_effect_scatter}}}
#' \item{\code{\link{e_candle}}}
#' \item{\code{\link{e_heatmap}}}
#' \item{\code{\link{e_pie}}}
#' \item{\code{\link{e_line_3d}}}
#' \item{\code{\link{e_lines_3d}}}
#' \item{\code{\link{e_bar_3d}}}
#' \item{\code{\link{e_lines}}}
#' \item{\code{\link{e_scatter_3d}}}
#' \item{\code{\link{e_scatter_gl}}}
#' \item{\code{\link{e_histogram}}}
#' \item{\code{\link{e_lm}}}
#' \item{\code{\link{e_loess}}}
#' \item{\code{\link{e_glm}}}
#' \item{\code{\link{e_density}}}
#' \item{\code{\link{e_pictorial}}}
#' \item{\code{\link{e_boxplot}}}
#' \item{\code{\link{e_map}}}
#' \item{\code{\link{e_map_3d}}}
#' \item{\code{\link{e_line_3d}}}
#' \item{\code{\link{e_gauge}}}
#' }
#'
#' @examples
#' mtcars |>
#' e_charts(qsec) |>
#' e_line(mpg)
#' @import htmlwidgets
#' @importFrom grDevices boxplot.stats
#' @importFrom grDevices colorRampPalette
#' @importFrom stats as.formula lm glm loess predict
#' @importFrom graphics hist
#'
#' @name init
#' @export
e_charts <- function(
data,
x,
width = NULL,
height = NULL,
elementId = NULL,
dispose = TRUE,
draw = TRUE,
renderer = "canvas",
timeline = FALSE,
...,
reorder = TRUE
) {
UseMethod("e_charts")
}
#' @rdname init
#' @export
e_charts.default <- function(
data,
x,
width = NULL,
height = NULL,
elementId = NULL,
dispose = TRUE,
draw = TRUE,
renderer = "canvas",
timeline = FALSE,
...,
reorder = TRUE
) {
xmap <- NULL
if (!missing(x)) {
xmap <- deparse(substitute(x))
}
# forward options using x
x <- list(
theme = "",
tl = timeline,
draw = draw,
renderer = tolower(renderer),
mapping = list(),
events = list(),
buttons = list(),
opts = list(
...,
yAxis = list(
list(show = TRUE)
)
)
)
if (!missing(data)) {
row.names(data) <- NULL
if (!is.null(xmap) && timeline == FALSE) {
data <- .arrange_data_x(data, xmap, reorder = reorder)
}
x$data <- map_grps_(data, timeline)
}
if (!is.null(xmap)) {
x$mapping$x <- xmap[1]
x$mapping$x_class <- class(data[[xmap]])
x <- .assign_axis(x, data)
}
if (isTRUE(timeline)) {
if (missing(data)) {
stop("timeline expects data", call. = FALSE)
}
if (!dplyr::is_grouped_df(data)) {
stop("must pass grouped data when timeline = TRUE", call. = FALSE)
}
if (!is.null(xmap)) {
x$data <- .arrange_data_by_group(x$data, xmap, reorder = reorder)
}
tl <- list(
baseOption = list(
yAxis = list(
list(show = TRUE)
)
),
options = purrr::map(1:dplyr::n_groups(data), function(x) list())
)
x$opts <- tl
x$opts$baseOption$timeline <- list(
data = as.list(names(x$data)),
axisType = "category",
...
)
if (!is.null(xmap)) {
x$mapping$x <- xmap[1]
x$mapping$x_class <- class(data[[xmap]])
x$mapping$include_x <- FALSE
cl <- x$mapping$x_class
if (any(c("character", "factor") %in% cl)) {
labs <- unique(data[[x$mapping$x]])
if (length(labs) == 1) {
labs <- list(labs)
}
x$opts$baseOption$xAxis <- list(list(data = labs, type = "category", boundaryGap = TRUE))
} else if (any(c("POSIXct", "POSIXlt", "Date") %in% cl)) {
labs <- unique(data[[x$mapping$x]])
if (length(labs) == 1) {
labs <- list(labs)
}
x$opts$baseOption$xAxis <- list(list(data = labs, type = "time", boundaryGap = TRUE))
} else {
x$mapping$include_x <- TRUE
x$opts$baseOption$xAxis <- list(list(type = "value"))
}
}
}
x$dispose <- dispose
# create widget
widget <- htmlwidgets::createWidget(
name = "echarts4r",
x,
width = width,
height = height,
package = "echarts4r",
elementId = elementId,
preRenderHook = echarts_build,
sizingPolicy = htmlwidgets::sizingPolicy(
defaultWidth = "100%",
knitr.figure = FALSE,
browser.fill = TRUE,
padding = 0
)
)
# check for theme
theme <- getOption("ECHARTS4R_THEME") # default theme
if (!is.null(theme)) {
widget <- e_theme(widget, theme)
}
return(widget)
}
#' @rdname init
#' @method e_charts Node
#' @export
e_charts.Node <- function(
data,
x,
width = NULL,
height = NULL,
elementId = NULL,
dispose = TRUE,
draw = TRUE,
renderer = "canvas",
timeline = FALSE,
...,
reorder = TRUE
) {
check_installed("data.tree")
json <- data.tree::ToListExplicit(data, unname = TRUE)
data <- json$children[[1]]$children
e_charts(
data,
x,
width = width,
height = height,
elementId = elementId,
dispose = dispose,
draw = draw,
renderer = renderer,
timeline = timeline,
...,
reorder = reorder
)
}
#' @rdname init
#' @export
e_charts_ <- function(
data,
x = NULL,
width = NULL,
height = NULL,
elementId = NULL,
dispose = TRUE,
draw = TRUE,
renderer = "canvas",
timeline = FALSE,
...,
reorder = TRUE
) {
xmap <- x
# forward options using x
x <- list(
theme = "",
tl = timeline,
draw = draw,
renderer = tolower(renderer),
mapping = list(),
events = list(),
buttons = list(),
opts = list(
...,
yAxis = list(
list(show = TRUE)
)
)
)
if (!missing(data)) {
row.names(data) <- NULL
if (!is.null(xmap) && timeline == FALSE) {
data <- .arrange_data_x(data, xmap, reorder = reorder)
}
x$data <- map_grps_(data, timeline)
}
if (!is.null(xmap)) {
x$mapping$x <- xmap[1]
x$mapping$x_class <- class(data[[xmap]])
x <- .assign_axis(x, data)
}
if (isTRUE(timeline)) {
if (missing(data)) {
stop("timeline expects data", call. = FALSE)
}
if (!dplyr::is_grouped_df(data)) {
stop("must pass grouped data when timeline = TRUE", call. = FALSE)
}
if (!is.null(xmap)) {
x$data <- .arrange_data_by_group(x$data, xmap, reorder = reorder)
}
tl <- list(
baseOption = list(
yAxis = list(
list(show = TRUE)
)
),
options = purrr::map(1:dplyr::n_groups(data), function(x) list())
)
x$opts <- tl
x$opts$baseOption$timeline <- list(
data = as.list(names(x$data)),
axisType = "category",
...
)
if (!is.null(xmap)) {
x$mapping$x <- xmap[1]
x$mapping$x_class <- class(data[[xmap]])
x$mapping$include_x <- FALSE
cl <- x$mapping$x_class
if (cl == "character" || cl == "factor") {
labs <- unique(data[[x$mapping$x]])
if (length(labs) == 1) {
labs <- list(labs)
}
x$opts$baseOption$xAxis <- list(list(data = labs, type = "category", boundaryGap = TRUE))
} else if (cl == "POSIXct" || cl == "POSIXlt" || cl == "Date") {
labs <- unique(data[[x$mapping$x]])
if (length(labs) == 1) {
labs <- list(labs)
}
x$opts$baseOption$xAxis <- list(list(data = labs, type = "time", boundaryGap = TRUE))
} else {
x$mapping$include_x <- TRUE
x$opts$baseOption$xAxis <- list(list(type = "value"))
}
}
}
x$dispose <- dispose
# create widget
widget <- htmlwidgets::createWidget(
name = "echarts4r",
x,
width = width,
height = height,
package = "echarts4r",
elementId = elementId,
preRenderHook = echarts_build,
sizingPolicy = htmlwidgets::sizingPolicy(
defaultWidth = "100%",
knitr.figure = FALSE,
browser.fill = TRUE,
padding = 0
)
)
# check for theme
theme <- getOption("ECHARTS4R_THEME") # default theme
if (!is.null(theme)) {
widget <- e_theme(widget, theme)
}
return(widget)
}
#' @rdname init
#' @export
e_chart <- e_charts
#' Add a dataset
#' This function can add one or more dataset into a echarts object.
#'
#' @examples
#' points <- mtcars[1:3, ]
#' mtcars |>
#' e_charts_("qsec") |>
#' e_line(mpg) |>
#' e_data(points, qsec) |>
#' e_scatter(mpg, color = "red", symbol_size = 20)
#' @rdname init
#' @export
e_data <- function(e, data, x) {
if (missing(data)) {
data <- e$x$data[[1]]
}
if (!missing(x)) {
xmap <- deparse(substitute(x))
}
if (!missing(x)) {
e$x$mapping$x <- xmap
e$x$mapping$x_class <- class(data[[xmap]])
e$x <- .assign_axis(e$x, data)
}
row.names(data) <- NULL
if (!missing(x)) {
data <- .arrange_data_x(data, xmap)
}
data <- map_grps_(data, FALSE)
e$x$data <- data
e
}
#' Shiny bindings for echarts4r
#'
#' Output and render functions for using echarts4r within Shiny
#' applications and interactive Rmd documents.
#'
#' @inheritParams init
#' @param outputId output variable to read from.
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
#' \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
#' string and have \code{'px'} appended.
#' @param expr An expression that generates a echarts4r
#' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable.
#' @param id Target chart id.
#' @param session Shiny session.
#'
#' @section Details: The chart is created inside a parent \code{'<div>'}
#' element, the dimensions of which are controlled by the \code{'width'} and
#' \code{'height'} arguments. When these dimensions are small, it is possible
#' that the chart \code{'grid'} resizes to a size larger than the parent,
#' which might result in unexpected size given the input arguments. To disable
#' this automatic readjustment, define a static \code{\link{e_grid}} like the
#' following: \code{'e_grid(e = current_chart, top = 0, left = 20, right = 0,
#' bottom = 20)'}.
#'
#' @section Callbacks:
#' \itemize{
#' \item{\code{id_brush}: returns data on brushed data points.}
#' \item{\code{id_legend_change}: returns series name of legend selected/unselected.}
#' \item{\code{id_clicked_data}: returns data of clicked data point.}
#' \item{\code{id_clicked_data_value}: returns value of clicked data point.}
#' \item{\code{id_clicked_row}: returns row number of clicked data point.}
#' \item{\code{id_clicked_serie}: returns name of serie of clicked data point.}
#' \item{\code{id_mouseover_data}: returns data on hovered data point.}
#' \item{\code{id_mouseover_data_value}: returns value of hovered data point.}
#' \item{\code{id_mouseover_row}: returns row o hovered data point.}
#' \item{\code{id_mouseover_serie}: returns name of serie of hovered data point.}
#' }
#'
#' @section Proxies:
#' The \code{echarts4rProxy} function returns a proxy for chart which allows
#' manipulating a drawn chart, adding data, adding or removing series, etc. without
#' redrawing the entire chart.
#'
#' \itemize{
#' \item{\code{\link{e_append1_p}} & \code{\link{e_append2_p}}}
#' \item{\code{\link{e_showtip_p}} & \code{\link{e_hidetip_p}}}
#' \item{\code{\link{e_highlight_p}} & \code{\link{e_downplay_p}}}
#' \item{\code{\link{e_focus_adjacency}} & \code{\link{e_unfocus_adjacency}}}
#' \item{\code{\link{e_dispatch_action_p}}}
#' \item{\code{\link{e_execute}}}
#' \item{\code{\link{e_remove_serie_p}}}
#' }
#'
#'
#' @name echarts4r-shiny
#'
#' @export
echarts4rOutput <- function(outputId, width = "100%", height = "400px") {
htmlwidgets::shinyWidgetOutput(outputId, "echarts4r", width, height, package = "echarts4r")
}
#' @rdname echarts4r-shiny
#' @export
renderEcharts4r <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) {
expr <- substitute(expr)
} # force quoted
htmlwidgets::shinyRenderWidget(expr, echarts4rOutput, env, quoted = TRUE)
}
#' @rdname echarts4r-shiny
#' @export
echarts4rProxy <- function(id, data, x, timeline = FALSE, session = shiny::getDefaultReactiveDomain(), reorder = TRUE) {
if (missing(data)) {
proxy <- list(id = id, session = session)
class(proxy) <- "echarts4rProxy"
return(proxy)
}
xmap <- NULL
if (!missing(x)) {
xmap <- deparse(substitute(x))
}
# forward options using x
x <- list(
theme = "",
tl = timeline,
draw = TRUE,
renderer = "canvas",
mapping = list(),
events = list(),
buttons = list(),
opts = list(
yAxis = list(
list(show = TRUE)
)
)
)
if (!missing(data)) {
row.names(data) <- NULL
if (!is.null(xmap)) {
data <- .arrange_data_x(data, xmap, reorder = reorder)
}
x$data <- map_grps_(data, timeline)
}
if (!is.null(xmap)) {
x$mapping$x <- xmap[1]
x$mapping$x_class <- class(data[[xmap]])
x <- .assign_axis(x, data)
}
if (isTRUE(timeline)) {
if (missing(data)) {
stop("timeline expects data", call. = FALSE)
}
if (!dplyr::is_grouped_df(data)) {
stop("must pass grouped data when timeline = TRUE", call. = FALSE)
}
if (!is.null(xmap)) {
x$data <- .arrange_data_by_group(x$data, xmap, reorder = reorder)
}
tl <- list(
baseOption = list(
yAxis = list(
list(show = TRUE)
)
),
options = purrr::map(1:dplyr::n_groups(data), function(x) list())
)
x$opts <- tl
x$opts$baseOption$timeline <- list(
data = as.list(names(x$data)),
axisType = "category"
)
if (!is.null(xmap)) {
x$mapping$x <- xmap[1]
x$mapping$x_class <- class(data[[xmap]])
x$mapping$include_x <- FALSE
cl <- x$mapping$x_class
if (cl == "character" || cl == "factor") {
labs <- unique(data[[x$mapping$x]])
if (length(labs) == 1) {
labs <- list(labs)
}
x$opts$baseOption$xAxis <- list(list(data = labs, type = "category", boundaryGap = TRUE))
} else if (cl == "POSIXct" || cl == "POSIXlt" || cl == "Date") {
labs <- unique(data[[x$mapping$x]])
if (length(labs) == 1) {
labs <- list(labs)
}
x$opts$baseOption$xAxis <- list(list(data = labs, type = "time", boundaryGap = TRUE))
} else {
x$mapping$include_x <- TRUE
x$opts$baseOption$xAxis <- list(list(type = "value"))
}
}
}
chart <- structure(list(x = x), class = c("echarts4r", class(x)))
proxy <- list(id = id, session = session, chart = chart)
class(proxy) <- "echarts4rProxy"
return(proxy)
}
#' @rdname echarts4r-shiny
#' @export
echarts4r_proxy <- echarts4rProxy
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.