#' @export
ec_list_parse <- function (df) {
assertthat::assert_that(is.data.frame(df))
purrr::map_if(df, is.factor, as.character) %>%
tibble::as_tibble() %>%
rlist::list.parse() %>% setNames(NULL)
}
#' @export
validate_args <- function(name, lstargs) {
lstargsnn <- lstargs[which(names(lstargs) == "")]
lenlst <- length(lstargsnn)
if (lenlst != 0) {
chrargs <- lstargsnn %>%
unlist() %>%
as.character()
chrargs <- paste0("'", chrargs, "'", collapse = ", ")
txt <- ifelse(lenlst == 1, " is ", "s are ")
stop(chrargs, " argument", txt, "not named in ", paste0("ec_", name),
call. = FALSE)
}
}
## set ec options
.ec_opt = function(ec, opt_name, baseoption = FALSE, add = FALSE, ...){
assertthat::assert_that(is.echart(ec))
validate_args(opt_name, eval(substitute(alist(...))))
if(rlang::has_name(list(...), 'id')){
add = TRUE
}
if(!baseoption){
if (is.null(ec$x$opt[[opt_name]])) {
if(is.null(names(c(...)))){
ec$x$opt[[opt_name]] <- c(...)
}else{
ec$x$opt[[opt_name]] <- list(...)
}
}else{
if(length(ec$x$opt[[opt_name]]) == 0){
ec$x$opt[[opt_name]] <- list(...)
}else{
if(add == FALSE){
# if add == FALSE, change option
ec$x$opt[[opt_name]] <- rlist::list.merge(ec$x$opt[[opt_name]], list(...))
}else{
# if add == TRUE, add option
if(is.null(names(ec$x$opt[[opt_name]]))){
ec$x$opt[[opt_name]] <- append(ec$x$opt[[opt_name]], list(list(...)))
}else{
ec$x$opt[[opt_name]] <- append(list(ec$x$opt[[opt_name]]), list(list(...)))
}
}
}
}
}else{
if (is.null(ec$x$opt$baseOption[[opt_name]])) {
if(is.null(names(c(...)))){
ec$x$opt$baseOption[[opt_name]] <- list(...)
}else{
ec$x$opt$baseOption[[opt_name]] <- list(...)
}
}else{
if(add == FALSE){
ec$x$opt$baseOption[[opt_name]] <- rlist::list.merge(ec$x$opt$baseOption[[opt_name]], list(...))
}else{
if(is.null(names(ec$x$opt$baseOption[[opt_name]]))){
ec$x$opt$baseOption[[opt_name]] <- append(ec$x$opt$baseOption[[opt_name]], list(list(...)))
}else{
ec$x$opt$baseOption[[opt_name]] <- append(list(ec$x$opt$baseOption[[opt_name]]), list(list(...)))
}
}
}
}
ec %>%
ec_add_dependency()
}
.index_add <- function(index = NULL){
if(!is.null(index)){
TRUE
}else{
FALSE
}
}
ec_get_opt_ <- function(ec, opt = NULL, index = NULL, num = NULL){
assertthat::assert_that(is.echart(ec))
if(is.null(opt)) stop("opt cannot be NULL")
if(!is.character(opt)) stop("opt must be character")
if(length(opt) != 1) stop("the length opt must be 1")
if(nchar(opt) == 0) stop("the nchar op opt must be greater than 0")
# opt_char <- stringr::str_extract(opt, "(\\D)+")
opt_char <- stringr::str_extract(opt, "[a-z]+(3D)*")
# opt_num <- as.numeric(stringr::str_extract(opt, "(\\d)+"))
opt_num <- as.numeric(stringr::str_extract(opt, "([0-9])+$"))
if(!is.na(opt_num)){
num <- opt_num
}
if(is.null(ec$x$opt[[opt_char]])){
opt_ <- NULL
}else{
if(is.null(names(ec$x$opt[[opt_char]]))){
opt_length <- length(ec$x$opt[[opt_char]])
if(!is.null(index)){
id_index <- lapply(seq(length(ec$x$opt[[opt_char]])), function(x){
tmp <- ec$x$opt[[opt_char]][[x]][["id"]]
if(is.null(tmp)){tmp <- 0}
list(id_index = tmp)
})
id_index_ <- rlist::list.map(id_index, id_index == index)
id_index_match <- which(id_index_ == TRUE)
if(length(id_index_match) > 1){
stop(paste0("opt index = ", index, " have ", length(id_index_match), " opt"))
}else if(length(id_index_match) == 0){
opt_ <- NULL
}else{
opt_ <- ec$x$opt[[opt_char]][[id_index_match]]
}
return(opt_)
}
}else{
opt_length <- 0
if(!is.null(index)){
tmp <- "id" %in% names(ec$x$opt[[opt_char]])
if(!tmp){
opt_index = 0
}else{
opt_index <- ec$x$opt[[opt_char]][["id"]]
}
if(opt_index == index){
opt_ <- ec$x$opt[[opt_char]]
}else{
opt_ <- NULL
}
return(opt_)
}
}
if(!is.null(num)){
if(is.null(names(ec$x$opt[[opt_char]]))){
opt_length <- length(ec$x$opt[[opt_char]])
}else{
opt_length <- 1
}
if(num <= 0) stop("num must be greater than 0")
if(num > opt_length) stop("num must be less than or equal to the length of opt")
if(is.null(names(ec$x$opt[[opt_char]]))){
opt_ <- ec$x$opt[[opt_char]][[num]]
}else{
opt_ <- ec$x$opt[[opt_char]]
}
}else{
opt_ <- ec$x$opt[[opt_char]]
}
}
return(opt_)
}
#' Get echarter options
#'
#' @description Get echarter options
#'
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param opt Arguments, eg:series.type or series2.data
#' @param index The id of opt, if set \code{opt = series2, index = 0}, then select the opt by id.
#' @param num The num of opt. if opt = series2, then num = 2.
#'
#' @export
ec_get_opt <- function(ec, opt = NULL, index = NULL, num = NULL){
assertthat::assert_that(is.echart(ec))
if(is.null(opt)) stop("opt cannot be NULL")
if(!is.character(opt)) stop("opt must be character")
if(length(opt) != 1) stop("the length opt must be 1")
if(nchar(opt) == 0) stop("the nchar op opt must be greater than 0")
opt_split <- stringr::str_split(opt, "\\.")[[1]]
if(length(opt_split) > 2) stop("The '.' opt can only have one at most.")
if(any(nchar(opt_split) == 0)) stop("The '.' position in opt is incorrect.")
if(length(opt_split) == 1){
opt_ <- ec_get_opt_(ec, opt_split[1], index = index, num = num)
}else{
opt_1 <- ec_get_opt_(ec, opt_split[1], index = index, num = num)
if(is.null(opt_1)){
opt_ <- NULL
}else{
if(is.null(names(opt_1))){
opt_ <- lapply(seq(length(opt_1)), function(x) {
opt_1[[x]][[opt_split[2]]]
})
}else{
opt_ <- opt_1[[opt_split[2]]]
}
}
}
return(opt_)
}
#' @export
.get_seriesindex <- function(ec, serie){
assertthat::assert_that(is.echart(ec))
purrr::map(ec$x$opt$series, "name") %>%
unlist() %>%
grep(serie, .)
}
## basic component====
#' @export
ec_title <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "title", baseoption = baseoption, add = add, ...)
}
#' @export
ec_legend <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "legend", baseoption = baseoption, add = add, ...)
}
#' @export
ec_colors <- function(ec, colors, baseoption = FALSE) {
assertthat::assert_that(is.vector(colors))
if (length(colors) == 1)
colors <- list(colors)
if(!baseoption){
ec$x$opt$color <- colors
}else{
ec$x$opt$baseOption$color <- colors
}
ec
}
#' @export
ec_backgroundColor <- function(ec, colors, baseoption = FALSE) {
assertthat::assert_that(is.vector(colors))
if (length(colors) == 1)
colors <- list(colors)
if(!baseoption){
ec$x$opt$backgroundColor <- colors
}else{
ec$x$opt$baseOption$backgroundColor <- colors
}
ec
}
#' @export
ec_textStyle <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "textStyle", baseoption = baseoption, add = add, ...)
}
#' @export
ec_axisPointer <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "axisPointer", baseoption = baseoption, add = add, ...)
}
## Rectangular Coordinate====
#' grid
#'
#' @description Rectangular Coordinate
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the grid
#' (\url{https://echarts.apache.org/zh/option.html#grid}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_grid <- function(ec, ..., baseoption = FALSE, add = TRUE){
.ec_opt(ec, "grid", baseoption = baseoption, add = add, ...)
}
#' xAxis
#'
#' @description The x axis in Rectangular Coordinate
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the xAxis
#' (\url{https://echarts.apache.org/zh/option.html#xAxis}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_xAxis <- function (ec, ..., baseoption = FALSE, add = FALSE) {
add <- .index_add(list(...)$gridIndex)
.ec_opt(ec, "xAxis", baseoption = baseoption, add = add, ...)
}
#' yAxis
#'
#' @description The y axis in Rectangular Coordinate
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the yAxis
#' (\url{https://echarts.apache.org/zh/option.html#yAxis}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_yAxis <- function (ec, ..., baseoption = FALSE, add = FALSE) {
add <- .index_add(list(...)$gridIndex)
.ec_opt(ec, "yAxis", baseoption = baseoption, add = add, ...)
}
## Polar Coordinate====
#' polor
#'
#' @description Polar Coordinate.
#'
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the polor.
#' (\url{https://echarts.apache.org/zh/option.html#polar}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_polar <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "polar", baseoption = baseoption, add = add, ...)
}
#' angleAxis
#'
#' @description The angle axis in Polar Coordinate.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the angleAxis.
#' (\url{https://echarts.apache.org/zh/option.html#angleAxis}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_angleAxis <- function(ec, ..., baseoption = FALSE, add = FALSE){
add <- .index_add(list(...)$polarIndex)
.ec_opt(ec, "angleAxis", baseoption = baseoption, add = add, ...)
}
#' radiusAxis
#'
#' @description The Radial axis in Polar Coordinate.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the radiusAxis.
#' (\url{https://echarts.apache.org/zh/option.html#radiusAxis}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_radiusAxis <- function(ec, ..., baseoption = FALSE, add = FALSE){
add <- .index_add(list(...)$polarIndex)
.ec_opt(ec, "radiusAxis", baseoption = baseoption, add = add, ...)
}
## Radar Coordinate====
#' radar
#'
#' @description Radar Coordinate.
#'
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the radar
#' (\url{https://echarts.apache.org/zh/option.html#radar}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_radar <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "radar", baseoption = baseoption, add = add, ...)
}
## Parallel Coordinates====
#' parallel
#'
#' @description Parallel Coordinates
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the parallel
#' (\url{https://echarts.apache.org/zh/option.html#parallel}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_parallel <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "parallel", baseoption = baseoption, add = add, ...)
}
#' parallelAxis
#'
#' @description the coordinate axis for Parallel Coordinates.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the parallelAxis
#' (\url{https://echarts.apache.org/zh/option.html#parallelAxis}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_parallelAxis <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "parallelAxis", baseoption = baseoption, add = add, ...)
}
## Single Coordinates====
#' singleAxis
#'
#' @description An axis with a single dimension
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the singleAxis
#' (\url{https://echarts.apache.org/zh/option.html#singleAxis}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_singleAxis <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "singleAxis", baseoption = baseoption, add = add, ...)
}
## Calendar Coordinates====
#' calendar
#'
#' @description Calendar Coordinates
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the calendar
#' (\url{https://echarts.apache.org/zh/option.html#calendar}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_calendar <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "calendar", baseoption = baseoption, add = add, ...)
}
## Geographic Coordinates====
#' geo
#'
#' @description Geographic Coordinates
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the geo
#' (\url{https://echarts.apache.org/zh/option.html#geo}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_geo <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "geo", baseoption = baseoption, add = add, ...)
}
#' Register map
#'
#' @description Register a \href{geojson}{http://geojson.org/} map.
#'
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param mapName Name of map
#' @param geoJson \href{Geojson}{http://geojson.org/}.
#' @param specialAreas specialAreas
#'
#' @examples
#' library(dplyr)
#' data("USA_geojson", package = "echarter")
#'
#' USArrests_ <- USArrests %>%
#' dplyr::mutate(states = row.names(.))
#'
#' echart() %>%
#' ec_registerMap("USA", USA_geojson) %>%
#' ec_add_series(
#' type = 'map', mapType = 'USA',
#' data = USArrests_,
#' mapping = ecaes(name = states, value = Murder)) %>%
#' ec_visualMap(
#' calculable = TRUE,
#' min = 0, max = 20, text = c("high", "low"),
#' color = c('#d94e5d','#eac736')) %>%
#' ec_tooltip(trigger = 'item',formatter = '{b}: {c}')
#'
#' @export
ec_registerMap <- function(ec, mapName, geoJson, specialAreas = NULL){
ec$x$registerMap <- TRUE
ec$x$mapName <- mapName
ec$x$geoJSON <- geoJson
ec$x$specialAreas <- specialAreas
ec
}
## dataset====
#' dataset
#'
#' @description dataset for echarts, brings convenience in data management
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param data An R object like json, data.frame, matrix.
#' @param ... Additional arguments for the dataset
#' (\url{https://echarts.apache.org/zh/option.html#dataset}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_dataset <- function (ec, data, ..., baseoption = FALSE, add = FALSE) {
assertthat::assert_that(is.echart(ec))
if(rlang::has_name(list(...), 'id')){
id <- list(...)[['id']]
}else{
if(is.null(ec$x$opt$dataset)){
id <- 0
}else{
id <- ec$x$opt$dataset$id + 1
}
}
if(rlang::has_name(list(...), 'source')){
if(class(list(...)[['source']]) == "json"){
source <- list(...)[['source']]
dimensions <- NULL
}else{
source <- jsonlite::toJSON(setNames(list(...)[['source']], NULL))
if(rlang::has_name(list(...), 'dimensions')){
dimensions <- list(...)[['dimensions']]
}else{
dimensions <- colnames(list(...)[['source']])
}
}
}else{
if(class(data) == "json"){
source <- data
dimensions <- NULL
}else{
source <- jsonlite::toJSON(setNames(data, NULL))
if(rlang::has_name(list(...), 'dimensions')){
dimensions <- list(...)[['dimensions']]
}else{
dimensions <- colnames(data)
}
}
}
if(rlang::has_name(list(...), 'sourceHeader')){
sourceHeader <- list(...)[['sourceHeader']]
}else{
sourceHeader <- FALSE
}
.ec_opt(
ec, "dataset", baseoption = baseoption, add = add,
id = id, source = source, dimensions = dimensions,
sourceHeader = sourceHeader)
}
## others component====
#' mark
#'
#' @description Mark an point, line, area in echarts
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param markname The mark name, markPoint, markLine, markArea
#' @param ... Additional arguments for the mark.
#' markPoint see (\url{https://echarts.apache.org/zh/option.html#series-line.markPoint}).
#' markLine see (\url{https://echarts.apache.org/zh/option.html#series-line.markLine}).
#' markArea see (\url{https://echarts.apache.org/zh/option.html#series-line.markArea}).
#' @param serie The serie index of ec
#'
#' @rdname ec_mark
#'
#' @export
ec_mark <- function(ec, ..., markname = 'markPoint', serie = NULL){
assertthat::assert_that(is.echart(ec))
markArray <- c("markPoint", "markLine", "markArea")
if(!(markname %in% markArray)){
stop('markname must in markPoint,markLine,markArea!')
}
n <- length(ec$x$opt$series)
if(is.null(serie)){
index <- 1
}else{
if(is.character(serie)){
index <- .get_seriesindex(ec, serie)
}else{
if(serie > n)
stop('Index must less than or qeual to series number!')
index <- serie
}
}
mark <- list(...)
if(is.null(ec$x$opt$series[[index]][[markname]]))
ec$x$opt$series[[index]][[markname]] <- append(ec$x$opt$series[[index]][[markname]], mark)
else
ec$x$opt$series[[index]][[markname]]$data <- append(ec$x$opt$series[[index]][[markname]], list(mark$data))
ec
}
#'
#' @rdname ec_mark
#'
#' @export
ec_markPoint <- function(ec, ..., serie = NULL){
ec_mark(ec, ..., markname = 'markPoint', serie = NULL)
}
#'
#' @rdname ec_mark
#'
#' @export
ec_markLine <- function(ec, ..., serie = NULL){
ec_mark(ec, ..., markname = 'markLine', serie = NULL)
}
#'
#' @rdname ec_mark
#'
#' @export
ec_markArea <- function(ec, ..., serie = NULL){
ec_mark(ec, ..., markname = 'markArea', serie = NULL)
}
#' tooltip
#'
#' @description tooltip component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the tooltip
#' (\url{https://echarts.apache.org/zh/option.html#tooltip}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_tooltip <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "tooltip", baseoption = baseoption, add = add, ...)
}
#' toolbox
#'
#' @description toolbox component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the toolbox
#' (\url{https://echarts.apache.org/zh/option.html#toolbox}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_toolbox <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "toolbox", baseoption = baseoption, add = add, ...)
}
#' visualMap
#'
#' @description visualMap component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the visualMap
#' (\url{https://echarts.apache.org/zh/option.html#visualMap}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_visualMap <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "visualMap", baseoption = baseoption, add = add, ...)
}
#' dataZoom
#'
#' @description dataZoom component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the dataZoom
#' (\url{https://echarts.apache.org/zh/option.html#dataZoom}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_dataZoom <- function (ec, ..., baseoption = FALSE, add = FALSE) {
.ec_opt(ec, "dataZoom", baseoption = baseoption, add = add, ...)
}
#' graphic
#'
#' @description graphic component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the graphic
#' (\url{https://echarts.apache.org/zh/option.html#graphic}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_graphic <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "graphic", baseoption = baseoption, add = add, ...)
}
#' brush
#'
#' @description brush component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the brush
#' (\url{https://echarts.apache.org/zh/option.html#brush}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_brush <- function(ec, ..., baseoption = FALSE, add = FALSE){
.ec_opt(ec, "brush", baseoption = baseoption, add = add, ...)
}
#' timeline
#'
#' @description timeline component.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the timeline
#' (\url{https://echarts.apache.org/zh/option.html#timeline}).
#' @param baseoption default TRUE
#' @param add default FALSE
#'
#' @export
ec_timeline <- function(ec, ..., baseoption = TRUE, add = FALSE){
.ec_opt(ec, "timeline", baseoption = baseoption, add = add, ...)
}
#' options
#'
#' @description echarts options
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ecs An \code{echarter} object list.
#'
#' @export
ec_options <- function(ec, ecs){
assertthat::assert_that(is.echart(ec))
n = length(ecs)
if(n < 2L)
stop('At least 2 echarts object!')
if(any(sapply(ecs, function(a){!is.echart(a)})))
stop('All objects should be echarts object!')
options = lapply(ecs, function(a) a$x$opt)
ec$x$opt$options <- lapply(ecs, function(a) a$x$opt)
ec
}
#' timeline2
#'
#' @description timeline component.
#' @param ecs An \code{echarter} object list.
#' @param ... Additional arguments for the timeline
#' (\url{https://echarts.apache.org/zh/option.html#timeline}).
#'
#' @export
ec_timeline2 <- function(ecs, ...){
timeline_opt = list(...)
n = length(ecs)
if(n < 2L)
stop('At least 2 echarts object!')
if(any(sapply(ecs,function(a){!is.echart(a)})))
stop('All objects should be echarts object!')
options = lapply(ecs, function(a) a$x$opt)
if(is.null(timeline_opt$data)){
timeline_opt$data = 1:n
}
x = list(
opt = list(
baseOption = list(timeline = timeline_opt),
options = options),
theme = ecs[[1]]$x$theme,
dispose = ecs[[1]]$x$dispose,
renderer = ecs[[1]]$x$renderer)
ec = htmlwidgets::createWidget(
'echarter', x,
package = 'echarter', width = NULL, height = NULL
)
ec
}
#' media
#'
#' @description media component for responsive.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param query query
#' @param option default FALSE
#' @param add default TRUE
#'
#' @export
ec_media <- function(ec, query, option, baseoption = FALSE, add = TRUE){
.ec_opt(ec, "media", baseoption = FALSE, add = add, ...)
}
#' aria
#'
#' @description generating description for charts automatically.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/zh/option.html#aria}).
#' @param baseoption default FALSE
#' @param add default FALSE
#'
#' @export
ec_aria <- function(ec, ..., baseoption = FALSE, add = TRUE){
.ec_opt(ec, "aria", baseoption = FALSE, add = add, ...)
}
## series ====
#' series
#'
#' @description series.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the series
#' (\url{https://echarts.apache.org/zh/option.html#series}).
#' @examples
#' library(dplyr)
#' library(echarter)
#' weekDays <- c('Mon','Tues','Wed','Thurs','Fri','Sat','Sun')
#' echart() %>%
#' ec_xAxis(type = 'category', data = weekDays) %>%
#' ec_yAxis(type = 'value') %>%
#' ec_series(
#' type = 'line',
#' name = 'Apple',
#' data = as.integer(runif(7, 20,100)))
#'
#' echart() %>%
#' ec_xAxis(type = 'category', data = weekDays) %>%
#' ec_yAxis(type = 'value') %>%
#' ec_add_series(
#' type = 'line',
#' name = 'Apple',
#' data = as.integer(runif(7, 20,100)))
#'
#' dat <- data.frame(
#' saleNum = round(runif(21, 20, 100), 0),
#' fruit = c(rep("Apple", 7), rep("Pear", 7), rep("Banana", 7)),
#' weekDay = c(rep(weekDays,3)),
#' price = round(runif(21, 10, 20), 0),
#' stringsAsFactors = FALSE)
#'
#' dat_sp <- dat %>%
#' select(fruit, weekDay, saleNum) %>%
#' tidyr::spread(fruit, saleNum) %>%
#' arrange(match(weekDay, weekDays))
#'
#' echart() %>%
#' ec_xAxis(type = 'category', data = weekDays) %>%
#' ec_yAxis(type = 'value') %>%
#' ec_dataset(data = dat_sp) %>%
#' ec_series(
#' name = "Apple",
#' datasetIndex = 0,
#' type = 'line', encode = list(y = "Apple")) %>%
#' ec_series(
#' name = "Banana",
#' datasetIndex = 0,
#' type = 'line', encode = list(y = 2, tooltip = c(0, 3)))
#'
#' @export
ec_series <- function (ec, ..., baseoption = FALSE, add = TRUE) {
.ec_opt(ec, "series", baseoption = FALSE, add = TRUE, ...)
}
## gl component====
#' globe
#'
#' @description The component provides the drawing of the Earth and the coordinate system. The developer can display 3D Scatter, 3D Bubble, 3D Bar, 3D Lines on it.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#globe}).
#' @examples
#' library(dplyr)
#' data(dnb_land_ocean_ice, package = "echarter")
#'
#' echart() %>%
#' ec_globe(
#' show = TRUE,
#' shading = 'color',
#' environment = '#000', heightTexture = NULL,
#' globeOuterRadius = 100,
#' baseTexture = dnb_land_ocean_ice,
#' viewControl = list(
#' autoRotate = TRUE
#' )
#' )
#' @export
ec_globe <- function(ec, ...){
.ec_opt(ec, "globe", baseoption = FALSE, add = TRUE, ...)
}
#' geo3D
#'
#' @description The component can draw a 3D GeoJSON and coordinate system. Developers can display 3D Scatter, 3D Bubble, 3D Bar, 3D Lines on it.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#geo3D}).
#'
#' @export
ec_geo3D <- function(ec, ...){
.ec_opt(ec, "geo3D", baseoption = FALSE, add = TRUE, ...)
}
#' mapbox3D
#'
#' @description The component can draw a 3D GeoJSON and coordinate system. Developers can display 3D Scatter, 3D Bubble, 3D Bar, 3D Lines on it.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#mapbox3D}).
#'
#' @export
ec_mapbox3D <- function(ec, ...){
.ec_opt(ec, "mapbox3D", baseoption = FALSE, add = TRUE, ...)
}
#' grid3D
#'
#' @description 3D cartesian coordinate system component. It requires \code{ec_xAxis3D}, \code{ec_yAxis3D} and \code{ec_zAxis3D} axis components to be used together.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#grid3D}).
#' @examples
#' library(dplyr)
#' # https://echarts.apache.org/examples/zh/editor.html?c=bar3d-punch-card&gl=1
#' hours <- c('12a', '1a', '2a', '3a', '4a', '5a', '6a',
#' '7a', '8a', '9a','10a','11a',
#' '12p', '1p', '2p', '3p', '4p', '5p',
#' '6p', '7p', '8p', '9p', '10p', '11p')
#' days <- c('Saturday', 'Friday', 'Thursday',
#' 'Wednesday', 'Tuesday', 'Monday', 'Sunday')
#' data <- data.frame(
#' hours = rep(0:23, 7),
#' days = rep(0:6, 24),
#' value = round(runif(168,1,100), 0),
#' stringsAsFactors = FALSE)
#' echart() %>%
#' ec_grid3D(
#' show = TRUE, boxWidth = 200, boxDepth = 80) %>%
#' ec_xAxis3D(
#' show = TRUE, type = 'category',
#' data = hours) %>%
#' ec_yAxis3D(
#' show = TRUE, type = 'category',
#' data = days) %>%
#' ec_zAxis3D(
#' show = TRUE, type = 'value') %>%
#' ec_series(type = 'bar3D', data = as.matrix(data)) %>%
#' ec_visualMap(
#' max = 100,
#' inRange = list(
#' color = c('#313695', '#4575b4', '#74add1',
#' '#abd9e9', '#e0f3f8', '#ffffbf', '#fee090',
#' '#fdae61', '#f46d43', '#d73027', '#a50026')
#' )
#' )
#'
#' @export
ec_grid3D <- function(ec, ...){
.ec_opt(ec, "grid3D", baseoption = FALSE, add = TRUE, ...)
}
#' xAxis3D
#'
#' @description The X-axis in a 3D cartesian coordinate system.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#xAxis3D}).
#'
#' @export
ec_xAxis3D <- function(ec, ...){
.ec_opt(ec, "xAxis3D", baseoption = FALSE, add = TRUE, ...)
}
#' yAxis3D
#'
#' @description The Y-axis in a 3D cartesian coordinate system.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#yAxis3D}).
#'
#' @export
ec_yAxis3D <- function(ec, ...){
.ec_opt(ec, "yAxis3D", baseoption = FALSE, add = TRUE, ...)
}
#' zAxis3D
#'
#' @description The Z-axis in a 3D cartesian coordinate system.
#' @param ec An \code{echarter} object as returned by \code{\link{echart}}.
#' @param ... Additional arguments for the aria
#' (\url{https://echarts.apache.org/en/option-gl.html#zAxis3D}).
#'
#' @export
ec_zAxis3D <- function(ec, ...){
.ec_opt(ec, "zAxis3D", baseoption = FALSE, add = TRUE, ...)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.