echarts4r coverage - 93.10%

Files
Source

#' Bar and Line chart
#'
#' Add bar serie.
#'
#' @param e An \code{echarts4r} object as returned by \code{\link{e_charts}} or
#' a proxy as returned by \code{\link{echarts4rProxy}}.
#' @param serie Column name of serie to plot.
#' @param bind Binding between datasets, namely for use of \code{\link{e_brush}}.
#' @param name name of the serie.
#' @param legend Whether to add serie to legend.
#' @param ... Any other option to pass, check See Also section.
#' @param x_index,y_index Indexes of x and y axis.
#' @param coord_system Coordinate system to plot against.
#'
#' @note The bar serie expects the data on the x axis to be
#' \code{categorical} in R this means a \code{factor} or
#' \code{character}. If the data on the x axis is numeric
#' everything should work well in most cases but strange
#' behaviour may be observed.
#'
#' @examples
#' library(dplyr)
#'
#' mtcars |>
#'   tibble::rownames_to_column("model") |>
#'   mutate(total = mpg + qsec) |>
#'   arrange(desc(total)) |>
#'   e_charts(model) |>
#'   e_bar(mpg, stack = "grp") |>
#'   e_bar(qsec, stack = "grp")
#' @seealso \href{https://echarts.apache.org/en/option.html#series-bar}{Additional arguments}
#'
#' @rdname e_bar
#' @export
e_bar <- function(e, serie, bind, name = NULL, legend = TRUE, y_index = 0, x_index = 0, coord_system = "cartesian2d", ...) UseMethod("e_bar")


#' @method e_bar echarts4r
#' @export
e_bar.echarts4r <- function(e, serie, bind, name = NULL, legend = TRUE, y_index = 0, x_index = 0, coord_system = "cartesian2d", ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  sr <- deparse(substitute(serie))

  e_bar_(e, sr, bd, name, legend, y_index, x_index, coord_system, ...)
}

#' @method e_bar echarts4rProxy
#' @export
e_bar.echarts4rProxy <- function(e, serie, bind, name = NULL, legend = TRUE, y_index = 0, x_index = 0, coord_system = "cartesian2d", ...) {

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  sr <- deparse(substitute(serie))

  e$chart <- e_bar_(e$chart, sr, bd, name, legend, y_index, x_index, coord_system, ...)
  return(e)
}

#' Line
#'
#' Add line serie.
#'
#' @inheritParams e_bar
#' @param coord_system Coordinate system to plot against.
#'
#' @examples
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length) |>
#'   e_line(Sepal.Width) |>
#'   e_tooltip(trigger = "axis")
#'
#' # timeline
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_line(Sepal.Width) |>
#'   e_tooltip(trigger = "axis")
#' @seealso \href{https://echarts.apache.org/en/option.html#series-line}{Additional arguments}
#'
#' @rdname e_line
#' @export
e_line <- function(
    e,
    serie,
    bind,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) UseMethod("e_line")

#' @export
#' @method e_line echarts4r
e_line.echarts4r <- function(
    e,
    serie,
    bind,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  bd <- .get_bind(deparse(substitute(bind)))

  e_line_(e, serie, bd, name, legend, y_index, x_index, coord_system, ...)
}

#' @export
#' @method e_line echarts4rProxy
e_line.echarts4rProxy <- function(
    e,
    serie,
    bind,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  bd <- .get_bind(deparse(substitute(bind)))
  e$chart <- e_line_(e$chart, serie, bd, name, legend, y_index, x_index, coord_system, ...)
  return(e)
}

#' Area
#'
#' Add area serie. Note that this is NOT an unique series type. Rather, this
#' function is a shorthand for using `e_bar()` with `areaStyle = list()`
#' enabled.
#'
#' @inheritParams e_bar
#'
#' @examples
#' CO2 |>
#'   group_by(Plant) |>
#'   e_charts(conc) |>
#'   e_area(uptake) |>
#'   e_tooltip(trigger = "axis")
#'
#' # timeline
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_area(Sepal.Width) |>
#'   e_tooltip(trigger = "axis")
#' @seealso \href{https://echarts.apache.org/en/option.html#series-line}{Additional arguments}
#'
#' @rdname e_area
#' @export
e_area <- function(
    e,
    serie,
    bind,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) UseMethod("e_area")

#' @export
#' @method e_area echarts4r
e_area.echarts4r <- function(
    e,
    serie,
    bind,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  bd <- .get_bind(deparse(substitute(bind)))

  e_area_(e, serie, bd, name, legend, y_index, x_index, coord_system, ...)
}

#' @export
#' @method e_area echarts4rProxy
e_area.echarts4rProxy <- function(
    e,
    serie,
    bind,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_area_(e$chart, serie, bd, name, legend, y_index, x_index, coord_system, ...)
  return(e)
}

#' Step
#'
#' Add step serie.
#'
#' @inheritParams  e_bar
#' @param step Step type, one of \code{start}, \code{middle} or \code{end}.
#' @param fill Set to fill as area.
#'
#' @examples
#' USArrests |>
#'   tibble::rownames_to_column("State") |>
#'   e_charts(State) |>
#'   e_step(Murder, name = "Start", step = "start", fill = TRUE) |>
#'   e_step(Rape, name = "Middle", step = "middle") |>
#'   e_step(Assault, name = "End", step = "end") |>
#'   e_tooltip(trigger = "axis")
#'
#' # timeline
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_step(Sepal.Width) |>
#'   e_tooltip(trigger = "axis")
#' @seealso \href{https://echarts.apache.org/en/option.html#series-line}{Additional arguments}
#'
#' @rdname e_step
#' @export
e_step <- function(
    e,
    serie,
    bind,
    step = c("start", "middle", "end"),
    fill = FALSE,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  UseMethod("e_step")
}

#' @export
#' @method e_step echarts4r
e_step.echarts4r <- function(
    e,
    serie,
    bind,
    step = c("start", "middle", "end"),
    fill = FALSE,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  bd <- .get_bind(deparse(substitute(bind)))

  e_step_(e, serie, bd, step, fill, name, legend, y_index, x_index, coord_system = coord_system, ...)
}

#' @export
#' @method e_step echarts4rProxy
e_step.echarts4rProxy <- function(
    e,
    serie,
    bind,
    step = c("start", "middle", "end"),
    fill = FALSE,
    name = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_step_(e$chart, serie, bd, step, fill, name, legend, y_index, x_index, coord_system = coord_system, ...)
  return(e)
}

#' Scatter
#'
#' Add scatter serie.
#'
#' @inheritParams e_bar
#' @param size Column name containing size of points.
#' @param symbol The symbol to use, default to \code{NULL}, can also be \code{circle}, \code{rect},
#' \code{roundRect}, \code{triangle}, \code{diamond}, \code{pin}, \code{arrow}, or \code{none}.
#' @param symbol_size Size of points, either an integer or a vector of length 2,
#' if \code{size} is \emph{not} \code{NULL} or missing it is applied as a multiplier to \code{scale}.
#' @param scale A function that takes a vector of \code{numeric} and returns a vector of \code{numeric}
#' of the same length. You can disable the scaling by setting it to \code{NULL}.
#' @param coord_system Coordinate system to plot against, see examples.
#' @param rm_x,rm_y Whether to remove x and y axis, only applies if \code{coord_system} is not
#' set to \code{cartesian2d}.
#' @param x A vector of integers or numeric.
#' @param jitter_factor,jitter_amount Jitter points, passed to \code{jitter}. This is now deprecated since the upgrade to echarts v6.
#' Recommend using e_jitter().
#' @param scale_js the JavaScript scaling function.
#'
#' @section Scaling function: defaults to \code{e_scale} which is a basic function that rescales \code{size}
#' between 1 and 20 for that makes for decent sized points on the chart.
#'
#' @examples
#' # scaling
#' e_scale(c(1, 1000))
#'
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_scatter(wt, qsec)
#'
#' # custom function
#' my_scale <- function(x) scales::rescale(x, to = c(2, 50))
#'
#' echart <- mtcars |>
#'   e_charts(mpg) |>
#'   e_scatter(wt, qsec, scale = my_scale)
#'
#' echart
#'
#' # rescale color too
#' echart |>
#'   e_visual_map(wt, scale = my_scale)
#'
#' # or
#' echart |>
#'   e_visual_map(min = 2, max = 50)
#'
#' # disable scaling
#' mtcars |>
#'   e_charts(qsec) |>
#'   e_scatter(wt, mpg, scale = NULL)
#'
#' # jitter point
#' mtcars |>
#'   e_charts(cyl) |>
#'   e_scatter(wt, symbol_size = 5) |>
#'   e_scatter(wt, jitter_factor = 2, legend = FALSE)
#'
#' # examples
#' USArrests |>
#'   e_charts(Assault) |>
#'   e_scatter(Murder, Rape) |>
#'   e_effect_scatter(Rape, Murder, y_index = 1) |>
#'   e_grid(index = c(0, 1)) |>
#'   e_tooltip()
#'
#' iris |>
#'   e_charts_("Sepal.Length") |>
#'   e_scatter_(
#'     "Sepal.Width",
#'     symbol_size = c(8, 2),
#'     symbol = "rect"
#'   ) |>
#'   e_x_axis(min = 4)
#'
#' quakes |>
#'   e_charts(long) |>
#'   e_geo(
#'     roam = TRUE,
#'     boundingCoords = list(
#'       c(185, -10),
#'       c(165, -40)
#'     )
#'   ) |>
#'   e_scatter(lat, mag, coord_system = "geo") |>
#'   e_visual_map(min = 4, max = 6.5)
#'
#' # timeline
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Petal.Width, timeline = TRUE) |>
#'   e_scatter(Sepal.Width, Sepal.Length) |>
#'   e_tooltip(trigger = "axis")
#' @seealso \href{https://echarts.apache.org/en/option.html#series-scatter}{Additional arguments scatter},
#'  \href{https://echarts.apache.org/en/option.html#series-effectScatter}{Additional arguments for effect scatter}
#'
#' @rdname scatter
#' @export
e_scatter <- function(
    e,
    serie,
    size,
    bind,
    symbol = NULL,
    symbol_size = 1,
    scale = e_scale,
    scale_js = "function(data){ return data[3];}",
    name = NULL,
    coord_system = "cartesian2d",
    jitter_factor = 0,
    jitter_amount = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  UseMethod("e_scatter")
}

#' @export
#' @method e_scatter echarts4r
e_scatter.echarts4r <- function(
    e,
    serie,
    size,
    bind,
    symbol = NULL,
    symbol_size = 1,
    scale = e_scale,
    scale_js = "function(data){ return data[3];}",
    name = NULL,
    coord_system = "cartesian2d",
    jitter_factor = 0,
    jitter_amount = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))
  sz <- .get_size(deparse(substitute(size)))
  bd <- .get_bind(deparse(substitute(bind)))

  e_scatter_(
    e = e,
    serie = serie,
    size = sz,
    bind = bd,
    symbol = symbol,
    symbol_size = symbol_size,
    scale = scale,
    scale_js = scale_js,
    name = name,
    coord_system = coord_system,
    jitter_factor = jitter_factor,
    jitter_amount = jitter_amount,
    legend = legend,
    y_index = y_index,
    x_index = x_index,
    rm_x = rm_x,
    rm_y = rm_y,
    ...
  )
}

#' @export
#' @method e_scatter echarts4rProxy
e_scatter.echarts4rProxy <- function(
    e,
    serie,
    size,
    bind,
    symbol = NULL,
    symbol_size = 1,
    scale = e_scale,
    scale_js = "function(data){ return data[3];}",
    name = NULL,
    coord_system = "cartesian2d",
    jitter_factor = 0,
    jitter_amount = NULL,
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  sz <- .get_size(deparse(substitute(size)))
  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_scatter_(
    e = e$chart,
    serie = serie,
    size = sz,
    bind = bd,
    symbol = symbol,
    symbol_size = symbol_size,
    scale = scale,
    scale_js = scale_js,
    name = name,
    coord_system = coord_system,
    jitter_factor = jitter_factor,
    jitter_amount = jitter_amount,
    legend = legend,
    y_index = y_index,
    x_index = x_index,
    rm_x = rm_x,
    rm_y = rm_y,
    ...
  )

  return(e)
}

#' @rdname scatter
#' @export
e_effect_scatter <- function(
    e,
    serie,
    size,
    bind,
    symbol = NULL,
    symbol_size = 1,
    scale = e_scale,
    scale_js = "function(data){ return data[3];}",
    name = NULL,
    coord_system = "cartesian2d",
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  UseMethod("e_effect_scatter")
}

#' @export
#' @method e_effect_scatter echarts4r
e_effect_scatter.echarts4r <- function(
    e,
    serie,
    size,
    bind,
    symbol = NULL,
    symbol_size = 1,
    scale = e_scale,
    scale_js = "function(data){ return data[3];}",
    name = NULL,
    coord_system = "cartesian2d",
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  sz <- .get_size(deparse(substitute(size)))
  bd <- .get_bind(deparse(substitute(bind)))

  e_effect_scatter_(
    e,
    serie = serie,
    size = sz,
    bind = bd,
    symbol = symbol,
    symbol_size = symbol_size,
    scale = scale,
    scale_js = scale_js,
    name = name,
    coord_system,
    legend,
    y_index,
    x_index,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_effect_scatter echarts4rProxy
e_effect_scatter.echarts4rProxy <- function(
    e,
    serie,
    size,
    bind,
    symbol = NULL,
    symbol_size = 1,
    scale = e_scale,
    scale_js = "function(data){ return data[3];}",
    name = NULL,
    coord_system = "cartesian2d",
    legend = TRUE,
    y_index = 0,
    x_index = 0,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  sz <- .get_size(deparse(substitute(size)))
  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_effect_scatter_(
    e$chart,
    serie = serie,
    size = sz,
    bind = bd,
    symbol = symbol,
    symbol_size = symbol_size,
    scale = scale,
    scale_js = scale_js,
    name = name,
    coord_system,
    legend,
    y_index,
    x_index,
    rm_x,
    rm_y,
    ...
  )

  return(e)
}

#' Candlestick
#'
#' Add a candlestick chart.
#'
#' @inheritParams e_bar
#' @param opening,closing,low,high Stock prices.
#'
#' @examples
#' date <- c(
#'   "2017-01-01",
#'   "2017-01-02",
#'   "2017-01-03",
#'   "2017-01-04",
#'   "2017-03-05",
#'   "2017-01-06",
#'   "2017-01-07"
#' )
#'
#' stock <- data.frame(
#'   date = date,
#'   opening = c(200.60, 200.22, 198.43, 199.05, 203.54, 203.40, 208.34),
#'   closing = c(200.72, 198.85, 199.05, 203.73, 204.08, 208.11, 211.88),
#'   low = c(197.82, 198.07, 197.90, 198.10, 202.00, 201.50, 207.60),
#'   high = c(203.32, 200.67, 200.00, 203.95, 204.90, 208.44, 213.17)
#' )
#'
#' stock |>
#'   e_charts(date) |>
#'   e_candle(opening, closing, low, high) |>
#'   e_y_axis(min = 190, max = 220)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-candlestick}{Additional arguments}
#'
#' @rdname e_candle
#' @export
e_candle <- function(e, opening, closing, low, high, bind, name = "candle", legend = TRUE, ...) {
  UseMethod("e_candle")
  }

#' @export
#' @method e_candle echarts4r
e_candle.echarts4r <- function(e, opening, closing, low, high, bind, name = "candle", legend = TRUE, ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(opening) || missing(closing) || missing(low) || missing(high)) {
    stop("missing inputs", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e_candle_(
    e,
    deparse(substitute(opening)),
    deparse(substitute(closing)),
    deparse(substitute(low)),
    deparse(substitute(high)),
    bd,
    name,
    legend,
    ...
  )
}

#' @export
#' @method e_candle echarts4rProxy
e_candle.echarts4rProxy <- function(e, opening, closing, low, high, bind, name = "candle", legend = TRUE, ...) {

  if (missing(opening) || missing(closing) || missing(low) || missing(high)) {
    stop("missing inputs", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_candle_(
    e$chart,
    deparse(substitute(opening)),
    deparse(substitute(closing)),
    deparse(substitute(low)),
    deparse(substitute(high)),
    bd,
    name,
    legend,
    ...
  )

  return(e)
}

#' Radar
#'
#' Add a radar chart
#'
#' @inheritParams e_bar
#' @param max Maximum value.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#' @param radar A \code{list} of options to pass to the \code{radar}
#' rather than the serie, see \href{https://echarts.apache.org/en/option.html#radar}{official documentation}
#' alternatively, use the \code{\link{e_radar_opts}}.
#'
#' @examples
#' df <- data.frame(
#'   x = LETTERS[1:5],
#'   y = runif(5, 1, 5),
#'   z = runif(5, 3, 7)
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_radar(y, max = 7) |>
#'   e_radar(z) |>
#'   e_tooltip(trigger = "item")
#' @rdname e_radar
#' @export
e_radar <- function(
    e,
    serie,
    max = 100,
    name = NULL,
    legend = TRUE,
    rm_x = TRUE,
    rm_y = TRUE,
    ...,
    radar = list()) {
  UseMethod("e_radar")
}

#' @export
#' @method e_radar echarts4r
e_radar.echarts4r <- function(
    e,
    serie,
    max = 100,
    name = NULL,
    legend = TRUE,
    rm_x = TRUE,
    rm_y = TRUE,
    ...,
    radar = list()) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  serie <- deparse(substitute(serie))

  e_radar_(e, serie, max, name, legend, rm_x, rm_y, ..., radar = radar)
}

#' @export
#' @method e_radar echarts4rProxy
e_radar.echarts4rProxy <- function(
    e,
    serie,
    max = 100,
    name = NULL,
    legend = TRUE,
    rm_x = TRUE,
    rm_y = TRUE,
    ...,
    radar = list()) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  if(is.null(e$chart$x$mapping$x)){
    stop("provide x in echarts4rProxy")
  }

  serie <- deparse(substitute(serie))

  e$chart <- e_radar_(e$chart, serie, max, name, legend, rm_x, rm_y, ..., radar = radar)
  return(e)
}

#' Funnel
#'
#' Add a funnel.
#'
#' @param e An \code{echarts4r} object as returned by \code{\link{e_charts}}.
#' @param name name of the serie.
#' @param legend Whether to add serie to legend.
#' @param ... Any other option to pass to \code{bar} or \code{line} char types.
#' @param values,labels Values and labels of funnel.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @details No \code{bind} argument here, with a funnel \code{bind} = \code{labels}.
#'
#' @examples
#' funnel <- data.frame(
#'   stage = c("View", "Click", "Purchase"),
#'   value = c(80, 30, 20)
#' )
#'
#' funnel |>
#'   e_charts() |>
#'   e_funnel(value, stage)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-funnel}{Additional arguments}
#'
#' @rdname e_funnel
#' @export
e_funnel <- function(e, values, labels, name = NULL, legend = TRUE, rm_x = TRUE, rm_y = TRUE, ...){
   UseMethod("e_funnel")
}
#' @export
#' @method e_funnel echarts4r
e_funnel.echarts4r <- function(e, values, labels, name = NULL, legend = TRUE, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(values) || missing(labels)) {
    stop("missing values or labels", call. = FALSE)
  }

  e_funnel_(
    e = e,
    values = deparse(substitute(values)),
    labels = deparse(substitute(labels)),
    name = name,
    legend = legend,
    rm_x = rm_x,
    rm_y = rm_y,
    ...
  )
}

#' @export
#' @method e_funnel echarts4rProxy
e_funnel.echarts4rProxy <- function(e, values, labels, name = NULL, legend = TRUE, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(values) || missing(labels)) {
    stop("missing values or labels", call. = FALSE)
  }

  e$chart <- e_funnel_(
    e = e$chart,
    values = deparse(substitute(values)),
    labels = deparse(substitute(labels)),
    name = name,
    legend = legend,
    rm_x = rm_x,
    rm_y = rm_y,
    ...
  )

  return(e)
}

#' Sankey
#'
#' Draw a sankey diagram.
#'
#' @inheritParams e_bar
#' @param layout Layout of sankey.
#' @param source,target Source and target columns.
#' @param value Value change from \code{source} to \code{target}.
#' @param rm_x,rm_y Whether to remove the x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' sankey <- data.frame(
#'   source = c("a", "b", "c", "d", "c"),
#'   target = c("b", "c", "d", "e", "e"),
#'   value = ceiling(rnorm(5, 10, 1)),
#'   stringsAsFactors = FALSE
#' )
#'
#' sankey |>
#'   e_charts() |>
#'   e_sankey(source, target, value)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-sankey}{Additional arguments}
#'
#' @rdname e_sankey
#' @export
e_sankey <- function(e, source, target, value, layout = "none", rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_sankey")
  }

#' @export
#' @method e_sankey echarts4r
e_sankey.echarts4r <- function(e, source, target, value, layout = "none", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(source) || missing(target) || missing(value)) {
    stop("missing source, target or values", call. = FALSE)
  }
  if(e$x$tl)(
    stop("timeline not supported")
  )

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  e_sankey_(
    e,
    deparse(substitute(source)),
    deparse(substitute(target)),
    deparse(substitute(value)),
    layout,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_sankey echarts4rProxy
e_sankey.echarts4rProxy <- function(e, source, target, value, layout = "none", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(source) || missing(target) || missing(value)) {
    stop("missing source, target or values", call. = FALSE)
  }

  # Remove bc this breaks
  # e <- .rm_axis(e, rm_x, "x")
  # e <- .rm_axis(e, rm_y, "y")

  e$chart <- e_sankey_(
    e$chart,
    deparse(substitute(source)),
    deparse(substitute(target)),
    deparse(substitute(value)),
    layout,
    rm_x,
    rm_y,
    ...
  )

  return(e)
}



#' Graph
#'
#' Create a graph.
#'
#' @param e An \code{echarts4} object as returned by \code{e_charts}.
#' @param name Name of graph.
#' @param nodes Data.frame of nodes.
#' @param names Names of nodes, unique.
#' @param value Values of nodes or edges.
#' @param size Sizes of nodes or edges.
#' @param symbol Symbols of nodes.
#' @param legend Whether to add serie to legend.
#' @param category Group of nodes (i.e.: group membership).
#' @param xpos,ypos X and Y coordinates for nodes. Valid when \code{layout = "none"}
#' @param edges Data.frame of edges.
#' @param source,target Column names of source and target.
#' @param color Variable to map to the color of the edges.
#' @param layout Layout, one of \code{force}, \code{none} or \code{circular}.
#' @param rm_x,rm_y Whether to remove the x and y axis, defaults to \code{TRUE}.
#' @param itemStyle This option is available for for GL and canvas
#' graph but is only necessary for GL.
#' @param ... Any other parameter.
#'
#' @examples
#' value <- rnorm(10, 10, 2)
#'
#' nodes <- data.frame(
#'   name = sample(LETTERS, 10),
#'   value = value,
#'   size = value,
#'   symbol = sample(c("circle", "rect", "triangle"), 10, replace = TRUE),
#'   grp = rep(c("grp1", "grp2"), 5),
#'   stringsAsFactors = FALSE
#' )
#'
#' value_edges <- sample(1:100, 20, replace = TRUE)
#' edges <- data.frame(
#'   source = sample(nodes$name, 20, replace = TRUE),
#'   target = sample(nodes$name, 20, replace = TRUE),
#'   value = value_edges,
#'   size = ceiling(value_edges / 20),
#'   stringsAsFactors = FALSE
#' )
#'
#' e_charts() |>
#'   e_graph() |>
#'   e_graph_nodes(nodes, name, value, size, grp, symbol) |>
#'   e_graph_edges(edges, source, target, value, size) |>
#'   e_tooltip()
#'
#' # Use graphGL for larger networks
#' nodes <- data.frame(
#'   name = paste0(LETTERS, 1:1000),
#'   value = rnorm(1000, 10, 2),
#'   size = rnorm(1000, 10, 2),
#'   grp = rep(c("grp1", "grp2"), 500),
#'   stringsAsFactors = FALSE
#' )
#'
#' edges <- data.frame(
#'   source = sample(nodes$name, 2000, replace = TRUE),
#'   target = sample(nodes$name, 2000, replace = TRUE),
#'   stringsAsFactors = FALSE
#' )
#'
#' e_charts() |>
#'   e_graph_gl() |>
#'   e_graph_nodes(nodes, name, value, size, grp) |>
#'   e_graph_edges(edges, source, target)
#'
#' # Fixed node positions, and edge color by variable
#' nodes <- data.frame(
#'   name = c("A", "B", "C", "D", "E"),
#'   value = c("A", "B", "C", "D", "E"),
#'   group = c("gr1", "gr1", "gr2", "gr2", "gr3"),
#'   size = 3:7 * 10,
#'   x = c(0, 200, 400, 600, 800),
#'   y = c(100, 100, 200, 200, 0)
#' )
#'
#' edges <- data.frame(
#'   source = c("A", "B", "C", "D", "E"),
#'   target = c("B", "C", "D", "E", "D"),
#'   size = rep(3, 5),
#'   color = c("red", "green", "blue", "yellow", "black")
#' )
#'
#' e_charts() |>
#'   e_graph(layout = "none", autoCurveness = TRUE) |>
#'   e_graph_nodes(nodes, name, value, size, category = group, xpos = x, ypos = y) |>
#'   e_graph_edges(edges, source, target, size = size, color = color) |>
#'   e_tooltip()
#' @seealso \href{https://echarts.apache.org/en/option.html#series-graph}{Additional arguments},
#'  \code{\link{e_modularity}}
#'
#' @rdname graph
#' @export
e_graph <- function(e, layout = "force", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) UseMethod("e_graph")

#' @export
#' @method e_graph echarts4r
e_graph.echarts4r <- function(e, layout = "force", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  serie <- list(
    name = name,
    type = "graph",
    layout = layout,
    ...
  )

  e$x$opts$series <- append(e$x$opts$series, list(serie))

  # dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-graph-modularity",
    version = "1.1.0",
    src = c(file = path),
    script = "echarts-graph-modularity.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' @export
#' @method e_graph echarts4rProxy
e_graph.echarts4rProxy <- function(e, layout = "force", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  e$chart <- e_graph(e$chart, layout, name, rm_x, rm_y, ...)
  return(e)
}

#' @rdname graph
#' @export
e_graph_gl <- function(e, layout = "force", name = NULL, rm_x = TRUE, rm_y = TRUE, ..., itemStyle = list(opacity = 1)) UseMethod("e_graph_gl")

#' @export
#' @method e_graph_gl echarts4r
e_graph_gl.echarts4r <- function(e, layout = "force", name = NULL, rm_x = TRUE, rm_y = TRUE, ..., itemStyle = list(opacity = 1)) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if(e$x$tl)(
    stop("timeline not supported")
  )
  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  serie <- list(
    name = name,
    type = "graphGL",
    layout = layout,
    itemStyle = itemStyle,
    ...
  )

  # add dependencies
  path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
  dep_gl <- htmltools::htmlDependency(
    name = "echarts-gl",
    version = "1.1.2",
    src = c(file = path),
    script = "echarts-gl.min.js"
  )

  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep_modularity <- htmltools::htmlDependency(
    name = "echarts-graph-modularity",
    version = "1.1.0",
    src = c(file = path),
    script = "echarts-graph-modularity.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep_gl))
  e$dependencies <- append(e$dependencies, list(dep_modularity))

  e$x$opts$series <- append(e$x$opts$series, list(serie))
  e
}

#' @export
#' @method e_graph_gl echarts4rProxy
e_graph_gl.echarts4rProxy <- function(e, layout = "force", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  e$chart <- e_graph_gl(e$chart, layout, name, rm_x, rm_y, ...)
  return(e)
}

#' @rdname graph
#' @export
e_graph_nodes <- function(e, nodes, names, value, size, category, symbol = NULL, legend = TRUE, xpos = NULL, ypos = NULL) UseMethod("e_graph_nodes")

#' @export
#' @method e_graph_nodes echarts4r
e_graph_nodes.echarts4r <- function(e, nodes, names, value, size, category, symbol = NULL, legend = TRUE, xpos = NULL, ypos = NULL) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(nodes) || missing(names) || missing(value)) {
    stop("missing arguments", call. = FALSE)
  }

  value <- dplyr::enquo(value)
  symbolSize <- dplyr::enquo(size)
  symbol <- dplyr::enquo(symbol)
  names <- dplyr::enquo(names)
  xpos <- dplyr::enquo(xpos)
  ypos <- dplyr::enquo(ypos)

  if (!missing(category) && !missing(size)) {
    e$x$opts$series[[length(e$x$opts$series)]]$categories <- .build_graph_category(nodes, dplyr::enquo(category))

    if (isTRUE(legend)) {
      e$x$opts$legend$data <- append(e$x$opts$legend$data, unique(nodes[[deparse(substitute(category))]]))
    }

    nodes <- .build_graph_nodes(
      nodes,
      names,
      value,
      symbolSize,
      dplyr::enquo(category),
      symbol,
      xpos,
      ypos
    )
  } else if (missing(category) && !missing(size)) {
    nodes <- .build_graph_nodes_no_cat(
      nodes,
      names,
      value,
      symbolSize,
      symbol,
      xpos,
      ypos
    )
  } else if (missing(category) && missing(size)) {
    nodes <- .build_graph_nodes_no_size(
      nodes,
      names,
      value,
      symbol,
      xpos,
      ypos
    )
  }

  # build JSON data
  e$x$opts$series[[length(e$x$opts$series)]]$data <- nodes
  e
}

#' @export
#' @method e_graph_nodes echarts4rProxy
e_graph_nodes.echarts4rProxy <- function(e, nodes, names, value, size, category, symbol = NULL, legend = TRUE, xpos = NULL, ypos = NULL) {

  if (missing(nodes) || missing(names) || missing(value)) {
    stop("missing arguments", call. = FALSE)
  }

  value <- dplyr::enquo(value)
  symbolSize <- dplyr::enquo(size)
  symbol <- dplyr::enquo(symbol)
  names <- dplyr::enquo(names)
  xpos <- dplyr::enquo(xpos)
  ypos <- dplyr::enquo(ypos)

  if (!missing(category) && !missing(size)) {
    e$chart$x$opts$series[[length(e$chart$x$opts$series)]]$categories <- .build_graph_category(nodes, dplyr::enquo(category))

    if (isTRUE(legend)) {
      e$chart$x$opts$legend$data <- append(e$chart$x$opts$legend$data, unique(nodes[[deparse(substitute(category))]]))
    }

    nodes <- .build_graph_nodes(
      nodes,
      names,
      value,
      symbolSize,
      symbol,
      dplyr::enquo(category),
      xpos,
      ypos
    )
  } else if (missing(category) && !missing(size)) {
    nodes <- .build_graph_nodes_no_cat(
      nodes,
      names,
      value,
      symbolSize,
      symbol,
      xpos,
      ypos
    )
  } else if (missing(category) && missing(size)) {
    nodes <- .build_graph_nodes_no_size(
      nodes,
      names,
      value,
      symbol,
      xpos,
      ypos
    )
  }

  # build JSON data
  e$chart$x$opts$series[[length(e$chart$x$opts$series)]]$data <- nodes
  e
}

#' @rdname graph
#' @export
e_graph_edges <- function(e, edges, source, target, value, size, color) UseMethod("e_graph_edges")

#' @method e_graph_edges echarts4r
#' @export
e_graph_edges.echarts4r <- function(e, edges, source, target, value, size, color) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(edges) || missing(source) || missing(target)) {
    stop("must pass edges, source and target", call. = FALSE)
  }

  if (missing(size)) {
    size <- NULL
  }

  if (missing(value)) {
    value <- NULL
  }

  if (missing(color)) {
    color <- NULL
  }

  source <- dplyr::enquo(source)
  target <- dplyr::enquo(target)
  value <- dplyr::enquo(value)
  size <- dplyr::enquo(size)
  color <- dplyr::enquo(color)

  data <- .build_graph_edges(
    edges,
    source,
    target,
    value,
    size,
    color
  )

  # build JSON data
  e$x$opts$series[[length(e$x$opts$series)]]$links <- data
  e
}


#' @method e_graph_edges echarts4rProxy
#' @export
e_graph_edges.echarts4rProxy <- function(e, edges, source, target, value, size, color) {

  if (missing(edges) || missing(source) || missing(target)) {
    stop("must pass edges, source and target", call. = FALSE)
  }

  if (missing(size)) {
    size <- NULL
  }

  if (missing(color)) {
    color <- NULL
  }

  source <- dplyr::enquo(source)
  target <- dplyr::enquo(target)
  value <- dplyr::enquo(value)
  size <- dplyr::enquo(size)
  color <- dplyr::enquo(color)

  data <- .build_graph_edges(
    edges,
    source,
    target,
    value,
    size,
    color
  )

  # build JSON data
  e$chart$x$opts$series[[length(e$chart$x$opts$series)]]$links <- data
  e
}


#' Heatmap
#'
#' Draw heatmap by coordinates.
#'
#' @inheritParams e_bar
#' @param y,z Coordinates and values.
#' @param coord_system Coordinate system to plot against, takes
#' \code{cartesian2d}, \code{geo} or \code{calendar}.
#' @param rm_x,rm_y Whether to remove x and y axis, only applies if \code{coord_system} is not
#' set to \code{cartesian2d}.
#' @param calendar The index of the calendar to plot against.
#'
#' @examples
#' v <- LETTERS[1:10]
#' matrix <- data.frame(
#'   x = sample(v, 300, replace = TRUE),
#'   y = sample(v, 300, replace = TRUE),
#'   z = rnorm(300, 10, 1),
#'   stringsAsFactors = FALSE
#' ) |>
#'   dplyr::group_by(x, y) |>
#'   dplyr::summarise(z = sum(z)) |>
#'   dplyr::ungroup()
#'
#' matrix |>
#'   e_charts(x) |>
#'   e_heatmap(y, z, itemStyle = list(emphasis = list(shadowBlur = 10))) |>
#'   e_visual_map(z)
#'
#' # calendar
#' dates <- seq.Date(as.Date("2017-01-01"), as.Date("2018-12-31"), by = "day")
#' values <- rnorm(length(dates), 20, 6)
#'
#' year <- data.frame(date = dates, values = values)
#'
#' year |>
#'   e_charts(date) |>
#'   e_calendar(range = "2018") |>
#'   e_heatmap(values, coord_system = "calendar") |>
#'   e_visual_map(max = 30)
#'
#' # calendar multiple years
#' year |>
#'   dplyr::mutate(year = format(date, "%Y")) |>
#'   group_by(year) |>
#'   e_charts(date) |>
#'   e_calendar(range = "2017", top = 40) |>
#'   e_calendar(range = "2018", top = 260) |>
#'   e_heatmap(values, coord_system = "calendar") |>
#'   e_visual_map(max = 30)
#'
#' # map
#' quakes |>
#'   e_charts(long) |>
#'   e_geo(
#'     boundingCoords = list(
#'       c(190, -10),
#'       c(180, -40)
#'     )
#'   ) |>
#'   e_heatmap(
#'     lat,
#'     mag,
#'     coord_system = "geo",
#'     blurSize = 5,
#'     pointSize = 3
#'   ) |>
#'   e_visual_map(mag)
#'
#' # timeline
#' library(dplyr)
#'
#' axis <- LETTERS[1:10]
#' df <- expand.grid(axis, axis)
#'
#' bind_rows(df, df) |>
#'   mutate(
#'     values = runif(n(), 1, 10),
#'     grp = c(
#'       rep("A", 100),
#'       rep("B", 100)
#'     )
#'   ) |>
#'   group_by(grp) |>
#'   e_charts(Var1, timeline = TRUE) |>
#'   e_heatmap(Var2, values) |>
#'   e_visual_map(values)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-heatmap}{Additional arguments}
#'
#' @rdname e_heatmap
#' @export
e_heatmap <- function(
    e,
    y,
    z,
    bind,
    name = NULL,
    coord_system = "cartesian2d",
    rm_x = TRUE,
    rm_y = TRUE,
    calendar = NULL,
    ...) {
  UseMethod("e_heatmap")
}

#' @export
#' @method e_heatmap echarts4r
e_heatmap.echarts4r <- function(
    e,
    y,
    z,
    bind,
    name = NULL,
    coord_system = "cartesian2d",
    rm_x = TRUE,
    rm_y = TRUE,
    calendar = NULL,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(y)) {
    stop("must pass y", call. = FALSE)
  }

  if (!missing(z)) {
    z <- deparse(substitute(z))
  } else {
    z <- NULL
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e_heatmap_(e, deparse(substitute(y)), z, bd, name, coord_system, rm_x, rm_y, calendar, ...)
}

#' @export
#' @method e_heatmap echarts4rProxy
e_heatmap.echarts4rProxy <- function(
    e,
    y,
    z,
    bind,
    name = NULL,
    coord_system = "cartesian2d",
    rm_x = TRUE,
    rm_y = TRUE,
    calendar = NULL,
    ...) {

  if (missing(y)) {
    stop("must pass y", call. = FALSE)
  }

  if(is.null(e$chart$x$mapping$x)){
    stop("provide x in echarts4rProxy")
  }

  if (!missing(z)) {
    z <- deparse(substitute(z))
  } else {
    z <- NULL
  }

  if (!missing(bind)) {
    bind <- deparse(substitute(bind))
  } else {
    bind <- NULL
  }

  e$chart <- e_heatmap_(e$chart, deparse(substitute(y)), z, bind, name, coord_system, rm_x, rm_y, calendar, ...)
  return(e)
}

#' Parallel
#'
#' Draw parallel coordinates.
#'
#' @inheritParams e_bar
#' @param ... Columns to select from the data passed to \code{\link{e_charts}}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#' @param opts A list of additional options to pass to the serie.
#'
#' @examples
#' df <- data.frame(
#'   price = rnorm(5, 10),
#'   amount = rnorm(5, 15),
#'   letter = LETTERS[1:5]
#' )
#'
#' df |>
#'   e_charts() |>
#'   e_parallel(price, amount, letter, opts = list(smooth = TRUE))
#' @seealso \href{https://echarts.apache.org/en/option.html#series-parallel}{Additional arguments}
#'
#' @rdname e_parallel
#' @export
e_parallel <- function(e, ..., name = NULL, rm_x = TRUE, rm_y = TRUE, opts = list()) {
  UseMethod("e_parallel")}

#' @export
#' @method e_parallel echarts4r
e_parallel.echarts4r <- function(e, ..., name = NULL, rm_x = TRUE, rm_y = TRUE, opts = list()) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if(e$x$tl)(
    stop("timeline not supported")
  )

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  data <- e$x$data[[1]] |>
    dplyr::select(...)

  # remove names
  df <- data
  row.names(data) <- NULL
  data <- unname(data)

  data <- apply(data, 1, as.list)

  # remove white spaces (ex: in " 1")
  data <- purrr::map(data, function(x) {
    gsub(" ", "", x) |>
      as.list()
  })

  serie <- list(
    name = name,
    type = "parallel",
    data = data
  )

  serie <- append(serie, opts)

  para <- list()
  for (i in seq_len(ncol(df))) {
    line <- list()
    line$dim <- i - 1
    line$name <- names(df)[i]
    if (inherits(df[, i], "character") || inherits(df[, i], "factor")) {
      line$type <- "category"
      line$data <- unique(df[, i])
    }

    para[[i]] <- line
  }

  e$x$opts$series <- append(e$x$opts$series, serie)
  e$x$opts$parallelAxis <- para
  e
}

#' @export
#' @method e_parallel echarts4rProxy
e_parallel.echarts4rProxy <- function(e, ..., name = NULL, rm_x = TRUE, rm_y = TRUE) {
  e$chart <- e_parallel(e$chart, ..., name = name, rm_x = rm_x, rm_y = rm_y)
  return(e)
}

#' Pie
#'
#' Draw pie and donut charts.
#'
#' @inheritParams e_bar
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' mtcars |>
#'   head() |>
#'   tibble::rownames_to_column("model") |>
#'   e_charts(model) |>
#'   e_pie(carb)
#'
#' # timeline
#' df <- data.frame(
#'   grp = c("A", "A", "A", "B", "B", "B"),
#'   labels = rep(LETTERS[1:3], 2),
#'   values = runif(6, 1, 5)
#' )
#'
#' df |>
#'   group_by(grp) |>
#'   e_charts(labels, timeline = TRUE) |>
#'   e_pie(values)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-pie}{Additional arguments}
#'
#' @rdname e_pie
#' @export
e_pie <- function(e, serie, name = NULL, legend = TRUE, coord_system = "", rm_x = TRUE, rm_y = TRUE, ...) UseMethod("e_pie")

#' @export
#' @method e_pie echarts4r
e_pie.echarts4r <- function(e, serie, name = NULL, legend = TRUE, coord_system = "", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  e_pie_(e, deparse(substitute(serie)), name, legend, coord_system, rm_x, rm_y, ...)
}

#' @export
#' @method e_pie echarts4rProxy
e_pie.echarts4rProxy <- function(e, serie, name = NULL, legend = TRUE, coord_system = "", rm_x = TRUE, rm_y = TRUE, ...) {

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  if(is.null(e$chart$x$mapping$x)){
    stop("provide x in echarts4rProxy")
  }

  e$chart <- e_pie_(e$chart, deparse(substitute(serie)), name, legend, coord_system, rm_x, rm_y, ...)
  return(e)
}

#' Sunburst
#'
#' Build a sunburst.
#'
#' @inheritParams e_bar
#' @param styles  Vector of style lists, defaults to \code{NULL}.
#' @param names Names of items to style, expects a \code{list}, defaults to \code{NULL}.
#' @param levels Hierarchical levels to style, expects a \code{list}, defaults to \code{NULL}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @details
#' Charts e_sunburst, e_treemap and e_tree require hierarchical input data.
#' Such structure could be represented thru json lists or nested tibbles (data.frame).
#' Input data may contain styles, see \code{itemStyle} in examples \code{jsonl} and \code{df} below.
#' The number of lists in the \code{styles} parameter should match the number of elements
#' in \code{names} and/or \code{levels}. If both \code{names} and \code{levels} are present,
#' name styles will take precedence over level styles.
#' Multiple names may have the same style, see \code{c('land','river')} below.
#' Multiple levels may have the same style, see \code{c(3,4)} below.
#' \code{styles} lists contain items such as \code{color}, or \code{borderColor} as specified in the
#' \href{https://echarts.apache.org/en/option.html#series-sunburst.data.itemStyle}{official documentation}.
#'
#' @examples
#'
#' # json list hierarchical data representation
#' jsonl <- jsonlite::fromJSON('[
#'   {"name": "earth", "value": 30,
#'     "children": [
#'       {"name": "land", "value":10,
#'         "children": [
#'                 {"name": "forest", "value": 3},
#'                 {"name": "river", "value": 7}
#'         ]},
#'       {"name": "ocean", "value":20,
#'         "children": [
#'           {"name": "fish", "value": 10,
#'             "children": [
#'               {"name": "shark", "value":2},
#'               {"name": "tuna", "value":6}
#'             ]},
#'           {"name": "kelp", "value": 5}
#'         ]}
#'     ]
#'   },
#'   {"name": "mars", "value": 30,
#'     "children": [
#'       {"name": "crater", "value": 20},
#'       {"name": "valley", "value": 20}
#'     ]},
#'   {"name": "venus", "value": 40, "itemStyle": {"color": "blue"} }
#' ]', simplifyDataFrame = FALSE)
#'
#' jsonl |>
#'   e_charts() |>
#'   e_sunburst() # demo
#'
#'
#' # tibble hierarchical data representation
#' library(dplyr)
#' df <- tibble(
#'   name = c("earth", "mars", "venus"),
#'   value = c(30, 40, 30),
#'   # 1st level
#'   itemStyle = tibble(color = c(NA, "red", "blue")),
#'   # embedded styles, optional
#'   children = list(
#'     tibble(
#'       name = c("land", "ocean"),
#'       value = c(10, 20),
#'       # 2nd level
#'       children = list(
#'         tibble(name = c("forest", "river"), value = c(3, 7)),
#'         # 3rd level
#'         tibble(
#'           name = c("fish", "kelp"),
#'           value = c(10, 5),
#'           children = list(
#'             tibble(name = c("shark", "tuna"), value = c(2, 6)),
#'             # 4th level
#'             NULL # kelp
#'           )
#'         )
#'       )
#'     ),
#'     tibble(name = c("crater", "valley"), value = c(20, 20)),
#'     NULL # venus
#'   )
#' )
#'
#' df |>
#'   e_charts() |>
#'   e_sunburst() |>
#'   e_theme("westeros")
#'
#' # with styles
#' myStyles <- c(list(color = "green"), list(color = "magenta")) # custom styles defined
#' myNames <- list(c("land", "river"), "crater") # names to style
#' myLevels <- list(2, c(3, 4)) # hierarchical levels to style
#'
#' df |>
#'   e_charts() |>
#'   e_sunburst(myStyles, myNames, myLevels)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-sunburst}{Additional arguments}
#'
#' @rdname e_sunburst
#' @export
e_sunburst <- function(e, styles = NULL, names = NULL, levels = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_sunburst")}

#' @export
#' @method e_sunburst echarts4r
e_sunburst.echarts4r <- function(e, styles = NULL, names = NULL, levels = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e_sunburst_(e, styles, names, levels, rm_x, rm_y, ...)
}

#' @export
#' @method e_sunburst echarts4rProxy
e_sunburst.echarts4rProxy <- function(e, styles = NULL, names = NULL, levels = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  e$chart <- e_sunburst_(e$chart, styles, names, levels, rm_x, rm_y, ...)

  return(e)
}

#' Treemap
#'
#' Build a treemap.
#'
#' @inheritParams e_bar
#' @param styles  Vector of style lists, defaults to \code{NULL}.
#' @param names Names of items to style, expects a \code{list}, defaults to \code{NULL}.
#' @param levels Hierarchical levels to style, expects a \code{list}, defaults to \code{NULL}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' library(dplyr)
#' df <- tibble(
#'   name = c("earth", "mars", "venus"),
#'   value = c(30, 40, 30),
#'   # 1st level
#'   itemStyle = tibble(color = c(NA, "red", "blue")),
#'   # embedded styles, optional
#'   children = list(
#'     tibble(
#'       name = c("land", "ocean"),
#'       value = c(10, 20),
#'       # 2nd level
#'       children = list(
#'         tibble(name = c("forest", "river"), value = c(3, 7)),
#'         # 3rd level
#'         tibble(
#'           name = c("fish", "kelp"),
#'           value = c(10, 5),
#'           children = list(
#'             tibble(name = c("shark", "tuna"), value = c(2, 6)),
#'             # 4th level
#'             NULL # kelp
#'           )
#'         )
#'       )
#'     ),
#'     tibble(name = c("crater", "valley"), value = c(20, 20)),
#'     NULL # venus
#'   )
#' )
#'
#' df |>
#'   e_charts() |>
#'   e_treemap()
#' @seealso \href{https://echarts.apache.org/en/option.html#series-treemap}{Additional arguments}
#'
#' @rdname e_treemap
#' @export
e_treemap <- function(e, styles = NULL, names = NULL, levels = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_treemap")}

#' @export
#' @method e_treemap echarts4r
e_treemap.echarts4r <- function(e, styles = NULL, names = NULL, levels = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e_treemap_(e, styles, names, levels, rm_x, rm_y, ...)
}

#' @export
#' @method e_treemap echarts4rProxy
e_treemap.echarts4rProxy <- function(e, styles = NULL, names = NULL, levels = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  e$chart <- e_treemap_(e$chart, styles, names, levels, rm_x, rm_y, ...)

  return(e)
}

#' River
#'
#' Build a theme river.
#'
#' @inheritParams e_bar
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' dates <- seq.Date(Sys.Date() - 30, Sys.Date(), by = "day")
#' grps <- lapply(LETTERS[1:3], rep, 31) |> unlist()
#'
#' df <- data.frame(
#'   dates = rep(dates, 3),
#'   groups = grps,
#'   values = runif(length(grps), 1, 50)
#' )
#'
#' df |>
#'   group_by(groups) |>
#'   e_charts(dates) |>
#'   e_river(values) |>
#'   e_tooltip(trigger = "axis")
#' @seealso \href{https://echarts.apache.org/en/option.html#series-themeRiver}{Additional arguments}
#'
#' @rdname e_river
#' @export
e_river <- function(e, serie, name = NULL, legend = TRUE, rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_river")
  }

#' @export
#' @method e_river echarts4r
e_river.echarts4r <- function(e, serie, name = NULL, legend = TRUE, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  e_river_(e, deparse(substitute(serie)), name, legend, rm_x, rm_y, ...)
}

#' @export
#' @method e_river echarts4rProxy
e_river.echarts4rProxy <- function(e, serie, name = NULL, legend = TRUE, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  if(is.null(e$chart$x$mapping$x)){
    stop("provide x in echarts4rProxy")
  }

  e$chart <- e_river_(e$chart, deparse(substitute(serie)), name, legend, rm_x, rm_y, ...)
  return(e)
}

#' Boxplot
#'
#' Draw boxplot.
#'
#' @inheritParams e_bar
#' @param outliers Whether to plot outliers.
#
#'
#' @examples
#' df <- data.frame(
#'   x = c(1:10, 25),
#'   y = c(1:10, -6)
#' )
#'
#' df |>
#'   e_charts() |>
#'   e_boxplot(y, outliers = TRUE) |>
#'   e_boxplot(x, outliers = TRUE)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-boxplot}{Additional arguments}
#'
#' @rdname e_boxplot
#' @export
e_boxplot <- function(e, serie, name = NULL, outliers = TRUE, ...) {
  UseMethod("e_boxplot")
  }

#' @export
#' @method e_boxplot echarts4r
e_boxplot.echarts4r <- function(e, serie, name = NULL, outliers = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  if (is.null(name)) { # defaults to column name
    name <- deparse(substitute(serie))
  }

  e_boxplot_(e, deparse(substitute(serie)), name, outliers, ...)
}

#' @export
#' @method e_boxplot echarts4rProxy
e_boxplot.echarts4rProxy <- function(e, serie, name = NULL, outliers = TRUE, ...) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  if (is.null(name)) { # defaults to column name
    name <- deparse(substitute(serie))
  }

  e$chart <- e_boxplot_(e$chart, deparse(substitute(serie)), name, outliers, ...)
  return(e)
}

#' Tree
#'
#' Build a tree.
#'
#' @inheritParams e_bar
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' library(dplyr)
#' df <- tibble(
#'   name = "earth",
#'   # 1st level
#'   children = list(
#'     tibble(
#'       name = c("land", "ocean"),
#'       # 2nd level
#'       children = list(
#'         tibble(name = c("forest", "river")),
#'         # 3rd level
#'         tibble(
#'           name = c("fish", "kelp"),
#'           children = list(
#'             tibble(
#'               name = c("shark", "tuna")
#'             ),
#'             # 4th level
#'             NULL # kelp
#'           )
#'         )
#'       )
#'     )
#'   )
#' )
#'
#' df |>
#'   e_charts() |>
#'   e_tree(initialTreeDepth = 3, label = list(offset = c(0, -11)))
#' @seealso \href{https://echarts.apache.org/en/option.html#series-tree}{Additional arguments}
#'
#' @rdname e_tree
#' @export
e_tree <- function(e, rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_tree")}

#' @export
#' @method e_tree echarts4r
e_tree.echarts4r <- function(e, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e_tree_(e, rm_x, rm_y, ...)
}

#' @export
#' @method e_tree echarts4rProxy
e_tree.echarts4rProxy <- function(e, rm_x = TRUE, rm_y = TRUE, ...) {
  e$chart <- e_tree_(e$chart, rm_x, rm_y, ...)
  return(e)
}

#' Gauge
#'
#' Plot a gauge.
#'
#' @inheritParams e_bar
#' @param value Value to gauge.
#' @param name Text on gauge.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' e_charts() |>
#'   e_gauge(57, "PERCENT")
#'
#' # timeline
#' data.frame(time = 2015:2017) |>
#'   group_by(time) |>
#'   e_charts(timeline = TRUE) |>
#'   e_gauge(
#'     c(57, 23, 65),
#'     c("percent", "percentage", "cases")
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#series-gauge}{Additional arguments}
#'
#' @rdname e_gauge
#' @export
e_gauge <- function(e, value, name = NULL, rm_x = TRUE, rm_y = TRUE, ...) UseMethod("e_gauge")

#' @export
#' @method e_gauge echarts4r
e_gauge.echarts4r <- function(e, value, name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {

  if (missing(e) || missing(value)) {
    stop("missing e or value", call. = FALSE)
  }

  if (!inherits(value, "numeric")) {
    stop("must pass numeric or integer", call. = FALSE)
  }

  # remove axis
  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  for (i in seq_along(value)) {
    serie <- list(
      data = list(list(value = value[i], name = name[i]))
    )

    opts <- list(
      type = "gauge",
      ...
    )

    if (!e$x$tl) {
      lst <- append(serie, opts)
      e$x$opts$series <- append(e$x$opts$series, list(lst))
    } else {
      e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(serie))
    }
  }

  if (e$x$tl) {
    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(opts))
  }
  e
}

#' @export
#' @method e_gauge echarts4rProxy
e_gauge.echarts4rProxy <- function(e, value, name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(value)) {
    stop("missing value", call. = FALSE)
  }

  # Breaks if no data, so I added this.
  if(is.null(e$chart$x$data[[1]])){
    stop("provide data in echarts4rProxy")
  }
  e$chart <- e_gauge(e$chart, value, name, rm_x, rm_y, ...)
  return(e)
}

#' @inheritParams e_bar
#' @rdname e_gauge
#' @export
e_gauge_ <- function(e, value, name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e) || missing(value) || missing(name)) {
    stop("missing e or value", call. = FALSE)
  }

  if (!inherits(value, "numeric")) {
    stop("must pass numeric or integer", call. = FALSE)
  }

  # remove axis
  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  for (i in seq_along(value)) {
    serie <- list(
      data = list(list(value = value[i], name = name[i]))
    )

    opts <- list(
      type = "gauge",
      ...
    )

    if (!e$x$tl) {
      lst <- append(serie, opts)
      e$x$opts$series <- append(e$x$opts$series, list(lst))
    } else {
      e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(serie))
    }
  }

  if (e$x$tl) {
    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(opts))
  }
  e
}

#' Lines 3D
#'
#' Add 3D lines.
#'
#' @inheritParams e_bar
#' @param coord_system Coordinate system to use, such as \code{cartesian3D}, or \code{globe}.
#' @param y,z Coordinates of lines.
#' @param source_lon,source_lat,target_lon,target_lat coordinates.
#' @param source_name,target_name Names of source and target.
#' @param value Value of edges.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' # Lines 3D
#' # Globe
#' # get tetures: echarts4r-assets.john-coene.com
#' # get textures: echarts4r-assets.john-coene.com
#' flights |>
#'   e_charts() |>
#'   e_globe(
#'     displacementScale = 0.05
#'   ) |>
#'   e_lines_3d(
#'     start_lon,
#'     start_lat,
#'     end_lon,
#'     end_lat,
#'     name = "flights",
#'     effect = list(show = TRUE)
#'   ) |>
#'   e_legend(FALSE)
#'
#' # Geo 3D
#' flights |>
#'   e_charts() |>
#'   e_geo_3d() |>
#'   e_lines_3d(
#'     start_lon,
#'     start_lat,
#'     end_lon,
#'     end_lat,
#'     coord_system = "geo3D"
#'   )
#'
#' # groups
#' flights$grp <- rep(LETTERS[1:2], 89)
#'
#' flights |>
#'   group_by(grp) |>
#'   e_charts() |>
#'   e_geo_3d() |>
#'   e_lines_3d(
#'     start_lon,
#'     start_lat,
#'     end_lon,
#'     end_lat,
#'     coord_system = "geo3D"
#'   )
#'
#' # line 3D
#' df <- data.frame(
#'   x = 1:100,
#'   y = runif(100, 10, 25),
#'   z = rnorm(100, 100, 50)
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_line_3d(y, z) |>
#'   e_visual_map() |>
#'   e_title("nonsense")
#'
#' # timeline
#' df$grp <- rep(LETTERS[1:5], 20)
#'
#' df |>
#'   group_by(grp) |>
#'   e_charts(x) |>
#'   e_line_3d(y, z) |>
#'   e_visual_map() |>
#'   e_title("nonsense")
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#series-lines3D}{Additional arguments for lines 3D},
#'  \href{https://echarts.apache.org/en/option-gl.html#series-lines3D}{Additional arguments for line 3D}
#'
#' @seealso \url{https://echarts4r-assets.john-coene.com}
#'
#' @rdname line3D
#' @export
e_lines_3d <- function(
    e,
    source_lon,
    source_lat,
    target_lon,
    target_lat,
    source_name,
    target_name,
    value,
    name = NULL,
    coord_system = "globe",
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  UseMethod("e_lines_3d")
}

#' @export
#' @method e_lines_3d echarts4r
e_lines_3d.echarts4r <- function(
    e,
    source_lon,
    source_lat,
    target_lon,
    target_lat,
    source_name,
    target_name,
    value,
    name = NULL,
    coord_system = "globe",
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(source_lat) || missing(source_lon) || missing(target_lat) || missing(target_lon)) {
    stop("missing coordinates", call. = FALSE)
  }

  if (missing(source_name)) {
    source_name <- NULL
  } else {
    source_name <- deparse(substitute(source_name))
  }

  if (missing(target_name)) {
    target_name <- NULL
  } else {
    target_name <- deparse(substitute(target_name))
  }

  if (missing(value)) {
    value <- NULL
  } else {
    value <- deparse(substitute(value))
  }

  e_lines_3d_(
    e,
    deparse(substitute(source_lon)),
    deparse(substitute(source_lat)),
    deparse(substitute(target_lon)),
    deparse(substitute(target_lat)),
    source_name,
    target_name,
    value,
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_lines_3d echarts4rProxy
e_lines_3d.echarts4rProxy <- function(
    e,
    source_lon,
    source_lat,
    target_lon,
    target_lat,
    source_name,
    target_name,
    value,
    name = NULL,
    coord_system = "globe",
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(source_lat) || missing(source_lon) || missing(target_lat) || missing(target_lon)) {
    stop("missing coordinates", call. = FALSE)
  }
  if (missing(source_name)) {
    source_name <- NULL
  }

  if (missing(target_name)) {
    target_name <- NULL
  }

  if (missing(value)) {
    value <- NULL
  }

  e$chart <- e_lines_3d_(
    e$chart,
    deparse(substitute(source_lon)),
    deparse(substitute(source_lat)),
    deparse(substitute(target_lon)),
    deparse(substitute(target_lat)),
    deparse(substitute(source_name)),
    deparse(substitute(target_name)),
    deparse(substitute(value)),
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
  return(e)
}

#' @rdname line3D
#' @export
e_line_3d <- function(e, y, z, name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) UseMethod("e_line_3d")

#' @export
#' @method e_line_3d echarts4r
e_line_3d.echarts4r <- function(e, y, z, name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  e_line_3d_(
    e,
    deparse(substitute(y)),
    deparse(substitute(z)),
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_line_3d echarts4rProxy
e_line_3d.echarts4rProxy <- function(e, y, z, name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {

  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  e$chart <- e_line_3d_(
    e$chart,
    deparse(substitute(y)),
    deparse(substitute(z)),
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
  return(e)
}

#' Bar 3D
#'
#' Add 3D bars
#'
#' @inheritParams e_bar
#' @param y,z Coordinates.
#' @param bind Binding.
#' @param coord_system Coordinate system to use, one of \code{cartesian3D}, \code{geo3D}, \code{globe}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' \dontrun{
#' # volcano
#' volcano |>
#'   as.table() |>
#'   as.data.frame() |>
#'   dplyr::mutate(
#'     Var1 = as.integer(Var1),
#'     Var2 = as.integer(Var2)
#'   ) |>
#'   e_charts(Var1) |>
#'   e_bar_3d(Var2, Freq) |>
#'   e_visual_map(Freq)
#'
#' url <- paste0(
#'   "https://echarts.apache.org/examples/",
#'   "data-gl/asset/data/population.json"
#' )
#' data <- jsonlite::fromJSON(url)
#' data <- as.data.frame(data)
#' names(data) <- c("lon", "lat", "value")
#'
#' # globe
#' data |>
#'   e_charts(lon) |>
#'   e_globe() |>
#'   e_bar_3d(lat, value, coord_system = "globe") |>
#'   e_visual_map()
#'
#' # get3d
#' data |>
#'   e_charts(lon) |>
#'   e_geo_3d() |>
#'   e_bar_3d(lat, value, coord_system = "geo3D") |>
#'   e_visual_map()
#'
#' # stacked
#' v <- LETTERS[1:10]
#' matrix <- data.frame(
#'   x = sample(v, 300, replace = TRUE),
#'   y = sample(v, 300, replace = TRUE),
#'   z1 = rnorm(300, 10, 1),
#'   z2 = rnorm(300, 10, 1),
#'   stringsAsFactors = FALSE
#' ) |>
#'   dplyr::group_by(x, y) |>
#'   dplyr::summarise(
#'     z1 = sum(z1),
#'     z2 = sum(z2)
#'   ) |>
#'   dplyr::ungroup()
#'
#' trans <- list(opacity = 0.4) # transparency
#' emphasis <- list(itemStyle = list(color = "#313695"))
#'
#' matrix |>
#'   e_charts(x) |>
#'   e_bar_3d(y, z1, stack = "stack", name = "Serie 1", itemStyle = trans, emphasis = emphasis) |>
#'   e_bar_3d(y, z2, stack = "stack", name = "Serie 2", itemStyle = trans, emphasis = emphasis) |>
#'   e_legend()
#'
#' # timeline
#' matrix |>
#'   group_by(x) |>
#'   e_charts(y, timeline = TRUE) |>
#'   e_bar_3d(z1, z2) |>
#'   e_visual_map(z2)
#' }
#'
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#series-bar3D}{Additional arguments}
#'
#' @rdname e_bar_3d
#' @export
e_bar_3d <- function(
    e,
    y,
    z,
    bind,
    coord_system = "cartesian3D",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  UseMethod("e_bar_3d")
}

#' @export
#' @method e_bar_3d echarts4r
e_bar_3d.echarts4r <- function(
    e,
    y,
    z,
    bind,
    coord_system = "cartesian3D",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e_bar_3d_(
    e,
    deparse(substitute(y)),
    deparse(substitute(z)),
    bd,
    coord_system,
    name,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_bar_3d echarts4rProxy
e_bar_3d.echarts4rProxy <- function(
    e,
    y,
    z,
    bind,
    coord_system = "cartesian3D",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  if(is.null(e$chart$x$mapping$x)){
    stop("provide x in echarts4rProxy")
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_bar_3d_(
    e$chart,
    deparse(substitute(y)),
    deparse(substitute(z)),
    bd,
    coord_system,
    name,
    rm_x,
    rm_y,
    ...
  )
  return(e)
}

#' Surface
#'
#' Add a surface plot.
#'
#' @inheritParams e_bar
#' @param y,z Coordinates.
#' @param bind Binding.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' data("volcano")
#'
#' surface <- as.data.frame(as.table(volcano))
#' surface$Var1 <- as.numeric(surface$Var1)
#' surface$Var2 <- as.numeric(surface$Var2)
#'
#' surface |>
#'   e_charts(Var1) |>
#'   e_surface(Var2, Freq) |>
#'   e_visual_map(Freq)
#' @rdname e_surface
#' @export
e_surface <- function(
    e,
    y,
    z,
    bind,
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  UseMethod("e_surface")
}

#' @export
#' @method e_surface echarts4r
e_surface.echarts4r <- function(
    e,
    y,
    z,
    bind,
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e_surface_(
    e,
    y = deparse(substitute(y)),
    z = deparse(substitute(z)),
    bind = bd,
    name = name,
    rm_x = rm_x,
    rm_y = rm_y,
    ...
  )
}

#' @export
#' @method e_surface echarts4rProxy
e_surface.echarts4rProxy <- function(
    e,
    y,
    z,
    bind,
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_surface_(
    e$chart,
    deparse(substitute(y)),
    deparse(substitute(z)),
    bd,
    name,
    rm_x,
    rm_y,
    ...
  )
  return(e)
}

#' Lines
#'
#' Add lines.
#'
#' @inheritParams e_bar
#' @param source_lon,source_lat,target_lon,target_lat coordinates.
#' @param source_name,target_name Names of source and target.
#' @param value Value of edges.
#' @param coord_system Coordinate system to use, one of \code{geo}, or \code{cartesian2d}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' flights |>
#'   e_charts() |>
#'   e_geo() |>
#'   e_lines(
#'     start_lon,
#'     start_lat,
#'     end_lon,
#'     end_lat,
#'     airport1,
#'     airport2,
#'     cnt,
#'     name = "flights",
#'     lineStyle = list(normal = list(curveness = 0.3))
#'   ) |>
#'   e_tooltip(
#'     trigger = "item",
#'     formatter = htmlwidgets::JS("
#'       function(params){
#'         return(
#'           params.seriesName +'<br />' +
#'           params.data.source_name + ' -> ' +
#'           params.data.target_name + ':'+ params.value
#'         )
#'       }
#'    ")
#'   )
#'
#' # timeline
#' flights$grp <- rep(LETTERS[1:2], 89)
#'
#' flights |>
#'   group_by(grp) |>
#'   e_charts(timeline = TRUE) |>
#'   e_geo() |>
#'   e_lines(
#'     start_lon,
#'     start_lat,
#'     end_lon,
#'     end_lat,
#'     cnt,
#'     coord_system = "geo"
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#series-lines}{Additional arguments}
#'
#' @rdname e_lines
#' @export
e_lines <- function(
    e,
    source_lon,
    source_lat,
    target_lon,
    target_lat,
    source_name,
    target_name,
    value,
    coord_system = "geo",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {

  UseMethod("e_lines")
}

#' @export
#' @method e_lines echarts4r
e_lines.echarts4r <- function(
    e,
    source_lon,
    source_lat,
    target_lon,
    target_lat,
    source_name,
    target_name,
    value,
    coord_system = "geo",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(source_lat) || missing(source_lon) || missing(target_lat) || missing(target_lon)) {
    stop("missing coordinates", call. = FALSE)
  }

  if (missing(source_name)) {
    source_name <- NULL
  } else {
    source_name <- deparse(substitute(source_name))
  }

  if (missing(target_name)) {
    target_name <- NULL
  } else {
    target_name <- deparse(substitute(target_name))
  }

  if (missing(value)) {
    value <- NULL
  } else {
    value <- deparse(substitute(value))
  }

  e_lines_(
    e,
    deparse(substitute(source_lon)),
    deparse(substitute(source_lat)),
    deparse(substitute(target_lon)),
    deparse(substitute(target_lat)),
    source_name,
    target_name,
    value,
    coord_system,
    name,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_lines echarts4rProxy
e_lines.echarts4rProxy <- function(
    e,
    source_lon,
    source_lat,
    target_lon,
    target_lat,
    source_name,
    target_name,
    value,
    coord_system = "geo",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    ...) {
  if (missing(source_lat) || missing(source_lon) || missing(target_lat) || missing(target_lon)) {
    stop("missing coordinates", call. = FALSE)
  }

  if (missing(source_name)) {
    source_name <- NULL
  }

  if (missing(target_name)) {
    target_name <- NULL
  }

  if (missing(value)) {
    value <- NULL
  }

  e$chart <- e_lines_(
    e$chart,
    deparse(substitute(source_lon)),
    deparse(substitute(source_lat)),
    deparse(substitute(target_lon)),
    deparse(substitute(target_lat)),
    deparse(substitute(source_name)),
    deparse(substitute(target_name)),
    deparse(substitute(value)),
    coord_system,
    name,
    rm_x,
    rm_y,
    ...
  )

  return(e)
}

#' Scatter 3D
#'
#' Add 3D scatter.
#'
#' @inheritParams e_bar
#' @param y,z Coordinates.
#' @param bind Binding.
#' @param color,size Color and Size of bubbles.
#' @param coord_system Coordinate system to use, one of \code{geo3D},
#'   \code{globe}, or \code{cartesian3D}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' v <- LETTERS[1:10]
#' matrix <- data.frame(
#'   x = sample(v, 300, replace = TRUE),
#'   y = sample(v, 300, replace = TRUE),
#'   z = rnorm(300, 10, 1),
#'   color = rnorm(300, 10, 1),
#'   size = rnorm(300, 10, 1),
#'   stringsAsFactors = FALSE
#' ) |>
#'   dplyr::group_by(x, y) |>
#'   dplyr::summarise(
#'     z = sum(z),
#'     color = sum(color),
#'     size = sum(size)
#'   ) |>
#'   dplyr::ungroup()
#'
#' matrix |>
#'   e_charts(x) |>
#'   e_scatter_3d(y, z, size, color) |>
#'   e_visual_map(
#'     min = 1,
#'     max = 100,
#'     inRange = list(symbolSize = c(1, 30)),
#'     # scale size
#'     dimension = 3 # third dimension 0 = x, y = 1, z = 2, size = 3
#'   ) |>
#'   e_visual_map(
#'     min = 1,
#'     max = 100,
#'     inRange = list(color = c("#bf444c", "#d88273", "#f6efa6")),
#'     # scale colors
#'     dimension = 4,
#'     # third dimension 0 = x, y = 1, z = 2, size = 3, color = 4
#'     bottom = 300 # padding to avoid visual maps overlap
#'   )
#'
#' airports |>
#'   e_charts(long) |>
#'   e_globe(
#'     globeOuterRadius = 100
#'   ) |>
#'   e_scatter_3d(lat, cnt, coord_system = "globe", blendMode = "lighter") |>
#'   e_visual_map(inRange = list(symbolSize = c(1, 10)))
#'
#' # timeline
#' airports |>
#'   group_by(state) |>
#'   e_charts(long, timeline = TRUE) |>
#'   e_globe(
#'     globeOuterRadius = 100
#'   ) |>
#'   e_scatter_3d(lat, cnt, coord_system = "globe", blendMode = "lighter") |>
#'   e_visual_map(inRange = list(symbolSize = c(1, 10)))
#' @seealso
#'   \href{https://echarts.apache.org/en/option-gl.html#series-scatter3D}{Additional
#'   arguments}
#'
#' @rdname e_scatter_3d
#' @export
e_scatter_3d <- function(
    e,
    y,
    z,
    color,
    size,
    bind,
    coord_system = "cartesian3D",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    legend = FALSE,
    ...) {
  UseMethod("e_scatter_3d")
}

#' @export
#' @method e_scatter_3d echarts4r
e_scatter_3d.echarts4r <- function(
    e,
    y,
    z,
    color,
    size,
    bind,
    coord_system = "cartesian3D",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    legend = FALSE,
    ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  if (!missing(color)) {
    colour <- deparse(substitute(color))
  } else {
    colour <- NULL
  }

  sz <- .get_size(deparse(substitute(size)))
  bd <- .get_bind(deparse(substitute(bind)))

  e_scatter_3d_(
    e,
    deparse(substitute(y)),
    deparse(substitute(z)),
    colour,
    sz,
    bd,
    coord_system,
    name,
    rm_x,
    rm_y,
    legend,
    ...
  )
}

#' @export
#' @method e_scatter_3d echarts4rProxy
e_scatter_3d.echarts4rProxy <- function(
    e,
    y,
    z,
    color,
    size,
    bind,
    coord_system = "cartesian3D",
    name = NULL,
    rm_x = TRUE,
    rm_y = TRUE,
    legend = FALSE,
    ...) {
  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  if(is.null(e$chart$x$mapping$x)){
    stop("provide x in echarts4rProxy")
  }

  if (!missing(color)) {
    colour <- deparse(substitute(color))
  } else {
    colour <- NULL
  }

  sz <- .get_size(deparse(substitute(size)))
  bd <- .get_bind(deparse(substitute(bind)))

  e$chart <- e_scatter_3d_(
    e$chart,
    deparse(substitute(y)),
    deparse(substitute(z)),
    colour,
    sz,
    bd,
    coord_system,
    name,
    rm_x,
    rm_y,
    legend,
    ...
  )

  return(e)
}

#' Flow GL
#'
#' @inheritParams e_bar
#' @param y Vector position on the y axis.
#' @param sx,sy Velocity in respective axis.
#' @param color Vector color.
#' @param coord_system Coordinate system to use.
#' @param rm_x,rm_y Whether to remove x and y axis, only applies if \code{coord_system} is not \code{null}.
#'
#' @examples
#' # coordinates
#' vectors <- expand.grid(0:9, 0:9)
#' names(vectors) <- c("x", "y")
#' vectors$sx <- rnorm(100)
#' vectors$sy <- rnorm(100)
#' vectors$color <- log10(runif(100, 1, 10))
#'
#' vectors |>
#'   e_charts(x) |>
#'   e_flow_gl(y, sx, sy, color) |>
#'   e_visual_map(
#'     min = 0,
#'     max = 1,
#'     # log 10
#'     dimension = 4,
#'     # x = 0, y = 1, sx = 3, sy = 4
#'     show = FALSE,
#'     # hide
#'     inRange = list(
#'       color = c(
#'         "#313695",
#'         "#4575b4",
#'         "#74add1",
#'         "#abd9e9",
#'         "#e0f3f8",
#'         "#ffffbf",
#'         "#fee090",
#'         "#fdae61",
#'         "#f46d43",
#'         "#d73027",
#'         "#a50026"
#'       )
#'     )
#'   ) |>
#'   e_x_axis(
#'     splitLine = list(show = FALSE)
#'   ) |>
#'   e_y_axis(
#'     splitLine = list(show = FALSE)
#'   )
#'
#' # map
#' latlong <- seq(-180, 180, by = 5)
#' wind <- expand.grid(lng = latlong, lat = latlong)
#' wind$slng <- rnorm(nrow(wind), 0, 200)
#' wind$slat <- rnorm(nrow(wind), 0, 200)
#' wind$color <- abs(wind$slat) - abs(wind$slng)
#' rng <- range(wind$color)
#'
#' trans <- list(opacity = 0.5) # transparency
#'
#' wind |>
#'   e_charts(lng, backgroundColor = "#333") |>
#'   e_geo() |>
#'   e_flow_gl(
#'     lat,
#'     slng,
#'     slat,
#'     color,
#'     itemStyle = trans,
#'     particleSize = 2
#'   ) |>
#'   e_visual_map(
#'     color,
#'     # range
#'     dimension = 4,
#'     # lng = 0, lat = 1, slng = 2, slat = 3, color = 4
#'     show = FALSE,
#'     # hide
#'     inRange = list(
#'       color = c(
#'         "#313695",
#'         "#4575b4",
#'         "#74add1",
#'         "#abd9e9",
#'         "#e0f3f8",
#'         "#ffffbf",
#'         "#fee090",
#'         "#fdae61",
#'         "#f46d43",
#'         "#d73027",
#'         "#a50026"
#'       )
#'     )
#'   ) |>
#'   e_x_axis(show = FALSE) |>
#'   e_y_axis(show = FALSE)
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#series-flowGL}{Additional arguments}
#'
#' @rdname e_flow_gl
#' @export
e_flow_gl <- function(e, y, sx, sy, color, name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_flow_gl")}

#' @export
#' @method e_flow_gl echarts4r
e_flow_gl.echarts4r <- function(e, y, sx, sy, color, name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(y) || missing(sx) || missing(sy)) {
    stop("must pass y, sx, and sy", call. = FALSE)
  }

  if (!missing(color)) {
    colour <- deparse(substitute(color))
  } else {
    colour <- NULL
  }

  e_flow_gl_(
    e = e,
    y = deparse(substitute(y)),
    sx = deparse(substitute(sx)),
    sy = deparse(substitute(sy)),
    color = colour,
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_flow_gl echarts4rProxy
e_flow_gl.echarts4rProxy <- function(e, y, sx, sy, color, name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(y) || missing(sx) || missing(sy)) {
    stop("must pass y and z", call. = FALSE)
  }

  if (!missing(color)) {
    colour <- deparse(substitute(color))
  } else {
    colour <- NULL
  }

  e$chart <- e_flow_gl_(
    e = e$chart,
    y = deparse(substitute(y)),
    sx = deparse(substitute(sx)),
    sy = deparse(substitute(sy)),
    color = colour,
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
  return(e)
}

#' Scatter GL
#'
#' Draw scatter GL.
#'
#' @inheritParams e_bar
#' @param y,z Column names containing y and z data.
#' @param coord_system Coordinate system to plot against.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' quakes |>
#'   e_charts(long) |>
#'   e_geo(
#'     roam = TRUE,
#'     boundingCoords = list(
#'       c(185, -10),
#'       c(165, -40)
#'     )
#'   ) |>
#'   e_scatter_gl(lat, depth)
#'
#' # timeline
#' quakes$year <- rep(c("2017", "2018"), 500)
#'
#' quakes |>
#'   group_by(year) |>
#'   e_charts(long, timeline = TRUE) |>
#'   e_geo(
#'     roam = TRUE,
#'     boundingCoords = list(
#'       c(185, -10),
#'       c(165, -40)
#'     )
#'   ) |>
#'   e_scatter_gl(lat, depth)
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#series-scatterGL}{Additional arguments}
#'
#' @rdname e_scatter_gl
#' @export
e_scatter_gl <- function(e, y, z, name = NULL, coord_system = "geo", rm_x = TRUE, rm_y = TRUE, ...) {
  UseMethod("e_scatter_gl")}

#' @export
#' @method e_scatter_gl echarts4r
e_scatter_gl.echarts4r <- function(e, y, z, name = NULL, coord_system = "geo", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  z_serie <- NULL
  if (!missing(z)) {
    z_serie <- deparse(substitute(z))
  }

  e_scatter_gl_(
    e,
    deparse(substitute(y)),
    z_serie,
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_scatter_gl echarts4rProxy
e_scatter_gl.echarts4rProxy <- function(e, y, z, name = NULL, coord_system = "geo", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(y) || missing(z)) {
    stop("must pass y and z", call. = FALSE)
  }

  e$chart <- e_scatter_gl_(
    e$chart,
    deparse(substitute(y)),
    deparse(substitute(z)),
    name,
    coord_system,
    rm_x,
    rm_y,
    ...
  )
  return(e)
}

#' Pictorial
#'
#' Pictorial bar chart is a type of bar chart that customized glyph
#' (like images, SVG PathData) can be used instead of rectangular bar.
#'
#' @inheritParams e_bar
#' @param symbol Symbol to plot.
#'
#' @section Symbols:
#' \describe{
#'   \item{Built-in}{ \code{circle}, \code{rect}, \code{roundRect}, \code{triangle}, \code{diamond},
#'   \code{pin}, \code{arrow}.}
#'   \item{SVG Path}{ Path data for SVG graphics.}
#'   \item{Images}{ Path to image, don't forget to precede it with \code{image://}, see examples.}
#' }
#'
#' @examples
#' # built-in symbols
#' y <- rnorm(10, 10, 2)
#' df <- data.frame(
#'   x = 1:10,
#'   y = y,
#'   z = y - rnorm(10, 5, 1)
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_bar(z, barWidth = 10) |>
#'   e_pictorial(
#'     y,
#'     symbol = "rect",
#'     symbolRepeat = TRUE,
#'     z = -1,
#'     symbolSize = c(10, 4)
#'   ) |>
#'   e_theme("westeros")
#'
#' # svg path
#' path <- "path://M0,10 L10,10 C5.5,10 5.5,5 5,0 C4.5,5 4.5,10 0,10 z"
#'
#' style <- list(
#'   normal = list(opacity = 0.5),
#'   # normal
#'   emphasis = list(opacity = 1) # on hover
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_pictorial(
#'     y,
#'     symbol = path,
#'     barCategoryGap = "-130%",
#'     itemStyle = style
#'   )
#'
#' # image
#' # might not work in RStudio viewer
#' # open in browser
#' qomo <- paste0(
#'   "https://ecomfe.github.io/echarts-examples/public/",
#'   "data/asset/img/hill-Qomolangma.png"
#' )
#'
#' kili <- paste0(
#'   "https://ecomfe.github.io/echarts-examples/public/",
#'   "data/asset/img/hill-Kilimanjaro.png"
#' )
#'
#' data <- data.frame(
#'   x = c("Qomolangma", "Kilimanjaro"),
#'   value = c(8844, 5895),
#'   symbol = c(
#'     paste0("image://", qomo),
#'     paste0("image://", kili)
#'   )
#' )
#'
#' data |>
#'   e_charts(x) |>
#'   e_pictorial(value, symbol) |>
#'   e_legend(FALSE)
#'
#' # timeline
#' df <- data.frame(
#'   x = rep(1:5, 2),
#'   y = runif(10, 1, 10),
#'   year = c(
#'     rep(2017, 5),
#'     rep(2018, 5)
#'   )
#' )
#'
#' df |>
#'   group_by(year) |>
#'   e_charts(x, timeline = TRUE) |>
#'   e_pictorial(
#'     y,
#'     symbol = "rect",
#'     symbolRepeat = TRUE,
#'     z = -1,
#'     symbolSize = c(10, 4)
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#series-pictorialBar}{Additional arguments}
#'
#' @rdname e_pictorial
#' @export
e_pictorial <- function(e, serie, symbol, bind, name = NULL, legend = TRUE, y_index = 0, x_index = 0, ...) UseMethod("e_pictorial")

#' @export
#' @method e_pictorial echarts4r
e_pictorial.echarts4r <- function(e, serie, symbol, bind, name = NULL, legend = TRUE, y_index = 0, x_index = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie) || missing(symbol)) {
    stop("must pass serie and symbol", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  # only deparse if it is a column name
  if (deparse(substitute(symbol)) %in% colnames(e$x$data[[1]])) {
    symbol <- deparse(substitute(symbol))
  }

  e_pictorial_(
    e,
    deparse(substitute(serie)),
    symbol,
    bd,
    name,
    legend,
    y_index,
    x_index,
    ...
  )
}

#' @export
#' @method e_pictorial echarts4rProxy
e_pictorial.echarts4rProxy <- function(e, serie, symbol, bind, name = NULL, legend = TRUE, y_index = 0, x_index = 0, ...) {
  if (missing(serie) || missing(symbol)) {
    stop("must pass serie and symbol", call. = FALSE)
  }

  bd <- .get_bind(deparse(substitute(bind)))

  # only deparse if it is a column name
  if (deparse(substitute(symbol)) %in% colnames(e$chart$x$data[[1]])) {
    symbol <- deparse(substitute(symbol))
  }

  e$chart <- e_pictorial_(
    e$chart,
    deparse(substitute(serie)),
    symbol,
    bd,
    name,
    legend,
    y_index,
    x_index,
    ...
  )
  return(e)
}

#' Smooth
#'
#' Plot formulas.
#'
#' @inheritParams e_bar
#' @param formula formula to pass to \code{\link{lm}}.
#' @param symbol Symbol to use in \code{\link{e_line}}.
#' @param smooth Whether to smooth the line.
#' @param model_args Arguments to pass to the underlying model.
#' @param ... Additional arguments to pass to \code{\link{e_line}}.
#'
#' @examples
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length) |>
#'   e_scatter(Sepal.Width) |>
#'   e_lm(Sepal.Width ~ Sepal.Length) |>
#'   e_x_axis(min = 4)
#'
#' mtcars |>
#'   e_charts(disp) |>
#'   e_scatter(mpg, qsec) |>
#'   e_loess(mpg ~ disp, smooth = TRUE, showSymbol = FALSE)
#'
#' # timeline
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_scatter(Sepal.Width) |>
#'   e_lm(Sepal.Width ~ Sepal.Length) |>
#'   e_x_axis(min = 4, max = 8) |>
#'   e_y_axis(max = 5)
#' @rdname smooth
#' @export
e_lm <- function(e, formula, name = NULL, legend = TRUE, symbol = "none", smooth = TRUE, model_args = list(), ...) UseMethod("e_lm")

#' @export
#' @method e_lm echarts4r
#' @importFrom stats complete.cases
e_lm.echarts4r <- function(e, formula, name = NULL, legend = TRUE, symbol = "none", smooth = TRUE, model_args = list(), ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  form <- as.formula(formula)

  if (!is.null(name) && length(name) != length(e$x$data)) {
    stop("More groups than names", call. = FALSE)
  }

  for (i in seq_along(e$x$data)) {
    e$x$data[[i]] <- e$x$data[[i]][stats::complete.cases(e$x$data[[i]]), ]

    model_args$formula <- form
    model_args$data <- e$x$data[[i]]

    model <- tryCatch(
      do.call(lm, model_args),
      error = function(e) e
    )

    if (!inherits(model, "error")) {
      data <- broom::augment(model)
      data <- data |> dplyr::select(-dplyr::one_of(names(model$model)))

      e$x$data[[i]] <- dplyr::bind_cols(e$x$data[[i]], data)

      vector <- .build_data2(e$x$data[[i]], e$x$mapping$x, ".fitted")

      l_data <- list(data = vector)

      l <- list(
        name = name,
        type = "line",
        symbol = symbol,
        smooth = smooth,
        ...
      )

      if (!e$x$tl) {
        if (is.null(name)) {
          nm <- paste0(names(e$x$data[[i]])[i], "-lm")
        } else {
          nm <- name[i]
        }

        l$name <- nm

        l <- append(l, l_data)

        e$x$opts$series <- append(e$x$opts$series, list(l))

        if (isTRUE(legend)) {
          e$x$opts$legend$data <- append(e$x$opts$legend$data, list(nm))
        }
      } else {
        e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(l_data))
      }
    }
  }

  if (isTRUE(e$x$tl) && !inherits(model, "error")) {
    if (isTRUE(legend) && !is.null(name)) {
      e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name))
    }

    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(l))
  }

  e
}

#' @export
#' @method e_lm echarts4rProxy
#' @importFrom stats complete.cases
e_lm.echarts4rProxy <- function(e, formula, name = NULL, legend = TRUE, symbol = "none", smooth = TRUE, model_args = list(), ...) {
  form <- as.formula(formula)

  for (i in seq_along(e$chart$x$data)) {
    e$chart$x$data[[i]] <- e$chart$x$data[[i]][stats::complete.cases(e$chart$x$data[[i]]), ]

    model_args$formula <- form
    model_args$data <- e$chart$x$data[[i]]

    model <- tryCatch(
      do.call(lm, model_args),
      error = function(e) e
    )

    if (!inherits(model, "error")) {
      data <- broom::augment(model)
      data <- data |> dplyr::select(-dplyr::one_of(names(model$model)))

      e$chart$x$data[[i]] <- dplyr::bind_cols(e$chart$x$data[[i]], data)

      vector <- .build_data2(e$chart$x$data[[i]], e$chart$x$mapping$x, ".fitted")

      l_data <- list(data = vector)

      l <- list(
        name = name,
        type = "line",
        symbol = symbol,
        smooth = smooth,
        ...
      )

      if (!e$chart$x$tl) {
        if (is.null(name)) {
          nm <- paste0(names(e$chart$x$data[[i]])[i], "-lm")
        } else {
          nm <- name
        }

        l$name <- nm

        l <- append(l, l_data)

        e$chart$x$opts$series <- append(e$chart$x$opts$series, list(l))

        if (isTRUE(legend)) {
          e$chart$x$opts$legend$data <- append(e$chart$x$opts$legend$data, list(nm))
        }
      } else {
        e$chart$x$opts$options[[i]]$series <- append(e$chart$x$opts$options[[i]]$series, list(l_data))
      }
    }
  }

  if (isTRUE(e$chart$x$tl) && !inherits(model, "error")) {
    if (isTRUE(legend) && !is.null(name)) {
      e$chart$x$opts$baseOption$legend$data <- append(e$chart$x$opts$baseOption$legend$data, list(name))
    }

    e$chart$x$opts$baseOption$series <- append(e$chart$x$opts$baseOption$series, list(l))
  }

  e
}

#' @rdname smooth
#' @export
e_glm <- function(e, formula, name = NULL, legend = TRUE, symbol = "none", smooth = TRUE, model_args = list(), ...) UseMethod("e_glm")

#' @export
#' @method e_glm echarts4r
#' @importFrom stats complete.cases
e_glm.echarts4r <- function(e, formula, name = NULL, legend = TRUE, symbol = "none", smooth = TRUE, model_args = list(), ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  form <- as.formula(formula)

  for (i in seq_along(e$x$data)) {
    e$x$data[[i]] <- e$x$data[[i]][stats::complete.cases(e$x$data[[i]]), ]

    model_args$formula <- form
    model_args$data <- e$x$data[[i]]

    model <- tryCatch(
      do.call(glm, model_args),
      error = function(e) e
    )

    if (!inherits(model, "error")) {
      data <- broom::augment(model)
      data <- data |> dplyr::select(-dplyr::one_of(names(model$model)))

      e$x$data[[i]] <- dplyr::bind_cols(e$x$data[[i]], data)

      vector <- .build_data2(e$x$data[[i]], e$x$mapping$x, ".fitted")

      l_data <- list(data = vector)

      l <- list(
        name = name,
        type = "line",
        symbol = symbol,
        smooth = smooth,
        ...
      )

      if (!e$x$tl) {
        if (is.null(name)) {
          nm <- paste0(names(e$x$data[[i]])[i], "-glm")
        } else {
          nm <- name
        }

        l$name <- nm

        l <- append(l, l_data)

        e$x$opts$series <- append(e$x$opts$series, list(l))

        if (isTRUE(legend)) {
          e$x$opts$legend$data <- append(e$x$opts$legend$data, list(nm))
        }
      } else {
        e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(l_data))
      }
    }
  }

  if (isTRUE(e$x$tl) && !inherits(model, "error")) {
    if (isTRUE(legend) && !is.null(name)) {
      e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name))
    }

    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(l))
  }

  e
}

#' @export
#' @method e_glm echarts4rProxy
#' @importFrom stats complete.cases
e_glm.echarts4rProxy <- function(e, formula, name = NULL, legend = TRUE, symbol = "none", smooth = TRUE, model_args = list(), ...) {
  form <- as.formula(formula)

  for (i in seq_along(e$chart$x$data)) {
    e$chart$x$data[[i]] <- e$chart$x$data[[i]][stats::complete.cases(e$chart$x$data[[i]]), ]

    model_args$formula <- form
    model_args$data <- e$chart$x$data[[i]]

    model <- tryCatch(
      do.call(glm, model_args),
      error = function(e) e
    )

    if (!inherits(model, "error")) {
      data <- broom::augment(model)
      data <- data |> dplyr::select(-dplyr::one_of(names(model$model)))

      e$chart$x$data[[i]] <- dplyr::bind_cols(e$chart$x$data[[i]], data)

      vector <- .build_data2(e$chart$x$data[[i]], e$chart$x$mapping$x, ".fitted")

      l_data <- list(data = vector)

      l <- list(
        name = name,
        type = "line",
        symbol = symbol,
        smooth = smooth,
        ...
      )

      if (!e$chart$x$tl) {
        if (is.null(name)) {
          nm <- paste0(names(e$chart$x$data[[i]])[i], "-glm")
        } else {
          nm <- name
        }

        l$name <- nm

        l <- append(l, l_data)

        e$chart$x$opts$series <- append(e$chart$x$opts$series, list(l))

        if (isTRUE(legend)) {
          e$chart$x$opts$legend$data <- append(e$chart$x$opts$legend$data, list(nm))
        }
      } else {
        e$chart$x$opts$options[[i]]$series <- append(e$chart$x$opts$options[[i]]$series, list(l_data))
      }
    }
  }

  if (isTRUE(e$chart$x$tl) && !inherits(model, "error")) {
    if (isTRUE(legend) && !is.null(name)) {
      e$chart$x$opts$baseOption$legend$data <- append(e$chart$x$opts$baseOption$legend$data, list(name))
    }

    e$chart$x$opts$baseOption$series <- append(e$chart$x$opts$baseOption$series, list(l))
  }

  e
}

#' @rdname smooth
#' @export
e_loess <- function(
    e,
    formula,
    name = NULL,
    legend = TRUE,
    symbol = "none",
    smooth = TRUE,
    x_index = 0,
    y_index = 0,
    model_args = list(),
    ...) {
  UseMethod("e_loess")
}

#' @export
#' @method e_loess echarts4r
#' @importFrom stats complete.cases
e_loess.echarts4r <- function(
    e,
    formula,
    name = NULL,
    legend = TRUE,
    symbol = "none",
    smooth = TRUE,
    x_index = 0,
    y_index = 0,
    model_args = list(),
    ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  for (i in seq_along(e$x$data)) {
    e$x$data[[i]] <- e$x$data[[i]][stats::complete.cases(e$x$data[[i]]), ]

    model_args$formula <- as.formula(formula)
    model_args$data <- e$x$data[[i]]

    mod <- tryCatch(
      do.call(loess, model_args),
      error = function(e) e
    )

    if (!inherits(mod, "error")) {
      ser <- "ECHARTS4RLOESS"

      e$x$data[[i]][, ser] <- predict(mod)

      vector <- .build_data2(
        e$x$data[[i]],
        e$x$mapping$x,
        ser
      )

      l_data <- list(data = vector)

      l_opts <- list(
        type = "line",
        yAxisIndex = y_index,
        xAxisIndex = x_index,
        name = name,
        ...
      )

      if (y_index != 0) {
        serie <- names(e$x$data[[i]])[i]
        e <- .set_y_axis(e, serie, y_index)
      }

      if (x_index != 0) {
        e <- .set_x_axis(e, x_index)
      }

      if (!e$x$tl) {
        if (is.null(name)) {
          nm <- paste0(names(e$x$data[[i]])[i], "-loess")
        } else {
          nm <- name
        }

        l_opts$name <- nm

        l_data <- append(l_data, l_opts)

        if (isTRUE(legend) && !is.null(nm)) {
          e$x$opts$legend$data <- append(e$x$opts$legend$data, list(nm))
        }

        e$x$opts$series <- append(e$x$opts$series, list(l_data))
      } else {
        e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(l_data))
      }
    }
  }

  if (isTRUE(e$x$tl) && !inherits(mod, "error")) {
    if (isTRUE(legend) && !is.null(name)) {
      e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name))
    }

    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(l_opts))
  }

  e
}

#' @export
#' @method e_loess echarts4rProxy
#' @importFrom stats complete.cases
e_loess.echarts4rProxy <- function(
    e,
    formula,
    name = NULL,
    legend = TRUE,
    symbol = "none",
    smooth = TRUE,
    x_index = 0,
    y_index = 0,
    model_args = list(),
    ...) {
  for (i in seq_along(e$chart$x$data)) {
    e$chart$x$data[[i]] <- e$chart$x$data[[i]][stats::complete.cases(e$chart$x$data[[i]]), ]

    model_args$formula <- as.formula(formula)
    model_args$data <- e$chart$x$data[[i]]

    mod <- tryCatch(
      do.call(loess, model_args),
      error = function(e) e
    )

    if (!inherits(mod, "error")) {
      ser <- "ECHARTS4RLOESS"

      e$chart$x$data[[i]][, ser] <- predict(mod)

      vector <- .build_data2(
        e$chart$x$data[[i]],
        e$chart$x$mapping$x,
        ser
      )

      l_data <- list(data = vector)

      l_opts <- list(
        type = "line",
        yAxisIndex = y_index,
        xAxisIndex = x_index,
        name = name,
        ...
      )

      if (y_index != 0) {
        serie <-  names(e$x$data[[i]])[i]
        e <- .set_y_axis(e, serie, y_index, i)
      }

      if (x_index != 0) {
        e <- .set_x_axis(e, x_index, i)
      }

      if (!e$chart$x$tl) {
        if (is.null(name)) {
          nm <- paste0(names(e$chart$x$data[[i]])[i], "-loess")
        } else {
          nm <- name
        }

        l_opts$name <- nm

        l_data <- append(l_data, l_opts)

        if (isTRUE(legend) && !is.null(nm)) {
          e$chart$x$opts$legend$data <- append(e$chart$x$opts$legend$data, list(nm))
        }

        e$chart$x$opts$series <- append(e$chart$x$opts$series, list(l_data))
      } else {
        e$chart$x$opts$options[[i]]$series <- append(e$chart$x$opts$options[[i]]$series, list(l_data))
      }
    }
  }

  if (isTRUE(e$chart$x$tl) && !inherits(mod, "error")) {
    if (isTRUE(legend) && !is.null(name)) {
      e$chart$x$opts$baseOption$legend$data <- append(e$chart$x$opts$baseOption$legend$data, list(name))
    }

    e$chart$x$opts$baseOption$series <- append(e$chart$x$opts$baseOption$series, list(l_opts))
  }

  e
}

#' Histogram & Density
#'
#' Add a histogram or density plots.
#'
#' @inheritParams e_bar
#' @param bar_width Width of bars.
#' @param breaks Passed to \code{\link{hist}}.
#' @param smooth Whether to use smoothed lines, passed to \code{\link{e_line}}.
#'
#' @examples
#' mtcars |>
#'   e_charts() |>
#'   e_histogram(mpg, name = "histogram") |>
#'   e_density(mpg, areaStyle = list(opacity = .4), smooth = TRUE, name = "density", y_index = 1) |>
#'   e_tooltip(trigger = "axis")
#'
#' # timeline
#' mtcars |>
#'   group_by(cyl) |>
#'   e_charts(timeline = TRUE) |>
#'   e_histogram(mpg, name = "histogram") |>
#'   e_density(mpg, name = "density", y_index = 1)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-bar}{Additional arguments for histogram},
#'  \href{https://echarts.apache.org/en/option.html#series-line}{Additional arguments for density}
#'
#' @rdname histogram
#' @export
e_histogram <- function(
  e,
  serie,
  breaks = "Sturges",
  name = "histogram",
  legend = TRUE,
  bar_width = "99%",
  x_index = 0,
  y_index = 0,
  ...
) {
  UseMethod("e_histogram")
}

#' @export
#' @method e_histogram echarts4r
e_histogram.echarts4r <- function(
  e,
  serie,
  breaks = "Sturges",
  name = "histogram",
  legend = TRUE,
  bar_width = "99%",
  x_index = 0,
  y_index = 0,
  ...
) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  e_histogram_(e, deparse(substitute(serie)), breaks, name, legend, bar_width, x_index, y_index, ...)
}

#' @export
#' @method e_histogram echarts4rProxy
e_histogram.echarts4rProxy <- function(
  e,
  serie,
  breaks = "Sturges",
  name = "histogram",
  legend = TRUE,
  bar_width = "99%",
  x_index = 0,
  y_index = 0,
  ...
) {
  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  e$chart <- e_histogram_(e$chart, deparse(substitute(serie)), breaks, name, legend, bar_width, x_index, y_index, ...)
  return(e)
}

#' @rdname histogram
#' @export
e_density <- function(
    e,
    serie,
    breaks = "Sturges",
    name = NULL,
    legend = TRUE,
    x_index = 0,
    y_index = 0,
    smooth = TRUE,
    ...) {
  UseMethod("e_density")
}

#' @export
#' @method e_density echarts4r
e_density.echarts4r <- function(
    e,
    serie,
    breaks = "Sturges",
    name = NULL,
    legend = TRUE,
    x_index = 0,
    y_index = 0,
    smooth = TRUE,
    ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  e_density_(e, deparse(substitute(serie)), breaks, name, legend, x_index, y_index, ...)
}

#' @export
#' @method e_density echarts4rProxy
e_density.echarts4rProxy <- function(
    e,
    serie,
    breaks = "Sturges",
    name = NULL,
    legend = TRUE,
    x_index = 0,
    y_index = 0,
    smooth = TRUE,
    ...) {

  if (missing(serie)) {
    stop("must pass serie", call. = FALSE)
  }

  e$chart <- e_density_(e$chart, deparse(substitute(serie)), breaks, name, legend, x_index, y_index, ...)
  return(e)
}

# TODO I can't get this to work. I need an example.
# flights |> e_charts() |> e_lines_gl(flights)

#' Lines WebGL
#'
#' Draw WebGL lines.
#'
#' @inheritParams e_bar
#' @param data A list.
#' @param ... Any other options (this series type is mostly undocumented).
#'
#' @export
e_lines_gl <- function(e, data, coord_system = "geo", ...) UseMethod("e_lines_gl")

#' @export
#' @method e_lines_gl echarts4r
e_lines_gl.echarts4r <- function(e, data, coord_system = "geo", ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(data)) {
    stop("missing data", call. = FALSE)
  }

  serie <- list(
    type = "linesGL",
    coordinateSystem = coord_system,
    data = data,
    ...
  )

  e$x$opts$series <- append(e$x$opts$series, list(serie))
  e
}

#' @export
#' @method e_lines_gl echarts4rProxy
e_lines_gl.echarts4rProxy <- function(e, data, coord_system = "geo", ...) {
  if (missing(data)) {
    stop("missing data", call. = FALSE)
  }

  serie <- list(
    type = "linesGL",
    coordinateSystem = coord_system,
    data = data,
    ...
  )

  e$chart$x$opts$series <- append(e$chart$x$opts$series, list(serie))
  e
}

#' Confidence bands
#'
#' Add confidence bands
#'
#' @inheritParams e_bar
#' @param min,max series.
#' @param stack Name of stack.
#' @param symbol Whether to show symbols on lower and upper band lines.
#' @param areaStyle The style of lower and upper bands, i.e.: color.
#' @param legend Whether to show \code{min} and \code{max} in legend.
#' @param ... All options must be of vectors or lists of length 2 where the first argument is
#' for the lower bound and the second for the upper bound, see examples.
#'
#' @examples
#' df <- data.frame(
#'   x = 1:10,
#'   y = runif(10, 5, 10)
#' ) |>
#'   dplyr::mutate(
#'     lwr = y - runif(10, 1, 3),
#'     upr = y + runif(10, 2, 4)
#'   )
#'
#' df |>
#'   e_charts(x) |>
#'   e_line(y) |>
#'   e_band(lwr, upr)
#' @name band
#' @export
e_band <- function(
    e,
    min,
    max,
    stack = "confidence-band",
    symbol = c("none", "none"),
    areaStyle = list(list(color = "rgba(0,0,0,0)"), list()),
    legend = list(FALSE, FALSE),
    ...) {

  UseMethod("e_band")
}

#' @export
#' @method e_band echarts4r
e_band.echarts4r <- function(
    e,
    min,
    max,
    stack = "confidence-band",
    symbol = c("none", "none"),
    areaStyle = list(list(color = "rgba(0,0,0,0)"), list()),
    legend = list(FALSE, FALSE),
    ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(min) || missing(max)) {
    stop("must pass min and max", call. = FALSE)
  }

  e_band_(
    e,
    deparse(substitute(min)),
    deparse(substitute(max)),
    stack = "confidence-band",
    symbol = symbol,
    areaStyle = areaStyle,
    legend = legend,
    ...
  )
}

#' @export
#' @method e_band echarts4rProxy
e_band.echarts4rProxy <- function(
    e,
    min,
    max,
    stack = "confidence-band",
    symbol = c("none", "none"),
    areaStyle = list(list(color = "rgba(0,0,0,0)"), list()),
    legend = list(FALSE, FALSE),
    ...) {
  if (missing(min) || missing(max)) {
    stop("must pass min and max", call. = FALSE)
  }

  e$chart <- e_band_(
    e$chart,
    deparse(substitute(min)),
    deparse(substitute(max)),
    stack = "confidence-band",
    symbol = symbol,
    areaStyle = areaStyle,
    legend = legend,
    ...
  )
  return(e)
}

#' Correlation
#'
#' @inheritParams e_bar
#' @param visual_map Whether to add the visual map.
#' @param order Ordering method, passed to \link[corrplot]{corrMatOrder}.
#'
#' @param ... Any argument to pass to \code{\link{e_heatmap}} and \code{\link{e_visual_map}}.
#'
#' @examples
#' cor(mtcars) |>
#'   e_charts() |>
#'   e_correlations(
#'     order = "hclust",
#'     visual_map = FALSE
#'   ) |>
#'   e_visual_map(
#'     min = -1,
#'     max = 1
#'   )
#' @export
e_correlations <- function(e, order = NULL, visual_map = TRUE, ...) UseMethod("e_correlations")

#' @export
#' @method e_correlations echarts4r
e_correlations.echarts4r <- function(e, order = NULL, visual_map = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  mat <- e$x$data[[1]]

  if (!is.null(order)) {
    order <- corrplot::corrMatOrder(mat, order = order)
    mat <- mat[order, order]
  }

  row.names(mat) <- colnames(mat)
  mat <- as.data.frame(as.table(mat))
  names(mat) <- c("x", "y", "correlation")

  e <- e |>
    e_data(mat, x) |>
    e_heatmap_("y", "correlation", ...)

  if (isTRUE(visual_map)) {
    e <- e |> e_visual_map_(min = -1, max = 1, ...)
  }

  return(e)
}

#' @export
#' @method e_correlations echarts4rProxy
e_correlations.echarts4rProxy <- function(e, order = NULL, visual_map = TRUE, ...) {

  mat <- e$chart$x$data[[1]]

  if (!is.null(order)) {
    order <- corrplot::corrMatOrder(mat, order = order)
    mat <- mat[order, order]
  }

  row.names(mat) <- colnames(mat)
  mat <- as.data.frame(as.table(mat))
  names(mat) <- c("x", "y", "correlation")

  e$chart <- e$chart |>
    e_data(mat, x) |>
    e_heatmap_("y", "correlation", ...)

  if (isTRUE(visual_map)) {
    e$chart <- e$chart |> e_visual_map_(min = -1, max = 1, ...)
  }

  return(e)
}

#' Error bar
#'
#' Add error bars.
#'
#' @inheritParams e_bar
#' @param lower,upper Lower and upper error bands.
#' @param renderer mame of render function from renderers.js
#' @param itemStyle  mostly used for borderWidth, default 1.5
#'
#' @examples
#' df <- data.frame(
#'   x = factor(c(1, 2)),
#'   y = c(1, 5),
#'   upper = c(1.1, 5.3),
#'   lower = c(0.8, 4.6)
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_bar(y) |>
#'   e_error_bar(lower, upper)
#'
#' # timeline
#' df <- data.frame(
#'   x = factor(c(1, 1, 2, 2)),
#'   y = c(1, 5, 3, 4),
#'   step = factor(c(1, 2, 1, 2)),
#'   upper = c(1.1, 5.3, 3.3, 4.2),
#'   lower = c(0.8, 4.6, 2.4, 3.6)
#' )
#'
#' df |>
#'   group_by(step) |>
#'   e_charts(x, timeline = TRUE) |>
#'   e_bar(y) |>
#'   e_error_bar(lower, upper)
#' @rdname errorbar
#' @export
e_error_bar <- function(
    e,
    lower,
    upper,
    name = NULL,
    legend = FALSE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  UseMethod("e_error_bar")
}

#' @export
#' @method e_error_bar echarts4r
e_error_bar.echarts4r <- function(
    e,
    lower,
    upper,
    name = NULL,
    legend = FALSE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(lower) || missing(upper)) {
    stop("must pass lower and upper", call. = FALSE)
  }

  e_error_bar_(
    e,
    deparse(substitute(lower)),
    deparse(substitute(upper)),
    name = name,
    legend = legend,
    y_index = y_index,
    x_index = x_index,
    coord_system = coord_system,
    ...
  )
}

#' @export
#' @method e_error_bar echarts4rProxy
e_error_bar.echarts4rProxy <- function(
    e,
    lower,
    upper,
    name = NULL,
    legend = FALSE,
    y_index = 0,
    x_index = 0,
    coord_system = "cartesian2d",
    ...) {
  if (missing(lower) || missing(upper)) {
    stop("must pass lower, or upper", call. = FALSE)
  }

  e$chart <- e_error_bar_(
    e$chart,
    deparse(substitute(lower)),
    deparse(substitute(upper)),
    name = name,
    legend = legend,
    y_index = y_index,
    x_index = x_index,
    coord_system = coord_system,
    ...
  )
  return(e)
}


#' Area bands
#'
#' Add area bands
#'
#' @inheritParams e_bar
#' @param lower,upper series of lower and upper borders of the band
#' @param itemStyle  mostly used for borderWidth, default 0.5
#' @param ... additional options
#'
#' @examples
#' data(EuStockMarkets)
#' as.data.frame(EuStockMarkets) |>
#'   dplyr::slice_head(n = 200) |>
#'   dplyr::mutate(day = 1:dplyr::n()) |>
#'   e_charts(day) |>
#'   e_line(CAC, symbol = "none") |>
#'   e_band2(DAX, FTSE, color = "lemonchiffon") |>
#'   e_band2(DAX, SMI, color = "lightblue", itemStyle = list(borderWidth = 0)) |>
#'   e_y_axis(scale = TRUE) |>
#'   e_datazoom(start = 50)
#' @name band2
#' @export
e_band2 <- function(e, lower, upper,   name = NULL,
                    legend = TRUE,
                    y_index = 0,
                    x_index = 0,
                    coord_system = "cartesian2d",
                    itemStyle = list(borderWidth = 0.5),
                    ...) {
  UseMethod("e_band2")
}

#' @export
#' @method e_band2 echarts4r
e_band2.echarts4r <- function(e, lower, upper,  name = NULL,
                              legend = TRUE,
                              y_index = 0,
                              x_index = 0,
                              coord_system = "cartesian2d",
                              itemStyle = list(borderWidth = 0.5), ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(lower) || missing(upper)) {
    stop("must pass lower and upper", call. = FALSE)
  }
  if (coord_system != "cartesian2d") {
    stop("only cartesian2d supported", call. = FALSE)
  }

  e_band2_(
    e,
    deparse(substitute(lower)),
    deparse(substitute(upper)),
    name,
    legend,
    y_index,
    x_index,
    coord_system,
    itemStyle,
    ...
  )
}

#' @export
#' @method e_band2 echarts4rProxy
e_band2.echarts4rProxy <- function(e, lower, upper,  name = NULL,
                                   legend = TRUE,
                                   y_index = 0,
                                   x_index = 0,
                                   coord_system = "cartesian2d",
                                   itemStyle = list(borderWidth = 0.5), ...) {
  if (missing(lower) || missing(upper)) {
    stop("must pass lower and upper", call. = FALSE)
  }

  e$chart <- e_band2_(
    e$chart,
    deparse(substitute(lower)),
    deparse(substitute(upper)),
    name,
    legend,
    y_index,
    x_index,
    coord_system,
    itemStyle,
    ...
  )
  return(e)
}

#' Chord
#'
#' Draw a Chord chart.
#'
#' @inheritParams e_bar
#' @param source,target Source and target columns.
#' @param value Value shared between \code{source} and \code{target}.
#' @param rm_x,rm_y Whether to remove the x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' chord_data <- data.frame(
#'   source = c("a", "b", "c", "d", "c"),
#'   target = c("b", "c", "d", "e", "e"),
#'   value = ceiling(rnorm(5, 10, 1)),
#'   stringsAsFactors = FALSE
#' )
#'
#' chord_data |>
#'   e_charts() |>
#'   e_chord(source, target, value)
#' @seealso \href{https://echarts.apache.org/en/option.html#series-chord}{Additional arguments}
#'
#' @rdname e_chord
#' @export
e_chord <- function(e, source, target, value, rm_x = TRUE, rm_y = TRUE, ...) UseMethod("e_chord")

#' @export
#' @method e_chord echarts4r
e_chord.echarts4r <- function(e, source, target, value, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(source) || missing(target) || missing(value)) {
    stop("missing source, target or values", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  e_chord_(
    e,
    deparse(substitute(source)),
    deparse(substitute(target)),
    deparse(substitute(value)),
    rm_x,
    rm_y,
    ...
  )
}

#' @export
#' @method e_chord echarts4rProxy
e_chord.echarts4rProxy <- function(e, source, target, value, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(source) || missing(target) || missing(value)) {
    stop("missing source, target or values", call. = FALSE)
  }

  e$chart <- e_chord_(
    e$chart,
    deparse(substitute(source)),
    deparse(substitute(target)),
    deparse(substitute(value)),
    rm_x,
    rm_y,
    ...
  )

  return(e)
}

#' Visual Map
#'
#' @inheritParams e_bar
#' @param serie Column name of serie to scale against.
#' @param calculable Whether show handles, which can be dragged to adjust "selected range".
#' @param type One of \code{continuous} or \code{piecewise}.
#' @param scale A function that takes a vector of \code{numeric} and returns a vector of \code{numeric}
#' of the same length.
#'
#' @section Scaling function: defaults to \code{e_scale} which is a basic function that rescales \code{size}
#' between 1 and 20 for that makes for decent sized points on the chart.
#'
#' @examples
#' # scaled data
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_scatter(wt, qsec, scale = e_scale) |>
#'   e_visual_map(qsec, scale = e_scale)
#'
#' # dimension
#' # color according to y axis
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_scatter(wt) |>
#'   e_visual_map(wt, dimension = 1)
#'
#' # color according to x axis
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_scatter(wt) |>
#'   e_visual_map(mpg, dimension = 0)
#'
#' v <- LETTERS[1:10]
#' matrix <- data.frame(
#'   x = sample(v, 300, replace = TRUE),
#'   y = sample(v, 300, replace = TRUE),
#'   z = rnorm(300, 10, 1),
#'   color = rnorm(300, 10, 1),
#'   size = rnorm(300, 10, 1),
#'   stringsAsFactors = FALSE
#' ) |>
#'   dplyr::group_by(x, y) |>
#'   dplyr::summarise(
#'     z = sum(z),
#'     color = sum(color),
#'     size = sum(size)
#'   ) |>
#'   dplyr::ungroup()
#'
#' matrix |>
#'   e_charts(x) |>
#'   e_scatter_3d(y, z, color, size) |>
#'   e_visual_map(
#'     z,
#'     # scale to z
#'     inRange = list(symbolSize = c(1, 30)),
#'     # scale size
#'     dimension = 3 # third dimension 0 = x, y = 1, z = 2, size = 3
#'   ) |>
#'   e_visual_map(
#'     z,
#'     # scale to z
#'     inRange = list(color = c("#bf444c", "#d88273", "#f6efa6")),
#'     # scale colors
#'     dimension = 4,
#'     # third dimension 0 = x, y = 1, z = 2, size = 3, color = 4
#'     bottom = 300 # padding to avoid visual maps overlap
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#visualMap}{Additional arguments}
#'
#' @rdname e_visual_map
#' @export
e_visual_map <- function(e, serie, calculable = TRUE, type = c("continuous", "piecewise"), scale = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!missing(serie)) {
    serie <- deparse(substitute(serie))
  } else {
    serie <- NULL
  }

  e_visual_map_(e, serie, calculable, type, scale, ...)
}

#' @rdname e_visual_map
#' @export
e_visual_map_ <- function(e, serie = NULL, calculable = TRUE, type = c("continuous", "piecewise"), scale = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!length(e$x$opts$visualMap)) {
    e$x$opts$visualMap <- list()
  }

  vm <- list(...)
  vm$calculable <- calculable
  vm$type <- type[1]

  if (!is.null(serie)) {
    dat <- .get_data(e, serie)
    if (!is.null(scale)) {
      dat <- scale(dat)
    }
    rng <- range(dat, na.rm = TRUE) |> .get_validate_range()
    vm$min <- rng$min
    vm$max <- rng$max
  }

  if (!e$x$tl) {
    e$x$opts$visualMap <- append(e$x$opts$visualMap, list(vm))
  } else {
    e$x$opts$baseOption$visualMap <- append(e$x$opts$baseOption$visualMap, list(vm))
  }

  e
}

#' Tooltip
#'
#' Customise tooltip
#'
#' @inheritParams e_bar
#' @param trigger What triggers the tooltip, one of \code{item} or \code{axis}.
#' @param formatter Item and Pointer formatter as returned
#' by \code{\link{e_tooltip_item_formatter}}, \code{\link{e_tooltip_pointer_formatter}},
#' \code{\link{e_tooltip_pie_formatter}}.
#' @param style Formatter style, one of \code{decimal}, \code{percent}, or \code{currency}.
#' @param currency Currency to to display.
#' @param digits Number of decimals.
#' @param locale Locale, if \code{NULL} then it is inferred from \code{Sys.getlocale}.
#'
#' @section Formatters:
#' \itemize{
#'   \item{\code{\link{e_tooltip_pie_formatter}}: special helper for \code{\link{e_pie}}.}
#'   \item{\code{\link{e_tooltip_item_formatter}}: general helper, this is passed to the \href{https://echarts.apache.org/en/option.html#tooltip.formatter}{tooltip \code{formatter}}.}
#'   \item{\code{\link{e_tooltip_pointer_formatter}}: helper for pointer, this is passed to the
#'   \href{https://echarts.apache.org/en/option.html#tooltip.axisPointer.label}{\code{label} parameter under \code{axisPointer}}.}
#' }
#'
#' @examples
#' # basic
#' USArrests |>
#'   e_charts(Assault) |>
#'   e_scatter(Murder) |>
#'   e_tooltip()
#'
#' # formatter
#' cars |>
#'   dplyr::mutate(
#'     dist = dist / 120
#'   ) |>
#'   e_charts(speed) |>
#'   e_scatter(dist, symbol_size = 5) |>
#'   e_tooltip(
#'     formatter = e_tooltip_item_formatter("percent")
#'   )
#'
#' # axis pointer
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist, symbol_size = 5) |>
#'   e_tooltip(
#'     formatter = e_tooltip_pointer_formatter("currency"),
#'     axisPointer = list(
#'       type = "cross"
#'     )
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#tooltip}{Additional arguments}
#'
#' @rdname e-tooltip
#' @export
e_tooltip <- function(e, trigger = c("item", "axis"), formatter = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  tooltip <- list(trigger = trigger[1], ...)

  if (!is.null(formatter)) {
    if (inherits(formatter, "item_formatter") || inherits(formatter, "pie_formatter") || inherits(formatter, "JS_EVAL")) {
      tooltip$formatter <- formatter
    }

    if (inherits(formatter, "pointer_formatter")) {
      tooltip$axisPointer$label <- formatter
    }
  }

  if (!e$x$tl) {
    e$x$opts$tooltip <- tooltip
  } else {
    e$x$opts$baseOption$tooltip <- tooltip
  }

  e
}

#' @rdname e-tooltip
#' @export
e_tooltip_item_formatter <- function(
  style = c("decimal", "percent", "currency"),
  digits = 0,
  locale = NULL,
  currency = "USD"
) {
  if (is.null(locale)) {
    locale <- .get_locale()
  }

  style <- match.arg(style)
  opts <- list(
    style = style,
    minimumFractionDigits = digits,
    maximumFractionDigits = digits,
    currency = currency
  )

  tip <- htmlwidgets::JS(sprintf("function(params, ticket, callback) {
        var fmt = new Intl.NumberFormat('%s', %s);
        var idx = 0;
        if (params.name == params.value[0]) {
            idx = 1;
        }
        return params.marker + ' ' +
               params.seriesName + ': ' + fmt.format(parseFloat(params.value[idx]));
    }", locale, jsonlite::toJSON(opts, auto_unbox = TRUE)))

  tip <- structure(tip, class = c("JS_EVAL", "item_formatter"))
  return(tip)
}

#' @rdname e-tooltip
#' @export
e_tooltip_choro_formatter <- function(
  style = c("decimal", "percent", "currency"),
  digits = 0,
  locale = NULL,
  currency = "USD"
) {
  if (is.null(locale)) {
    locale <- .get_locale()
  }

  style <- match.arg(style)
  opts <- list(
    style = style,
    minimumFractionDigits = digits,
    maximumFractionDigits = digits,
    currency = currency
  )

  tip <- htmlwidgets::JS(sprintf("function(params, ticket, callback) {
        var fmt = new Intl.NumberFormat('%s', %s);
        var value = parseFloat(params.value) || 0;
        return params.marker + ' ' +
               params.name + ': ' + fmt.format(value);
    }", locale, jsonlite::toJSON(opts, auto_unbox = TRUE)))

  tip <- structure(tip, class = c("JS_EVAL", "item_formatter"))
  return(tip)
}

#' @rdname e-tooltip
#' @export
e_tooltip_pie_formatter <- function(
  style = c("decimal", "percent", "currency"),
  digits = 0,
  locale = NULL,
  currency = "USD",
  ...
) {
  if (is.null(locale)) {
    locale <- .get_locale()
  }

  style <- match.arg(style)

  opts <- list(
    style = style,
    minimumFractionDigits = digits,
    maximumFractionDigits = digits,
    currency = currency
  )

  tip <- htmlwidgets::JS(sprintf("function(params, ticket, callback) {
    var fmt = new Intl.NumberFormat('%s', %s);
    return params.marker + ' ' +
           params.name + ': ' +
           fmt.format(params.value);
    }", locale, jsonlite::toJSON(opts, auto_unbox = TRUE)))

  tip <- structure(tip, class = c("JS_EVAL", "item_formatter"))
  return(tip)
}

#' @rdname e-tooltip
#' @export
e_tooltip_pointer_formatter <- function(
  style = c("decimal", "percent", "currency"),
  digits = 0,
  locale = NULL,
  currency = "USD"
) {
  if (is.null(locale)) {
    locale <- .get_locale()
  }

  style <- match.arg(style)
  opts <- list(
    style = style,
    minimumFractionDigits = digits,
    maximumFractionDigits = digits,
    currency = currency
  )

  tip <- htmlwidgets::JS(sprintf("function(params, ticket, callback) {
        var fmt = new Intl.NumberFormat('%s', %s);
        var res = params[0].value[0];
        for (i = 0; i < params.length; i++) {
            res += '<br />' +
                   params[i].marker + ' ' +
                   params[i].seriesName + ': ' +
                   fmt.format(parseFloat(params[i].value[1]));
        }
        return res;
    }", locale, jsonlite::toJSON(opts, auto_unbox = TRUE)))
  tip <- structure(tip, class = c("JS_EVAL", "pointer_formatter"))
  return(tip)
}

#' Legend
#'
#' Customise the legend.
#'
#' @inheritParams e_bar
#' @param show Set to \code{FALSE} to hide the legend.
#' @param type Type of legend, \code{plain} or \code{scroll}.
#' @param icons A optional list of icons the same length as there are series, see example.
#'
#' @examples
#' e <- cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist, symbol_size = 5)
#'
#' # with legend
#' e
#'
#' # without legend
#' e |>
#'   e_legend(show = FALSE)
#'
#' # with icon
#' # path is taken from http://svgicons.sparkk.fr/
#' path <- paste0(
#'   "path://M11.344,5.71c0-0.73,0.074-1.122,1.199-1.122",
#'   "h1.502V1.871h-2.404c-2.886,0-3.903,1.36-3.903,3.646",
#'   "v1.765h-1.8V10h1.8v8.128h3.601V10h2.403l0.32-2.718h",
#'   "-2.724L11.344,5.71z"
#' )
#'
#' e |>
#'   e_legend(
#'     icons = list(path)
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#legend}{Additional arguments}
#'
#' @export
e_legend <- function(e, show = TRUE, type = c("plain", "scroll"), icons = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (!is.null(icons)) {
   if (length(icons) < length(e$x$opts$legend$data)) {
      stop(
        "invalid number of icons; ",
        length(icons),
        " icons passed but ",
        length(e$x$opts$legend$data),
        " legend items."
      )
   } else if (length(icons) == 1) {
     e$x$opts$legend$icon <- icons
     icons <- NULL
   }


    for (i in seq_along(e$x$opts$legend$data)) {
      e$x$opts$legend$data[[i]] <- list(name = e$x$opts$legend$data[[i]])
      e$x$opts$legend$data[[i]]$icon <- icons[[i]]
    }
  }

  legend <- list(
    show = show,
    type = type[1],
    ...
  )

  if (!e$x$tl) {
    e$x$opts$legend <- append(e$x$opts$legend, legend)
  } else {
    e$x$opts$baseOption$legend <- append(e$x$opts$baseOption$legend, legend)
  }

  e
}

#' Toolbox
#'
#' Add toolbox interface.
#'
#' @inheritParams e_bar
#' @param feature Feature to add, defaults to all.
#'
#' @details Valid \code{feature}:
#' \itemize{
#'   \item{\code{saveAsImage}}
#'   \item{\code{brush}}
#'   \item{\code{restore}}
#'   \item{\code{dataView}}
#'   \item{\code{dataZoom}}
#'   \item{\code{magicType}}
#' }
#'
#' @examples
#' USArrests |>
#'   e_charts(UrbanPop) |>
#'   e_line(Assault) |>
#'   e_area(Murder, y_index = 1, x_index = 1) |>
#'   e_datazoom(x_index = 0)
#'
#' mtcars |>
#'   tibble::rownames_to_column("model") |>
#'   e_charts(model) |>
#'   e_line(qsec) |>
#'   e_toolbox() |>
#'   e_toolbox_feature(
#'     feature = "magicType",
#'     type = list("line", "bar")
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#toolbox}{Additional arguments}
#'
#' @rdname toolbox
#' @export
e_toolbox_feature <- function(e, feature, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(feature)) {
    feature <- c("saveAsImage", "restore", "dataView", "dataZoom", "magicType", "brush")
  }

  options <- list(...)

  if (!e$x$tl) {
    if (!length(e$x$opts$toolbox)) {
      e$x$opts$toolbox <- list(feature = list())
    }

    for (i in seq_along(feature)) {
      e$x$opts$toolbox$feature[[feature[i]]] <- list()
    }

    if (length(options)) {
      for (i in seq_along(options)) {
        e$x$opts$toolbox$feature[[feature]][[names(options)[i]]] <- options[[i]]
      }
    }
  } else {
    if (!length(e$x$opts$baseOption$toolbox)) {
      e$x$opts$baseOption$toolbox <- list(feature = list())
    }

    for (i in seq_along(feature)) {
      e$x$opts$baseOption$toolbox$feature[[feature[i]]] <- list()
    }

    if (length(options)) {
      for (i in seq_along(options)) {
        e$x$opts$baseOption$toolbox$feature[[feature]][[names(options)[i]]] <- options[[i]]
      }
    }
  }

  e
}

#' @rdname toolbox
#' @export
e_toolbox <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (!e$x$tl) {
    e$x$opts$toolbox <- list(...)
  } else {
    e$x$opts$baseOption$toolbox <- list(...)
  }

  e
}

#' Data zoom
#'
#' Add data zoom.
#'
#' @inheritParams e_bar
#' @param toolbox Whether to add the toolbox, \code{\link{e_toolbox_feature}}, (\code{e_toolbox_feature(e, "dataZoom")}).
#'
#' @examples
#' USArrests |>
#'   e_charts(UrbanPop) |>
#'   e_line(Assault) |>
#'   e_area(Murder, y_index = 1, x_index = 1) |>
#'   e_y_axis(gridIndex = 1) |>
#'   e_x_axis(gridIndex = 1) |>
#'   e_grid(height = "35%") |>
#'   e_grid(height = "35%", top = "50%") |>
#'   e_toolbox_feature("dataZoom", title = list(zoom = "zoom", back = "back")) |>
#'   e_datazoom(x_index = c(0, 1))
#' @seealso \href{https://echarts.apache.org/en/option.html#dataZoom}{Additional arguments}
#'
#' @export
e_datazoom <- function(e, x_index = NULL, y_index = NULL, toolbox = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!is.null(x_index) && !is.null(y_index)) {
    stop("pass x_index or y_index, not both", call. = FALSE)
  }

  if (!e$x$tl) {
    if (!length(e$x$opts$dataZoom)) { # initialize if not existing
      e$x$opts$dataZoom <- list()
    }
  } else {
    if (!length(e$x$opts$baseOption$dataZoom)) { # initialize if not existing
      e$x$opts$baseOption$dataZoom <- list()
    }
  }

  if (!e$x$tl) {
    if (!length(e$x$opts$toolbox$feature$dataZoom) && isTRUE(toolbox)) {
      e <- e_toolbox_feature(e, "dataZoom")
    }
  } else {
    if (!length(e$x$opts$baseOption$toolbox$feature$dataZoom) && isTRUE(toolbox)) {
      e <- e_toolbox_feature(e, "dataZoom")
    }
  }

  opts <- list(...)
  if (!is.null(x_index)) opts$xAxisIndex <- x_index
  if (!is.null(y_index)) opts$yAxisIndex <- y_index

  if (!e$x$tl) {
    e$x$opts$dataZoom <- append(e$x$opts$dataZoom, list(opts))
  } else {
    e$x$opts$baseOption$dataZoom <- append(e$x$opts$baseOption$dataZoom, list(opts))
  }

  e
}

#' Brush
#'
#' Add a brush.
#'
#' @inheritParams e_bar
#' @param brush_link Links interaction between selected items in different series.
#'
#' @section \code{brush_link}:$
#' \itemize{
#'   \item{\code{c(3, 4, 5)}, for interacting series with seriesIndex as 3, 4, or 5.}
#'   \item{\code{all}, for interacting all series.}
#'   \item{\code{none} for disabling.}
#' }
#'
#' @examples
#' quakes |>
#'   e_charts(long) |>
#'   e_geo(
#'     boundingCoords = list(
#'       c(190, -10),
#'       c(180, -40)
#'     )
#'   ) |>
#'   e_scatter(lat, mag, stations, coord_system = "geo", name = "mag") |>
#'   e_data(quakes, depth) |>
#'   e_scatter(mag, mag, stations, name = "mag & depth") |>
#'   e_grid(right = 40, top = 100, width = "30%") |>
#'   e_y_axis(type = "value", name = "depth", min = 3.5) |>
#'   e_brush() |>
#'   e_theme("dark")
#' @seealso \href{https://echarts.apache.org/en/option.html#brush}{Additional arguments}
#'
#' @export
e_brush <- function(e, x_index = NULL, y_index = NULL, brush_link = "all", ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!is.null(x_index) && !is.null(y_index)) {
    stop("pass x_index or y_index, not both", call. = FALSE)
  }

  if (!e$x$tl) {
    if (!length(e$x$opts$brush)) { # initiatilise if not existing
      e$x$opts$brush <- list()
    }
  } else {
    if (!length(e$x$opts$baseOption$brush)) { # initiatilise if not existing
      e$x$opts$baseOption$brush <- list()
    }
  }

  if (!e$x$tl) {
    if (!length(e$x$opts$toolbox$feature$brush)) {
      e <- e_toolbox_feature(e, "brush")
    }
  } else {
    if (!length(e$x$opts$baseOption$toolbox$feature$brush)) {
      e <- e_toolbox_feature(e, "brush")
    }
  }

  opts <- list(brushLink = brush_link, ...)
  opts$xAxisIndex <- x_index
  opts$yAxisIndex <- y_index

  if (!e$x$tl) {
    e$x$opts$brush <- append(e$x$opts$brush, opts)
  } else {
    e$x$opts$baseOption$brush <- append(e$x$opts$baseOption$brush, opts)
  }

  e
}

#' Title
#'
#' Add title.
#'
#' @inheritParams e_bar
#' @param text,subtext Title and Subtitle.
#' @param link,sublink Title and Subtitle link.
#'
#' @examples
#' quakes |>
#'   dplyr::mutate(mag = exp(mag) / 60) |>
#'   e_charts(stations) |>
#'   e_scatter(depth, mag) |>
#'   e_visual_map(min = 3, max = 7) |>
#'   e_title("Quakes", "Stations and Magnitude")
#' @seealso \href{https://echarts.apache.org/en/option.html#title}{Additional arguments}
#'
#' @export
e_title <- function(e, text = NULL, subtext = NULL, link = NULL, sublink = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  title <- list(...)
  title$text <- text
  title$subtext <- subtext
  title$link <- link
  title$sublink <- sublink

  if (!e$x$tl) {
    e$x$opts$title <- append(e$x$opts$title, list(title))
  } else {
    e$x$opts$baseOption$title <- append(e$x$opts$baseOption$title, list(title))
  }

  e
}

#' Polar
#'
#' Customise polar coordinates.
#'
#' @inheritParams e_bar
#' @param show Whether to display the axis.
#'
#' @examples
#' df <- data.frame(x = 1:10, y = seq(1, 20, by = 2))
#'
#' df |>
#'   e_charts(x) |>
#'   e_polar() |>
#'   e_angle_axis() |>
#'   e_radius_axis() |>
#'   e_line(y, coord_system = "polar", smooth = TRUE)
#' @seealso \href{https://echarts.apache.org/en/option.html#polar}{Additional arguments}
#'
#' @export
e_polar <- function(e, show = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!e$x$tl) {
    e$x$opts$yAxis <- NULL
    e$x$opts$xAxis <- NULL

    e$x$opts$polar <- list(show = show, ...)
  } else {
    e$x$opts$baseOption$yAxis <- NULL
    e$x$opts$baseOption$xAxis <- NULL

    e$x$opts$baseOption$polar <- list(show = show, ...)
  }

  e
}

#' Axis pointer
#'
#' Customise axis pointer.
#'
#' @inheritParams e_bar
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#axisPointer}{Additional arguments}
#'
#' @export
e_axis_pointer <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!e$x$tl) {
    e$x$opts$axisPointer <- list(...)
  } else {
    e$x$opts$baseOption$axisPointer <- list(...)
  }

  e
}

#' Animation
#'
#' Customise animations.
#'
#' @inheritParams e_bar
#' @param show Set to show animation.
#' @param threshold Whether to set graphic number threshold to animation.
#' Animation will be disabled when graphic number is larger than threshold.
#' @param duration Duration of the first animation.
#' @param easing Easing method used for the first animation.
#' @param delay Delay before updating the first animation.
#' @param duration.update Time for animation to complete.
#' @param easing.update Easing method used for animation.
#' @param delay.update Delay before updating animation.
#'
#'
#' @examples
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_area(drat) |>
#'   e_animation(duration = 10000)
#' @seealso \href{https://echarts.apache.org/en/option.html#animation}{Additional arguments}
#'
#' @export
e_animation <- function(
  e,
  show = TRUE,
  threshold = NULL,
  duration = NULL,
  easing = NULL,
  delay = NULL,
  duration.update = NULL,
  easing.update = NULL,
  delay.update = NULL
) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (!e$x$tl) {
    e$x$opts$animation <- show
    e$x$opts$animationThreshold <- threshold
    e$x$opts$animationDuration <- duration
    e$x$opts$animationEasing <- easing
    e$x$opts$animationDelay <- delay
    e$x$opts$animationDurationUpdate <- duration.update
    e$x$opts$animationEasingUpdate <- easing.update
    e$x$opts$animationDelayUpdate <- delay.update
  } else {
    e$x$opts$baseOption$animation <- show
    e$x$opts$baseOption$animationThreshold <- threshold
    e$x$opts$baseOption$animationDuration <- duration
    e$x$opts$baseOption$animationEasing <- easing
    e$x$opts$baseOption$animationDelay <- delay
    e$x$opts$baseOption$animationDurationUpdate <- duration.update
    e$x$opts$baseOption$animationEasingUpdate <- easing.update
    e$x$opts$baseOption$animationDelayUpdate <- delay.update
  }

  e
}

#' Use UTC
#'
#' Use UTC
#'
#' @inheritParams e_bar
#'
#' @export
e_utc <- function(e) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (!e$x$tl) {
    e$x$opts$useUTC <- TRUE
  } else {
    e$x$opts$baseOption$useUTC <- TRUE
  }

  e
}

#' Flip coordinates
#'
#' Flip cartesian 2D coordinates.
#'
#' @inheritParams e_bar
#'
#' @examples
#' df <- data.frame(
#'   x = LETTERS[1:5],
#'   y = runif(5, 1, 5),
#'   z = runif(5, 3, 10)
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_bar(y) |>
#'   e_line(z) -> plot
#'
#' plot # normal
#' e_flip_coords(plot) # flip
#' @export
e_flip_coords <- function(e) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (!e$x$tl) {
    n <- names(e$x$opts)
    n <- gsub("xAxis", "RENAME", n)
    n <- gsub("yAxis", "xAxis", n)
    n <- gsub("RENAME", "yAxis", n)

    names(e$x$opts) <- n

    for (i in seq_along(e$x$opts$series)) {
      for (j in seq_along(e$x$opts$series[[i]]$data)) {

        if(!is.null(names(e$x$opts$series[[i]]$data[[j]]))){
          try({
            vals <- e$x$opts$series[[i]]$data[[j]]$value
            e$x$opts$series[[i]]$data[[j]]$value <- rev(vals)
          }, silent = TRUE)
        } else {
          try({
            vals <- e$x$opts$series[[i]]$data[[j]]
            e$x$opts$series[[i]]$data[[j]] <- rev(vals)
          }, silent = TRUE)
        }
      }
    }
  } else {
    n <- names(e$x$opts$baseOption)
    n <- gsub("xAxis", "RENAME", n)
    n <- gsub("yAxis", "xAxis", n)
    n <- gsub("RENAME", "yAxis", n)

    names(e$x$opts$baseOption) <- n

    for (i in seq_along(e$x$opts$options)) {
      for (j in seq_along(e$x$opts$options[[i]]$series)) {
        for (k in seq_along(e$x$opts$options[[i]]$series[[j]]$data)) {
          try({
            vals <- e$x$opts$options[[i]]$series[[j]]$data[[k]]$value
            e$x$opts$options[[i]]$series[[j]]$data[[k]]$value <- rev(vals)
          }, silent = TRUE)
        }
      }
    }
  }

  e
}

#' Text style
#'
#' Define global font style. Font styles may have to be specified in their
#' respected element.
#'
#' @inheritParams e_bar
#'
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#textStyle}{official
#'   documentation}
#'
#' @examples
#' cars |>
#'   e_charts(dist) |>
#'   e_scatter(speed) |>
#'   e_labels(color = "#1E90FF") |>
#'   e_text_style(
#'     fontStyle = "italic"
#'   )
#' @export
e_text_style <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (!e$x$tl) {
    e$x$opts$textStyle <- list(...)
  } else {
    e$x$opts$baseOption$textStyle <- list(...)
  }

  e
}

#' Connect charts
#'
#' Connect charts together.
#'
#' @inheritParams e_bar
#' @param ids Scalar, vector or list of ids of chart to connect with.
#' @param rows,cols Number of rows and columns.
#' @param ... Any \code{echarts} objects.
#' @param width Width of columns, one of \code{xs}, \code{md}, \code{lg}.
#' @param group Group name.
#' @param title Title of charts.
#'
#' @section Functions:
#' \itemize{
#'   \item{\code{e_connect}: connects charts by \code{ids}, \emph{cannot} be disconnected.}
#'   \item{\code{e_group}: assigns a group to chart.}
#'   \item{\code{e_connect_group}: connects chart with another group.}
#'   \item{\code{e_disconnect_group}: diconnects chart from group.}
#'   \item{\code{e_arrange}: arrange charts.}
#' }
#'
#' @return \code{e_arrange}: in an interactive session, returns a \code{htmltools::browsable}, in \code{rmarkdown} returns a
#' container (\code{htmltools::div}).
#'
#' @examples
#' # linked datazoom
#' e1 <- cars |>
#'   e_charts(
#'     speed,
#'     height = 200
#'   ) |>
#'   e_scatter(dist) |>
#'   e_datazoom(show = FALSE) |>
#'   e_group("grp") # assign group
#'
#' e2 <- cars |>
#'   e_charts(
#'     dist,
#'     height = 200
#'   ) |>
#'   e_scatter(speed) |>
#'   e_datazoom() |>
#'   e_group("grp") |> # assign group
#'   e_connect_group("grp") # connect
#'
#' if (interactive()) {
#'   e_arrange(e1, e2, title = "Linked datazoom")
#' }
#' @note \code{e_arrange} may not work properly in the RStudio viewer.
#'
#' @name connections
#' @export
e_connect <- function(e, ids) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(ids)) stop("missing ids", call. = FALSE)
  e$x$connect <- as.list(ids)
  return(e)
}

#' @rdname connections
#' @export
e_group <- function(e, group) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(group)) {
    stop("missing group", call. = FALSE)
  }

  e$x$chartGroup <- group

  e
}

#' @rdname connections
#' @export
e_connect_group <- function(e, group) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(group)) {
    stop("missing group", call. = FALSE)
  }

  e$x$groupConnect <- group

  e
}

#' @rdname connections
#' @export
e_disconnect_group <- function(e, group = NULL) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e$x$groupDisconnect <- group

  e
}

#' @rdname connections
#' @export
e_arrange <- function(..., rows = NULL, cols = NULL, width = "xs", title = NULL) {
  plots <- list(...)

  if (is.null(rows)) {
    rows <- length(plots)
  }

  if (is.null(cols)) {
    cols <- 1
  }

  w <- "-xs"
  if (!isTRUE(getOption("knitr.in.progress"))) {
    w <- ""
  }

  x <- 0
  tg <- htmltools::tagList()
  for (i in 1:rows) {
    r <- htmltools::div(class = "row")

    for (j in 1:cols) {
      x <- x + 1
      cl <- paste0("col", w, "-", 12 / cols)
      if (x <= length(plots)) {
        c <- htmltools::div(class = cl, plots[[x]])
      } else {
        c <- htmltools::div(class = cl)
      }
      r <- htmltools::tagAppendChild(r, c)
    }
    tg <- htmltools::tagAppendChild(tg, r)
  }

  if (!isTRUE(getOption("knitr.in.progress"))) {
    htmltools::browsable(
      htmltools::div(
        class = "container-fluid",
        htmltools::tags$head(
          htmltools::tags$link(
            rel="stylesheet",
            href="https://cdn.jsdelivr.net/npm/bootstrap@5.3.8/dist/css/bootstrap.min.css",
            integrity="sha384-YEteyAKbjYSLDrpbBY0aFgK1CrQHo0Erb5XT/MU5FYvkb3SmPSZSisW7LOYTKvTx",
            crossorigin="anonymous"
          )
        ),
        htmltools::h3(title),
        tg
      )
    )
  } else {
    if (!is.null(title)) {
      htmltools::div(title, tg)
    } else {
      tg
    }
  }
}

#' Dimensions
#'
#' Sets the dimensions of the chart _internally._
#' This will only affect the dimensions of the
#' chart within its parent container.
#' Use the `height` and `width` arguments of
#' [e_charts] if you want to change the dimensions
#' of said parent (recommended).
#'
#' @inheritParams e_bar
#' @param height,width Dimensions in pixels, percentage or string.
#'
#' @export
e_dims <- function(e, height = "auto", width = "auto") {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e$x$mainOpts$width <- width
  e$x$mainOpts$height <- height
  return(e)
}

#' Locale
#'
#' Change the locale to auto-translate
#' days of the week, etc.
#'
#' @section Locales:
#' - AR
#' - CS
#' - DE
#' - EN
#' - ES
#' - FA
#' - FI
#' - FR
#' - HU
#' - IT
#' - JA
#' - KO
#' - NL
#' - PL
#' - PT (brazil)
#' - RO
#' - RU
#' - SI
#' - SV
#' - TH
#' - TR
#' - UK
#' - VI
#' - ZH
#'
#' @examples
#' # top right corner zoom is in
#' # French
#' cars |>
#'  e_charts(speed) |>
#'  e_scatter(dist) |>
#'  e_datazoom() |>
#'  e_locale("FR")
#'
#' @inheritParams e_bar
#' @param locale Locale to set to.
#' @param path Path to the local file to use.
#'
#' @details The "manual" function expects a file
#' to use for translations.
#' You can browse the `.js` files
#' [here](https://github.com/apache/echarts/tree/master/i18n)
#' to have an idea of what they should look like.
#'
#' @name e_locale
#' @export
e_locale <- function(e, locale){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if(missing(locale))
    stop("missing locale", call. = FALSE)

  locale <- toupper(locale)

  if(!locale %in% c("ZH", "EN")){
    dep <- htmltools::htmlDependency(
      name = sprintf("%s-echarts4r-locale", locale),
      version = utils::packageVersion("echarts4r"),
      src = "htmlwidgets/lib/echarts-6.1.0/i18n",
      package = "echarts4r",
      script = sprintf("lang%s.js", locale)
    )

    e$dependencies <- append(e$dependencies, list(dep))
  }

  e$x$mainOpts$locale <- locale
  return(e)
}

#' @rdname e_locale
#' @export
e_locale_manual <- function(e, locale, path){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if(missing(locale))
    stop("missing locale", call. = FALSE)

  if(missing(path))
    stop("missing path", call. = FALSE)

  path <- normalizePath(path)

  file <- basename(path)
  dir <- gsub(sprintf("%s$", file), "", path)

  dep <- htmltools::htmlDependency(
    name = sprintf("%s-manual-echarts4r-locale", locale),
    version = utils::packageVersion("echarts4r"),
    src = c(
      file = dir
    ),
    script = file
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e$x$mainOpts$locale <- locale
  return(e)
}

#' Wordcloud
#'
#' Draw a wordcloud.
#'
#' @inheritParams e_bar
#' @param word,freq Terms and their frequencies.
#' @param color Word color.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' words <- function(n = 5000) {
#'   a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
#'   paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE))
#' }
#'
#' tf <- data.frame(
#'   terms = words(100),
#'   freq = rnorm(100, 55, 10)
#' ) |>
#'   dplyr::arrange(-freq)
#'
#' tf |>
#'   e_color_range(freq, color) |>
#'   e_charts() |>
#'   e_cloud(terms, freq, color, shape = "circle", sizeRange = c(3, 15))
#' @seealso \href{https://github.com/ecomfe/echarts-wordcloud}{official documentation}
#'
#' @rdname e_cloud
#' @export
e_cloud <- function(e, word, freq, color, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!missing(color)) {
    cl <- deparse(substitute(color))
  } else {
    cl <- NULL
  }

  e_cloud_(e, deparse(substitute(word)), deparse(substitute(freq)), cl, rm_x, rm_y, ...)
}

#' @rdname e_cloud
#' @export
e_cloud_ <- function(e, word, freq, color = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  data <- .build_data(e, freq)
  data <- .add_bind(e, data, word)

  if (!is.null(color)) {
    color <- .get_data(e, color)
    for (i in seq_along(data)) {
      col <- list(
        color = color[i]
      )
      data[[i]]$textStyle <- col
    }
  }

  serie <- list(
    type = "wordCloud",
    data = data,
    ...
  )

  e$x$opts$series <- append(e$x$opts$series, list(serie))

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-wordcloud",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-wordcloud.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Liquid fill
#'
#' Draw liquid fill.
#'
#' @inheritParams e_bar
#' @param color Column of color to plot.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' df <- data.frame(val = c(0.6, 0.5, 0.4))
#'
#' df |>
#'   e_charts() |>
#'   e_liquid(val) |>
#'   e_theme("dark")
#' @seealso \href{https://github.com/ecomfe/echarts-liquidfill}{official documentation}
#'
#' @rdname e_liquid
#' @export
e_liquid <- function(e, serie, color, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if(e$x$tl)(
    stop("timeline not supported")
  )

  if (!missing(color)) {
    cl <- deparse(substitute(color))
  } else {
    cl <- NULL
  }

  e_liquid_(e, deparse(substitute(serie)), cl, rm_x, rm_y, ...)
}

#' @rdname e_liquid
#' @export
e_liquid_ <- function(e, serie, color = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  data <- .get_data(e, serie) |>
    unlist() |>
    unname()

  serie <- list(
    type = "liquidFill",
    data = data,
    ...
  )

  if (!is.null(color)) {
    serie$color <- .get_data(e, color) |>
      unlist() |>
      unname()
  }

  e$x$opts$series <- append(e$x$opts$series, list(serie))

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-liquidfill",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-liquidfill.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Modularity
#'
#' Graph modularity extension will do community detection and partian a graph's vertices in several subsets.
#' Each subset will be assigned a different color.
#'
#' @inheritParams e_bar
#' @param modularity Either set to \code{TRUE}, or a \code{list}.
#'
#' @section Modularity:
#' \itemize{
#'   \item{\code{resolution} Resolution}
#'   \item{\code{sort} Whether to sort to comunities}
#' }
#'
#' @examples
#' nodes <- data.frame(
#'   name = paste0(LETTERS, 1:100),
#'   value = rnorm(100, 10, 2),
#'   stringsAsFactors = FALSE
#' )
#'
#' edges <- data.frame(
#'   source = sample(nodes$name, 200, replace = TRUE),
#'   target = sample(nodes$name, 200, replace = TRUE),
#'   stringsAsFactors = FALSE
#' )
#'
#' e_charts() |>
#'   e_graph() |>
#'   e_graph_nodes(nodes, name, value) |>
#'   e_graph_edges(edges, source, target) |>
#'   e_modularity(
#'     list(
#'       resolution = 5,
#'       sort = TRUE
#'     )
#'   )
#' @note Does not work in RStudio viewer, open in browser.
#'
#' @seealso \href{https://github.com/ecomfe/echarts-graph-modularity}{Official documentation}
#'
#' @export
e_modularity <- function(e, modularity = TRUE) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  clu <- list(
    modularity = modularity
  )

  e$x$opts$series[[length(e$x$opts$series)]]$modularity <- clu

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-modularity",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-graph-modularity.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Segmented Doughnut
#'
#' Draw segmented doughnut.
#'
#' @inheritParams e_bar
#' @param numerator,denominator numeraetor to provide filled segments and denominator for total segments.
#' @param formatter javascript string formatter for center text of chart.
#' @param fontSize,fontColor font values for center text of chart.
#' @param center,radius center provides relative position of the center of chart while radius provides the radius of your circle for outer segments.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#'
#'
#' e_chart() |>
#'  e_doughnut(numerator = 3, denominator = 6)
#'
#' @seealso \href{https://github.com/apache/echarts-custom-series/tree/main/custom-series/segmentedDoughnut}{official documentation}
#'
#' @rdname e_doughnut
#' @export
e_doughnut <- function(e,
                        numerator = NULL,
                        denominator = NULL,
                        formatter = "{c}/{b}",
                        fontSize = "10em",
                        fontColor = "#555",
                        center = c("50%","50%"),
                        radius = c("50%","65%"),
                        rm_x = TRUE,
                        rm_y = TRUE,
                        ...) {

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  serie <- list(
    type = "custom",
    renderItem = "segmentedDoughnut",
    coordinateSystem = "none",
    itemPayload = list(center = as.list(center),
                       radius = as.list(radius),
                       segmentCount = denominator,
                       label = list(
                         show = TRUE,
                         formatter = formatter,
                         fontSize = fontSize,
                         color = fontColor
                       )
    ),
    data = list(numerator),
    ...
  )

  e$x$opts$series <- append(e$x$opts$series, list(serie))

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-doughnut",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-doughnut.js")

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Violin chart
#'
#' Draw a violin chart with scattered dots.
#'
#' @inheritParams e_band2_
#' @param symbolSize overall size of symbol.
#' @param areaOpacity opacity of violin area.
#' @param bandWidthScale scale for the amplitude of violin area
#' @param binCount number of bins for violin plot. More bins will provide a more detailed version of the plot,
#'
#' @examples
#'
#' PlantGrowth |>
#'   e_charts(group) |>
#'   e_scatter(weight) |>
#'   e_violin(binCount = 200)
#'
#' @seealso \href{https://github.com/apache/echarts-custom-series/tree/main/custom-series/violin}{official documentation}
#'
#' @rdname e_violin
#' @export
e_violin <- function(e,
                     name = "violin",
                     legend = TRUE,
                     y_index = 0,
                     x_index = 0,
                     symbolSize = 10,
                     areaOpacity = 0.5,
                     binCount = 100,
                     bandWidthScale = 1,
                     ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (e$x$tl) {
    stop("timeline not supported", call. = FALSE)
  }

  no_tl <- e$x$opts$series[[1]]$type
  tl <- e$x$opts$baseOption$series[[1]]$type
  is_scatter <- identical(no_tl, "scatter") || identical(tl, "scatter")

  if (is_scatter == FALSE & (is.null(no_tl) & is.null(tl))
  ) {
    stop("violin is only supported with scatter plots", call. = FALSE)
  }

 for (i in seq_along(e$x$opts$series)) {

  # adjust scatter data to necessary format for violin polygons
    vector <- list()
    for(j in seq_along(e$x$opts$series[[i]]$data)){
      vector <- append(vector,list(as.list(e$x$opts$series[[i]]$data[[j]]$value)))
    }
    e_serie <- list(data = vector)

    if (y_index != 0) {
      serie <- e$x$opts$series[[i]]$name
      e <- .set_y_axis(e, serie, y_index, i)
    }
    if (x_index != 0) {
      e <- .set_x_axis(e, x_index, i)
    }
      serie <- list(
        type = "custom",
        renderItem = 'violin',
        silent = TRUE,
        itemPayload = list(
          symbolSize = symbolSize,
          areaOpacity = areaOpacity,
          binCount = binCount,
          bandWidthScale = bandWidthScale
        ),
        ...
      )

      e$x$opts$series <- append(e$x$opts$series, list(serie))

      if (isTRUE(legend)) {
        # Adding these 2 lines and legend is added
        current_trace <- length(e$x$opts$series)
        e$x$opts$series[[current_trace]]$name <- name
        e$x$opts$legend$data <- append(e$x$opts$legend$data, list(name))
      }
      e$x$opts$dataset <- list(source = vector)
  }

    # add dependency
    path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
    dep <- htmltools::htmlDependency(
      name = "echarts-violin",
      version = "1.0.0",
      src = c(file = path),
      script = "echarts-violin.js")

    e$dependencies <- append(e$dependencies, list(dep))

    e
}

#' Bar range chart
#'
#' Draw a bar range plot with labels on each end.
#'
#' @inheritParams e_band2_
#' @param barWidth width of each bar
#' @param borderRadius roundness of the bar ends
#' @param margin space between the text labels and the bar
#' @param textSymbol string for the label to end with
#'
#' @examples
#' df <- iris |>
#'   dplyr::group_by(Species) |>
#'   dplyr::summarise(min_length = min(Sepal.Length),
#'                    max_length = max(Sepal.Length))
#'
#' df |> e_chart(Species) |>
#'   e_barRange(lower = min_length,
#'              upper = max_length,
#'              textSymbol = '"'
#'   )
#' @seealso \href{https://github.com/apache/echarts-custom-series/tree/main/custom-series/barRange}{official documentation}
#'
#' @rdname e_barRange
#' @export
e_barRange <- function(e,
                       lower,
                       upper,
                       name = "barRange",
                       legend = TRUE,
                       y_index = 0,
                       x_index = 0,
                       barWidth = 10,
                       borderRadius = 5,
                       margin = 10,
                       textSymbol = "F",
                       ...){

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  for (i in seq_along(e$x$data)) {

    vector <- .build_data2(
      e$x$data[[i]],
      e$x$mapping$x,
      deparse(substitute(lower)),
      deparse(substitute(upper))
    )
    e_serie <- list(data = vector)

    if (y_index != 0) {
      e <- .set_y_axis(e, deparse(substitute(upper)), y_index, i)
    }
    if (x_index != 0) {
      e <- .set_x_axis(e, x_index, i)
    }

    if (!e$x$tl) {
      # generate series list
      serie <- list(
        type = "custom",
        renderItem = 'barRange',
        name = name,
        encode = list(x= 0,
                      y = c(1,2),
                      tooltip = c(1,2)),
        data = vector,
        itemPayload = list(
          textSymbol = textSymbol,
          barWidth = barWidth,
          borderRadius = borderRadius,
          margin = margin
        ),
        ...
      )
      e$x$opts$series <- append(e$x$opts$series, list(serie))

      if (isTRUE(legend)) {
        current_trace <- length(e$x$opts$series)
        e$x$opts$series[[current_trace]]$name <- name
        e$x$opts$legend$data <- append(e$x$opts$legend$data, list(name))
      }
      e$x$opts$series <- append(e$x$opts$series, list(e_serie))
    }
    else {
      if (isTRUE(legend)) {
        e$x$opts$legend$data <- append(
          e$x$opts$legend$data,
          list(name)
        )
      }

      e$x$opts$options[[i]]$series <- append(
        e$x$opts$options[[i]]$series,
        list(e_serie)
      )
    }
  }
  if (isTRUE(e$x$tl)) {
    series_opts <- list(
      type = "custom",
      renderItem = 'barRange',
      name = name,
      encode = list(x= 0,
                    y = c(1,2),
                    tooltip = c(1,2)),
      data = vector,
      itemPayload = list(
        textSymbol = textSymbol,
        barWidth = barWidth,
        borderRadius = borderRadius,
        margin = margin
      ),
      ...
    )

    if (isTRUE(legend)) {
      e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name))
    }
    e$x$opts$baseOption$series <- append(
      e$x$opts$baseOption$series,
      list(series_opts)
    )
  }

  # In the js I replaced "°C" with 't.itemPayload.textSymbol' since the symbol
  # was hard-coded
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-barRange",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-barRange.js")

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Contour chart
#'
#' Draw a contour plot. x and y must each be numbers.
#'
#' @inheritParams e_bar
#' @param thresholds contour density
#' @param bandwidth the size of the contours
#' @param lineStyle list of properties of the line
#' @param contourOpacity opacity of the countours
#' @param contourColors colors used for the contours
#'
#' @examples
#'
#' mtcars |>
#'  e_charts(mpg) |>
#'  e_contour(serie = mpg)
#' @seealso \href{https://github.com/apache/echarts-custom-series/tree/main/custom-series/contour}{official documentation}
#'
#' @rdname e_contour
#' @export
e_contour <- function(e,
                      serie,
                      name = "contour",
                      legend = TRUE,
                      thresholds = 8,
                      bandwidth = 20,
                      lineStyle = list(opacity = 0.3, color = "black", width=1),
                      contourOpacity = 0.8,
                      contourColors = list('#5470c6', '#91cc75', '#fac858', '#ee6666'),
                       ...){

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  for (i in seq_along(e$x$data)) {
    vector <-   .build_data2(e$x$data[[i]], e$x$mapping$x, deparse(substitute(serie)))

    e_serie <- list(data = vector)

    e <- e |> e_axis(type = 'value')

    if (!e$x$tl) {
      opts <- list(
        type = "custom",
        renderItem = 'contour',
        encode = list(x= 0,
                      y = 1,
                      tooltip = 2),
        data = vector,
        name = name,
        itemPayload = list(
          thresholds = thresholds,
          bandwidth = bandwidth,
          lineStyle = lineStyle,
          itemStyle = list(opacity = contourOpacity,
                           color = contourColors)
        ),
        ...
      )

      e_serie <- append(opts, e_serie) # data after renderItem, data used for Y-sizing only

      if (isTRUE(legend)) {
        e$x$opts$legend$data <- append(e$x$opts$legend$data, list(name))
      }
      e$x$opts$series <- append(e$x$opts$series, list(e_serie))

    }
    else {
      if (isTRUE(legend)) {
        e$x$opts$legend$data <- append(
          e$x$opts$legend$data,
          list(name)
        )
      }
      e$x$opts$options[[i]]$series <- append(
        e$x$opts$options[[i]]$series,
        list(e_serie)
      )
    }
  }
  if (isTRUE(e$x$tl)) {
    # generate series list
    series_opts <- list(
      type = "custom",
      renderItem = 'contour',
      encode = list(x= 0,
                    y = 1,
                    tooltip = 2),
      data = vector,
      name = name,
      itemPayload = list(
        thresholds = thresholds,
        bandwidth = bandwidth,
        lineStyle = lineStyle,
        itemStyle = list(opacity = contourOpacity,
                         color = contourColors)
      ),
      ...
    )

    if (isTRUE(legend)) {
      e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name))
    }
    e$x$opts$baseOption$series <- append(
      e$x$opts$baseOption$series,
      list(series_opts)
    )
  }

  path_d3 <- system.file("htmlwidgets/lib/d3", package = "echarts4r")
  dep_d3 <- htmltools::htmlDependency(
    name = "d3",
    version = "7.9.0",
    src = c(file = path_d3),
    script = "d3.min.js")

  e$dependencies <- append(e$dependencies, list(dep_d3))

  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-contour",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-contour.js")

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Line range chart
#'
#' Draw a line range area plot.
#'
#' @inheritParams e_band2_
#' @param lineStyle properties of the border lines
#' @param areaStyle properties of the area between the lines
#'
#' @examples
#'
#' df <- iris |>
#'   dplyr::group_by(Species) |>
#'   dplyr::summarise(lower = min(Sepal.Length),
#'                    upper = max(Sepal.Length))
#' df |>
#'   e_chart(Species) |>
#'   e_lineRange(lower = lower, upper = upper)
#' @seealso \href{https://github.com/apache/echarts-custom-series/tree/main/custom-series/lineRange}{official documentation}
#'
#' @rdname e_lineRange
#' @export
e_lineRange <- function(e,
                       lower,
                       upper,
                       name = "lineRange",
                       legend = TRUE,
                       y_index = 0,
                       x_index = 0,
                       lineStyle = list(opacity = 0.3, color = "#000", width=1),
                       areaStyle = list(opacity = 0.3, color = "#032", width=1),
                       ...){

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(lower) || missing(upper)) {
    stop("must pass lower, or upper", call. = FALSE)
  }

  if (e$x$tl) {
    stop("timeline not supported", call. = FALSE)
  }

  # Extract the color from areaStyle to use in legend
  legend_color <- if (!is.null(areaStyle$color)) areaStyle$color else "#032"

  for (i in seq_along(e$x$data)) {
    vector <- .build_data2(
      e$x$data[[i]],
      e$x$mapping$x,
      deparse(substitute(lower)),
      deparse(substitute(upper))
    )
    e_serie <- list(data = vector)

    if (y_index != 0) {
      e <- .set_y_axis(e, deparse(substitute(upper)), y_index, i)
    }
    if (x_index != 0) {
      e <- .set_x_axis(e, x_index, i)
    }

      opts <- list(
        type = "custom",
        name = name,
        renderItem = 'lineRange',
        encode = list(x= 0,
                      y = c(1,2),
                      tooltip = c(1,2)),
        data = vector,
        itemPayload = list(
          areaStyle = areaStyle,
          lineStyle = lineStyle
        ),
         ...
      )

      e_serie <- append(opts, e_serie) # data after renderItem, data used for Y-sizing only

      if (isTRUE(legend)) {
        legend_entry <- list(
          name = name,
          icon = "rect",  # Use rectangle icon
          itemStyle = list(color = legend_color)
        )
        e$x$opts$legend$data <- append(e$x$opts$legend$data, list(legend_entry))
      }
      e$x$opts$series <- append(e$x$opts$series, list(e_serie))

  }
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-lineRange",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-lineRange.js")

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Stage chart
#'
#' Draw a stage plot.
#'
#' @inheritParams e_band2_
#' @param start column for start of stage on x axis
#' @param end column for end of stage on x axis
#' @param stage column for stage on y axis
#' @param borderRadius The border radius of the stage.
#' @param verticalMargin The vertical margin of the bars.
#' @param minHorizontalSize The minimum width of the bars.
#' @param envelope The envelope of the stage.
#' @param axisLabel The style of the axis label.
#'
#' @export
#'
#' @examples
#'
#' df <- data.frame(
#'   start = as.POSIXct(c(
#'     "2024-09-07 06:12", "2024-09-07 06:15", "2024-09-07 05:45",
#'     "2024-09-07 04:57", "2024-09-07 06:12", "2024-09-07 06:18"
#'   )),
#'
#'   end = as.POSIXct(c(
#'     "2024-09-07 06:12", "2024-09-07 06:18", "2024-09-07 06:12",
#'     "2024-09-07 05:45", "2024-09-07 06:15", "2024-09-07 07:37"
#'   )),
#'
#'   stage = c(
#'     "Awake", "Awake",  "REM",
#'     "Core", "Core", "Deep"
#'   ),
#'   stringsAsFactors = FALSE
#'  )
#' stage_order = c( "Deep", "Core","REM", "Awake")
#'
#' df |>
#'   e_charts() |>
#'   e_stage(start = start,
#'           end = end,
#'           stage = stage) |>
#'           e_x_axis(type = 'time') |>
#'           e_y_axis(type = 'category', data = stage_order)
#'
#'@seealso \href{https://github.com/apache/echarts-custom-series/tree/main/custom-series/stage}{official documentation}
#'
#' @rdname e_stage
#' @export
e_stage <- function(e,
                      start,
                      end,
                      stage,
                      legend = TRUE,
                      name = "stage",
                      borderRadius = 8,
                      verticalMargin = 10,
                      minHorizontalSize = 3,
                      envelope = list(show = TRUE, color = "#888", opacity = 0.25, externalRadius = 8 ),
                      axisLabel = list(formatter = NULL, color = "#8A8A8A"),
                      ...){

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  data <- e$x$data

  for (i in seq_along(data)) {

    df <- data[[i]]
    start_col <- deparse(substitute(start))
    end_col <- deparse(substitute(end))
    stage_col <- deparse(substitute(stage))

    vector <- lapply(seq_len(nrow(df)), function(j) {
      list(
        df[[start_col]][[j]],
        df[[end_col]][[j]],
        df[[stage_col]][[j]]
      )
    })

    e_serie <- list(data = vector)

    if (!e$x$tl) {
      opts <- list(
        type = "custom",
        renderItem = 'stage',
        colorBy = 'data',
        encode = list(
            x = c(0, 1),
            y = 2,
            tooltip = c(0, 1)),
        name = name,
        itemPayload = list(
          borderRadius = borderRadius,
          verticalMargin = verticalMargin,
          minHorizontalSize = minHorizontalSize,
          envelope = envelope,
          axisLabel = axisLabel
        ),
         ...
      )
      e$x$opts$series <- append(e$x$opts$series, list(opts))

      if (isTRUE(legend)) {
        e$x$opts$legend$data <- append(e$x$opts$legend$data, list(name))
      }

      e$x$opts$dataset <- list(source = vector, sourceHeader = FALSE)

    }
    else {
      if (isTRUE(legend)) {
        e$x$opts$legend$data <- append(
          e$x$opts$legend$data,
          list(name)
        )
      }
      e$x$opts$options[[i]]$series <- append(
        e$x$opts$options[[i]]$series,
        list(e_serie)
      )
    }
  }
  if (isTRUE(e$x$tl)) {

    series_opts <- list(
      type = "custom",
      renderItem = 'stage',
      colorBy = 'data',
      encode = list(
          x = c(0, 1),
          y = 2,
          tooltip = c(0, 1)),
      name = name,
      itemPayload = list(
        borderRadius = borderRadius,
        verticalMargin = verticalMargin,
        minHorizontalSize = minHorizontalSize,
        envelope = envelope,
        axisLabel = axisLabel
      ),
      ...
    )

    if (isTRUE(legend)) {
      e$x$opts$baseOption$legend$data <- append(e$x$opts$baseOption$legend$data, list(name))
    }
    e$x$opts$baseOption$series <- append(
      e$x$opts$baseOption$series,
      list(series_opts)
    )
  }

  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-stage",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-stage.js")

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Mark point
#'
#' Mark points and lines.
#'
#' @inheritParams e_bar
#' @param serie Serie or vector of series to mark on, defaults to all series.
#' @param data Placement of point, line or area.
#' @param title A convenience argument to easily set label, see details.
#' @param title_position Position of title.
#'
#' @details To set a label you need to either use the \code{title}
#' argument or pass a list specifying the label formatter.
#' \code{label = list(formatter = "label")}. The former is more convenient
#' but more limited, e.g.: you cannot specify the placement of the label.
#' When the \code{e_mark} series function is used with \code{e_timeline} at the
#' same time, if the number of marks provided does not match the series, the
#' mark information will follow the setting of the previous frame.
#'
#' @examples
#' max <- list(
#'   name = "Max",
#'   type = "max"
#' )
#'
#' min <- list(
#'   name = "Min",
#'   type = "min"
#' )
#'
#' avg <- list(
#'   type = "average",
#'   name = "AVG"
#' )
#'
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_line(wt) |>
#'   e_line(drat) |>
#'   e_line(cyl) |>
#'   e_mark_point("wt", data = max) |>
#'   e_mark_point(c("cyl", "drat"), data = min) |>
#'   e_mark_line(data = avg) |> # applies to all
#'   e_mark_area(
#'     serie = "wt",
#'     data = list(
#'       list(xAxis = "min", yAxis = "min"),
#'       list(xAxis = "max", yAxis = "max")
#'     )
#'   )
#'
#' # Serie options, since the mark of "virginica" is not set, the mark setting
#' # of the previous frame is used
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_line(Sepal.Width) |>
#'   e_timeline_serie(
#'     title = list(
#'       list(text = "setosa"),
#'       list(text = "versicolor"),
#'       list(text = "virginica")
#'     )
#'   ) |>
#'   e_mark_area(
#'     serie = "setosa",
#'     data = list(
#'       list(xAxis = 4, yAxis = 2),
#'       list(xAxis = 6, yAxis = 4.5)
#'     ),
#'     itemStyle = list(color = "lightgreen")
#'   ) |>
#'   e_mark_area(
#'     serie = "versicolor",
#'     data = list(
#'       list(xAxis = 4.5),
#'       list(xAxis = 7)
#'     ),
#'     itemStyle = list(color = "lightblue")
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#series-line.markPoint}{Additional point arguments},
#' \href{https://echarts.apache.org/en/option.html#series-line.markLine}{Additional line arguments}
#'
#' @rdname mark
#' @export
e_mark_point <- function(e, serie = NULL, data = NULL, ..., title = NULL, title_position = NULL) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (is.null(serie)) {
    index <- seq_along(if (e$x$tl) e$x$opts$options else e$x$opts$series)
  } else if (e$x$tl){
    index <- 1
  } else {
    index <- .get_index(e, serie)
  }

  for (i in index) {
    point <- list(...)

    if (!is.null(data)) {
      point$data <- list(data)
    }

    if (!is.null(title) && !is.null(data)) {
      point$data[[1]]$label <- list(formatter = title, position = title_position)
    }

    if (e$x$tl) {
      for(j in seq_along(e$x$opts$options[[i]]$series)){
        if (is.null(e$x$opts$options[[i]]$series[[j]]$markPoint)) {
          e$x$opts$options[[i]]$series[[j]]$markPoint <- append(e$x$opts$options[[i]]$series[[j]]$markPoint, point)
        } else {
          e$x$opts$options[[i]]$series[[j]]$markPoint$data <- append(e$x$opts$options[[i]]$series[[j]]$markPoint$data, point$data)
        }
      }
    }
    else {
      if (is.null(e$x$opts$series[[i]]$markPoint)) {
        e$x$opts$series[[i]]$markPoint <- append(e$x$opts$series[[i]]$markPoint, point)
      } else {
        e$x$opts$series[[i]]$markPoint$data <- append(e$x$opts$series[[i]]$markPoint$data, point$data)
      }
    }
  }

  e
}

#' @rdname mark
#' @export
e_mark_line <- function(e, serie = NULL, data = NULL, ..., title = NULL, title_position = NULL) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (is.null(serie)) {
    index <- seq_along(if (e$x$tl) e$x$opts$options else e$x$opts$series)
  } else {
    index <- .get_index(e, serie)
  }

  for (i in index) {
    point <- list(...)

    if (!is.null(data)) {
      point$data <- list(data)
    }

    if (!is.null(title) && !is.null(data)) {
      point$data[[1]]$label <- list(formatter = title, position = title_position)
    }

    if (e$x$tl) {
      for(j in seq_along(e$x$opts$options[[i]]$series)){
        if (is.null(e$x$opts$options[[i]]$series[[j]]$markLine)) {
          e$x$opts$options[[i]]$series[[j]]$markLine <- append(e$x$opts$options[[i]]$series[[j]]$markLine, point)
        } else {
          e$x$opts$options[[i]]$series[[j]]$markLine$data <- append(e$x$opts$options[[i]]$series[[j]]$markLine$data, point$data)
        }
      }
    }
    else {
      if (is.null(e$x$opts$series[[i]]$markLine)) {
        e$x$opts$series[[i]]$markLine <- append(e$x$opts$series[[i]]$markLine, point)
      } else {
        e$x$opts$series[[i]]$markLine$data <- append(e$x$opts$series[[i]]$markLine$data, point$data)
      }
    }
  }

  e
}

#' @rdname mark
#' @export
e_mark_area <- function(e, serie = NULL, data = NULL, ..., title = NULL, title_position = NULL) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (is.null(serie)) {
    index <- seq_along(if (e$x$tl) e$x$opts$options else e$x$opts$series)
  } else {
    index <- .get_index(e, serie)
  }

  for (i in index) {
    point <- list(...)

    if (!is.null(data)) {
      point$data <- list(data)
    }

    if (!is.null(title) && !is.null(data)) {
      point$data[[1]]$label <- list(formatter = title, position = title_position)
    }

    if (e$x$tl) {
      for(j in seq_along(e$x$opts$options[[i]]$series)){
        if (is.null(e$x$opts$options[[i]]$series[[j]]$markArea)) {
          e$x$opts$options[[i]]$series[[j]]$markArea <- append(e$x$opts$options[[i]]$series[[j]]$markArea, point)
        } else {
          e$x$opts$options[[i]]$series[[j]]$markArea$data <- append(e$x$opts$options[[i]]$series[[j]]$markArea$data, point$data)
        }
      }
    }
    else {
      if (is.null(e$x$opts$series[[i]]$markArea)) {
        e$x$opts$series[[i]]$markArea <- append(e$x$opts$series[[i]]$markArea, point)
      } else {
        e$x$opts$series[[i]]$markArea$data <- append(e$x$opts$series[[i]]$markArea$data, point$data)
      }
    }
  }

  e
}

#' Mark
#'
#' Mark points, lines, and areas with a proxy ([echarts4rProxy()]).
#'
#' @inheritParams e_bar
#' @param type Type of mark: 'point','line' or 'area', defaults to 'point'.
#' @param serie_index Single index of serie to mark on, defaults to 1.
#' Proxy doesn't know series' names, so it only uses index.
#' @param data Location of point, line or area, defaults to NULL.
#'
#' @details Allows the three type of marks to work with [echarts4rProxy()]
#'
#' @examples
#' library(shiny)
#' library(dplyr)
#'
#' ui <- fluidPage(
#'   fluidRow(
#'     column(3, actionButton("pxy", "Marks")),
#'     column(
#'       3,
#'       checkboxInput("tln", "Timeline", value = FALSE)
#'     )
#'   ),
#'   echarts4rOutput("plot")
#' )
#'
#' server <- function(input, output) {
#'   data(EuStockMarkets)
#'
#'   bb <- as.data.frame(EuStockMarkets) |>
#'     slice_head(n = 150) |>
#'     mutate(day = 1:n())
#'
#'   output$plot <- renderEcharts4r({
#'     react()
#'   })
#'
#'   observeEvent(input$pxy, {
#'     echarts4rProxy("plot", data = NULL) |>
#'       e_mark_p(
#'         type = "line",
#'         serie_index = 1,
#'         data = list(type = "average"),
#'         lineStyle = list(type = "dashed", color = "cyan")
#'       ) |>
#'       e_mark_p(
#'         serie_index = 2,
#'         data = list(
#'           xAxis = bb$day[60],
#'           yAxis = bb$SMI[60],
#'           value = "pnt"
#'         )
#'       ) |>
#'       e_mark_p(
#'         type = "line",
#'         serie_index = 2,
#'         data = list(
#'           list(xAxis = bb$day[10], yAxis = bb$SMI[10]),
#'           list(xAxis = bb$day[37], yAxis = bb$SMI[37])
#'         ),
#'         lineStyle = list(type = "solid", color = "yellow")
#'       ) |>
#'       e_mark_p(
#'         type = "area",
#'         serie_index = 1,
#'         data = list(
#'           list(xAxis = bb$day[95]),
#'           list(xAxis = bb$day[105])
#'         ),
#'         itemStyle = list(color = "lightblue"),
#'         label = list(formatter = "X-area", position = "middle")
#'       ) |>
#'       e_merge()
#'   })
#'
#'   react <- eventReactive(input$tln, {
#'     tmp <- bb
#'     if (input$tln) tmp <- tmp |> group_by(day < 75)
#'
#'     tmp |>
#'       e_charts(
#'         day,
#'         backgroundColor = "#181818",
#'         legend = list(textStyle = list(color = "#aaa")),
#'         timeline = input$tln
#'       ) |>
#'       e_y_axis(scale = TRUE, axisLabel = list(color = "#aaa")) |>
#'       e_line(CAC, symbol = "none", color = "#ff33b8") |>
#'       e_line(SMI, symbol = "none", color = "green")
#'   })
#' }
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' @name e_mark_p
#' @export
e_mark_p <- function(e, type, serie_index, data, ...) UseMethod("e_mark_p")

#' @method e_mark_p echarts4r
#' @export
e_mark_p.echarts4r <- function(e, type = "point", serie_index = NULL, data = NULL, ...) {
  if (missing(e)) stop("must pass e", call. = FALSE)
  e_mark_p_(e, type, serie_index, data, ...)
}

#' @method e_mark_p echarts4rProxy
#' @export
e_mark_p.echarts4rProxy <- function(e, type = "point", serie_index = NULL, data = NULL, ...) {
  e$chart <- e_mark_p_(e$chart, type, serie_index, data, ...)
  return(e)
}

#' @rdname e_mark_p
#' @export
e_mark_p_ <- function(e, type, serie_index, data = NULL, ...) {
  if (missing(e)) stop("must pass e", call. = FALSE)
  if (missing(type)) stop("must pass type", call. = FALSE)
  mtype <- type

  if (!mtype %in% c("point", "line", "area")) stop("type must be line,point or area", call. = FALSE)
  if (!startsWith(mtype, "mark")) {
    mtype <- switch(type, "point" = "markPoint", "line" = "markLine", "area" = "markArea")
  }

  index <- ifelse(is.null(serie_index), 1, as.numeric(serie_index))

  for (i in 1:index) {
    if (length(e$x$opts$series) < i) {
      e$x$opts$series[[i]] <- list()
    } # init
    if (i < index) next

    point <- list(...)

    if (!is.null(data)) point$data <- list(data)

    suppressWarnings( # eval generates redundant warnings
      if (e$x$tl) {
        if (mtype %in% names(e$x$opts$options[[i]]$series[[1]])) {
          eval(parse(text = paste0("e$x$opts$options[[i]]$series[[1]]$", mtype, "$data <- append(e$x$opts$options[[i]]$series[[1]]$", mtype, "$data, point$data)")))
        } else {
          eval(parse(text = paste0("e$x$opts$options[[i]]$series[[1]]$", mtype, " <- point")))
        }
      }
      else {
        if (mtype %in% names(e$x$opts$series[[i]])) {
          eval(parse(text = paste0("e$x$opts$series[[i]]$", mtype, "$data <- append(e$x$opts$series[[i]]$", mtype, "$data, point$data)")))
        } else {
          eval(parse(text = paste0("e$x$opts$series[[i]]$", mtype, " <- point")))
        }
      }
    )
  }
  e
}

#' Graphic
#'
#' Low level API to define graphic elements.
#'
#' @inheritParams  e_bar
#'
#' @section Functions:
#' \itemize{
#'   \item{\code{e_graphic_g} to initialise graphics, entirely optional.}
#'   \item{\code{e_group_g} to create group, the children of which will share attributes.}
#'   \item{\code{e_image_g} to a png or jpg image.}
#'   \item{\code{e_text_g} to add text.}
#'   \item{\code{e_rect_g} to add a rectangle.}
#'   \item{\code{e_circle_g} to add a circle.}
#'   \item{\code{e_ring_g} to add a ring.}
#'   \item{\code{e_sector_g}}
#'   \item{\code{e_arc_g} to create an arc.}
#'   \item{\code{e_polygon_g} to create a polygon.}
#'   \item{\code{e_polyline_g} to create a polyline.}
#'   \item{\code{e_line_g} to draw a line.}
#'   \item{\code{e_bezier_curve_g} to draw a quadratic bezier curve or cubic bezier curve.}
#' }
#'
#' @note Some elements, i.e.: \code{e_image_g} may not display in the RStudio
#'   browwser but will work fine in your browser, R markdown documents and Shiny
#'   applications.
#'
#' @examples
#' # may not work in RStudio viewer
#' # Open in browser
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_image_g(
#'     right = 20,
#'     top = 20,
#'     z = -999,
#'     style = list(
#'       image = "https://www.r-project.org/logo/Rlogo.png",
#'       width = 150,
#'       height = 150,
#'       opacity = .6
#'     )
#'   )
#'
#' anno_text <-
#' 'xAxis represents miles per gallon, yAxis represents weight in tonnes.'
#' # Position does change depending on window size.
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_line(wt) |>
#'   e_group_g(
#'     left = '18%',
#'     top = '55%',
#'     children = list(
#'       # Background rectangle
#'       list(
#'         type = 'rect',
#'         z = 100,
#'         left = 'center',
#'         top = 'middle',
#'         shape = list(
#'           width = 240,
#'           height = 70
#'         ),
#'         style = list(
#'           fill = '#fff',
#'           stroke = '#555',
#'           lineWidth = 1,
#'           shadowBlur = 8,
#'           shadowOffsetX = 3,
#'           shadowOffsetY = 3,
#'           shadowColor = 'rgba(0,0,0,0.2)'
#'         )
#'       ),
#'       # Text element
#'       list(
#'         type = 'text',
#'         z = 100,
#'         left = 'center',
#'         top = 'middle',
#'         style = list(
#'           fill = '#333',
#'           width = 220,
#'           overflow = 'break',
#'           text = anno_text,
#'           font = '14px Microsoft YaHei'
#'         )
#'       )
#'     )
#'   )
#' #' @seealso \href{https://echarts.apache.org/en/option.html#graphic}{official documentation}
#'
#' @rdname graphic
#' @export
e_graphic_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!e$x$tl) {
    e$x$opts$graphic <- list(...)
  } else {
    e$x$opts$baseOption$graphic <- list(...)
  }
  e
}

#' @rdname graphic
#' @export
e_group_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "group", ...)
}

#' @rdname graphic
#' @export
e_image_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "image", ...)
}

#' @rdname graphic
#' @export
e_text_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "text", ...)
}

#' @rdname graphic
#' @export
e_rect_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "rect", ...)
}

#' @rdname graphic
#' @export
e_circle_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "circle", ...)
}

#' @rdname graphic
#' @export
e_ring_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "ring", ...)
}

#' @rdname graphic
#' @export
e_sector_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "sector", ...)
}

#' @rdname graphic
#' @export
e_arc_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "arc", ...)
}

#' @rdname graphic
#' @export
e_polygon_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "polygon", ...)
}

#' @rdname graphic
#' @export
e_polyline_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "polyline", ...)
}

#' @rdname graphic
#' @export
e_line_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "line", ...)
}

#' @rdname graphic
#' @export
e_bezier_curve_g <- function(e, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  .e_graphic_elem(e, "bezierCurve", ...)
}

#' Draft
#'
#' Add a draft watermark to your graph.
#'
#' @inheritParams e_bar
#' @param text Text to display.
#' @param size Font size of text.
#' @param opacity,color Opacity and color of text.
#'
#' @examples
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_draft()
#' @export
e_draft <- function(e, text = "DRAFT", size = "120px", opacity = 0.4, color = "#d3d3d3") {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e |>
    e_text_g(
      left = "center",
      top = "center",
      z = -1000,
      style = list(
        fill = color,
        text = text,
        font = paste(size, '"STHeiti", sans-serif'),
        opacity = opacity
      )
    )
}

# group2series
map_grps_ <- function(data, timeline = FALSE) {

  row.names(data) <- NULL

  if (dplyr::is.grouped_df(data)) {
    splat <- dplyr::group_split(data)
    keys <- dplyr::group_keys(data)[[1]]
    splat <- purrr::map(splat, as.data.frame)
    names(splat) <- keys

    data <- splat
  } else if (inherits(data, "grouped_tt")) {
    splat <- split(data, factor(data[[attr(data, "groups")]]))
    keys <- names(splat)
    splat <- purrr::map(splat, as.data.frame)
    names(splat) <- keys
    data <- splat
  } else {
    if (inherits(data, "data.frame")) {
      data <- as.data.frame(data)
    } # force data frame

    data <- list(data)
  }

  # Remove row names and now row.names is just the index
  .no_nm <- function(x) {
    row.names(x) <- NULL
    return(x)
  }

  data <- lapply(data, .no_nm)

  return(data)
}

#' Themes
#'
#' Add a custom theme or apply a pre-built one.
#'
#' @inheritParams e_bar
#' @param theme Theme, A json string or a see below.
#' @param name Name of theme.
#'
#' @section Functions:
#' \itemize{
#'  \item{\code{e_theme} - Use a default theme by name.}
#'  \item{\code{e_theme_custom} - Use a custom theme.}
#'  \item{\code{e_theme_register} - Register a theme globally in shiny or R markdown.}
#' }
#'
#' @details The function \code{e_theme_register} can be used to register the theme globally
#' in R markdown or shiny (UI). This is useful because 1) the \code{e_theme_custom} registers the
#' theme every time and is more computationally expensive.
#'
#' @examples
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_line(disp) |>
#'   e_area(hp) |>
#'   e_x_axis(min = 10) -> p
#'
#' p |> e_theme("chalk")
#' p |> e_theme_custom('{"color":["#ff715e","#ffaf51"]}')
#' @seealso \href{https://echarts.apache.org/en/theme-builder.html}{create your own theme}.
#'
#' @rdname theme
#' @export
e_theme <- function(
  e,
  name = c("auritus", "azul", "bee-inspired", "blue", "caravan", "carp",
    "chalk", "cool", "dark", "dark-blue", "dark-bold", "dark-digerati", "dark-fresh-cut",
    "dark-mushroom", "eduardo", "essos", "forest", "fresh-cut",
    "fruit", "gray", "green", "halloween", "helianthus", "infographic",
    "inspired", "jazz", "london", "macarons", "macarons2", "mint",
    "purple-passion", "rainbow", "red", "red-velvet",  "roma", "royal", "sakura",
    "shine", "tech-blue", "v5", "vintage", "walden", "wef", "weforum",
    "westeros", "wonderland"
  )
) {
  # cannot match.arg we need to support custom themes
  name <- name[1]

  # add name to register
  e$x$theme <- name

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/themes", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = name,
    version = "1.0.0",
    src = c(file = path),
    script = paste0(name, ".js")
  )

  e$dependencies <- append(e$dependencies, list(dep))
  e
}

#' @rdname theme
#' @export
e_theme_custom <- function(e, theme, name = "custom") {
  if (missing(theme)) {
    stop("must pass `theme`", call. = FALSE)
  }

  if (grepl("\\.json", theme)) {
    theme <- readLines(theme) # read the file
    theme <- paste0(theme, collapse = "") # collapse to a string
  }

  e$x$theme2 <- TRUE
  e$x$customTheme <- theme
  e$x$theme <- "custom"
  e$x$theme_name <- name
  e
}

#' @rdname theme
#' @export
e_theme_register <- function(theme, name = "custom") {
  if (missing(theme)) {
    stop("must pass `theme`", call. = FALSE)
  }

  if (grepl("\\.json", theme)) {
    theme <- readLines(theme) # read the file
    theme <- paste0(theme, collapse = "") # collapse to a string
  }

  shiny::singleton(
    shiny::tags$head(
      shiny::tags$script(
        paste0("window.echarts.registerTheme('", name, "', ", theme, ");")
      )
    )
  )
}

#' @keywords internal
#' @noRd
get_base_nodes <- function(x) {
  found_values <- list()

  if (is.list(x) && !is.data.frame(x)) {
    current_names <- names(x)

    for (i in seq_along(x)) {
      element <- x[[i]]

      is_unnamed <- is.null(current_names) || current_names[i] == ""
      is_atomic_data <- !is.list(element) || is.data.frame(element)

      if (is_unnamed && is_atomic_data) {
        found_values <- c(found_values, list(element))
      }

      found_values <- c(found_values, get_base_nodes(element))
    }
  }
  return(found_values)
}


#' Generate Matrix
#'
#' helper function for generating the x and y axes for a matrix grid.
#'
#' @inheritParams e_bar
#' @param xAxis,yAxis provide column name of dataframe to generate X-axis and
#'   Y-axis header cells
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#' "Grade" = c("Grade1","Grade2", "Grade3"),
#' "A" = sample(1:10, 9),
#' "B" = sample(1:10,9))
#'
#' df |> e_charts() |> e_matrix(xAxis = "Class", yAxis = "Grade")
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#matrix}{Additional
#'   arguments}
#'
#' @rdname e_matrix
#' @export
e_matrix <- function(e, xAxis, yAxis, ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if(e$x$tl == TRUE){
    stop("timeline is not supported in matrix")
  }


  if (missing(xAxis) | missing(yAxis)) {
    stop("must provide both x and y values", call. = FALSE)
  }
  
  e$x$opts$yAxis <- NULL

  e$x$opts$matrix <- append(e$x$opts$matrix, list(x = list(data = as.list(unique(e$x$data[[1]][[xAxis]])), name = xAxis)))

  e$x$opts$matrix <- append(e$x$opts$matrix, list(y = list(data = as.list(unique(e$x$data[[1]][[yAxis]])), name = yAxis)))

  e$x$opts$matrix <- append(e$x$opts$matrix, list(...))

  e
}

#' Generate Matrix
#'
#' helper function for generating default
#'
#' @inheritParams e_bar
#' @param rows,cols provide integer values for the number of rows and columns in the matrix grid
#' @examples
#'
#' e_matrix_raw(rows = 3, cols = 3, backgroundStyle=list(borderWidth=0))
#'
#' e_matrix_raw(rows = 3, cols = 3, body = list(itemStyle = list(borderWidth = 0)))
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#matrix}{Additional arguments}
#'
#' @rdname e_matrix_raw
#' @export
e_matrix_raw <- function(rows = NULL, cols = NULL, ...){
  if(is.null(rows) || is.null(cols)) {
    stop("Must provide both the number of rows and columns.")
  }

  e <- e_chart()
  e$x$opts$yAxis <- NULL
  e$x$opts$matrix <- list(x = list(data = rep(list(NA), cols), show = FALSE),
                          y = list(data = rep(list(NA),rows), show = FALSE),
                          ...)
  e
}


#' Generate Matrix Axis Parents
#'
#' helper function for generating parent values for x or y axis headers
#'
#' @inheritParams e_bar
#' @param axis which axis the parent should be added
#' @param value text for the new parent header cell
#' @param children vector containing values for which current header cells will be children for the new parent cell
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#' "Grade" = c("Grade1","Grade2", "Grade3"),
#' "A" = sample(1:10, 9),
#' "B" = sample(1:10,9))
#'
#' df |> e_charts() |> e_matrix(xAxis = "Class", yAxis = "Grade") |>
#' e_matrix_parent(value = "Primary", children = c("Class1", "Class2")) |>
#' e_matrix_parent(value = "High", children = "Class3")
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#matrix.x.data}{Additional arguments}
#'
#' @rdname e_matrix_parent
#' @export
e_matrix_parent <- function(e, axis = "x", value, children, ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if(axis=="x"){

    child_ndx <- which(e$x$opts$matrix$x$data %in% children)

    if(length(child_ndx)==0){
      for(i in seq_along(e$x$opts$matrix$x$data )){
        data_subset <- e$x$opts$matrix$x$data[[i]]
        if("value" %in% names(data_subset) && data_subset$value %in% children){
          child_ndx <- append(child_ndx, i)
        }
      }
      if(length(child_ndx)==0){
        stop("No children found in the data")
      }
    }

    new_node <- list(value = value, children = e$x$opts$matrix$x$data[child_ndx], ...)

    e$x$opts$matrix$x$data <- append(e$x$opts$matrix$x$data, list(new_node))
    e$x$opts$matrix$x$data <- e$x$opts$matrix$x$data[-child_ndx]
  }

  if(axis=="y"){

    child_ndx <- which(e$x$opts$matrix$y$data %in% children)

    if(length(child_ndx)==0){
      for(i in seq_along(e$x$opts$matrix$y$data )){
        data_subset <- e$x$opts$matrix$y$data[[i]]
        if("value" %in% names(data_subset) && data_subset$value %in% children){
          child_ndx <- append(child_ndx, i)
        }
      }
      if(length(child_ndx)==0){
        stop("No children found in the data")
      }
    }

    new_node <- list(value = value, children = e$x$opts$matrix$y$data[child_ndx], ...)

    e$x$opts$matrix$y$data <- append(e$x$opts$matrix$y$data, list(new_node))
    e$x$opts$matrix$y$data <- e$x$opts$matrix$y$data[-child_ndx]
  }

  e

}

#' Fill Matrix Axis Corner
#'
#' helper function for adding data to the corner of matrix
#'
#' @inheritParams e_bar
#' @param coord corner cell coordinate location
#' @param value text to display in corner cell
#' @param mergeCells whether the body cells and corner cells can be merged
#' @param coordClamp determines whether null values can be used to indicate an entire row/column
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#' "Grade" = c("Grade1","Grade2", "Grade3"),
#' "A" = sample(1:10, 9),
#' "B" = sample(1:10,9))
#'
#' df |> e_charts() |> e_matrix(xAxis = "Class", yAxis = "Grade") |>
#' e_matrix_parent(value = "Primary", children = c("Class1", "Class2")) |>
#' e_matrix_parent(value = "High", children = "Class3") |>
#' e_matrix_corner(value = "All School",
#' label = list(fontSize = 24, color = "#555", position = "inside"))
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#matrix.corner}{Additional arguments}
#'
#' @rdname e_matrix_corner
#' @export
e_matrix_corner <- function(e, coord = c(-1,-1), value, mergeCells = TRUE, coordClamp = FALSE, ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  data <- list(coord = coord, value = value, mergeCells = mergeCells, coordClamp = coordClamp)
  l <- list(data = list(data), ...)

  e$x$opts$matrix$corner <- append(e$x$opts$matrix$corner, l)

  e
}

#' Format Matrix Axis
#'
#' helper function for formatting the x and y axes for a matrix grid.
#'
#' @inheritParams e_bar
#' @param axis indicate which axis shoud be adjusted
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#' "Grade" = c("Grade1","Grade2", "Grade3"),
#' "A" = sample(1:10, 9),
#' "B" = sample(1:10,9))
#'
#' df |> e_charts() |> e_matrix(xAxis = "Class", yAxis = "Grade") |>
#' e_format_matrix_axis(axis = "x", label = list(color = "red"))
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#matrix}{Additional arguments}
#'
#' @rdname e_format_matrix_axis
#' @export
e_format_matrix_axis <- function(e, axis = "x", ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(axis)) {
    stop("must specify which axis", call. = FALSE)
  }

  if(axis == "x"){
    e$x$opts$matrix$x <- append(e$x$opts$matrix$x, list(...))
  }

  if(axis == "y"){
    e$x$opts$matrix$y <- append(e$x$opts$matrix$y, list(...))
  }

  e
}

#' Add new chart to matrix chart
#'
#' Adds an already existing echart to your new matrix chart. Charts with timelines are not supported.
#'
#' @inheritParams e_bar
#' @param chart An existing echart that you want to attach to your new matrix
#'   chart
#' @param coord X,Y Coordinate of matrix to place your new chart. Charts can
#'   cover multiple coordinates such as `list(c(0,1),0)`. See
#'   \href{https://echarts.apache.org/en/option.html#matrix.body.data.coord}{Matrix
#'   Coordinates} for more information on matrix coordinates.
#' @param id Unique id value that will be added when chart is placed in the
#'   matrix. Defaults to `"chart1"`
#' @param legend Whether chart contains a legend. Defaults to \code{TRUE}.
#' @param legend_pos Position of the legend. One of "top", "right", "bottom",
#'   "left". Determines to which side the `legend_space` argument applies.
#' @param legend_space Space between legend and plot area. Supports
#'   integers(pixels) or strings(percent of parent cell).
#' @param margin_trbl Adjusts the size of the outside margin around the plotting
#'   area. Default is `c(t = "15%", r = "5%", b = "5%", l = "5%")`. Supports
#'   integers(pixels) or strings(percent of parent cell) To change only e.g. two
#'   sides `c("r" = 8, "l" = 8)` could be used, other sides will use defaults.
#'
#'
#' @examples
#' echart <- iris |>
#' group_by(Species) |>
#'   e_charts(Sepal.Length) |>
#'   e_line(Sepal.Width) |>
#'   e_tooltip(trigger = "axis")
#'
#' e_matrix_raw(rows = 3, cols = 3, body = list(
#' itemStyle = list(borderWidth = 0))) |>
#' e_matrix_addChart(echart, coord = list(
#'    c(0,2),0), margin_trbl = c("b" = "20%"))
#'
#'
#' @rdname e_matrix_addChart
#' @export
e_matrix_addChart <- function(e,
                              chart,
                              coord,
                              id = "chart1",
                              legend = TRUE,
                              legend_pos = "bottom",
                              legend_space = "0%",
                              margin_trbl = c(t = "5%", r = "5%", b = "15%", l = "5%")
){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(chart)) {
    stop("must provide an echart to add into matrix grid", call. = FALSE)
  }
  if (!("echarts4r" %in% class(chart))) {
    stop("the provided chart must be an echart", call. = FALSE)
  }
  if (missing(coord)) {
    stop("must provide coordinates for chart locations in matrix grid", call. = FALSE)
  }
  if (chart$x$tl) {
    stop("e_matrix_addChart does not currently support timeline charts", call. = FALSE)
  }
  
  if(!is.null(chart$x$opts$parallelAxis)){
    stop("e_matrix_addChart does not support parallel charts")
  }
  
  if(!is.null(chart$x$opts$calendar)){
    stop("e_matrix_addChart does not support calendar charts")
  }
  
  if(!is.null(chart$x$opts$radar)){
    stop("e_matrix_addChart does not support radar charts")
  }
  
  # Remove existing yAxis if using e_matrix instead of e_matrix_raw
  if(is.null(e$x$opts$yAxis[[1]]$id)){
    e$x$opts$yAxis <- NULL
  }
  
  
  # ID Check
  if(!is.null(e$x$opts$yAxis)){
    for(i in seq_along(e$x$opts$yAxis)){
      if(e$x$opts$yAxis[[i]]$id == id){
        stop("Chart id has already been used. Please supply a different id value")
      }
    }
  }

  # Get count of existing charts in matrix for future ids
  chart_count <- length(e$x$opts$xAxis)
  # Specified margins
  spec_margin <- c("t", "r", "b", "l") %in% names(margin_trbl) # see which elements are present
  margin_trbl <- c(margin_trbl, # add missing elements
                   c(t = 5, r = 5, b = 5, l = 5)[!spec_margin])

  # add new data into matrix chart
  e$x$data <- append(e$x$data, chart$x$data)

  #Build x and y axes if they are missing
  if(is.null(chart$x$opts$yAxis)){
    chart$x$opts$yAxis[[1]] <- list(show = FALSE)
  }
  if(is.null(chart$x$opts$xAxis)){
    chart$x$opts$xAxis[[1]] <- list(show = FALSE)
  }
  
  
  
  # add IDs for grid and matrix based on supplied id
  chart <- chart |> e_axis(axis = "x", id = id, gridId = id) |> e_axis(axis = "y", id = id, gridId = id)

  for(i in seq_along(chart$x$opts$series)){
    chart$x$opts$series[[i]]$xAxisId <- id
    chart$x$opts$series[[i]]$yAxisId <- id
    chart$x$opts$series[[i]]$xAxisIndex <- chart_count
    chart$x$opts$series[[i]]$yAxisIndex <- chart_count
    
    if(chart$x$opts$series[[i]]$type == "themeRiver"){
      stop("e_matrix_addChart does not support themeRiver charts")
    }
    
    if(chart$x$opts$series[[i]]$type == "pie"){
      chart$x$opts$series[[i]]$coordinateSystem <- "matrix"
      chart$x$opts$series[[i]]$coord <- coord
    }
  }
  
  ## Add visualMap
  if(!is.null(chart$x$opts$visualMap)){
    chart$x$opts$series[[1]]$id <- id
    chart$x$opts$visualMap[[1]]$coordinateSystem <- "matrix"
    chart$x$opts$visualMap[[1]]$seriesId <- id
    chart$x$opts$visualMap[[1]]$coord <- coord
    e$x$opts$visualMap <- append(e$x$opts$visualMap, chart$x$opts$visualMap)
  }

  # Attach series and axis information to the matrix chart
  e$x$opts$yAxis <- append(e$x$opts$yAxis, chart$x$opts$yAxis)
  e$x$opts$xAxis <- append(e$x$opts$xAxis, chart$x$opts$xAxis)
  e$x$opts$series <- append(e$x$opts$series, chart$x$opts$series)

  # Generate and link grid
  e$x$opts$grid <- append(e$x$opts$grid, list(list(id = id, coordinateSystem = "matrix", coord = coord
                                                   , left = margin_trbl[["l"]]
                                                   , top = margin_trbl[["t"]]
                                                   , right = margin_trbl[["r"]]
                                                   , bottom = margin_trbl[["b"]]
  )
  )
  )
  
  

  # Update and add legend
  if(legend){
    chart$x$opts$legend$coordinateSystem <- "matrix"
    chart$x$opts$legend$coord <- coord
    if(legend_pos == "top"){
      chart$x$opts$legend$top <- legend_space
    } else if(legend_pos == "right"){
      chart$x$opts$legend$right <- legend_space
    } else if(legend_pos == "left"){
      chart$x$opts$legend$left <- legend_space
    } else if(legend_pos == "bottom"){
      chart$x$opts$legend$bottom <- legend_space
    }
    e$x$opts$legend <- append(e$x$opts$legend, list(chart$x$opts$legend))
  }

  e
}


#' Generate Chart Titles for Matrix
#'
#' helper function for creating titles for every plot in a geofacet style
#' matrix. This generates the title using the name of the series.
#'
#' @inheritParams e_bar
#' @examples
#' df <- data.frame(group = rep(letters[1:6], each = 20),
#' date = seq(from = as.Date("2025-01-01"),
#'            to = as.Date("2025-01-20"), by = "day"),
#' temp = sample(c(10:20), size = 60, replace = TRUE))
#' grid <- data.frame(name = unique(df$group), row = c(1:6), col = c(1:6))
#'
#' df |>
#'   group_by(group) |>
#'   e_chart(date) |>
#'   e_line(temp, symbol = "none") |>
#'   e_x_axis(splitNumber = 2) |>
#'   e_y_axis(splitNumber = 2) |>
#'   e_geoFacet(legend = FALSE,
#'              grid = grid,
#'              margin_trbl = c("t"="25%"),
#'              left = "5%",
#'              width = "90%") |>
#'   e_title(text = "Group Temps") |>
#'   e_title_matrix(textStyle = list(fontSize = 10),
#'                  left = "center", top = "top")
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#title}{Additional
#'   arguments}
#'
#' @rdname e_title_matrix
#' @export
e_title_matrix <- function(e, ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  for(i in seq_along(e$x$opts$series)){
    e$x$opts$title <- append(e$x$opts$title, list(list(text = e$x$opts$series[[i]]$name,
                                                       coordinateSystem = "matrix",
                                                       coord = e$x$opts$grid[[i]]$coord,
                                                       ...)
    ))
  }
  e
}


#' Create geoFacet Echart
#'
#' generates a faceted chart using matrix functionality. Provides similar
#' functionality to e_facet(). Similar to geoFacet package. Timeline is NOT
#' supported.
#'
#' @inheritParams e_bar
#' @param rows,cols Provide integer values for the number of rows and columns in
#'   the matrix grid
#' @param grid A custom grid containing row,col positions and name. Or a string
#'   containing the name of a premade geoFacet grid from the geoFacet package.
#' @param legend Whether chart contains a legend. Defaults to \code{TRUE}.
#' @param legend_pos Position of the legend. One of "top", "right", "bottom",
#'   "left". Determines to which side the `legend_space` argument applies.
#' @param legend_space Space between legend and plot area. Supports
#'   integers(pixels) or strings(percent of parent cell).
#' @param margin_trbl Adjusts the size of the outside margin around the plotting
#'   area. Default is `c(t = "15%", r = "5%", b = "5%", l = "5%")`. Supports
#'   integers(pixels) or strings(percent of parent cell) To change only e.g. two
#'   sides `c("r" = 8, "l" = 8)` could be used, other sides will use defaults.
#'
#'
#' @examples
#' if (require("geofacet", quietly = TRUE)) {
#'   library(geofacet)
#'
#'   df <- data.frame(group = rep(letters[1:6], each = 20),
#'   date = seq(from = as.Date("2025-01-01"),
#'              to = as.Date("2025-01-20"), by = "day"),
#'   temp = sample(c(10:20), size = 60, replace = TRUE))
#'   grid <- data.frame(name = unique(df$group), row = c(1:6), col = c(1:6))
#'
#'   df |>
#'     group_by(group) |>
#'     e_chart(date) |>
#'     e_line(temp, symbol = "none") |>
#'     e_x_axis(splitNumber = 2) |>
#'     e_y_axis(splitNumber = 2) |>
#'     e_geoFacet(legend = FALSE,
#'                grid = grid,
#'                margin_trbl = c("t"="25%"),
#'                left = "5%",
#'                width = "90%") |>
#'     e_title(text = "Group Temps")
#'
#'
#'   tem <- data.frame(state.x77)
#'   sta <- cbind(state.name, tem)
#'   colnames(sta)[1] <- "State"
#'
#'   sta |>
#'     group_by(State) |>
#'     e_charts(Population) |>
#'     e_scatter(Income) |>
#'     e_geoFacet(grid = "us_state_grid1") |>
#'     e_tooltip()
#'  }
#'
#' @rdname e_geoFacet
#' @export
e_geoFacet <- function(e,
                       rows,
                       cols,
                       grid,
                       legend = TRUE,
                       legend_pos = "top",
                       legend_space = "10%",
                       margin_trbl = c(t = "8%", r = "5%", b = "8%", l = "8%"),
                       ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if(typeof(grid) !="character" & !is.data.frame(grid)){
    stop("must provide valid grid. Either name of geofacet grid object or custom dataframe grid", call. = FALSE)
  }

  if(typeof(grid)=="character"){
    check_installed_installer("geofacet")
    grid <- getExportedValue("geofacet", grid)
  }

  if(missing(rows) || missing(cols)){
    rows <- max(grid$row)
    cols <- max(grid$col)
  }

  e2 <- e_matrix_raw(rows = rows, cols = cols, ...)

  n <- length(e$x$opts$series)
  for(i in seq_len(nrow(grid))){
    e3 <- e
    series_pos <- NA
    for(j in 1:n){
      if(e$x$opts$series[[j]]$name == grid$name[i]){
        series_pos <- j
      }
    }
    if(is.na(series_pos)){
      warning(paste(grid$name[i], "data not found in series", sep = ": "))
      next
    }
    e3$x$opts$series <- list(e3$x$opts$series[[series_pos]])
    e3$x$data <- NULL
    e2 <- e2 |> e_matrix_addChart(e2,
                                  chart = e3,
                                  coord = list(grid$col[i]-1, grid$row[i]-1),
                                  id = paste0("chart",i),
                                  legend = FALSE,
                                  margin_trbl = margin_trbl)
  }

  e2
}


#' Generate pie chart for matrix
#'
#' Draw pie or donut chart in matrix coordinate system
#'
#' @inheritParams e_bar
#' @param x,y x and y column names for data to be used in the pie chart
#' @param legend Whether to add a legend, defaults to \code{TRUE}.
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#'                    "Grade" = c("Grade1","Grade2", "Grade3"),
#'                   "A" = sample(1:10, 9),
#'                   "B" = sample(1:10,9),
#'                   "C" = sample(1:10,9))
#'
#' df |> e_chart(x = A) |>
#'  e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'  e_matrix_parent(value = "Primary", children = c("Class1", "Class2")) |>
#'  e_matrix_parent(value = "High", children = "Class3") |>
#'  e_matrix_corner(value = "All School",
#'    label = list(fontSize = 24, color = "#555", position = "inside")) |>
#'  e_pie(B, coord_system = "matrix", label = list(show = FALSE)) |>
#'  e_tooltip(trigger = "item") |>
#'  e_legend()
#'
#'  df |> e_chart() |>
#'   e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'   e_pie_(serie = c("A","B","C"),
#'    coord_system = "matrix",
#'      label = list(show = FALSE)) |>
#'   e_tooltip(trigger = "item") |>
#'   e_legend()
#'
#'  df |> e_chart() |>
#'  e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'  e_pie_matrix(x = "A", y = c( "B", "C"))
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#series-pie}{Additional arguments}
#'
#' @rdname e_pie_matrix
#' @export
e_pie_matrix <- function(e, x, y, legend = TRUE, ...){

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if(is.null(e$x$opts$matrix)){
    stop("Matrix coordinate system must be built before adding data. e.g. e_matrix()")
  }
  e <- .rm_axis(e, TRUE, "x")
  e <- .rm_axis(e, TRUE, "y")

  base_nodes_x <- get_base_nodes(e$x$opts$matrix$x$data)
  base_nodes_y <- get_base_nodes(e$x$opts$matrix$y$data)

  for(i in seq_along(base_nodes_x)){
    for(j in seq_along(base_nodes_y)){
      center <- c(base_nodes_x[[i]], base_nodes_y[[j]])
      data <- e$x$data[[1]] |> dplyr::filter(.data[[e$x$opts$matrix$x$name]] == center[[1]] & .data[[e$x$opts$matrix$y$name]] == center[[2]]) |> dplyr::select(dplyr::all_of(c(x,y)))
      l_data <- list()
      for(k in seq_along(col(data))){
        l <- list(name = colnames(data)[k], value = data[,k])
        l_data <- append(l_data, list(l))
      }
      serie <- list(type = "pie",
                    coordinateSystem = "matrix",
                    center = center,
                    data = l_data,
                    ...
      )
      e$x$opts$series <- append(e$x$opts$series, list(serie))
    }
  }

  e
}


#' Generate scatter point for matrix
#'
#' Draw scatter points chart in matrix coordinate system
#'
#' @inheritParams e_bar
#' @param z Column name for data to be used for scatter points
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#'                    "Grade" = c("Grade1","Grade2", "Grade3"),
#'                   "A" = sample(1:10, 9))
#'
#' df |> e_chart() |>
#'  e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'  e_matrix_parent(value = "Primary", children = c("Class1", "Class2")) |>
#'  e_matrix_parent(value = "High", children = "Class3") |>
#'  e_matrix_corner(value = "All School",
#'    label = list(fontSize = 24, color = "#555", position = "inside")) |>
#'  e_scatter(A, coord_system = "matrix", symbolSize = 0) |>
#'  e_labels(position = "inside",
#'           formatter = htmlwidgets::JS(
#'            'function(params){return(params.value[2]);}'),
#'           color = "#555",
#'           fontWeight = "bold")
#'
#' df |> e_chart() |>
#'  e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'  e_scatter_matrix("A") |>
#'  e_labels(position = "inside",
#'           formatter = htmlwidgets::JS('function(params){return(params.value[2]);}'),
#'           color = "#555",
#'           fontWeight = "bold") |>
#'  e_visual_map(A, inRange = list(symbolSize = c(1,50)))
#'
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#series-scatter}{Additional arguments}
#'
#' @rdname e_scatter_matrix
#' @export
e_scatter_matrix <- function(e, z, ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if(is.null(e$x$opts$matrix)){
    stop("Matrix coordinate system must be built before adding data. e.g. e_matrix()")
  }
  e <- .rm_axis(e, TRUE, "x")
  e <- .rm_axis(e, TRUE, "y")

  base_nodes_x <- get_base_nodes(e$x$opts$matrix$x$data)
  base_nodes_y <- get_base_nodes(e$x$opts$matrix$y$data)

  all_data <- list()
  for(i in seq_along(base_nodes_x)){
    for(j in seq_along(base_nodes_y)){
      center <- c(base_nodes_x[[i]], base_nodes_y[[j]])
      data <- e$x$data[[1]] |> dplyr::filter(.data[[e$x$opts$matrix$x$name]] == center[[1]] & .data[[e$x$opts$matrix$y$name]] == center[[2]]) |> dplyr::select(dplyr::all_of(c(z)))
      serie <- list(center[[1]], center[[2]], data[[1]])
      all_data <- append(all_data, list(serie))
    }
  }

  serie <- list(type = "scatter", coordinateSystem = "matrix", data = all_data, ...)
  e$x$opts$series <- append(e$x$opts$series, list(serie))

  e
}


#' Generate heatmap for matrix
#'
#' Draw heatmap chart in matrix coordinate system
#'
#' @inheritParams e_bar
#' @param z_val Column name for data to be used for heatmap
#' @examples
#'
#' df <- data.frame("Class" = rep(c("Class1", "Class2", "Class3"),each = 3),
#'                    "Grade" = c("Grade1","Grade2", "Grade3"),
#'                   "A" = sample(1:10, 9))
#'
#' df |> e_chart() |>
#'  e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'  e_matrix_parent(value = "Primary", children = c("Class1", "Class2")) |>
#'  e_matrix_parent(value = "High", children = "Class3") |>
#'  e_matrix_corner(value = "All School", label = list(
#'    fontSize = 24, color = "#555", position = "inside")) |>
#'  e_heatmap(A, coord_system = "matrix") |>
#'  e_labels(position = "inside",
#'           formatter = htmlwidgets::JS(
#'             'function(params){return(params.value[2]);}'),
#'           color = "#555",
#'           fontWeight = "bold")
#'
#' df |> e_chart() |>
#'  e_matrix(xAxis = "Class", yAxis = "Grade") |>
#'  e_heatmap_matrix("A") |>
#'  e_labels(position = "inside",
#'           formatter = htmlwidgets::JS(
#'             'function(params){return(params.value[2]);}'),
#'           fontWeight = "bold") |>
#'  e_visual_map(A, inRange = list(color = c("#bf444c", "#d88273", "#f6efa6")))
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#series-scatter}{Additional arguments}
#'
#' @rdname e_heatmap_matrix
#' @export
e_heatmap_matrix <- function(e, z_val, ...){
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if(is.null(e$x$opts$matrix)){
    stop("Matrix coordinate system must be built before adding data. e.g. e_matrix()")
  }
  e <- .rm_axis(e, TRUE, "x")
  e <- .rm_axis(e, TRUE, "y")

  base_nodes_x <- get_base_nodes(e$x$opts$matrix$x$data)
  base_nodes_y <- get_base_nodes(e$x$opts$matrix$y$data)

  all_data <- list()
  for(i in seq_along(base_nodes_x)){
    for(j in seq_along(base_nodes_y)){
      center <- c(base_nodes_x[[i]], base_nodes_y[[j]])
      data <- e$x$data[[1]] |> dplyr::filter(.data[[e$x$opts$matrix$x$name]] == center[[1]] & .data[[e$x$opts$matrix$y$name]] == center[[2]]) |> dplyr::select(dplyr::all_of(c(z_val)))
      serie <- list(center[[1]], center[[2]], data[[1]])
      all_data <- append(all_data, list(serie))
    }
  }

  serie <- list(type = "heatmap", coordinateSystem = "matrix", data = all_data, ...)
  e$x$opts$series <- append(e$x$opts$series, list(serie))

  e
}

#' Timeline
#'
#' Set timeline options
#'
#' @inheritParams e_bar
#' @param axis_type Type of axis, \code{time}, \code{value}, or \code{category}.
#' @param index The index of the element to apply options to, see examples.
#' @param serie_index The index of the serie to add elements to.
#' @param ... Named options.
#'
#' @section Functions:
#' \itemize{
#'   \item{\code{e_timeline_opts}: Pass general timeline options, see \href{https://echarts.apache.org/en/option.html#timeline}{official documentation}.}
#'   \item{\code{e_timeline_serie}: Pass options to each serie, each options \emph{must}  be a vector or list the same length as their are steps, see examples.}
#'   \item{\code{e_timeline_make}: Helper function that wraps your data and \code{e_timeline_serie} to dynamically add options to series.}
#' }
#'
#' @examples
#' # general options
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_line(Sepal.Width) |>
#'   e_timeline_opts(
#'     autoPlay = TRUE,
#'     rewind = TRUE
#'   )
#'
#' # serie options
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length, timeline = TRUE) |>
#'   e_line(Sepal.Width) |>
#'   e_timeline_serie(
#'     title = list(
#'       list(text = "setosa"),
#'       list(text = "versicolor"),
#'       list(text = "virginica")
#'     )
#'   )
#' @name timeline-opts
#' @export
e_timeline_opts <- function(e, axis_type = "category", ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!e$x$tl) {
    warning("timeline not enabled in e_chart", call. = FALSE)
  }

  e$x$opts$baseOption$timeline$axisType <- axis_type

  e$x$opts$baseOption$timeline <- append(e$x$opts$baseOption$timeline, list(...))

  e
}

#' @name timeline-opts
#' @export
e_timeline_serie <- function(e, ..., index = 1) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  args <- list(...)

  if (length(args) == 0) {
    stop("no arguments passed", call. = FALSE)
  }

  for (i in seq_along(e$x$opts$options)) {
    for (j in seq_along(args)) {
      if (!length(e$x$opts$options[[i]][[names(args)[j]]]) < index) {
        e$x$opts$options[[i]][[names(args)[j]]][[index]] <- list()
      }
      e$x$opts$options[[i]][[names(args)[j]]][[index]] <- args[[j]][[i]]
    }
  }

  e
}

#' @name timeline-opts
#' @export
e_timeline_on_serie <- function(e, ..., serie_index) {
  if (missing(e) || missing(serie_index)) {
    stop("must pass e or serie_index", call. = FALSE)
  }

  args <- list(...)

  if (length(args) == 0) {
    stop("no arguments passed", call. = FALSE)
  }

  for (i in seq_along(e$x$opts$options)) {
    for (j in seq_along(args)) {
      if (!length(e$x$opts$options[[i]]$series[[serie_index]][[names(args)[j]]]) < serie_index) {
        e$x$opts$options[[i]]$series[[serie_index]][[names(args)[j]]] <- list()
      }
      e$x$opts$options[[i]]$series[[serie_index]][[names(args)[j]]] <- args[[j]][[i]]
    }
  }

  e
}

#' Leaflet
#'
#' Leaflet extension.
#'
#' @inheritParams e_bar
#' @param roam Whether to allow the user to roam.
#' @param template \code{urlTemplate}, should not be changed.
#' @param options List of options, including \code{attribution} and \code{label}.
#'
#' @examples
#' population |>
#'   dplyr::filter(value > 8) |>
#'   e_charts(lon) |>
#'   e_leaflet() |>
#'   e_leaflet_tile(options = list(maxZoom = 3)) |>
#'   e_scatter(lat, size = value, coord_system = "leaflet")
#'
#' @rdname leaflet
#' @export
e_leaflet <- function(e, roam = TRUE, ...) {
  leaf <- list(...)
  leaf$roam <- roam
  leaf$tiles <- list()

  # remove axis
  e <- .rm_axis(e, TRUE, "x")
  e <- .rm_axis(e, TRUE, "y")

  e$x$opts$leaflet <- leaf

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")

  dep <- htmltools::htmlDependency(
    name = "leaflet",
    version = "1.9.4",
    src = c(file = path),
    stylesheet = "leaflet.css",
    script = "leaflet.js"
  )

  dep2 <- htmltools::htmlDependency(
    name = "echarts-leaflet",
    version = "1.0.0",
    src = c(file = path),
    script = "echarts-leaflet.js"
  )

  e$dependencies <- append(e$dependencies, htmlwidgets::getDependency("leaflet"))
  e$dependencies <- append(e$dependencies, list(dep, dep2))

  e
}

#' @rdname leaflet
#' @export
e_leaflet_tile <- function(
  e,
  template = "https://{s}.tile.openstreetmap.fr/hot/{z}/{x}/{y}.png",
  options = NULL,
  ...
) {
  pkgs <- utils::installed.packages() |> rownames()
  if (!"leaflet" %in% pkgs) {
    stop("Requires the `leaflet` package installed", call. = FALSE)
  }

  if (!length(e$x$opts$leaflet$roam)) {
    e <- e_leaflet(e)
  }

  tile <- list(...)
  tile$urlTemplate <- template

  if (!is.null(options)) {
    tile$options <- options
  }

  e$x$opts$leaflet$tiles <- list(tile)

  e
}

#' Axis
#'
#' Customise axis.
#'
#' @inheritParams e_bar
#' @param axis Axis to customise.
#' @param serie Column name of serie to range the axis. If used the range of the serie is used as,
#' \code{min} an \code{max}.
#' @param margin Margin to apply to \code{serie}: \eqn{min = serie - margin} and
#' \eqn{max = serie + margin}
#' @param index Index of axis to customise.
#' @param formatter An axis formatter as returned by \code{\link{e_axis_formatter}}.
#' @param style Formatter style, one of \code{decimal}, \code{percent}, or \code{currency}.
#' @param currency Currency to to display.
#' @param digits Number of decimals.
#' @param locale Locale, if \code{NULL} then it is inferred from \code{Sys.getlocale}.
#'
#' @section Functions:
#' \itemize{
#'   \item{\code{e_axis} to customise axis}
#'   \item{\code{e_rm_axis} to remove axis}
#' }
#'
#' @details The \code{e_axis_formatter} may not work in RStudio,
#' open the plot in your browser. It will display just fine in
#' Rmarkdown and Shiny.
#'
#' @examples
#' # range axis based on serie
#' cars |>
#'   e_charts(speed) |>
#'   e_line(dist) |>
#'   e_x_axis(speed) |>
#'   e_y_axis(dist)
#'
#' # use formatter
#' cars |>
#'   dplyr::mutate(
#'     speed = speed / 25
#'   ) |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_y_axis(
#'     formatter = e_axis_formatter("currency")
#'   ) |>
#'   e_x_axis(
#'     formatter = e_axis_formatter("percent", digits = 0)
#'   )
#'
#' # plot all labels & rotate
#' USArrests |>
#'   head(10) |>
#'   tibble::rownames_to_column(var = "State") |>
#'   e_charts(State) |>
#'   e_area(Murder) |>
#'   e_x_axis(axisLabel = list(interval = 0, rotate = 45)) # rotate
#' @seealso \href{https://echarts.apache.org/en/option.html#xAxis}{Additional x arguments},
#' \href{https://echarts.apache.org/en/option.html#yAxis}{Additional y arguments}
#'
#' @rdname axis
#' @export
e_axis <- function(e, serie, axis = c("x", "y", "z"), index = 0, formatter = NULL, margin = 0, ...) {
  if (missing(serie)) {
    serie <- NULL
  } else {
    serie <- deparse(substitute(serie))
  }

  e_axis_(e, serie = serie, axis = axis, index = index, formatter = formatter, margin = margin, ...)
}

#' @rdname axis
#' @export
e_axis_ <- function(e, serie = NULL, axis = c("x", "y", "z"), index = 0, formatter = NULL, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  axis <- .r2axis(axis[1])

  r.index <- index + 1
  max <- length(e$x$opts[[axis]])

  attrs <- list(...)

  if (!is.null(serie)) {
    dat <- .get_data(e, serie)
    if (inherits(dat, "numeric") || inherits(dat, "integer")) {
      rng <- range(dat)
      # If min or max is provided, that will replace the min/max in the data
      if(!is.null(attrs$min)){
        rng[1] <- attrs$min
      }
      if(!is.null(attrs$max)){
        rng[2] <- attrs$max
      }

      attrs$min <- rng[1] - margin
      attrs$max <- rng[2] + margin
    }
  }

  if (!is.null(formatter)) {
    attrs$axisLabel$formatter <- formatter
  }

  if (!length(attrs)) {
    stop("no attribute", call. = FALSE)
  }

  # initiatlise if wrong index
  if (r.index > max) {
    r.index <- 1
  }

  if (!e$x$tl) {
    dp <- .list_depth(e$x$opts[[axis]])
  } else {
    dp <- .list_depth(e$x$opts$baseOption[[axis]])
  }

  if (dp >= 2) {
    for (i in seq_along(attrs)) {
      arg <- names(attrs)[i]
      if (!e$x$tl) {
        e$x$opts[[axis]][[r.index]][[arg]] <- attrs[[i]]
      } else {
        e$x$opts$baseOption[[axis]][[r.index]][[arg]] <- attrs[[i]]
      }
    }
  } else {
    for (i in seq_along(attrs)) {
      arg <- names(attrs)[i]
      if (!e$x$tl) {
        e$x$opts[[axis]][[arg]] <- attrs[[i]]
      } else {
        e$x$opts$baseOption[[axis]][[arg]] <- attrs[[i]]
      }
    }
  }

  e
}

#' @rdname axis
#' @export
e_x_axis_ <- function(e, serie = NULL, index = 0, formatter = NULL, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e_axis_(e, serie, "x", index, formatter, margin = margin, ...)
}

#' @rdname axis
#' @export
e_y_axis_ <- function(e, serie = NULL, index = 0, formatter = NULL, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e_axis_(e = e, serie = serie, axis = "y", index = index, formatter, margin = margin, ...)
}

#' @rdname axis
#' @export
e_z_axis_ <- function(e, serie = NULL, index = 0, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e_axis_(e = e, serie = serie, axis = "z", index = index, margin = margin, ...)
}


#' @rdname axis
#' @export
e_x_axis <- function(e, serie, index = 0, formatter = NULL, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    serie <- NULL
  } else {
    serie <- deparse(substitute(serie))
  }

  e_axis_(e, serie, "x", index, formatter, margin = margin, ...)
}

#' @rdname axis
#' @export
e_y_axis <- function(e, serie, index = 0, formatter = NULL, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    serie <- NULL
  } else {
    serie <- deparse(substitute(serie))
  }

  e_axis_(e = e, serie = serie, axis = "y", index = index, formatter, margin = margin, ...)
}

#' @rdname axis
#' @export
e_z_axis <- function(e, serie, index = 0, margin = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(serie)) {
    serie <- NULL
  } else {
    serie <- deparse(substitute(serie))
  }

  e_axis_(e = e, serie = serie, axis = "z", index = index, margin = margin, ...)
}

#' @rdname axis
#' @export
e_rm_axis <- function(e, axis = c("x", "y", "z")) {
  match.arg(axis, c("x", "y", "z"))
  axis <- .r2axis(axis[1])

  e$x$opts[[axis]] <- NULL

  return(e)
}

#' @rdname axis
#' @export
e_axis_formatter <- function(
  style = c("decimal", "percent", "currency"),
  digits = 0,
  locale = NULL,
  currency = "USD"
) {
  if (rstudioapi::isAvailable()) {
    warning("`e_axis_formatter` breaks the plot in RStudio, open it in your browser.", call. = FALSE)
  }

  if (is.null(locale)) {
    locale <- .get_locale()
  }

  style <- match.arg(style)
  opts <- list(
    style = style,
    minimumFractionDigits = digits,
    maximumFractionDigits = digits,
    currency = currency
  )
  htmlwidgets::JS(sprintf("function(value, index) {
        var fmt = new Intl.NumberFormat('%s', %s);
        return fmt.format(value);
    }", locale, jsonlite::toJSON(opts, auto_unbox = TRUE)))
}

#' Grid
#'
#' Customise grid.
#'
#' @inheritParams e_bar
#' @inheritParams e_axis
#'
#' @examples
#' USArrests |>
#'   e_charts(UrbanPop) |>
#'   e_line(Assault, smooth = TRUE) |>
#'   e_area(Murder, y_index = 1, x_index = 1) |>
#'   e_y_axis(gridIndex = 1) |>
#'   e_x_axis(gridIndex = 1) |>
#'   e_grid(height = "40%") |>
#'   e_grid(height = "40%", top = "55%")
#' @seealso \href{https://echarts.apache.org/en/option.html#grid}{Additional arguments}
#'
#' @export
e_grid <- function(e, index = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (is.null(index)) {
    index <- length(e$x$opts[["grid"]]) + 1
  }

  attrs <- list(...)

  # initialise of not existing
  if (!e$x$tl) {
    if (!length(e$x$opts[["grid"]])) {
      e$x$opts$grid <- list()
    }

    e$x$opts$grid <- append(e$x$opts$grid, list(attrs))
  } else {
    if (!length(e$x$opts$baseOption[["grid"]])) {
      e$x$opts$baseOption$grid <- list()
    }

    e$x$opts$baseOption$grid <- append(e$x$opts$baseOption$grid, list(attrs))
  }

  e
}

#' Radius axis
#'
#' Customise radius axis.
#'
#' @inheritParams e_bar
#' @param serie Serie to use as axis labels.
#' @param show Whether to display the axis.
#'
#' @examples
#' df <- data.frame(x = LETTERS[1:10], y = seq(1, 20, by = 2))
#'
#' df |>
#'   e_charts(x) |>
#'   e_polar() |>
#'   e_angle_axis() |>
#'   e_radius_axis(x) |>
#'   e_bar(y, coord_system = "polar")
#' @seealso \href{https://echarts.apache.org/en/option.html#radiusAxis}{Additional arguments}
#'
#' @export
#' @name radius_axis
e_radius_axis <- function(e, serie, show = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  opts <- list(show = show, ...)

  if (!missing(serie)) {
    sr <- deparse(substitute(serie))
  }

  if (!missing(serie)) {
    opts$data <- e$x$data |>
      purrr::map(sr) |>
      unlist() |>
      unname() |>
      unique() |>
      as.list()
  }

  if (!e$x$tl) {
    e$x$opts$radiusAxis <- opts
  } else {
    e$x$opts$baseOption$radiusAxis <- opts
  }

  e
}

#' @rdname radius_axis
#' @export
e_radius_axis_ <- function(e, serie = NULL, show = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  opts <- list(show = show, ...)

  if (!is.null(serie)) {
    opts$data <- e$x$data |>
      purrr::map(serie) |>
      unlist() |>
      unname() |>
      unique() |>
      as.list()
  }

  if (!e$x$tl) {
    e$x$opts$radiusAxis <- opts
  } else {
    e$x$opts$baseOption$radiusAxis <- opts
  }

  e
}

#' Angle axis
#'
#' Customise angle axis.
#'
#' @inheritParams e_bar
#' @param serie Serie to use as axis labels.
#' @param show Whether to display the axis.
#'
#' @examples
#' df <- data.frame(x = 1:100, y = seq(1, 200, by = 2))
#'
#' df |>
#'   e_charts(x) |>
#'   e_polar(FALSE) |>
#'   e_angle_axis(FALSE) |>
#'   e_radius_axis(FALSE) |>
#'   e_line(y, coord_system = "polar", smooth = TRUE) |>
#'   e_legend(show = FALSE)
#'
#' df <- data.frame(x = LETTERS[1:5], y = runif(5))
#'
#' df |>
#'   e_charts(x) |>
#'   e_polar() |>
#'   e_angle_axis(x) |>
#'   e_radius_axis() |>
#'   e_line(y, coord_system = "polar", smooth = TRUE)
#' @seealso \href{https://echarts.apache.org/en/option.html#angleAxis}{Additional arguments}
#'
#' @name angle_axis
#' @export
e_angle_axis <- function(e, serie, show = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  opts <- list(show = show, ...)

  if (!missing(serie)) {
    sr <- deparse(substitute(serie))
  }

  if (!missing(serie)) {
    opts$data <- e$x$data |>
      purrr::map(sr) |>
      unlist() |>
      unname() |>
      unique() |>
      as.list()
  }

  if (!e$x$tl) {
    e$x$opts$angleAxis <- opts
  } else {
    e$x$opts$baseOption$angleAxis <- opts
  }

  e
}

#' @rdname angle_axis
#' @export
e_angle_axis_ <- function(e, serie = NULL, show = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  opts <- list(show = show, ...)

  if (!is.null(serie)) {
    opts$data <- e$x$data |>
      purrr::map(serie) |>
      unlist() |>
      unname() |>
      unique() |>
      as.list()
  }

  if (!e$x$tl) {
    e$x$opts$angleAxis <- opts
  } else {
    e$x$opts$baseOption$angleAxis <- opts
  }

  e
}

#' Radar axis
#'
#' Radar axis setup and options.
#'
#' @inheritParams e_bar
#' @param index Index of axis to customise.
#'
#' @examples
#' df <- data.frame(
#'   x = LETTERS[1:5],
#'   y = runif(5, 1, 5),
#'   z = runif(5, 3, 7)
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_radar(y, max = 7) |>
#'   e_radar(z) |>
#'   e_radar_opts(center = c("25%", "25%")) |>
#'   e_tooltip(trigger = "item")
#' @export
e_radar_opts <- function(e, index = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  r.index <- index + 1
  max <- length(e$x$opts$radar)

  attrs <- list(...)

  if (!length(attrs)) {
    stop("no attribute", call. = FALSE)
  }

  # initiatlise if wrong index
  if (r.index > max) {
    r.index <- 1
    # This part seemed to break the plot
    # if (!e$x$tl) {
    #   e$x$opts$radar <- list(list())
    # } else {
    #   e$x$opts$baseOption$radar <- list(list())
    # }
  }

  for (i in seq_along(attrs)) {
    arg <- names(attrs)[i]
    if (!e$x$tl) {
      e$x$opts$radar[[r.index]][[arg]] <- attrs[[i]]
    } else {
      e$x$opts$baseOption$radar[[r.index]][[arg]] <- attrs[[i]]
    }
  }

  e
}

#' Single Axis
#'
#' Setup single axis.
#'
#' @inheritParams e_bar
#' @param index Index of axis to customise.
#'
#' @examples
#' df <- data.frame(
#'   axis = LETTERS[1:10],
#'   value = runif(10, 3, 20),
#'   size = runif(10, 3, 20)
#' )
#'
#' df |>
#'   e_charts(axis) |>
#'   e_single_axis() |> # add the single axis
#'   e_scatter(
#'     value,
#'     size,
#'     coord_system = "singleAxis"
#'   )
#' @export
e_single_axis <- function(e, index = 0, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  r.index <- index + 1

  e$x$opts$xAxis <- NULL
  e$x$opts$yAxis <- NULL

  if (!e$x$tl) {
    if (!length(e$x$opts$singleAxis)) {
      e$x$opts$singleAxis <- list(...)
    } else {
      e$x$opts$singleAxis <- append(e$x$opts$singleAxis, list(...))
    }
  } else {
    if (!length(e$x$opts$baseOption$singleAxis)) {
      e$x$opts$baseOption$singleAxis <- list(...)
    } else {
      e$x$opts$baseOption$singleAxis <- append(e$x$opts$baseOption$singleAxis, list(...))
    }
  }

  if (!is.null(e$x$mapping$x)) {
    type <- .get_type(e, e$x$mapping$x)

    if (!e$x$tl) {
      e$x$opts$singleAxis$type <- type
    } else {
      e$x$opts$baseOption$singleAxis$type <- type
    }

    if (type == "category" || type == "time") {
      vect <- c()
      for (i in seq_along(e$x$data)) {
        dat <- e$x$data[[i]] |>
          dplyr::select(e$x$mapping$x) |>
          unlist()
        dat <- unname(dat)
        dat <- as.character(dat)

        vect <- append(vect, dat)
      }

      vect <- unique(vect)

      if (!e$x$tl) {
        e$x$opts$singleAxis$data <- vect
      } else {
        e$x$opts$baseOption$singleAxis$data <- vect
      }
    }
  } else {
    warning("x not pass to e_charts", call. = FALSE)
  }

  e
}

#' Axis Labels
#'
#' Convenience function to add axis labels.
#'
#' @inheritParams e_bar
#' @param x,y Labels of axes.
#'
#' @examples
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_axis_labels(
#'     x = "speed",
#'     y = "distance"
#'   )
#' @export
e_axis_labels <- function(e, x = "", y = "") {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  e |>
    e_x_axis(name = x) |>
    e_y_axis(name = y)
}

#'' Hide Grid Lines
#'
#' A convenience function to easily hide grid lines.
#'
#' @inheritParams e_bar
#' @param which Which axis grid lines to hide.
#'
#' @examples
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_hide_grid_lines()
#' @export
e_hide_grid_lines <- function(e, which = c("x", "y")) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if ("x" %in% which) {
    if (!e$x$tl) {
      e$x$opts[["xAxis"]][[1]]$splitLine$show <- FALSE
    } else {
      e$x$opts$baseOption[["xAxis"]][[1]]$splitLine$show <- FALSE
    }
  }

  if ("y" %in% which) {
    if (!e$x$tl) {
      e$x$opts[["yAxis"]][[1]]$splitLine$show <- FALSE
    } else {
      e$x$opts$baseOption[["yAxis"]][[1]]$splitLine$show <- FALSE
    }
  }

  return(e)
}

#' Stagger Axis Labels
#'
#' Stagger axis labels.
#'
#' @inheritParams e_bar
#'
#' @examples
#' df <- data.frame(
#'   x = c("a very long label", "Another long label"),
#'   y = 1:2
#' )
#'
#' df |>
#'   e_charts(x, width = 150) |>
#'   e_bar(y) |>
#'   e_axis_stagger()
#' @export
e_axis_stagger <- function(e) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  form <- "function(value, index){
    if(index % 2){
      return('\\n' + value)
    }

    return(value)
  }" |>
    htmlwidgets::JS()

  if (!e$x$tl) {
    e$x$opts[["xAxis"]][[1]]$axisLabel$formatter <- form
  } else {
    e$x$opts$baseOption[["xAxis"]][[1]]$axisLabel$formatter <- form
  }

  return(e)
}

#' Country names
#'
#' Convert country names to echarts format.
#'
#' @param data Data.frame in which to find column names.
#' @param input,output Input and output columns.
#' @param type Passed to \link[countrycode]{countrycode} \code{origin} parameter.
#' @param ... Any other parameter to pass to \link[countrycode]{countrycode}.
#'
#' @details Taiwan and Hong Kong cannot be plotted.
#'
#' @examples
#' cns <- data.frame(country = c("US", "BE"))
#'
#' # replace
#' e_country_names(cns, country)
#'
#' # specify output
#' e_country_names(cns, country, country_name)
#' @rdname e_country_names
#' @export
e_country_names <- function(data, input, output, type = "iso2c", ...) {
  if (missing(data) || missing(input)) {
    stop("must pass data and input", call. = FALSE)
  }

  if (missing(output)) {
    output <- NULL
  } else {
    output <- deparse(substitute(output))
  }

  e_country_names_(data, deparse(substitute(input)), output, type, ...)
}

#' @rdname e_country_names
#' @export
e_country_names_ <- function(data, input, output = NULL, type = "iso2c", ...) {
  if (missing(data) || missing(input)) {
    stop("must pass data and input", call. = FALSE)
  }

  src <- input
  cn <- countrycode::countrycode(data[[src]], origin = type, destination = "country.name", ...)

  if (is.null(output)) {
    output <- src
  }

  data[[output]] <- .correct_countries(cn)
  data
}

#' Color range
#'
#' Build manual color range
#'
#' @param data Data.frame in which to find column names.
#' @param input,output Input and output columns.
#' @param colors Colors to pass to \code{\link{colorRampPalette}}.
#' @param ... Any other argument to pass to \code{\link{colorRampPalette}}.
#'
#' @examples
#' df <- data.frame(val = 1:10)
#'
#' e_color_range(df, val, colors)
#' @rdname e_color_range
#' @export
e_color_range <- function(data, input, output, colors = c("#bf444c", "#d88273", "#f6efa6"), ...) {
  if (missing(data) || missing(input) || missing(output)) {
    stop("must pass data, input and output", call. = FALSE)
  }

  e_color_range_(data, deparse(substitute(input)), deparse(substitute(output)), colors, ...)
}

#' @rdname e_color_range
#' @export
e_color_range_ <- function(data, input, output, colors = c("#bf444c", "#d88273", "#f6efa6"), ...) {
  if (missing(data) || missing(input) || missing(output)) {
    stop("must pass data, input and output", call. = FALSE)
  }

  serie <- data[[input]]
  if (inherits(serie, "factor") || inherits(serie, "character")) {
    col <- scales::col_factor(colors, domain = (serie))(serie)
  } else {
    col <- scales::col_numeric(colors, domain = range(serie))(serie)
  }

  data[[output]] <- col
  data
}

#' Get data
#'
#' Get data passed to \code{\link{e_charts}}.
#'
#' @inheritParams e_bar
#'
#' @return A list of data.frames, one for each group.
#'
#' @examples
#' echart <- cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_lm(dist ~ speed)
#'
#' echart
#'
#' e_get_data(echart)[[1]]
#' @export
e_get_data <- function(e) {
  e$x$data
}

#' Formatters
#'
#' Simple formatters as helpers.
#'
#' @inheritParams e_bar
#' @param axis Axis to apply formatter to.
#' @param suffix,prefix Suffix and prefix of label.
#' @param ... Any other arguments to pass to \code{\link{e_axis}}.
#'
#' @examples
#' # Y = %
#' df <- data.frame(
#'   x = 1:10,
#'   y = round(
#'     runif(10, 1, 100),
#'     2
#'   )
#' )
#'
#' df |>
#'   e_charts(x) |>
#'   e_line(y) |>
#'   e_format_y_axis(suffix = "%") |>
#'   e_format_x_axis(prefix = "A")
#' @rdname formatters
#' @export
e_format_axis <- function(e, axis = "y", suffix = NULL, prefix = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (is.null(suffix) && is.null(prefix)) {
    stop("missing formatting")
  }

  fmt <- paste(prefix, "{value}", suffix)

  e <- e |>
    e_axis(
      axis = axis,
      axisLabel = list(formatter = fmt),
      ...
    )

  e
}

#' @rdname formatters
#' @export
e_format_x_axis <- function(e, suffix = NULL, prefix = NULL, ...) {
  e_format_axis(e, "x", suffix, prefix, ...)
}

#' @rdname formatters
#' @export
e_format_y_axis <- function(e, suffix = NULL, prefix = NULL, ...) {
  e_format_axis(e, "y", suffix, prefix, ...)
}

#' Format labels
#'
#' @inheritParams e_bar
#' @param show Set to \code{TRUE} to show the labels.
#' @param position Position of labels, see
#' \href{https://echarts.apache.org/en/option.html#series-line.label.position}{official documentation}
#'  for the full list of options.
#' @param ... Any other options see
#' \href{https://echarts.apache.org/en/option.html#series-line.label}{documentation} for other options.
#'
#' @examples
#' mtcars |>
#'   e_chart(wt) |>
#'   e_scatter(qsec, cyl) |>
#'   e_labels(fontSize = 9)
#'
#' mtcars |>
#'   group_by(cyl) |>
#'   e_chart(wt) |>
#'   e_scatter(qsec, mpg) |>
#'   e_labels(fontSize = 9)
#'
#' # timeline
#' mtcars |>
#'   group_by(cyl) |>
#'   e_chart(wt, timeline = TRUE) |>
#'   e_scatter(qsec, mpg) |>
#'   e_labels(fontSize = 9)
#' @export
e_labels <- function(e, show = TRUE, position = "top", ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  opts <- list(
    show = show,
    position = position,
    ...
  )

  if (!e$x$tl) {
    for (i in seq_along(e$x$opts$series)) {
      e$x$opts$series[[i]]$label <- opts
    }
  } else {
    for (i in seq_along(e$x$opts$baseOption$series)) {
      e$x$opts$baseOption$series[[i]]$label <- opts
    }
  }

  return(e)
}

#' List
#'
#' simply pass a list of options, similar to a \code{JSON}.
#'
#' @inheritParams e_bar
#' @param list A \code{list} of options passed to \code{setOptions}.
#' @param append if \code{TRUE} the \code{list} is appended to the options,
#' otherwise it \emph{overwrites} everything.
#'
#' @examples
#' N <- 20 # data points
#'
#' opts <- list(
#'   xAxis = list(
#'     type = "category",
#'     data = LETTERS[1:N]
#'   ),
#'   yAxis = list(
#'     type = "value"
#'   ),
#'   series = list(
#'     list(
#'       type = "line",
#'       data = round(runif(N, 5, 20))
#'     )
#'   )
#' )
#'
#' e_charts() |>
#'   e_list(opts)
#' @export
e_list <- function(e, list, append = FALSE) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }
  if (missing(list)) {
    stop("missing list", call. = FALSE)
  }

  if (isTRUE(append)) {
    e$x$opts <- append(e$x$opts, list)
  } else {
    e$x$opts <- list
  }

  e
}

#' Aria
#'
#' W3C defined the Accessible Rich Internet Applications Suite (WAI-ARIA)
#' to make Web content and Web applications more accessible to the disabled.
#' From ECharts 4.0, echarts4r supports ARIA by generating description for
#' charts automatically.
#'
#' @details There should be an aria-label attribute on the chart DOM, which
#' can help the disabled understand the content of charts with the help of certain devices.
#'
#' @inheritParams e_bar
#' @param enabled Whether to enable aria helper text.
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#aria}{official documentation}
#'
#' @export
e_aria <- function(e, enabled = TRUE, ...) {
  e$x$opts$aria <- list(
    enabled = enabled,
    ...
  )

  return(e)
}

#' To & From JSON
#'
#' Get JSON options from an echarts4r object and build one from JSON.
#'
#' @inheritParams e_bar
#' @param json Whether to return the JSON, otherwise returns a \code{list}.
#' @param txt JSON character string, url, or file.
#' @param jswrapper Whether to wrap pure JS functions in \code{htmlwidgets::JS}, Default is FALSE.
#' @param ... Additional options to pass to \link[jsonlite]{toJSON}.
#'
#' @details \code{txt} should contain the full list of options required to build a chart.
#' This is subsequently passed to the \code{setOption} ECharts (JavaScript) function.
#'
#' @examples
#' p <- cars |>
#'   e_charts(dist) |>
#'   e_scatter(speed, symbol_size = 10)
#'
#' p # plot
#'
#' # extract the JSON
#' json <- p |>
#'   e_inspect(
#'     json = TRUE,
#'     pretty = TRUE
#'   )
#'
#' # print json
#' json
#'
#' # rebuild plot
#' echarts_from_json(json) |>
#'   e_theme("dark") # modify
#' @return \code{e_inspect} Returns a \code{list} if \code{json} is \code{FALSE} and a
#' JSON string otherwise. \code{echarts_from_json} returns an object of class \code{echarts4r}.
#'
#' @note Must be passed as last option.
#'
#' @rdname echartsNJSON
#' @export
e_inspect <- function(e, json = FALSE, ...) {
  opts <- e$x$opts

  if (isTRUE(json)) {
    opts <- jsonlite::toJSON(opts, force = TRUE, auto_unbox = TRUE, null = "null", ...)
  }

  return(opts)
}

#' @rdname echartsNJSON
#' @export
echarts_from_json <- function(txt, jswrapper = FALSE) {
  json <- jsonlite::fromJSON(txt, simplifyVector = FALSE)

  e <- e_charts()
  e$x$opts <- json
  if (isTRUE(jswrapper)) {
      for (i in seq_along(e$x$opts$tooltip)) {

        if (is.character(e$x$opts$tooltip[[i]]) && startsWith(e$x$opts$tooltip[[i]], "function")) {
          # Wrap pure JS functions in htmlwidgets::JS
          e$x$opts$tooltip[[i]] <- htmlwidgets::JS(e$x$opts$tooltip[[i]])
        }

      }
  }

  e
}

#' Axis ZigZags
#'
#' helper function for generating axis break zigzags in chart
#'
#' @inheritParams e_bar
#' @param axis Axis to apply formatter to. Supports x and y axis
#' @param start,end Start and End point for boundary of zigzag. Also supports vectors for generating multiple breaks. Can also support time values.
#' @param gap Determines the visual size of the axis break area.
#' Supports Percentage(String) as proportional value relative to axis. Supports Absolute value(numeric) which refers to literal values in the axis similar to start,end (Not a pixel value).
#' @param zigzagAmplitude Amplitude of zigzag. Unit is pixels.
#' @param ... Any other arguments to pass to breakArea argument.
#'
#' @examples
#'
#' df <- data.frame(
#'               x = c("a", "b", "c", "d", "c"),
#'               y = c(100, 200, 200, 700, 300)
#'              )
#'
#' df |>
#'   e_charts(x) |>
#'   e_bar(y) |>
#'   e_zigzag(axis = 'y', start = 400, end = 500)
#'
#' df |>
#'   e_charts(x) |>
#'   e_bar(y) |>
#'   e_zigzag(axis = 'y', start = c(125,400), end = c(150,500))
#' @seealso \href{https://echarts.apache.org/en/option.html#series-bar}{Additional arguments}
#'
#' @rdname e_zigzag
#' @export
e_zigzag <- function(e, axis = 'y', start, end, gap = "3%", zigzagAmplitude = 10, ...){

  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(axis)) {
    stop("must indicate which axis to zigzag. e.g. 'x' or 'y'", call. = FALSE)
  }

  if (missing(start) | missing(end)) {
    stop("must provide start and end values")
  }

  df <- data.frame("starts" = start, "ends" = end, "gap" = gap)
  b <- .build_zigzags(df, starts = "starts", ends = "ends", gap = "gap")

  bA <- list(
    zigzagAmplitude = zigzagAmplitude,
    ...
  )

  if(axis == 'y'){
    e <- e |> e_y_axis(breaks = b, breakArea = bA)
  }

  if(axis == 'x'){
    e <- e |> e_x_axis(breaks = b, breakArea = bA)
  }
  e
}


#' Axis Jitter
#'
#' helper function for generating jitter between points in a scatter plot. This is only applicable to e_scatter().
#'
#' @inheritParams e_bar
#' @param axis Axis to apply formatter to. Supports x and y axis
#' @param jitter Pixel units indicating the amount of random noise to add to each data point position.
#' @param jitterOverlap Boolean allowing overlap between data points. If false, overlap will not be allowed. For some cases, scatters may still overlap if there is no reasonable way to avoid.
#' @param jitterMargin When you have jitter and jiterOverlap is FALSE, this is the minimum distance in pixels between two data points.
#'
#' @examples
#'
#' df <- data.frame(
#' value = c(rnorm(50, mean = 5, sd = 1),
#'          rnorm(50, mean = 10, sd = 1),
#'          rnorm(50, mean = 15, sd = 1)),
#'          group = rep(c("Group A", "Group B", "Group C"), each = 50)
#'           )
#'
#' df |> e_charts(group) |> e_scatter(value) |> e_jitter()
#' @seealso \href{https://echarts.apache.org/en/option.html#yAxis.jitter}{Additional arguments}
#'
#' @rdname e_jitter
#' @export
e_jitter <- function(e, axis = 'x', jitter = 20, jitterOverlap = FALSE, jitterMargin = 5){
  if(missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if(is.null(axis)) {
    stop("must indicate which axis to apply jitter. e.g. 'x' or 'y'", call. = FALSE)
  }

  if(e$x$opts$series[[1]]$type != 'scatter' || is.null(e$x$opts$series[[1]]$type)){
    stop("jitter is only supported with scatter plots")
  }

  if(axis == 'x'){
    e <- e |> e_x_axis(jitter = jitter, jitterOverlap = jitterOverlap, jitterMargin = jitterMargin)
  }

  if(axis == 'y'){
    e <- e |> e_y_axis(jitter = jitter, jitterOverlap = jitterOverlap, jitterMargin = jitterMargin)
  }
  e
}

#' Append Proxy
#'
#' Append data dynamically.
#'
#' @inheritParams e_highlight_p
#' @param series_index Index of serie to append to (starts from 0).
#' @param data Data.frame containing data to append.
#' @param x,y,z Columns names to plot.
#' @param name if using `bind` with e.g `e_scatter` this can be used to supply the colname for
#' the name attribute bind is mapping to
#' @param scale A scaling function as passed to \code{\link{e_scatter}}.
#' @param symbol_size Multiplier of scaling function as in \code{\link{e_scatter}}.
#'
#' @details Currently not all types of series supported incremental rendering when using appendData.
#' Only these types of series support it: \code{\link{e_scatter}} and \code{\link{e_line}} of pure echarts, and
#' \code{\link{e_scatter_3d}}, and \code{\link{e_line_3d}} of echarts-gl.
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' ui <- fluidPage(
#'   actionButton("add", "Add Data to y"),
#'   echarts4rOutput("plot"),
#'   h4("Brush"),
#'   verbatimTextOutput("selected"),
#'   h4("Legend select change"),
#'   verbatimTextOutput("legend")
#' )
#'
#' server <- function(input, output, session) {
#'   data <- data.frame(x = rnorm(10, 5, 3), y = rnorm(10, 50, 12), z = rnorm(10, 5, 20))
#'
#'   react <- eventReactive(input$add, {
#'     set.seed(sample(1:1000, 1))
#'     data.frame(x = rnorm(10, 5, 2), y = rnorm(10, 50, 10), z = rnorm(10, 5, 20))
#'   })
#'
#'   output$plot <- renderEcharts4r({
#'     data |>
#'       e_charts(x) |>
#'       e_scatter(y, z, scale = NULL) |>
#'       e_scatter(z) |>
#'       e_brush()
#'   })
#'
#'   observeEvent(input$add, {
#'
#'     echarts4rProxy("plot") |>
#'       e_append2_p(0, react(), x, y, z)
#'   })
#'
#'   output$selected <- renderPrint({
#'     input$plot_brush
#'   })
#'
#'   output$legend <- renderPrint({
#'     input$plot_legend_change
#'   })
#' }
#'
#' shinyApp(ui, server)
#' }
#'
#' @rdname append
#' @export
e_append1_p <- function(proxy, series_index = NULL, data, x, y, name = NULL) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  e_append1_p_(proxy, series_index, data, deparse(substitute(x)), deparse(substitute(y)), deparse(substitute(name)))
}

#' @rdname append
#' @export
e_append1_p_ <- function(proxy, series_index = NULL, data, x, y, name = NULL) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  dlist <- data |>
    dplyr::select(dplyr::all_of(c(x, y, name))) |>
    unname() |>
    apply(1, function(row){
      if(!is.null(name)){
        list(value=as.numeric(row[1:2]),name=row[3])
      } else {
        list(value=as.numeric(row[1:2]))
      }
    })

  opts <- list(id = proxy$id, seriesIndex = series_index, data = dlist)

  proxy$session$sendCustomMessage("e_append_p", opts)

  return(proxy)
}

#' @rdname append
#' @export
e_append2_p <- function(proxy, series_index = NULL, data, x, y, z, scale = NULL, symbol_size = 1) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  e_append2_p_(
    proxy = proxy,
    series_index = series_index,
    data = data,
    x = deparse(substitute(x)),
    y = deparse(substitute(y)),
    z = deparse(substitute(z)),
    scale = scale,
    symbol_size = symbol_size
  )
}

#' @rdname append
#' @export
e_append2_p_ <- function(proxy, series_index = NULL, data, x, y, z, scale = NULL, symbol_size = 1) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- data |>
    dplyr::select(dplyr::all_of(c(x, y, z)))

  if (!is.null(scale)) {
    data[[4]] <- scale(data[[3]]) * symbol_size
  } else {
    data[[4]] <- data[[3]]
  }

  data <- unname(data)

  dlist <- apply(data, 1, function(x) {
    list(value = unlist(x, use.names = FALSE))
  })

  opts <- list(id = proxy$id, seriesIndex = series_index, data = dlist)

  proxy$session$sendCustomMessage("e_append_p", opts)

  return(proxy)
}

#' Remove Serie
#'
#' Remove a serie by name or precising its index.
#'
#' @inheritParams e_highlight_p
#' @param serie_index Index of serie to append to (starts from 0).
#' @param serie_name Name of serie to remove.
#'
#' @examples
#' library(shiny)
#'
#' ui <- fluidPage(
#'   actionButton("rm", "Remove z serie"),
#'   echarts4rOutput("plot")
#' )
#'
#' server <- function(input, output, session) {
#'   data <- data.frame(
#'     x = rnorm(10, 5, 3),
#'     y = rnorm(10, 50, 12),
#'     z = rnorm(10, 50, 5)
#'   )
#'
#'   output$plot <- renderEcharts4r({
#'     data |>
#'       e_charts(x) |>
#'       e_scatter(y) |>
#'       e_scatter(z)
#'   })
#'
#'   observeEvent(input$rm, {
#'     echarts4rProxy("plot") |>
#'       e_remove_serie_p(serie_name = "z")
#'   })
#' }
#' \dontrun{
#' shinyApp(ui, server)
#' }
#'
#' @name e_remove
#' @export
e_remove_serie_p <- function(proxy, serie_name = NULL, serie_index = NULL) {
  if (is.null(serie_index) && is.null(serie_name)) {
    stop("Must define `serie_index` or `serie_name`")
  }

  opts <- list(id = proxy$id, serie_index = serie_index, serie_name = serie_name)

  proxy$session$sendCustomMessage("e_remove_serie_p", opts)

  return(proxy)
}

#' @rdname e_remove
#' @export
e_remove_serie <- e_remove_serie_p

#' Send
#'
#' Send new series to chart.
#'
#' @inheritParams e_highlight_p
#'
#' @name e_execute
#' @export
e_execute <- function(proxy) {
  if (missing(proxy)) {
    stop("missing proxy", call. = FALSE)
  }

  proxy$session$sendCustomMessage(
    "e_send_p",
    list(id = proxy$id, opts = proxy$chart$x$opts)
  )
  return(proxy)
}

#' @rdname e_execute
#' @export
e_execute_p <- e_execute

#' Merge options in chart, used in e_mark
#'
#' @inheritParams e_highlight_p
#'
#' @name e_merge
#' @export
e_merge <- function(proxy) {
  if (missing(proxy)) stop("missing proxy", call. = FALSE)

  proxy$session$sendCustomMessage(
    "e_merge_p",
    list(id = proxy$id, opts = proxy$chart$x$opts)
  )
  return(proxy)
}

#' Highlight & Downplay
#'
#' Highlight series
#'
#' @inheritParams e_bar
#' @param series_index,series_name Index or name of serie to highlight or
#'   \code{list} or \code{vector} of series.
#' @param btn A \code{\link{e_button}} id.
#'
#' @examples
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length) |>
#'   e_line(Sepal.Width) |>
#'   e_line(Petal.Length) |>
#'   e_highlight(series_name = "setosa") # highlight group
#' @name highlight_action
#' @export
e_highlight <- function(e, series_index = NULL, series_name = NULL, btn = NULL) {
  if (is.null(series_index) && is.null(series_name)) {
    stop("must set index or name", call. = FALSE)
  }

  opts <- list()

  data <- list(type = "highlight")
  if (!is.null(series_index)) data$seriesIndex <- as.list(series_index)
  if (!is.null(series_name)) data$seriesName <- as.list(series_name)
  opts$data <- data

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @name highlight_action
#' @export
e_downplay <- function(e, series_index = NULL, series_name = NULL, btn = NULL) {
  if (is.null(series_index) && is.null(series_name)) {
    stop("must set index or name", call. = FALSE)
  }

  opts <- list()

  data <- list(type = "downplay")
  if (!is.null(series_index)) data$seriesIndex <- as.list(series_index)
  if (!is.null(series_name)) data$seriesName <- as.list(series_name)
  opts$data <- data

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Show & Hide Tooltip
#'
#' Show or hide tooltip.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param ... Any options, see
#'   \href{https://echarts.apache.org/en/api.html#action.tooltip}{official
#'   documentation}
#'
#' @note The tooltip must be initialised with \code{\link{e_tooltip}} for this
#'   to work.
#'
#' @examples
#' cars |>
#'   e_charts(dist) |>
#'   e_scatter(speed) |>
#'   e_tooltip() |>
#'   e_hidetip(btn = "btn") |>
#'   e_button("btn", "Hide tooltip")
#' @name tooltip_action
#' @export
e_showtip <- function(e, ..., btn = NULL) {
  opts <- list()
  data <- list(type = "showTip", ...)
  opts$data <- data

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @name tooltip_action
#' @export
e_hidetip <- function(e, ..., btn = NULL) {
  opts <- list()
  data <- list(type = "hideTip", ...)
  opts$data <- data

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Zoom
#'
#' Zoom on a region.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param ... Any options, see
#'   \href{https://echarts.apache.org/en/api.html#action.dataZoom.dataZoom}{official
#'   documentation}
#'
#' @examples
#' cars |>
#'   e_charts(dist) |>
#'   e_scatter(speed) |>
#'   e_datazoom() |>
#'   e_zoom(
#'     dataZoomIndex = 0,
#'     start = 20,
#'     end = 40,
#'     btn = "BUTTON"
#'   ) |>
#'   e_button("BUTTON", "Zoom in")
#' @export
e_zoom <- function(e, ..., btn = NULL) {
  opts <- list()
  opts$data <- list(type = "dataZoom", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Select Visual Map
#'
#' Selects data range of visual mapping.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param ... Any options, see
#'   \href{https://echarts.apache.org/en/api.html#action.visualMap}{official
#'   documentation}
#'
#' @examples
#' data("state")
#'
#' as.data.frame(state.x77) |>
#'   e_charts(Population) |>
#'   e_scatter(Income, Frost) |>
#'   e_visual_map(Frost, scale = e_scale) |>
#'   e_legend(FALSE) |>
#'   e_visual_map_range(
#'     selected = list(60, 120)
#'   )
#' @export
e_visual_map_range <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "selectDataRange", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

# TODO this works but I see nothing changing in the examples.
# There's also pieToggleSelect

#' Select & Unselect Pie
#'
#' Actions related to \code{\link{e_pie}}.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param ... Any options, see
#'   \href{https://echarts.apache.org/en/api.html#action.pie}{official
#'   documentation}
#'
#' @examples
#' mtcars |>
#'   head() |>
#'   tibble::rownames_to_column("model") |>
#'   e_charts(model) |>
#'   e_pie(carb) |>
#'   e_pie_select(dataIndex = 0)
#' @name pie_action
#' @export
e_pie_select <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "pieSelect", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname pie_action
#' @export
e_pie_unselect <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "pieUnSelect", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Nodes Adjacency
#'
#' Actions related to \code{\link{e_graph}}.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param ... Any options, see
#'   \href{https://echarts.apache.org/en/api.html#action.graph}{official
#'   documentation}
#'
#' @examples
#' value <- rnorm(10, 10, 2)
#'
#' nodes <- data.frame(
#'   name = sample(LETTERS, 10),
#'   value = value,
#'   size = value,
#'   grp = rep(c("grp1", "grp2"), 5),
#'   stringsAsFactors = FALSE
#' )
#'
#' edges <- data.frame(
#'   source = sample(nodes$name, 20, replace = TRUE),
#'   target = sample(nodes$name, 20, replace = TRUE),
#'   stringsAsFactors = FALSE
#' )
#'
#' e_charts() |>
#'   e_graph() |>
#'   e_graph_nodes(nodes, name, value, size, grp) |>
#'   e_graph_edges(edges, source, target) |>
#'   e_focus_adjacency(
#'     seriesIndex = 0,
#'     dataIndex = 4
#'   )
#' @name graph_action
#' @export
e_focus_adjacency <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "focusNodeAdjacency", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname graph_action
#' @export
e_unfocus_adjacency <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "unfocusNodeAdjacency", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Legend
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param name Legend name.
#' @param scroll_index Controle the scrolling of legend when \code{type =
#'   "scroll"} in \code{e_legend}.
#' @param legend_id Id of legend.
#'
#' @examples
#' e <- CO2 |>
#'   group_by(Type) |>
#'   e_charts(conc) |>
#'   e_scatter(uptake)
#'
#' e |>
#'   e_legend_unselect("Quebec")
#'
#' e |>
#'   e_legend_unselect("Quebec", btn = "btn") |>
#'   e_button("btn", "Quebec")
#' @name legend_action
#' @export
e_legend_select <- function(e, name, btn = NULL) {
  if (missing(name)) {
    stop("missing name", call. = FALSE)
  }

  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "legendSelect")

  if (!is.null(name)) {
    opts$data$name <- name
  }

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname legend_action
#' @export
e_legend_unselect <- function(e, name, btn = NULL) {
  if (missing(name)) {
    stop("missing name", call. = FALSE)
  }

  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "legendUnSelect")

  if (!is.null(name)) {
    opts$data$name <- name
  }

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname legend_action
#' @export
e_legend_toggle_select <- function(e, name, btn = NULL) {
  if (missing(name)) {
    stop("missing name", call. = FALSE)
  }

  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "legendToggleSelect")

  if (!is.null(name)) {
    opts$data$name <- name
  }

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname legend_action
#' @export
e_legend_scroll <- function(e,
                            scroll_index = NULL,
                            legend_id = NULL,
                            btn = NULL
                            ) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "legendScroll")

  if (!is.null(scroll_index)) {
    opts$data$scrollDataIndex <- scroll_index
  }

  if (!is.null(legend_id)) {
    opts$data$legendId <- legend_id
  }

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Restore Toolbox
#'
#' Restore Toolbox.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#'
#' @examples
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_datazoom() |>
#'   e_restore("btn") |>
#'   e_button("btn", "Reset")
#' @export
e_restore <- function(e, btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "restore")

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' Map Actions
#'
#' Map-related actions.
#'
#' @inheritParams e_bar
#' @param btn A \code{\link{e_button}} id.
#' @param ... Any options, see
#'   \href{https://echarts.apache.org/en/api.html#action.map}{official
#'   documentation}
#'
#' @examples
#' choropleth <- data.frame(
#'   countries = c(
#'     "France",
#'     "Brazil",
#'     "China",
#'     "Russia",
#'     "Canada",
#'     "India",
#'     "United States",
#'     "Argentina",
#'     "Australia"
#'   ),
#'   values = round(runif(9, 10, 25))
#' )
#'
#' choropleth |>
#'   e_charts(countries) |>
#'   e_map(values) |>
#'   e_visual_map(min = 10, max = 25) |>
#'   e_map_toggle_select(name = "China", btn = "btn") |>
#'   e_button("btn", "Select China")
#' @seealso \code{\link{e_map_register}}
#'
#' @name map_actions
#' @export
e_map_select <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "mapSelect", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname map_actions
#' @export
e_map_unselect <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "mapUnSelect", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

#' @rdname map_actions
#' @export
e_map_toggle_select <- function(e, ..., btn = NULL) {
  opts <- list()
  if (!is.null(btn)) opts$id <- btn
  opts$data <- list(type = "mapToggleSelect", ...)

  e <- .actions_btn(e = e, opts = opts, btn = btn)

  return(e)
}

`%||%` <- function(a, b) if (is.null(a)) b else a

#' Add annotations to a chart
#'
#' @description
#'
#' Apache ECharts does not include a native annotation system. This is a custom
#' function that creates annotations using SVG. This currently only works in a
#' 'cartesian2d' coordinate system.
#'
#' Each annotation must be in a list with an x, y, and text. Styling can be
#' added - see @details. Because they are SVG, it takes SVG arguments, not
#' ECharts arguments for styling.
#'
#' In Shiny, to output an annotation position after dragging the box, use
#' \code{input$id_dragged_annotation} or see \link{echarts4r-shiny}. This
#' captures the annotation parameters - not any of the styles.
#'
#' @details annotations can take the following styles to change the defaults. To
#'   remove any element use "none".
#'
#' - \strong{rectStyle} Styles the annotation box. It also takes \strong{shape} that uses \href{https://echarts.apache.org/en/option.html#graphic.elements-rect.shape}{echarts graphic.elements-rect.shape attributes} that controls rectangle width,  height and corner radius.
#'
#' - \strong{textStyle}, Styles the annotation text. This supports limited HTML tags using tspan. Supported tags are: \code{b, strong, i, em, u, br, span}. Styling inside \code{span} can use \code{color, fontSize, fontWeight, fontStyle}. \code{x} and \code{y} attributes are automatically determined based on box size, unless specified. \code{padding_trbl} was also added to add padding - this must be a list of exactly 4 integers - in the order of top, right, bottom, and left padding. This padding just pushes the text in that direction.
#'
#' - \strong{lineStyle} Styles the line that connects the annotation box to the arrow using \href{https://www.w3schools.com/graphics/svg_stroking.asp}{SVG stroke attributes}
#'
#' - \strong{arrowStyle}: Styles the arrow. size was added that automatically adjusts the vertices of the triangle.
#'
#' @param e An echarts4r object
#' @param annotations list of annotations to plot
#' @param .facet integer; facet's index. Only needed for faceted plots. Defaults to first plot.
#'   panel.
#' @param legend Whether to add annotations to legend.
#' @param name name of the legend
#' @param legend_color color of the legend box
#' @param default_color color of all SVG elements, unless specified in each
#'   style. It colors text, line, arrow, and rectable outline.
#' @param draggable booleon; if TRUE, annotations can be dragged by the user
#' @note HTML tags may not apply in RStudio viewer, open in browser.
#'
#' @examples
#' # May not work render HTML correctly in RStudio viewer
#' # Open in browser
#' mtcars |>
#'   e_charts(mpg) |>
#'   e_scatter(wt) |>
#'   e_annotations(
#'     annotations = list(
#'       list(
#'         id = 0,
#'         x = 15,
#'         y = 3,
#'         text = 'An annotation<br>with <i>style</i>',
#'         offsetX = 0,
#'         offsetY = -50,
#'         textStyle = list(
#'           "font-size" = 14,
#'           "font-weight" = 'bold',
#'           color = "#394",
#'           padding_trbl = list(0, 0, 5, 0)
#'         ),
#'         rectStyle = list(
#'           `stroke-dasharray` = c(35, 10),
#'           `stroke-width` = 2,
#'               # Shadow can be added!
#'                shadow = list(
#'                  dx= 0,
#'                  dy= 2,
#'                  blur= 4,
#'                  color= '#000',
#'                  opacity= 0.3
#'                ),
#'           shape = list(width = 105, height = 50, r = 0)
#'         ),
#'         lineStyle = list(`stroke-width` = 2),
#'         arrowStyle = list(size = 8)
#'       ),
#'       # No styles, will just show text
#'       list(
#'         id = 0,
#'         x = 25,
#'         y = 1,
#'         text = 'No styles',
#'         lineStyle = "none",
#'         rectStyle = "none",
#'         arrowStyle = "none"
#'       ),
#'       # Default style
#'       list(
#'         id = 2,
#'         x = 25,
#'         y = 4.5,
#'         text = "Default style",
#'         offsetX = 0,
#'         offsetY = -40
#'       ),
#'       # left-aligned annotation
#'       list(
#'         id = 2,
#'         x = 0,
#'         y = 0.5,
#'         text = "I'm left<br>aligned!",
#'         offsetX = 60,
#'         offsetY = -40,
#'         textStyle = list(
#'           "text-anchor" = "start",
#'           padding_trbl = list(0, 0, 6, 10)
#'         )
#'       )
#'     ))
#' @seealso
#'
#' - \href{https://www.w3schools.com/graphics/svg_text.asp}{Additional arguments for textStyle}
#'
#' - \href{https://www.w3schools.com/graphics/svg_stroking.asp}{Additional arguments for rectStyle}
#'
#' - \href{https://www.w3schools.com/graphics/svg_stroking.asp}{Additional
#' arguments for lineStyle}
#'
#' - \href{https://www.w3schools.com/graphics/svg_fill.asp}{Additional
#' arguments for arrowStyle}
#'
#' - \href{https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute}{Even more arguments for SVG attributes}
#'
#' @rdname e_annotations
#' @export
e_annotations <- function(
  e,
  annotations,
  .facet = NULL,
  legend = TRUE,
  name = "Annotations",
  legend_color = '#738DE4',
  default_color = '#738DE4',
  draggable = TRUE
) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(annotations)) {
    stop("must provide list of annotations")
  }

  if (!is.list(annotations) || !is.list(annotations[[1]])) {
    stop("annotations must be a list")
  }

  if(!is.null(.facet) && !is.numeric(.facet)){
    stop(".facet must be an integer, The first facet (.facet = 1) is the default when facet is NULL.")
  }


  if (!is.null(.facet)) {
    # facet number (1-based R indexing)
    grid_idx <- .facet - 1
  } else {
    grid_idx <- 0
  }



  new_annos <- lapply(annotations, function(ann) {
    processed <- process_single_annotation(ann, default_color, draggable)
    processed$gridIndex <- ann$gridIndex %||% grid_idx
    processed$legend_name <- ann$legend_name %||% name
    processed
  })

  # Get existing annotations from chart object
  existing_annos <- e$x$annotations %||% list()

  # Add new annotation to list
  if (is.null(existing_annos) || length(existing_annos) == 0) {
    all_annos <- new_annos
  } else {
    all_annos <- existing_annos
    for (new_anno in new_annos) {
      all_annos[[length(all_annos) + 1]] <- new_anno
    }
  }

  # Store back in chart object
  e$x$annotations <- all_annos

  # ADD DUMMY SERIES FOR LEGEND
  if (legend) {
    # Extract unique legend groups
    legend_info <- list()

    for (i in seq_along(all_annos)) {
      ann <- all_annos[[i]]

      # Get color
      color <- legend_color

      # Get grid
      grid_idx <- if (!is.null(ann$gridIndex)) {
        ann$gridIndex
      } else {
        0
      }
      # Store first occurrence
      if (is.null(legend_info[[name]])) {
        legend_info[[name]] <- list(
          color = color,
          gridIndex = grid_idx
        )
      }
    }

    # Add a dummy series for each unique legend group
    if (is.null(e$x$opts$series)) {
      e$x$opts$series <- list()
    }

    for (group_name in names(legend_info)) {
      info <- legend_info[[group_name]]

      dummy_series <- list(
        type = "scatter",
        name = group_name,
        data = list(), # Empty data
        symbol = "rect",
        symbolSize = 8,
        itemStyle = list(
          color = info$color
        ),
        gridIndex = info$gridIndex,
        xAxisIndex = info$gridIndex,
        yAxisIndex = info$gridIndex,
        tooltip = list(show = FALSE),
        silent = TRUE,
        animation = FALSE,
        isAnnotationLegend = TRUE
      )

      if (isTRUE(e$x$tl)) {
        e$x$opts$baseOption$series[[
          length(e$x$opts$baseOption$series) + 1
        ]] <- dummy_series
      } else {
        # Append to series
        e$x$opts$series[[length(e$x$opts$series) + 1]] <- dummy_series
      }
    }
  }

  # Adding this solves the issue for the SVG line to get messed up when
  # `shiny::fluidRow(echarts4r::echarts4rOutput("chart"))` with no e_tooltip().
  # I don't understand why this fixes it.
  if (!e$x$tl & is.null(e$x$opts$tooltip)) {
    e$x$opts$tooltip <- list(trigger = 'fake')
  } else if ((e$x$tl & is.null(e$x$opts$tooltip))) {
    e$x$opts$baseOption$tooltip <- list(trigger = 'fake')
  }

  dep <-
    htmltools::htmlDependency(
      name = "echarts-annotations",
      version = "1.0.0",
      src = system.file("htmlwidgets/lib/echarts-6.1.0/plugins/", package = "echarts4r"),
      script = "echarts-annotations.js"
      )

  e$dependencies <- append(e$dependencies, list(dep))

  e |>
    htmlwidgets::onRender(
      "function(el, x, data) {
      function initWhenReady() {
        if (typeof EChartsAnnotations === 'undefined') {
          setTimeout(initWhenReady, 50);
          return;
        }

        EChartsAnnotations.initialize(el, x, data);
      }

      initWhenReady();
    }"
    )

}
# R function with multiple positioning options
#' @keywords internal
find_text_position <- function(
  box_shape,
  position = "middle"
) {

  # Calculate base positions
  x_left <- box_shape$x
  x_middle <- box_shape$x + (box_shape$width / 2)
  x_right <- box_shape$x + box_shape$width

  y_top <- box_shape$y
  y_middle <- box_shape$y + (box_shape$height / 2)
  y_bottom <- box_shape$y + box_shape$height

  # Choose position
  pos <- switch(
    position,
    "middle" = list(
      x = x_middle,
      y = y_middle
    ),
    "start" = list(x = x_left,
                   y = y_middle),
    "end" = list(
      x = x_right,
      y = y_middle
    ),
    # default to middle
    list(x = x_middle, y = y_middle)
  )
  pos
}

# Process a single annotation with all styles so js can read it.
#' @keywords internal
process_single_annotation <- function(
  ann,
  default_color = "#738DE4",
  draggable = TRUE
) {
  # Required fields
  if (is.null(ann$x) || is.null(ann$y) || is.null(ann$text)) {
    stop("Annotation must have x, y, and text fields")
  }

  # Default Properties --
  # For these, better to use ann$arrowStyle[["fill"]] evaluation as opposed to ann$arrowStyle$fill so it does do a partial match.

  default_text_style <- list(
    "font-size" = 11,
    "font-weight" = 'bold',
    "text-anchor" = ann$textStyle[["text-anchor"]] %||% "middle",
    "dominant-baseline" = ann$textStyle[["dominant-baseline"]] %||% "central"
  )

  if (if_style_is_not_none(ann$lineStyle)) {
    default_line_style <- list(
      `stroke-width` = 2,
      stroke = ann$lineStyle[["stroke"]] %||% default_color
    )
  } else {
    default_line_style <- list()
    ann$lineStyle <- NULL
  }

  if (if_style_is_not_none(ann$arrowStyle)) {
    default_arrow_style <- list(
      fill = ann$arrowStyle[["fill"]] %||% default_color,
      size = ann$arrowStyle[["size"]] %||% 8
    )
  } else {
    default_arrow_style <- list(size = 0)
    ann$arrowStyle <- NULL
  }

  if (if_style_is_not_none(ann$rectStyle)) {
    default_box_style <- list(
      stroke = ann$rectStyle[["stroke"]] %||% default_color,
      fill = '#ffffff',
      "stroke-width" = 2
    )
  } else {
    # Fully transparent
    default_box_style <- list(fill = "rgba(255, 255, 255, 0)")
    ann$rectStyle <- NULL
  }

  default_box_width <- 80
  default_box_height <- 40
  default_box_radius <- 3

  padding <- ann$textStyle$padding_trbl

  if(!is.null(padding) && length(padding) > 0){
    isPadNumber <- is.numeric(unlist(padding))

    if(length(padding) != 4 || isPadNumber == FALSE){
      stop("padding_trbl must be a list with 4 numbers")
    }
  }

  pad_top <- padding[[1]] %||% 0
  pad_right <- padding[[2]] %||% 0
  pad_bot <- padding[[3]] %||% 0
  pad_left <- padding[[4]] %||% 0

  # Find box position --

  # None of these should ever be NA
  box_width <- ann$rectStyle$shape[["width"]] %||% default_box_width
  box_height <- ann$rectStyle$shape[["height"]] %||% default_box_height
  box_radius <- ann$rectStyle$shape[["r"]] %||% default_box_radius
  box_x <- ann$rectStyle$shape[["x"]] %||% -box_width / 2
  box_y <- ann$rectStyle$shape[["y"]] %||% -box_height / 2

  # Box shape.
  # x and y make the line connect in the middle.
  box_shape <- list(
    x = box_x,
    y = box_y,
    width = box_width,
    height = box_height,
    r = box_radius
  )

  # Calculate text position (start, end, middle)
  text_pos <- find_text_position(
    box_shape,
    position = default_text_style[["text-anchor"]]
  )

  final_text_style <- utils::modifyList(
    default_text_style,
    c(
      ann$textStyle %||% list(),
      list(
        x = (ann$textStyle$x %||% text_pos$x) + pad_left - pad_right,
        y = (ann$textStyle$y %||% text_pos$y) + pad_top - pad_bot,
        text = as.character(ann$text),
        fill = ann$textStyle[["color"]] %||% default_color
      )
    )
  )

  final_box_style <- utils::modifyList(
    default_box_style,
    c(
      ann$rectStyle %||% list()
    )
  )

  final_line_style <- utils::modifyList(
    default_line_style,
    c(
      ann$lineStyle %||% list()
    )
  )

  final_arrow_style <- utils::modifyList(
    default_arrow_style,
    c(
      ann$arrowStyle %||% list()
    )
  )

  arrow_size <- final_arrow_style$size

  arrow_vertices <- list(
    c(-arrow_size / 2, -arrow_size),
    c(arrow_size / 2, -arrow_size),
    c(0, 0)
  )

  list(
    id = ann$id %||% 0,
    x = ann$x,
    y = ann$y,
    text = ann$text,
    offsetX = ann$offsetX %||% 0,
    offsetY = ann$offsetY %||% 0,
    rectShape = box_shape,
    rectStyle = final_box_style,
    textStyle = final_text_style,
    lineStyle = final_line_style,
    arrowStyle = final_arrow_style,
    arrowVertices = arrow_vertices,
    arrowTip = -arrow_size,
    draggable = draggable
  )
}

#' Determine if first element is none, then no style
#'The first element could be NULL, a style, or a vector so we must account for all these.
#' style = NULL
#' style = list(lineWidth = 5)
#' style = list(shape = list(width = 100))
#' @keywords internal
if_style_is_not_none <- function(style) {
  is.null(style) ||
    !(is.character(style[[1]]) && style[[1]] == "none")
}

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} or a crosstalk  \code{SharedData} object
#' @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}}}
#' }
#' @section Crosstalk: TO use crosstalk, pass \code{selectedMode = TRUE}) into
#'   the chart type argument. crosstalk functionality currently supports the
#'   following chart types (but only cartesion2d):
#' \itemize{
#'   \item{\code{\link{e_area}}}
#'   \item{\code{\link{e_bar}}}
#'   \item{\code{\link{e_candle}}}
#'   \item{\code{\link{e_density}}}
#'   \item{\code{\link{e_effect_scatter}}}
#'   \item{\code{\link{e_funnel}}}
#'   \item{\code{\link{e_heatmap}}}
#'   \item{\code{\link{e_histogram}}}
#'   \item{\code{\link{e_line}}}
#'   \item{\code{\link{e_pictorial}}}
#'   \item{\code{\link{e_pie}}}
#'   \item{\code{\link{e_scatter}}}
#'   \item{\code{\link{e_step}}}
#' }
#'
#' @examples
#' mtcars |>
#'   e_charts(qsec) |>
#'   e_line(mpg)
#'
#' sd <- crosstalk::SharedData$new(mtcars)
#' mtcars |>
#'   e_charts(qsec) |>
#'   e_line(mpg, selectedMode = TRUE)
#'
#' @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))
  }

  # Crosstalk
  ct_key   <- NULL
  ct_group <- NULL
  isGroupedData <- NULL
  isCrosstalk <- FALSE
  if (!missing(data) && crosstalk::is.SharedData(data)) {
    ct_key   <- data$key() |> as.character()
    ct_group <- data$groupName()

    isCrosstalk = TRUE

    # origData() returns wrong thing on grouped SharedData
    data <- (data$origData())
    data$XkeyX <- ct_key  # add key column
    isGroupedData <- dplyr::is.grouped_df(data)
  }

  # forward options using x
  x <- list(
    theme = "",
    tl = timeline,
    draw = draw,
    renderer = tolower(renderer),
    mapping = list(),
    events = list(),
    buttons = list(),
    # ── 2. Store crosstalk metadata on x so JS + serie functions can read it ─
    settings = list(
      crosstalk_key   = ct_key,
      crosstalk_group = ct_group
    ),
    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)
  }

  # Start crosstalk -------------------------------------------------------
  # First, I'll acknowledge {echarty} for guidance on how to implement
  # this. https://github.com/helgasoft/echarty/

  # Crosstalk works by adding a column called 'XkeyX' so each row (i.e. data
  # point) will have a unique key. e$x$settings contains crosstalk_key and
  # crosstalk_group - assigned by crosstalk, unless specified.
  # e$x$crosstalk_grpvar contains name of group (if any)

  # When data is constructed (i.e. in e_line()), each data point will have an
  # 'XkeyX'. This key is used to identify which data was selected. This gets
  # matched using this id and datasetId. These values are found:

  # e$x$opts$dataset[[1]]$source[[1]]$XkeyX
  # e$x$opts$series[[1]]$datasetId

  # This will attach dimensions (i.e. colnames) and e$opts$dataset (i.e.)
  # js / crosstalk and the js looks for this column to grab
  if (!is.null(ct_group) & isTRUE(isGroupedData)) {

    flat_data <- dplyr::ungroup(data)

    # Just the name of the group_by variable
    grp_var   <- if (dplyr::is_grouped_df(data)) dplyr::group_vars(data)[1] else NULL

    source_data <- lapply(seq_len(nrow(flat_data)), function(i) {
      as.list(flat_data[i, , drop = FALSE])
    })
    x$crosstalk_grpvar <- grp_var
    grp_vals <- as.character(unique(flat_data[[grp_var]]))

    grp_transforms <- lapply(grp_vals, function(g) {
      list(
        id = paste0("Xtalk_", g),
        fromDatasetIndex = 0,
        transform = list(
          # filter by group first, then by crosstalk key
          list(type = "filter", config = list(dimension = grp_var, `=` = g)),
          list(type = "filter", config = list(dimension = "XkeyX", reg = "^"))
        )
      )
    })

    x$opts$dataset <- c(
      list(list(id = "source", dimensions = colnames(flat_data), source = source_data)),
      grp_transforms
    )
  }

  # after building x$opts, add the dataset + Xtalk transform
  if (!is.null(ct_group) & isFALSE(isGroupedData)) {
    # convert data frame to list of rows
    source_data <- lapply(seq_len(nrow(data)), function(i) {
      as.list(data[i, , drop = FALSE])
    })

    x$opts$dataset <- list(
      list(
        id = "source",
        dimensions = colnames(data),
        source = source_data
      ),
      list(
        id = "Xtalk",
        fromDatasetId = "source",
        transform = list(
          type = "filter",
          config = list(dimension = "XkeyX", reg = "^")
        )
      )
    )
  }

# End crosstalk -----------------------------------------------------------

  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,
    dependencies = if (!is.null(ct_group)) crosstalk::crosstalkLibs() else NULL,
    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)
}

# TODO is this being used? Remove it?
#' @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)
      )
    )
  )

  # Crosstalk
  ct_key   <- NULL
  ct_group <- NULL
  isGroupedData <- NULL
  isCrosstalk <- FALSE
  if (!missing(data) && crosstalk::is.SharedData(data)) {
    ct_key   <- data$key() |> as.character()
    ct_group <- data$groupName()

    isCrosstalk = TRUE

    # origData() returns wrong thing on grouped SharedData
    data <- (data$origData())
    data$XkeyX <- ct_key  # add key column
    isGroupedData <- dplyr::is.grouped_df(data)
  }

  # forward options using x
  x <- list(
    theme = "",
    tl = timeline,
    draw = draw,
    renderer = tolower(renderer),
    mapping = list(),
    events = list(),
    buttons = list(),
    # ── 2. Store crosstalk metadata on x so JS + serie functions can read it ─
    settings = list(
      crosstalk_key   = ct_key,
      crosstalk_group = ct_group
    ),
    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)
  }


  # Start crosstalk -------------------------------------------------------
  # First, I'll acknowledge {echarty} for guidance on how to implement
  # this. https://github.com/helgasoft/echarty/

  # Crosstalk works by adding a column called 'XkeyX' so each row (i.e. data
  # point) will have a unique key. e$x$settings contains crosstalk_key and
  # crosstalk_group - assigned by crosstalk, unless specified.
  # e$x$crosstalk_grpvar contains name of group (if any)

  # When data is constructed (i.e. in e_line()), each data point will have an
  # 'XkeyX'. This key is used to identify which data was selected. This gets
  # matched using this id and datasetId. These values are found:

  # e$x$opts$dataset[[1]]$source[[1]]$XkeyX
  # e$x$opts$series[[1]]$datasetId

  # This will attach dimensions (i.e. colnames) and e$opts$dataset (i.e.)
  # js / crosstalk and the js looks for this column to grab
  if (!is.null(ct_group) & isTRUE(isGroupedData)) {

    flat_data <- dplyr::ungroup(data)

    # Just the name of the group_by variable
    grp_var   <- if (dplyr::is_grouped_df(data)) dplyr::group_vars(data)[1] else NULL

    source_data <- lapply(seq_len(nrow(flat_data)), function(i) {
      as.list(flat_data[i, , drop = FALSE])
    })
    x$crosstalk_grpvar <- grp_var
    grp_vals <- as.character(unique(flat_data[[grp_var]]))

    grp_transforms <- lapply(grp_vals, function(g) {
      list(
        id = paste0("Xtalk_", g),
        fromDatasetIndex = 0,
        transform = list(
          # filter by group first, then by crosstalk key
          list(type = "filter", config = list(dimension = grp_var, `=` = g)),
          list(type = "filter", config = list(dimension = "XkeyX", reg = "^"))
        )
      )
    })

    x$opts$dataset <- c(
      list(list(id = "source", dimensions = colnames(flat_data), source = source_data)),
      grp_transforms
    )
  }

  # after building x$opts, add the dataset + Xtalk transform
  if (!is.null(ct_group) & isFALSE(isGroupedData)) {
    # convert data frame to list of rows
    source_data <- lapply(seq_len(nrow(data)), function(i) {
      as.list(data[i, , drop = FALSE])
    })

    x$opts$dataset <- list(
      list(
        id = "source",
        dimensions = colnames(data),
        source = source_data
      ),
      list(
        id = "Xtalk",
        fromDatasetId = "source",
        transform = list(
          type = "filter",
          config = list(dimension = "XkeyX", reg = "^")
        )
      )
    )
  }

  # End crosstalk -----------------------------------------------------------

  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(cl %in% c("character", "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 (any(cl %in% c("POSIXct", "POSIXlt", "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.}
#'   \item{\code{id_dragged_annotation}: returns data on dragged annotation.}
#' }
#'
#' @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) & timeline) {
    stop("timeline expects data", call. = FALSE)
  }

  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 (!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(cl %in% c("character", "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 (any(cl %in% c("POSIXct", "POSIXlt", "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

.onAttach <- function(libname, pkgname) {
  shiny::registerInputHandler("echarts4rParse", function(data, ...) {
    jsonlite::fromJSON(jsonlite::toJSON(data, auto_unbox = TRUE))
  }, force = TRUE)

  options(
    "ECHARTS4R_THEME" = NULL,
    "ECHARTS4R_FONT_FAMILY" = NULL
  )
}

.onLoad <- function(libname, pkgname) {
  shiny::registerInputHandler("echarts4rParse", function(data, ...) {
    jsonlite::fromJSON(jsonlite::toJSON(data, auto_unbox = TRUE))
  }, force = TRUE)

  options(
    "ECHARTS4R_THEME" = NULL,
    "ECHARTS4R_FONT_FAMILY" = NULL
  )
}

#' Highlight & Downplay Proxy
#'
#' Proxies to highlight and downplay series.
#'
#' @param proxy An echarts4r proxy as returned by \code{\link{echarts4rProxy}}.
#' @param series_index Series index, can be a vector.
#' @param series_name Series Name, can be vector.
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' ui <- fluidPage(
#'   fluidRow(
#'     column(
#'       3,
#'       actionButton("highlightmpg", "Highlight MPG")
#'     ),
#'     column(
#'       3,
#'       actionButton("highlighthp", "Highlight HP")
#'     ),
#'     column(
#'       3,
#'       actionButton("downplaympg", "Downplay MPG")
#'     ),
#'     column(
#'       3,
#'       actionButton("downplayhp", "Downplay HP")
#'     )
#'   ),
#'   echarts4rOutput("plot")
#' )
#'
#' server <- function(input, output, session) {
#'   output$plot <- renderEcharts4r({
#'     mtcars |>
#'       e_charts(mpg) |>
#'       e_line(disp) |>
#'       e_line(hp, name = "HP") # explicitly pass name
#'   })
#'
#'   # highlight
#'
#'   observeEvent(input$highlightmpg, {
#'     echarts4rProxy("plot") |>
#'       e_highlight_p(series_index = 0) # using index
#'   })
#'
#'   observeEvent(input$highlighthp, {
#'     echarts4rProxy("plot") |>
#'       e_highlight_p(series_name = "HP") # using name
#'   })
#'
#'   # downplay
#'
#'   observeEvent(input$downplaympg, {
#'     echarts4rProxy("plot") |>
#'       e_downplay_p(series_name = "disp")
#'   })
#'
#'   observeEvent(input$downplayhp, {
#'     echarts4rProxy("plot") |>
#'       e_downplay_p(series_index = 1)
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @rdname highlight_proxy
#' @export
e_highlight_p <- function(proxy, series_index = NULL, series_name = NULL) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- list(id = proxy$id)
  if (!is.null(series_index)) data$seriesIndex <- series_index
  if (!is.null(series_name)) data$seriesName <- series_name

  proxy$session$sendCustomMessage("e_highlight_p", data)

  return(proxy)
}

#' @rdname highlight_proxy
#' @export
e_downplay_p <- function(proxy, series_index = NULL, series_name = NULL) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- list(id = proxy$id)
  if (!is.null(series_index)) data$seriesIndex <- series_index
  if (!is.null(series_name)) data$seriesName <- series_name

  proxy$session$sendCustomMessage("e_downplay_p", data)

  return(proxy)
}

#' Tooltip Proxy
#'
#' Proxies to show or hide tooltip.
#'
#' @inheritParams e_highlight_p
#' @param ... Any other option, see \href{https://echarts.apache.org/en/api.html#action.tooltip}{showTip}.
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' ui <- fluidPage(
#'   fluidRow(
#'     actionButton("show", "Show tooltip"),
#'     actionButton("hide", "Hide tooltip")
#'   ),
#'   fluidRow(
#'     echarts4rOutput("plot"),
#'     h3("clicked Data"),
#'     verbatimTextOutput("clickedData"),
#'     h3("clicked Serie"),
#'     verbatimTextOutput("clickedSerie"),
#'     h3("clicked Row"),
#'     verbatimTextOutput("clickedRow")
#'   )
#' )
#'
#' server <- function(input, output, session) {
#'   output$plot <- renderEcharts4r({
#'     mtcars |>
#'       e_charts(mpg) |>
#'       e_line(disp, bind = carb, name = "displacement") |>
#'       e_line(hp) |>
#'       e_x_axis(min = 10) |>
#'       e_tooltip(show = FALSE) |>
#'       e_theme("westeros")
#'   })
#'
#'   observeEvent(input$show, {
#'     echarts4rProxy("plot") |>
#'       e_showtip_p(
#'         name = "displacement",
#'         position = list(5, 5)
#'       )
#'   })
#'
#'   observeEvent(input$hide, {
#'     echarts4rProxy("plot") |>
#'       e_hidetip_p()
#'   })
#'
#'   output$clickedData <- renderPrint({
#'     input$plot_clicked_data
#'   })
#'
#'   output$clickedSerie <- renderPrint({
#'     input$plot_clicked_serie
#'   })
#'
#'   output$clickedRow <- renderPrint({
#'     input$plot_clicked_row
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @rdname tooltip_proxy
#' @export
e_showtip_p <- function(proxy, ...) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- list(
    id = proxy$id,
    opts = list(
      type = "showTip",
      ...
    )
  )

  proxy$session$sendCustomMessage("e_showtip_p", data)

  return(proxy)
}

#' @rdname tooltip_proxy
#' @export
e_hidetip_p <- function(proxy) {
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- list(id = proxy$id)

  proxy$session$sendCustomMessage("e_hidetip_p", data)

  return(proxy)
}

#' Node Adjacency
#'
#' Focus or unfocus on node adjacency.
#'
#' @inheritParams e_highlight_p
#' @param index One or more node index to focus on.
#' @param ... Any other options, see
#' \href{https://echarts.apache.org/en/api.html#action.graph}{official documentation} and details.
#'
#' @details Must pass \code{seriesId}, \code{seriesIndex}, or \code{seriesName}, generally \code{seriesIndex = 0} will work.
#'
#' @examples
#' value <- rnorm(10, 10, 2)
#'
#' nodes <- data.frame(
#'   name = sample(LETTERS, 10),
#'   value = value,
#'   size = value,
#'   grp = rep(c("grp1", "grp2"), 5),
#'   stringsAsFactors = FALSE
#' )
#'
#' edges <- data.frame(
#'   source = sample(nodes$name, 20, replace = TRUE),
#'   target = sample(nodes$name, 20, replace = TRUE),
#'   stringsAsFactors = FALSE
#' )
#' \dontrun{
#'
#' library(shiny)
#'
#' ui <- fluidPage(
#'   fluidRow(
#'     column(
#'       2,
#'       numericInput("index", "Node", value = 3, min = 1, max = 9)
#'     ),
#'     column(
#'       2,
#'       br(),
#'       actionButton("focus", "Focus")
#'     ),
#'     column(
#'       2,
#'       br(),
#'       actionButton("unfocus", "Unfocus")
#'     )
#'   ),
#'   fluidRow(
#'     column(12, echarts4rOutput("graph"))
#'   )
#' )
#'
#' server <- function(input, output, session) {
#'   output$graph <- renderEcharts4r({
#'     e_charts() |>
#'       e_graph() |>
#'       e_graph_nodes(nodes, name, value, size, grp) |>
#'       e_graph_edges(edges, source, target)
#'   })
#'
#'   observeEvent(input$focus, {
#'     echarts4rProxy("graph") |>
#'       e_focus_adjacency_p(
#'         seriesIndex = 0,
#'         index = input$index
#'       )
#'   })
#'
#'   observeEvent(input$unfocus, {
#'     echarts4rProxy("graph") |>
#'       e_unfocus_adjacency_p(seriesIndex = 0)
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @rdname node_adjacency
#' @export
e_focus_adjacency_p <- function(proxy, index, ...) {
  .Deprecated("Dropped in v5 use: emphasis = list(focus = 'adjacency')")
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  args <- list(...)

  hasArgs <- c("seriesId", "seriesIndex", "seriesName") %in% names(args)

  if (sum(hasArgs) != 1) {
    stop("Must pass one of seriesId, seriesIndex, or seriesName", call. = FALSE)
  }

  data <- purrr::map(index, function(i, id) {
    list(
      id = id,
      opts = list(
        type = "focusNodeAdjacency",
        dataIndex = i,
        ...
      )
    )
  }, id = proxy$id)

  proxy$session$sendCustomMessage("e_focus_node_adjacency_p", data)

  return(proxy)
}

#' @rdname node_adjacency
#' @export
e_unfocus_adjacency_p <- function(proxy, ...) {
  .Deprecated("Dropped in v5 use: emphasis = list(focus = 'adjacency')")
  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  args <- list(...)

  hasArgs <- c("seriesId", "seriesIndex", "seriesName") %in% names(args)

  if (sum(hasArgs) != 1) {
    stop("Must pass one of seriesId, seriesIndex, or seriesName", call. = FALSE)
  }

  data <- list(
    id = proxy$id,
    opts = list(
      type = "unfocusNodeAdjacency",
      ...
    )
  )

  proxy$session$sendCustomMessage("e_unfocus_node_adjacency_p", data)

  return(proxy)
}

#' Dispatch Action
#'
#' Create your own proxies, essentially a wrapper around the
#' \href{https://echarts.apache.org/en/api.html#action}{action API}.
#'
#' @inheritParams e_highlight_p
#' @param type Type of action to dispatch, i.e.: \code{highlight}.
#' @param ... Named options.
#'
#' @examples
#' \dontrun{
#'
#' library(shiny)
#'
#' ui <- fluidPage(
#'   fluidRow(
#'     column(8, echarts4rOutput("chart")),
#'     column(4, actionButton("zoom", "Zoom"))
#'   )
#' )
#'
#' server <- function(input, output, session) {
#'   output$chart <- renderEcharts4r({
#'     cars |>
#'       e_charts(speed) |>
#'       e_scatter(dist) |>
#'       e_datazoom()
#'   })
#'
#'   observe({
#'     req(input$zoom)
#'
#'     echarts4rProxy("chart") |>
#'       e_dispatch_action_p("dataZoom", startValue = 1, endValue = 10)
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @export
e_dispatch_action_p <- function(proxy, type, ...) {
  if (missing(proxy) || missing(type)) {
    stop("must pass proxy and type", call. = FALSE)
  }

  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- list(id = proxy$id, opts = list(type = type, ...))

  proxy$session$sendCustomMessage("e_dispatch_action_p", data)
}


#' Capture event
#'
#' Add an event capture.
#'
#' @inheritParams e_bar
#' @param event An event name from the \href{https://echarts.apache.org/en/api.html#events}{event documentation}.
#'
#' @details Many events can be captured, however not all are integrated, you can pass one that is not implemented with this function.
#'
#' @examples
#' \dontrun{
#' # add datazoom
#' library(shiny)
#'
#' ui <- fluidPage(
#'   echarts4rOutput("chart"),
#'   verbatimTextOutput("zoom")
#' )
#'
#' server <- function(input, output) {
#'   output$chart <- renderEcharts4r({
#'     mtcars |>
#'       e_charts(mpg) |>
#'       e_scatter(qsec) |>
#'       e_datazoom() |>
#'       e_capture("datazoom")
#'   })
#'
#'   output$zoom <- renderPrint({
#'     input$chart_datazoom
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @export
e_capture <- function(e, event) {
  e$x$capture <- event
  e
}

#' Draw
#'
#' Draw the chart.
#'
#' @inheritParams e_highlight_p
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' ui <- fluidPage(
#'   echarts4rOutput("chart"),
#'   actionButton("draw", "draw")
#' )
#'
#' server <- function(input, output) {
#'   output$chart <- renderEcharts4r({
#'     mtcars |>
#'       e_charts(mpg, draw = FALSE) |>
#'       e_scatter(qsec) |>
#'       e_datazoom()
#'   })
#'
#'   observeEvent(input$draw, {
#'     echarts4rProxy("chart") |>
#'       e_draw_p()
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @details Useful if you set \code{draw} to \code{FALSE} in \code{\link{e_charts}}.
#'
#' @export
e_draw_p <- function(proxy) {
  if (missing(proxy)) {
    stop("must pass proxy and type", call. = FALSE)
  }

  if (!"echarts4rProxy" %in% class(proxy)) {
    stop("must pass echarts4rProxy object", call. = FALSE)
  }

  data <- list(id = proxy$id)

  proxy$session$sendCustomMessage("e_draw_p", data)
}

#' Resize
#'
#' Force resize the chart.
#'
#' @inheritParams e_highlight_p
#'
#' @export
e_resize <- function(proxy) UseMethod("e_resize")

#' @export
#' @method e_resize echarts4rProxy
e_resize.echarts4rProxy <- function(proxy) {
  data <- list(id = proxy$id)
  proxy$session$sendCustomMessage("e_resize", data)
  return(proxy)
}

#' Facet
#'
#' Create facets for multiple plots.
#'
#' @inheritParams e_bar
#' @param rows,cols Number of rows and columns. If both are `NULL` the number of rows and columns
#'     will be determined automatically.
#' @param legend_pos Position of the legend. One of "top", "right", "bottom", "left". Determines
#'     to which side the `legend_space` argument applies.
#' @param legend_space Space between legend and plot area. The entered number will be used
#'     as percentage.
#' @param margin_trbl Adjusts the size of the outside margin around the plotting area. Default is
#'     `c(t = 2, r = 2, b = 5, l = 2)`. Numbers are used as percentage of total plotting area. To
#'     change only e.g. two sides `c("r" = 8, "l" = 8)` could be used, other sides will use
#'     defaults.
#' @param h_panel_space,v_panel_space Horizontal and vertical spacing between the individual grid
#'     elements. Expects numeric input, which will be used as percentage of total plotting area.
#'     Default `NULL` will automatically add some panel spacing for low dimensional grids.
#'
#'
#' @examples
#' group_size <- 20
#' n_groups <- 13
#' df <- data.frame("day" = rep(1:group_size, times=n_groups),
#'                  "temperature" = runif(group_size * n_groups, 10, 40),
#'                  "location" = rep(LETTERS[1:n_groups], each=group_size))
#'
#' df |>
#'   group_by(location) |>
#'   e_charts(day) |>
#'   e_line(temperature) |>
#'   e_facet(rows = 4, cols=4, legend_pos = "top", legend_space = 12)
#'
#' @details Each serie, i.e.: \code{\link{e_bar}} will be plotted against a facet.
#'
#'
#' @importFrom grDevices n2mfrow
#'
#'
#' @export
#' @importFrom  grDevices n2mfrow
e_facet <- function(e,
                    rows = NULL,
                    cols = NULL,
                    legend_pos = "top",
                    legend_space = 10,
                    margin_trbl = c(t = 2, r = 2, b = 5, l = 2),
                    h_panel_space = NULL,
                    v_panel_space = NULL) {


    # Generate default values ---------------------------------------------------------------------

    # number of series
    nseries <- length(e$x$opts$series)

    if (is.null(rows) && is.null(cols)) {
        # Automatically generate grid dimensions
        dims <- n2mfrow(nseries)
        rows <- dims[2]
        cols <- dims[1]
    } else if (is.null(rows) || is.null(cols)) {
        stop("Must provide both the number of rows and columns.")
    } else {
        # Do series match the grid?
        if (nseries > rows * cols) {
            warning(paste0(nseries, " series exceed the number of panels created by ",
                           rows, " rows and ", cols, " columns."))
        }
    }

    # Specified margins
    spec_margin <- c("t", "r", "b", "l") %in% names(margin_trbl) # see which elements are present
    margin_trbl <- c(margin_trbl, # add missing elements
                     c(t = 2, r = 2, b = 5, l = 5)[!spec_margin])

    # Calculate spacings ------------------------------------------------------

    # introduce some spacing between panels for low dimensional grids
    if (is.null(v_panel_space)) {
        v_panel_space <- if (rows < 10) 10 - rows else 0
    } else {
        v_panel_space
    }

    if (is.null(h_panel_space)) {
        h_panel_space <- if (cols < 10) 10 - cols else 0
    } else {
        h_panel_space
    }


    # Maximum space for facets (depends on legend position, and space for axis labels)
    if (legend_pos %in% c("top", "bottom")) {
        w_max <- 100 - margin_trbl[["l"]] - margin_trbl[["r"]]
        h_max <- 100 - legend_space - margin_trbl[["b"]] - margin_trbl[["t"]]
    } else if (legend_pos %in% c("left", "right")){
        w_max <- 100 - legend_space - margin_trbl[["l"]] - margin_trbl[["r"]]
        h_max <- 100 - margin_trbl[["b"]] -margin_trbl[["t"]]
    } else {
        w_max <- 100 - margin_trbl[["l"]] - margin_trbl[["r"]]
        h_max <- 100 - margin_trbl[["b"]] - margin_trbl[["t"]]
    }

    # Total space for panels, taking between-panel spacing, legend space, and
    #   extra space for axis labels into account
    rows_h_max <- h_max - (v_panel_space * (rows-1))
    cols_w_max <- w_max - (h_panel_space * (cols-1))

    # Dimensions of each panel
    height <- rows_h_max / rows
    width <- cols_w_max / cols


    # Panel positions ---------------------------------------------------------

    # Offset only when legend is left or top
    top_offset <- 0
    left_offset <- 0
    if (legend_pos == "top") {
        top_offset <- legend_space
    }
    if (legend_pos == "left") {
        left_offset <- legend_space
    }

    # Generate a vector for positions from the top
    top_pos_values <- vapply(
      X = seq_len(rows),
      FUN = function(x) {
        margin_trbl[["t"]] + top_offset + ((x - 1) * (height + v_panel_space))
      },
      FUN.VALUE = numeric(1)
    )

    top_positions <- rep(top_pos_values, each=cols)[1:nseries]

    # Generate a vector for positions from the left
    left_pos_values <- vapply(
      X = seq_len(cols),
      FUN = function(x) {
        margin_trbl[["l"]] + left_offset + ((x-1) * (width + h_panel_space))
      },
      FUN.VALUE = numeric(1)
    )

    left_positions <- rep(left_pos_values, times=rows)[1:nseries]


    # Create grid -------------------------------------------------------------

    # Act differently depending on chart types
    chart_type <- e$x$opts$series[[1]]$type

    # No chart type found
    if (is.null(chart_type)) stop("No chart type found for first series")

    # When it is a pie chart
    if (chart_type == "pie") {
        for (i in 1:nseries) {

            e$x$opts$series[[i]]$height <- paste0(height, "%")
            e$x$opts$series[[i]]$width <- paste0(width, "%")
            e$x$opts$series[[i]]$top <- paste0(top_positions[i], "%")
            e$x$opts$series[[i]]$left <- paste0(left_positions[i], "%")
            e$x$opts$series[[i]]$avoidLabelOverlap <- FALSE # I noticed that many labels stay hidden when this is on the default: TRUE

        }
    }

    # For any other chart type, might not always produce desired results
    else {

        for (i in 1:nseries) {
            # Create new grid elements
            e <- e |>
                e_grid(
                    height = paste0(height, "%"),
                    width = paste0(width, "%"),
                    top = paste0(top_positions[i], "%"),
                    left = paste0(left_positions[i], "%")
                )

            # Create new axes for the series, that mimic the first axes
            e$x$opts$xAxis[[i]] <- e$x$opts$xAxis[[1]]
            e$x$opts$yAxis[[i]] <- e$x$opts$yAxis[[1]]

            # Assign the new axes to the new grid element
            e$x$opts$xAxis[[i]]$gridIndex <- i - 1
            e$x$opts$yAxis[[i]]$gridIndex <- i - 1

            # Dictate to which grid panel the series will be assigned
            e$x$opts$series[[i]]$yAxisIndex <- i - 1
            e$x$opts$series[[i]]$xAxisIndex <- i - 1

        }
    }

    e
}

#' Choropleth
#'
#' Draw maps.
#'
#' @inheritParams e_bar
#' @param serie Values to plot.
#' @param map Map type.
#' @param coord_system Coordinate system to use, one of \code{cartesian3D}, \code{geo3D}, \code{globe}.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#' @param id,value,height Columns corresponding to registered map.
#'
#' @examples
#' \dontrun{
#' choropleth <- data.frame(
#'   countries = c(
#'     "France",
#'     "Brazil",
#'     "China",
#'     "Russia",
#'     "Canada",
#'     "India",
#'     "United States",
#'     "Argentina",
#'     "Australia"
#'   ),
#'   values = round(runif(9, 10, 25))
#' )
#'
#' choropleth |>
#'   e_charts(countries) |>
#'   e_map(values) |>
#'   e_visual_map(min = 10, max = 25)
#'
#' choropleth |>
#'   e_charts(countries) |>
#'   e_map_3d(values, shading = "lambert") |>
#'   e_visual_map(min = 10, max = 30)
#'
#' # custom
#' buildings <- jsonlite::read_json(
#'   paste0(
#'     "https://echarts.apache.org/examples/",
#'     "data-gl/asset/data/buildings.json"
#'   )
#' )
#'
#' heights <- purrr::map(buildings$features, "properties") |>
#'   purrr::map("height") |>
#'   unlist()
#'
#' names <- purrr::map(buildings$features, "properties") |>
#'   purrr::map("name") |>
#'   unlist()
#'
#' data <- dplyr::tibble(
#'   name = names,
#'   value = round(runif(length(names), 0, 1), 6),
#'   height = heights / 10
#' )
#'
#' data |>
#'   e_charts() |>
#'   e_map_register("buildings", buildings) |>
#'   e_map_3d_custom(name, value, height) |>
#'   e_visual_map(
#'     show = FALSE,
#'     min = 0.4,
#'     max = 1
#'   )
#'
#' # timeline
#' choropleth <- data.frame(
#'   countries = rep(choropleth$countries, 3)
#' ) |>
#'   dplyr::mutate(
#'     grp = c(
#'       rep(2016, nrow(choropleth)),
#'       rep(2017, nrow(choropleth)),
#'       rep(2018, nrow(choropleth))
#'     ),
#'     values = runif(27, 1, 10)
#'   )
#'
#' choropleth |>
#'   group_by(grp) |>
#'   e_charts(countries, timeline = TRUE) |>
#'   e_map(values) |>
#'   e_visual_map(min = 1, max = 10)
#'
#' choropleth |>
#'   group_by(grp) |>
#'   e_charts(countries, timeline = TRUE) |>
#'   e_map_3d(values) |>
#'   e_visual_map(min = 1, max = 10)
#' }
#'
#' @seealso \code{\link{e_country_names}},
#' \href{https://echarts.apache.org/en/option.html#series-map}{Additional map arguments},
#' \href{https://echarts.apache.org/en/option-gl.html#series-map3D}{Additional map 3D arguments}
#'
#' @rdname map
#' @export
e_map <- function(e, serie, map = "world", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!missing(serie)) {
    sr <- deparse(substitute(serie))
  } else {
    sr <- NULL
  }

  e_map_(e, sr, map, name, rm_x, rm_y, ...)
}

#' @rdname map
#' @export
e_map_ <- function(e, serie = NULL, map = "world", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  for (i in seq_along(e$x$data)) {
    app <- list(
      type = "map",
      map = map,
      name = name,
      ...
    )

    app_data <- list()
    if (!is.null(serie)) {
      data <- .build_data2(e$x$data[[i]], serie)
      data <- .add_bind2(e, data, e$x$mapping$x, i = i)
      app_data <- list(data = data)
    }

    if (!e$x$tl) {
      if (is.null(name) && !is.null(serie)) {
        app$name <- serie
      }

      app <- append(app, app_data)

      e$x$opts$series <- append(e$x$opts$series, list(app))
    } else {
      e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(app_data))
    }
  }

  if(length(e$x$data) == 0){
    app <- list(
      type = "map",
      map = map,
      name = name,
      ...
    )
    e$x$opts$series <- append(e$x$opts$series, list(app))
  }

  if (isTRUE(e$x$tl)) {
    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(app))
  }

  if (map == "world") {
    # add dependency
    path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
    dep <- htmltools::htmlDependency(
      name = "echarts-world",
      version = "1.0.0",
      src = c(file = path),
      script = "world.js"
    )

    e$dependencies <- append(e$dependencies, list(dep))
  }

  e
}

#' @rdname map
#' @export
e_svg <- e_map

#' @rdname map
#' @export
e_svg_ <- e_map_

#' @rdname map
#' @export
e_map_3d <- function(e, serie, map = "world", name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!missing(serie)) {
    sr <- deparse(substitute(serie))
  } else {
    sr <- NULL
  }

  e_map_3d_(e = e, serie = sr, map, name, coord_system, rm_x, rm_y, ...)
}

#' @rdname map
#' @export
e_map_3d_ <- function(e, serie = NULL, map = "world", name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  for (i in seq_along(e$x$data)) {
    if (!is.null(serie)) {
      data <- .build_data2(e$x$data[[i]], serie)
      data <- .add_bind2(e, data, e$x$mapping$x, i = i)
      dat <- data
    }

    app <- list(
      type = "map3D",
      map = map,
      coordinateSystem = coord_system,
      name = name,
      ...
    )

    app_data <- list(data = data)

    if (!e$x$tl) {
      if (is.null(name) && !is.null(serie)) {
        app$name <- serie
      }

      app <- append(app, app_data)

      e$x$opts$series <- append(e$x$opts$series, list(app))
    } else {
      e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(app_data))
    }
  }

  if (isTRUE(e$x$tl)) {
    e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(app))
  }

  if (map == "world") {
    # add dependency
    path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
    dep <- htmltools::htmlDependency(
      name = "echarts-world",
      version = "1.0.0",
      src = c(file = path),
      script = "world.js"
    )

    e$dependencies <- append(e$dependencies, list(dep))
  }

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-gl",
    version = "1.1.2",
    src = c(file = path),
    script = "echarts-gl.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' @rdname map
#' @export
e_map_3d_custom <- function(e, id, value, height, map = NULL, name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (missing(id) || missing(value) || missing(height)) {
    stop("must pass id, value, and height", call. = FALSE)
  }

  if (is.null(map) && length(e$x$registerMap[[1]]$mapName)) {
    map <- unlist(e$x$registerMap[[1]]$mapName)
  } else if (is.null(map)) { # fix when map value is not NULL
    stop("not map registered, see e_map_register", call. = FALSE)
  }

  e$x$mainOpts$renderer <- "webgl" # 'canvas' works also, maybe even more efficient

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  app <- list(
    type = "map3D",
    map = map,
    ...
  )

  if (!is.null(name)) {
    app$name <- name
  }

  name_quo <- dplyr::enquo(id)
  value_quo <- dplyr::enquo(value)
  height_quo <- dplyr::enquo(height)

  data <- e$x$data[[1]] |>
    dplyr::select(
      c(name = !!name_quo,
      value = !!value_quo,
      height = !!height_quo)
    ) |>
    apply(1, as.list)

  app$data <- data

  e$x$opts$series <- append(e$x$opts$series, list(app))

  # add dependency
  path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-gl",
    version = "1.1.2",
    src = c(file = path),
    script = "echarts-gl.min.js"
  )
  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' Register map
#'
#' Register a \href{https://geojson.org/}{geojson} map.
#'
#' @param e An \code{echarts4r} object as returned by \code{\link{e_charts}}.
#' @param name Name of map, to used in \code{\link{e_map}}.
#' @param json,svg \href{https://geojson.org/}{Geojson}, or SVG.
#' @param async Whether to read the file asynchronously.
#' @param session A valid Shiny session.
#' @param ... Additional options passed to \href{https://echarts.apache.org/en/api.html#echarts.registerMap}{registerMap}.
#'
#' @details \code{e_map_register_p} is not truly a proxy as it does not require
#' a chart to function. While the function \code{e_map_register_ui} is meant to
#' register the map globally in the Shiny UI, not that then \code{json} must be accessible
#' from the UI (generally www folder).
#'
#' @examples
#' \dontrun{
#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json")
#'
#' USArrests |>
#'   tibble::rownames_to_column("states") |>
#'   e_charts(states) |>
#'   e_map_register("USA", json) |>
#'   e_map(Murder, map = "USA") |>
#'   e_visual_map(Murder)
#' }
#'
#' @rdname e_map_register
#' @export
e_map_register <- function(e, name, json, ...) UseMethod("e_map_register")

#' @export
#' @method e_map_register echarts4r
e_map_register.echarts4r <- function(e, name, json, ...) {
  if (!length(e$x$registerMap)) {
    e$x$registerMap <- list()
  }

  opts <- list(
    mapName = name,
    geoJSON = json
  )

  extra <- list(...)
  if(length(extra) > 0)
    opts$extra <- extra

  e$x$registerMap <- append(e$x$registerMap, list(opts))
  e
}

#' @rdname e_map_register
#' @export
e_svg_register <- function(e, name, svg) UseMethod("e_svg_register")

#' @export
#' @method e_svg_register echarts4r
e_svg_register.echarts4r <- function(e, name, svg) {
  if (!length(e$x$registerMap)) {
    e$x$registerMap <- list()
  }

  opts <- list(
    mapName = name,
    geoJSON = list(svg = svg)
  )

  e$x$registerMap <- append(e$x$registerMap, list(opts))
  e
}

#' @rdname e_map_register
#' @export
e_map_register_p <- function(name, json, async = FALSE, session = shiny::getDefaultReactiveDomain()) {
  opts <- list(
    mapAsync = async,
    mapName = name,
    geoJSON = json
  )

  session$sendCustomMessage("e_register_map", opts)
  invisible()
}

#' @rdname e_map_register
#' @export
e_map_register_ui <- function(name, json, async = FALSE) {
  async <- paste0(tolower(async))
  script <- paste0("
    $.ajax({
        url: '", json, "',
        dataType: 'json',
        async: ", async, ",
        success: function(map){
          echarts.registerMap('", name, "', map);
        }
      });")
  shiny::tags$script(
    script[1]
  )
}

#' Mapbox
#'
#' Use mapbox.
#'
#' @inheritParams e_bar
#' @param token Your mapbox token from \href{https://www.mapbox.com/}{mapbox}.
#' @param ... Any option.
#'
#' @examples
#' \dontrun{
#' url <- paste0(
#'   "https://echarts.apache.org/examples/",
#'   "data-gl/asset/data/population.json"
#' )
#' data <- jsonlite::fromJSON(url)
#' data <- as.data.frame(data)
#' names(data) <- c("lon", "lat", "value")
#'
#' data |>
#'   e_charts(lon) |>
#'   e_mapbox(
#'     token = "YOUR_MAPBOX_TOKEN",
#'     style = "mapbox://styles/mapbox/dark-v9"
#'   ) |>
#'   e_bar_3d(lat, value, coord_system = "mapbox") |>
#'   e_visual_map()
#' }
#'
#' @note Mapbox may not work properly in the RSudio console.
#'
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#mapbox3D.style}{Official documentation},
#' \href{https://docs.mapbox.com/mapbox-gl-js/api/}{mapbox documentation}
#'
#' @name mapbox
#' @export
e_mapbox <- function(e, token, ...) {
  if (missing(token)) {
    stop("missing token", call. = FALSE)
  }

  e$x$mapboxToken <- token

  if (!e$x$tl) {
    e$x$opts$mapbox <- list(...)
  } else {
    e$x$opts$baseOption$mapbox <- list(...)
  }

  # add dependency
  path <- system.file("htmlwidgets/lib/mapbox", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-mapbox",
    version = "3.17.0",
    src = c(file = path),
    script = "mapbox-gl.js",
    stylesheet = "mapbox-gl.css"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  e
}

#' General options
#'
#' @param font_family Font family.
#' @param theme A theme.
#'
#' @export
e_common <- function(font_family = NULL, theme = NULL) {
  options(
    "ECHARTS4R_THEME" = theme,
    "ECHARTS4R_FONT_FAMILY" = font_family
  )
}

#' Color
#'
#' Customise chart and background colors.
#'
#' @inheritParams e_bar
#' @param color Vector of colors.
#' @param background Background color.
#' @param append Only applicable to `echarts4rProxy`.
#' Whether to append the `color` to the existing
#' array (vector) or colors or to replace it.
#'
#' @examples
#' mtcars |>
#'   e_charts(drat) |>
#'   e_line(mpg) |>
#'   e_area(qsec) |>
#'   e_color(
#'     c("red", "blue"),
#'     "#d3d3d3"
#'   )
#' @seealso \code{\link{e_theme}},
#' \href{https://echarts.apache.org/en/option.html#color}{Official color documentation},
#' \href{https://echarts.apache.org/en/option.html#backgroundColor}{Official background documentation}
#' 
#' @name e_color
#' @export
e_color <- function(e, color = NULL, background = NULL, append = TRUE) UseMethod("e_color")

#' @rdname e_color
#' @export 
e_color.echarts4r <- function(e, color = NULL, background = NULL, append = TRUE) {
  if (!e$x$tl) {
    if (!is.null(color)) e$x$opts$color <- as.list(color)
    if (!is.null(background)) e$x$opts$backgroundColor <- background
  } else {
    if (!is.null(color)) e$x$opts$baseOption$color <- color
    if (!is.null(background)) e$x$opts$baseOption$backgroundColor <- background
  }
  e
}

#' @rdname e_color
#' @export 
e_color.echarts4rProxy <- function(e, color = NULL, background = NULL, append = TRUE) {
  if (!is.null(color)) e$chart$x$opts$color <- as.list(color)
  if (!is.null(background)) e$chart$x$opts$backgroundColor <- background
  e$chart$x$opts$appendColor <- append

  e
}

#' Axis 3D
#'
#' Customise 3D axis.
#'
#' @inheritParams e_bar
#' @param axis Axis to customise.
#' @param index Index of axis to customise.
#'
#' @examples
#' # phony data
#' v <- LETTERS[1:10]
#' matrix <- data.frame(
#'   x = sample(v, 300, replace = TRUE),
#'   y = sample(v, 300, replace = TRUE),
#'   z1 = rnorm(300, 10, 1),
#'   z2 = rnorm(300, 10, 1),
#'   stringsAsFactors = FALSE
#' ) |>
#'   dplyr::group_by(x, y) |>
#'   dplyr::summarise(
#'     z1 = sum(z1),
#'     z2 = sum(z2)
#'   ) |>
#'   dplyr::ungroup()
#'
#' trans <- list(opacity = 0.4) # transparency
#' emphasis <- list(itemStyle = list(color = "#313695"))
#'
#' matrix |>
#'   e_charts(x) |>
#'   e_bar_3d(y, z1, stack = "stack", name = "Serie 1", itemStyle = trans, emphasis = emphasis) |>
#'   e_bar_3d(y, z2, stack = "stack", name = "Serie 2", itemStyle = trans, emphasis = emphasis) |>
#'   e_x_axis_3d(axisLine = list(lineStyle = list(color = "blue")))
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#xAxis3D}{Additional x arguments},
#'  \href{https://echarts.apache.org/en/option-gl.html#yAxis3D}{Additional y arguments},
#'  \href{https://echarts.apache.org/en/option-gl.html#zAxis3D}{Additional z arguments}
#'
#' @rdname axis3d
#' @export
e_axis_3d <- function(e, axis = c("x", "y", "z"), index = 0, ...) {
  if (missing(e)) {
    stop("missing e", call. = FALSE)
  }

  axis <- .r2axis3D(axis[1])

  r.index <- index + 1

  x_data <- if(e$x$tl){
    e$x$opts$baseOption[[axis]]
  } else {
      e$x$opts[[axis]]}

  max <- length(x_data)

  if (r.index > max) {
    stop("invalid axis", call. = FALSE)
  }

  attrs <- list(...)

  if (!length(attrs)) {
    stop("no attribute", call. = FALSE)
  }

  for (i in seq_along(attrs)) {
    arg <- names(attrs)[i]

    if (!e$x$tl) {
      e$x$opts[[axis]][[r.index]][[arg]] <- attrs[[i]]
    } else {
      e$x$opts$baseOption[[axis]][[r.index]][[arg]] <- attrs[[i]]
    }
  }

  e
}

#' @rdname axis3d
#' @export
e_x_axis_3d <- function(e, index = 0, ...) {
  if (missing(e)) {
    stop("missing e", call. = FALSE)
  }
  e <- e_axis_3d(e, axis = "x", index = index, ...)
  e
}

#' @rdname axis3d
#' @export
e_y_axis_3d <- function(e, index = 0, ...) {
  if (missing(e)) {
    stop("missing e", call. = FALSE)
  }
  e <- e_axis_3d(e = e, axis = "y", index = index, ...)
  e
}

#' @rdname axis3d
#' @export
e_z_axis_3d <- function(e, index = 0, ...) {
  if (missing(e)) {
    stop("missing e", call. = FALSE)
  }
  e <- e_axis_3d(e = e, axis = "z", index = index, ...)
  e
}

#' Grid
#'
#' Customise grid.
#'
#' @inheritParams e_bar
#' @inheritParams e_axis
#'
#' @examples
#' # phony data
#' v <- LETTERS[1:10]
#' matrix <- data.frame(
#'   x = sample(v, 300, replace = TRUE),
#'   y = sample(v, 300, replace = TRUE),
#'   z1 = rnorm(300, 10, 1),
#'   z2 = rnorm(300, 10, 1),
#'   stringsAsFactors = FALSE
#' ) |>
#'   dplyr::group_by(x, y) |>
#'   dplyr::summarise(
#'     z1 = sum(z1),
#'     z2 = sum(z2)
#'   ) |>
#'   dplyr::ungroup()
#'
#' trans <- list(opacity = 0.4) # transparency
#' emphasis <- list(itemStyle = list(color = "#313695"))
#'
#' matrix |>
#'   e_charts(x) |>
#'   e_bar_3d(y, z1, stack = "stack", name = "Serie 1", itemStyle = trans, emphasis = emphasis) |>
#'   e_bar_3d(y, z2, stack = "stack", name = "Serie 2", itemStyle = trans, emphasis = emphasis) |>
#'   e_grid_3d(splitLine = list(lineStyle = list(color = "blue")))
#' @seealso \href{https://echarts.apache.org/en/option-gl.html#grid3D}{Additional arguments}
#'
#' @export
e_grid_3d <- function(e, index = 0, ...) {
  if (missing(e)) {
    stop("missing e", call. = FALSE)
  }

  r.index <- index + 1

  # initialise if not existing
  if (!e$x$tl) {
    if (!length(e$x$opts[["grid3D"]])) {
      e$x$opts$grid3D <- list(NULL)
    }
  } else {
    if (!length(e$x$opts$baseOption[["grid3D"]])) {
      e$x$opts$baseOption$grid3D <- list(NULL)
    }
  }

  attrs <- list(...)

  if (!length(attrs)) {
    stop("no attribute", call. = FALSE)
  }

  for (i in seq_along(attrs)) {
    arg <- names(attrs)[i]

    if (!e$x$tl) {
      e$x$opts$grid3D[[r.index]][[arg]] <- attrs[[i]]
    } else {
      e$x$opts$baseOption$grid3D[[r.index]][[arg]] <- attrs[[i]]
    }
  }

  e
}

#' Geo 3D
#'
#' Initialise geo 3D.
#'
#' @inheritParams e_bar
#' @param color Color.
#' @param type Map type.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' choropleth <- data.frame(
#'   countries = c(
#'     "France",
#'     "Brazil",
#'     "China",
#'     "Russia",
#'     "Canada",
#'     "India",
#'     "United States",
#'     "Argentina",
#'     "Australia"
#'   ),
#'   height = runif(9, 1, 5),
#'   color = c(
#'     "#F7FBFF",
#'     "#DEEBF7",
#'     "#C6DBEF",
#'     "#9ECAE1",
#'     "#6BAED6",
#'     "#4292C6",
#'     "#2171B5",
#'     "#08519C",
#'     "#08306B"
#'   )
#' )
#'
#' choropleth |>
#'   e_charts(countries) |>
#'   e_geo_3d(height, color)
#' @seealso \code{\link{e_country_names}},
#' \href{https://echarts.apache.org/en/option-gl.html#geo3D}{Additional arguments}
#'
#' @rdname e_geo_3d
#' @export
e_geo_3d <- function(e, serie, color, type = "world", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (!missing(serie)) {
    sr <- deparse(substitute(serie))
  } else {
    sr <- NULL
  }

  if (!missing(color)) {
    cl <- deparse(substitute(color))
  } else {
    cl <- NULL
  }

  e_geo_3d_(e, sr, cl, type, rm_x, rm_y, ...)
}

#' @rdname e_geo_3d
#' @export
e_geo_3d_ <- function(e, serie = NULL, color = NULL, type = "world", rm_x = TRUE, rm_y = TRUE, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  series <- list(
    map = type,
    ...
  )

  if (!is.null(color) && !is.null(serie)) {
    series$regions <- .build_height(e, serie, color, j = 1)
  } else if (is.null(color) && !is.null(serie)) {
    series$regions <- .build_height(e, serie, j = 1)
  }

  if (!e$x$tl) {
    e$x$opts$geo3D <- series
  } else {
    e$x$opts$baseOption$geo3D <- series
  }

  path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
  dep <- htmltools::htmlDependency(
    name = "echarts-gl",
    version = "1.1.2",
    src = c(file = path),
    script = "echarts-gl.min.js"
  )

  e$dependencies <- append(e$dependencies, list(dep))

  if (type == "world") {
    # add dependency
    path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
    dep <- htmltools::htmlDependency(
      name = "echarts-world",
      version = "1.0.0",
      src = c(file = path),
      script = "world.js"
    )

    e$dependencies <- append(e$dependencies, list(dep))
  }

  e
}

#' Geo
#'
#' Initialise geo.
#'
#' @inheritParams e_bar
#' @param map Map type.
#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
#'
#' @examples
#' flights |>
#'   e_charts() |>
#'   e_geo() |>
#'   e_lines(
#'     start_lon,
#'     start_lat,
#'     end_lon,
#'     end_lat,
#'     name = "flights",
#'     lineStyle = list(normal = list(curveness = 0.3))
#'   )
#' @seealso \href{https://echarts.apache.org/en/option.html#geo}{Additional arguments}
#'
#' @export
e_geo <- function(e, map = "world", ..., rm_x = TRUE, rm_y = TRUE) {
  opts <- list(
    map = map,
    ...
  )

  e <- .rm_axis(e, rm_x, "x")
  e <- .rm_axis(e, rm_y, "y")

  if (!e$x$tl) {
    e$x$opts$geo <- opts
  } else {
    e$x$opts$baseOption$geo <- opts
  }

  if (map == "world") {
    # add dependency
    path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
    dep <- htmltools::htmlDependency(
      name = "echarts-world",
      version = "1.0.0",
      src = c(file = path),
      script = "world.js"
    )

    e$dependencies <- append(e$dependencies, list(dep))
  }

  e
}

#' Morphing
#'
#' __This is experimental__
#'
#' Morph between graphs.
#'
#' @param e,... Graphs (from `e_graph`).
#' @param callback JavaScript callback function as a
#' character string (vector of length 1).
#' This function has access to the `chart` object, as well
#' as `opts` an array containing the options of the charts
#' passed to `e` and `...`.
#' @param default Default chart to show.
#'
#' @examples
#' mtcars2 <- mtcars |>
#'   head() |>
#'   tibble::rownames_to_column("model")
#'
#' e1 <- mtcars2 |>
#'   e_charts(model) |>
#'   e_bar(
#'     carb,
#'     universalTransition = TRUE,
#'     animationDurationUpdate = 1000L
#'   )
#'
#' e2 <- mtcars2 |>
#'   e_charts(model) |>
#'   e_pie(
#'     carb,
#'     universalTransition = TRUE,
#'     animationDurationUpdate = 1000L
#'   )
#'
#' cb <- "() => {
#'   let x = 0;
#'   setInterval(() => {
#'     x++
#'     chart.setOption(opts[x % 2], true);
#'   }, 3000);
#' }"
#'
#' e_morph(e1, e2, callback = cb)
#'
#' @export
e_morph <- \(e, ..., callback, default = 1L) {
  warning("This is experimental")

  if(...length() < 1)
    stop("Must pass at least two charts")

  if(missing(callback))
    stop("Missing callback")

  opts <- lapply(list(e, ...), \(p) {
    p$x$opts
  }) |>
    unname()

  e$x$opts <- list(opts)
  e$x$morphed <- list(
    callback = callback,
    default = default - 1L
  )

  return(e)
}

#' Calendar
#'
#' @inheritParams e_bar
#' @param range Range of calendar format, string or vector.
#'
#' @examples
#' dates <- seq.Date(as.Date("2017-01-01"), as.Date("2019-12-31"), by = "day")
#' values <- rnorm(length(dates), 20, 6)
#' year <- data.frame(date = dates, values = values)
#'
#' year |>
#'    e_charts(date) |>
#'    e_calendar(range = "2017") |>
#'    e_visual_map(max = 30) |>
#'    e_heatmap(values, coord_system = "calendar")
#'
#' # month
#' year |>
#'    e_charts(date) |>
#'    e_calendar(range = "2017-01") |>
#'    e_visual_map(max = 30) |>
#'    e_heatmap(values, coord_system = "calendar")
#'
#' # range
#' year |>
#'    e_charts(date) |>
#'    e_calendar(range = c("2018-01", "2018-07")) |>
#'    e_visual_map(max = 30) |>
#'    e_heatmap(values, coord_system = "calendar")
#'
#' @seealso \href{https://echarts.apache.org/en/option.html#calendar}{Additional arguments}
#'
#' @export
e_calendar <- function(e, range, ...) {
  if (missing(e) || missing(range)) {
    stop("missing e or range", call. = FALSE)
  }

  # initialise
  if (!length(e$x$opts$calendar)) {
    e$x$opts$calendar <- list()
  }

  cal <- list(range = range, ...)

  if (!e$x$tl) {
    e$x$opts$calendar <- append(e$x$opts$calendar, list(cal))
  } else {
    e$x$opts$baseOption$calendar <- append(e$x$opts$baseOption$calendar, list(cal))
  }

  e
}

#' Callbacks
#'
#' Binds events to chart interactions.
#'
#' @inheritParams e_bar
#' @param query Condition that triggers the handler
#' @param handler Javascript handler, passed to \link[htmlwidgets]{JS}.
#' @param event Event that triggers the handler.
#'
#' @examples
#' cars |>
#'   e_charts(speed) |>
#'   e_scatter(dist) |>
#'   e_on(
#'     list(seriesName = "dist"),
#'     "function(){alert('Serie clicked')}"
#'   )
#' @seealso
#'   \href{https://echarts.apache.org/en/api.html#echartsInstance.on}{official
#'   documentation}
#'
#' @name callbacks
#' @export
e_on <- function(e, query, handler, event = "click") {
  if (missing(query) || missing(handler)) {
    stop("must pass query and handler", call. = FALSE)
  }

  if (!length(e$x$on)) {
    e$x$on <- list()
  }

  opts <- list(
    event = event,
    query = query,
    handler = htmlwidgets::JS(handler)
  )

  e$x$on <- append(e$x$on, list(opts))

  e
}

#' @rdname callbacks
#' @export
e_off <- function(e, query, handler, event = "click") {
  if (missing(query) || missing(handler)) {
    stop("must pass query and handler", call. = FALSE)
  }

  if (!length(e$x$off)) {
    e$x$off <- list()
  }

  opts <- list(
    event = event,
    query = query,
    handler = htmlwidgets::JS(handler)
  )

  e$x$off <- append(e$x$off, list(opts))

  e
}


#' Blank Area
#'
#' Use this function to capture a click on a
#' blank area of the canvas.
#' Note that this may stops other "click" events
#' from working.
#'
#' @inheritParams e_bar
#' @export
e_get_zr <- function(e){
  e$x$zr <- TRUE
  e
}

#' Globe
#'
#' Add globe.
#'
#' @inheritParams e_bar
#' @param environment Texture of background.
#' @param base_texture Base texture of globe.
#' @param height_texture Texture of height.
#'
#' @examples
#' \dontrun{
#' url <- paste0(
#'   "https://echarts.apache.org/examples/",
#'   "data-gl/asset/data/population.json"
#' )
#' data <- jsonlite::fromJSON(url)
#' data <- as.data.frame(data)
#' names(data) <- c("lon", "lat", "value")
#'
#' data |>
#'   e_charts(lon) |>
#'   e_globe(
#'     displacementScale = 0.04
#'   ) |>
#'   e_bar_3d(lat, value, "globe") |>
#'   e_visual_map(show = FALSE)
#' }
#'
#' @seealso \code{\link{e_country_names}}, \href{https://echarts.apache.org/en/option-gl.html#globe}{Additional arguments}
#'
#' @export
e_globe <- function(e, environment = NULL, base_texture = NULL, height_texture = NULL, ...) {
  if (missing(e)) {
    stop("must pass e", call. = FALSE)
  }

  if (is.null(base_texture)) {
    message("`base_texture` is `NULL`, see echarts4r-assets.john-coene.com")
  }

  e$x$mainOpts$renderer <- "webgl"

  ls <- list(
    environment = environment,
    heightTexture = height_texture,
    baseTexture = base_texture,
    series = list(),
    ...
  )

  if (!e$x$tl) {
    e$x$opts$globe <- ls
  } else {
    e$x$opts$baseOption$globe <- ls
  }

  e
}

#' Loading
#'
#' Show or hide loading.
#'
#' @inheritParams e_bar
#' @param hide_overlay Hides the white overlay that appears in shiny when a plot is recalculating.
#' @param text Text to display.
#' @param color Color of spinner.
#' @param text_color Color of text.
#' @param mask_color Color of mask.
#' @param zlevel Z level.
#'
#' @details This only applies to Shiny.
#'
#' @examples
#' \dontrun{
#'
#' # no redraw
#' # no loading
#' library(shiny)
#' ui <- fluidPage(
#'   fluidRow(
#'     column(12, actionButton("update", "Update"))
#'   ),
#'   fluidRow(
#'     column(12, echarts4rOutput("plot"))
#'   )
#' )
#'
#' server <- function(input, output) {
#'   data <- eventReactive(input$update, {
#'     data.frame(
#'       x = 1:10,
#'       y = rnorm(10)
#'     )
#'   })
#'
#'   output$plot <- renderEcharts4r({
#'     data() |>
#'       e_charts(x) |>
#'       e_bar(y)
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#'
#' # add loading
#' server <- function(input, output) {
#'   data <- eventReactive(input$update, {
#'     Sys.sleep(1) # sleep one second to show loading
#'     data.frame(
#'       x = 1:10,
#'       y = rnorm(10)
#'     )
#'   })
#'
#'   output$plot <- renderEcharts4r({
#'     data() |>
#'       e_charts(x) |>
#'       e_bar(y) |>
#'       e_show_loading()
#'   })
#' }
#'
#' if (interactive()) {
#'   shinyApp(ui, server)
#' }
#' }
#'
#' @rdname loading
#' @export
e_show_loading <- function(
  e,
  hide_overlay = TRUE,
  text = "loading",
  color = "#c23531",
  text_color = "#000",
  mask_color = "rgba(255, 255, 255, 0.8)",
  zlevel = 0
) {
  e$x$loading <- TRUE
  e$x$hideWhite <- hide_overlay
  opts <- list(
    text = text,
    color = color,
    textColor = text_color,
    maskColor = mask_color,
    zlevel = zlevel
  )
  e$x$loadingOpts <- opts
  e
}

#' @rdname loading
#' @export
e_hide_loading <- function(e) {
  e$x$loading <- FALSE
  e
}

#' Button
#'
#' Add a button to your visualisation.
#'
#' @inheritParams e_bar
#' @param position Position of button, \code{top} or \code{bottom}.
#' @param tag A Valid \code{htmltools::tags} function.
#' @param id A valid CSS id.
#' @param ... Content of the button, complient with \code{htmltools}.
#'
#' @examples
#' iris |>
#'   group_by(Species) |>
#'   e_charts(Sepal.Length) |>
#'   e_line(Sepal.Width) |>
#'   e_line(Petal.Length) |>
#'   e_highlight(series_name = "setosa", btn = "myBtn") |>
#'   e_button("myBtn", "highlight stuff")
#' @export
e_button <- function(e, id, ..., position = "top", tag = htmltools::tags$button) {
  if (missing(id)) {
    stop("missing id", call. = FALSE)
  }

  if (!id %in% names(e$x$buttons)) {
    e$x$buttons[[id]] <- list()
  }

  if (position == "top") {
    htmlwidgets::prependContent(e, tag(id = id, ...))
  } else {
    htmlwidgets::appendContent(e, tag(id = id, ...))
  }
}

1		#' Box
2		#'
3		#' Renders a data box in shiny.
4		#'
5		#' @param data A dataframe containing data to plot.
6		#' @param x,y Bare column name of variables to draw.
7		#' @param text,subtext Title and subtitle of box.
8		#' @param type Chart type to draw.
9		#' @param color Color of chart in box.
10		#' @param text_color Color of text.
11		#' @param background_color Color of box.
12		#' @param step Step method, only used if \code{type = "step"}.
13		#' @param title_args Additional arguments to add to the title.
14		#' @param tooltip Tooltip to use.
15		#' @param ... Additional arguments to pass to the serie.
16		#'
17		#' @examples
18		#' library(shiny)
19		#'
20		#' ui <- fluidPage(
21		#' fluidRow(
22		#' column(3, echarts4rBoxOutput("box1"))
23		#' )
24		#' )
25		#'
26		#' server <- function(input, output) {
27		#' output$box1 <- renderEcharts4rBox({
28		#' echarts4rBox(cars, speed, dist, "Cars", type = "bar")
29		#' })
30		#' }
31		#' \dontrun{
32		#' shinyApp(ui, server)
33		#' }
34		#' @seealso \code{\link{renderEcharts4rBox}}, \code{\link{echarts4rBoxOutput}}
35		#'
36		#' @export
37		echarts4rBox <- function(
38		data,
39		x,
40		y,
41		text = "",
42		subtext = "",
43		type = c("bar", "line", "scatter", "area", "step"),
44		...,
45		color = "#ffffff",
46		text_color = "#ffffff",
47		background_color = "#293c55",
48		step = c("start", "middle", "end"),
49		title_args = list(),
50		tooltip = list(trigger = "axis")
51		) {
52
53		# for area, keep to use in series opts
54	15x	original_type <- type
55
56		# inputs
57	15x	type <- match.arg(type)
58	15x	step <- match.arg(step)
59
60		# override area
61	2x	if (type %in% c("area", "step")) type <- "line"
62
63		# Make sure x and y are strings
64	15x	x <- toString(substitute(x))
65	15x	y <- toString(substitute(y))
66
67		# build expected data format
68	15x	data <- .build_data2(data, {{ x }}, {{ y }})
69
70		# build serie
71	15x	serie <- list(
72	15x	color = color,
73	15x	type = type,
74	15x	data = data,
75		...
76		)
77
78		# make are
79	1x	if (original_type == "area") serie$areaStyle <- list()
80
81		# make step
82	1x	if (original_type == "step") serie$step <- step
83
84		# title
85	15x	title <- list(
86	15x	text = text,
87	15x	subtext = subtext
88		)
89	15x	title <- append(title, title_args)
90	15x	title$textStyle$color <- text_color
91
92		# build options
93	15x	opts <- list(
94	15x	title = title,
95	15x	tooltip = tooltip,
96	15x	xAxis = list(show = FALSE),
97	15x	yAxis = list(show = FALSE),
98	15x	grid = list(
99	15x	left = 0,
100	15x	top = 0,
101	15x	bottom = 0,
102	15x	right = 0
103		),
104	15x	series = list(serie)
105		)
106
107	15x	list(
108	15x	options = opts,
109	15x	bgColor = background_color
110		)
111		}
112
113		#' Render box
114		#'
115		#' Render an echarts4r box.
116		#'
117		#' @param expr An expression that produces as \code{\link{echarts4rBox}}.
118		#' @param env The environment in which to evaluate ‘expr’.
119		#' @param quoted Is ‘expr’ a quoted expression (with ‘quote()’)? This is useful if you want to save an expression in a variable.
120		#'
121		#' @export
122		renderEcharts4rBox <- function(expr, env = parent.frame(), quoted = FALSE) {
123	5x	func <- shiny::exprToFunction(expr, env = env, quoted = quoted)
124
125	5x	function() {
126	4x	val <- func()
127
128	4x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
129
130	4x	deps <- htmltools::htmlDependency(
131	4x	name = "echarts",
132	4x	version = "6.1.0",
133	4x	src = c(file = path),
134	4x	script = c("echarts.min.js")
135		)
136
137	4x	val$deps <- lapply(
138	4x	htmltools::resolveDependencies(list(deps)),
139	4x	shiny::createWebDependency
140		)
141
142	4x	return(val)
143		}
144		}
145
146		#' Box Output
147		#'
148		#' Place box output in Shiny ui.
149		#'
150		#' @param id Id of box.
151		#' @param height Height of box, any valid CSS value, numerics are treated as pixels.
152		#'
153		#' @export
154		echarts4rBoxOutput <- function(id, height = 150) {
155	8x	if (missing(id)) {
156	1x	stop("Missing id", call. = FALSE)
157		}
158
159		# num to px
160	7x	if (inherits(height, "numeric")) {
161	6x	height <- paste0(height, "px")
162		}
163
164		# make style string
165	7x	style <- sprintf("width:100%%;height:%s;", height)
166
167	7x	el <- htmltools::div(
168	7x	class = "panel",
169	7x	id = sprintf("echarts4r-box-container-%s", id),
170	7x	htmltools::div(id = id, class = "echarts4rBox", style = style)
171		)
172
173		# add binding and css
174	7x	path <- system.file("box", package = "echarts4r")
175
176	7x	deps <- list(
177	7x	htmltools::htmlDependency(
178	7x	name = "echarts4rBox",
179	7x	version = "1.0.0",
180	7x	src = c(file = path),
181	7x	script = c("box-binding.js")
182		)
183		)
184
185	7x	htmltools::attachDependencies(el, deps)
186		}

1		#' Mark point
2		#'
3		#' Mark points and lines.
4		#'
5		#' @inheritParams e_bar
6		#' @param serie Serie or vector of series to mark on, defaults to all series.
7		#' @param data Placement of point, line or area.
8		#' @param title A convenience argument to easily set label, see details.
9		#' @param title_position Position of title.
10		#'
11		#' @details To set a label you need to either use the \code{title}
12		#' argument or pass a list specifying the label formatter.
13		#' \code{label = list(formatter = "label")}. The former is more convenient
14		#' but more limited, e.g.: you cannot specify the placement of the label.
15		#' When the \code{e_mark} series function is used with \code{e_timeline} at the
16		#' same time, if the number of marks provided does not match the series, the
17		#' mark information will follow the setting of the previous frame.
18		#'
19		#' @examples
20		#' max <- list(
21		#' name = "Max",
22		#' type = "max"
23		#' )
24		#'
25		#' min <- list(
26		#' name = "Min",
27		#' type = "min"
28		#' )
29		#'
30		#' avg <- list(
31		#' type = "average",
32		#' name = "AVG"
33		#' )
34		#'
35		#' mtcars \|>
36		#' e_charts(mpg) \|>
37		#' e_line(wt) \|>
38		#' e_line(drat) \|>
39		#' e_line(cyl) \|>
40		#' e_mark_point("wt", data = max) \|>
41		#' e_mark_point(c("cyl", "drat"), data = min) \|>
42		#' e_mark_line(data = avg) \|> # applies to all
43		#' e_mark_area(
44		#' serie = "wt",
45		#' data = list(
46		#' list(xAxis = "min", yAxis = "min"),
47		#' list(xAxis = "max", yAxis = "max")
48		#' )
49		#' )
50		#'
51		#' # Serie options, since the mark of "virginica" is not set, the mark setting
52		#' # of the previous frame is used
53		#' iris \|>
54		#' group_by(Species) \|>
55		#' e_charts(Sepal.Length, timeline = TRUE) \|>
56		#' e_line(Sepal.Width) \|>
57		#' e_timeline_serie(
58		#' title = list(
59		#' list(text = "setosa"),
60		#' list(text = "versicolor"),
61		#' list(text = "virginica")
62		#' )
63		#' ) \|>
64		#' e_mark_area(
65		#' serie = "setosa",
66		#' data = list(
67		#' list(xAxis = 4, yAxis = 2),
68		#' list(xAxis = 6, yAxis = 4.5)
69		#' ),
70		#' itemStyle = list(color = "lightgreen")
71		#' ) \|>
72		#' e_mark_area(
73		#' serie = "versicolor",
74		#' data = list(
75		#' list(xAxis = 4.5),
76		#' list(xAxis = 7)
77		#' ),
78		#' itemStyle = list(color = "lightblue")
79		#' )
80		#' @seealso \href{https://echarts.apache.org/en/option.html#series-line.markPoint}{Additional point arguments},
81		#' \href{https://echarts.apache.org/en/option.html#series-line.markLine}{Additional line arguments}
82		#'
83		#' @rdname mark
84		#' @export
85		e_mark_point <- function(e, serie = NULL, data = NULL, ..., title = NULL, title_position = NULL) {
86	4x	if (missing(e)) {
87	1x	stop("must pass e", call. = FALSE)
88		}
89
90	3x	if (is.null(serie)) {
91	!	index <- seq_along(if (e$x$tl) e$x$opts$options else e$x$opts$series)
92	3x	} else if (e$x$tl){
93	2x	index <- 1
94		} else {
95	1x	index <- .get_index(e, serie)
96		}
97
98	3x	for (i in index) {
99	3x	point <- list(...)
100
101	3x	if (!is.null(data)) {
102	3x	point$data <- list(data)
103		}
104
105	3x	if (!is.null(title) && !is.null(data)) {
106	1x	point$data[[1]]$label <- list(formatter = title, position = title_position)
107		}
108
109	3x	if (e$x$tl) {
110	2x	for(j in seq_along(e$x$opts$options[[i]]$series)){
111	2x	if (is.null(e$x$opts$options[[i]]$series[[j]]$markPoint)) {
112	1x	e$x$opts$options[[i]]$series[[j]]$markPoint <- append(e$x$opts$options[[i]]$series[[j]]$markPoint, point)
113		} else {
114	1x	e$x$opts$options[[i]]$series[[j]]$markPoint$data <- append(e$x$opts$options[[i]]$series[[j]]$markPoint$data, point$data)
115		}
116		}
117		}
118		else {
119	1x	if (is.null(e$x$opts$series[[i]]$markPoint)) {
120	1x	e$x$opts$series[[i]]$markPoint <- append(e$x$opts$series[[i]]$markPoint, point)
121		} else {
122	!	e$x$opts$series[[i]]$markPoint$data <- append(e$x$opts$series[[i]]$markPoint$data, point$data)
123		}
124		}
125		}
126
127	3x	e
128		}
129
130		#' @rdname mark
131		#' @export
132		e_mark_line <- function(e, serie = NULL, data = NULL, ..., title = NULL, title_position = NULL) {
133	4x	if (missing(e)) {
134	1x	stop("must pass e", call. = FALSE)
135		}
136
137	3x	if (is.null(serie)) {
138	2x	index <- seq_along(if (e$x$tl) e$x$opts$options else e$x$opts$series)
139		} else {
140	1x	index <- .get_index(e, serie)
141		}
142
143	3x	for (i in index) {
144	5x	point <- list(...)
145
146	5x	if (!is.null(data)) {
147	5x	point$data <- list(data)
148		}
149
150	5x	if (!is.null(title) && !is.null(data)) {
151	!	point$data[[1]]$label <- list(formatter = title, position = title_position)
152		}
153
154	5x	if (e$x$tl) {
155	4x	for(j in seq_along(e$x$opts$options[[i]]$series)){
156	4x	if (is.null(e$x$opts$options[[i]]$series[[j]]$markLine)) {
157	2x	e$x$opts$options[[i]]$series[[j]]$markLine <- append(e$x$opts$options[[i]]$series[[j]]$markLine, point)
158		} else {
159	2x	e$x$opts$options[[i]]$series[[j]]$markLine$data <- append(e$x$opts$options[[i]]$series[[j]]$markLine$data, point$data)
160		}
161		}
162		}
163		else {
164	1x	if (is.null(e$x$opts$series[[i]]$markLine)) {
165	1x	e$x$opts$series[[i]]$markLine <- append(e$x$opts$series[[i]]$markLine, point)
166		} else {
167	!	e$x$opts$series[[i]]$markLine$data <- append(e$x$opts$series[[i]]$markLine$data, point$data)
168		}
169		}
170		}
171
172	3x	e
173		}
174
175		#' @rdname mark
176		#' @export
177		e_mark_area <- function(e, serie = NULL, data = NULL, ..., title = NULL, title_position = NULL) {
178	3x	if (missing(e)) {
179	1x	stop("must pass e", call. = FALSE)
180		}
181
182	2x	if (is.null(serie)) {
183	1x	index <- seq_along(if (e$x$tl) e$x$opts$options else e$x$opts$series)
184		} else {
185	1x	index <- .get_index(e, serie)
186		}
187
188	2x	for (i in index) {
189	3x	point <- list(...)
190
191	3x	if (!is.null(data)) {
192	3x	point$data <- list(data)
193		}
194
195	3x	if (!is.null(title) && !is.null(data)) {
196	!	point$data[[1]]$label <- list(formatter = title, position = title_position)
197		}
198
199	3x	if (e$x$tl) {
200	2x	for(j in seq_along(e$x$opts$options[[i]]$series)){
201	2x	if (is.null(e$x$opts$options[[i]]$series[[j]]$markArea)) {
202	2x	e$x$opts$options[[i]]$series[[j]]$markArea <- append(e$x$opts$options[[i]]$series[[j]]$markArea, point)
203		} else {
204	!	e$x$opts$options[[i]]$series[[j]]$markArea$data <- append(e$x$opts$options[[i]]$series[[j]]$markArea$data, point$data)
205		}
206		}
207		}
208		else {
209	1x	if (is.null(e$x$opts$series[[i]]$markArea)) {
210	1x	e$x$opts$series[[i]]$markArea <- append(e$x$opts$series[[i]]$markArea, point)
211		} else {
212	!	e$x$opts$series[[i]]$markArea$data <- append(e$x$opts$series[[i]]$markArea$data, point$data)
213		}
214		}
215		}
216
217	2x	e
218		}
219
220		#' Mark
221		#'
222		#' Mark points, lines, and areas with a proxy ([echarts4rProxy()]).
223		#'
224		#' @inheritParams e_bar
225		#' @param type Type of mark: 'point','line' or 'area', defaults to 'point'.
226		#' @param serie_index Single index of serie to mark on, defaults to 1.
227		#' Proxy doesn't know series' names, so it only uses index.
228		#' @param data Location of point, line or area, defaults to NULL.
229		#'
230		#' @details Allows the three type of marks to work with [echarts4rProxy()]
231		#'
232		#' @examples
233		#' library(shiny)
234		#' library(dplyr)
235		#'
236		#' ui <- fluidPage(
237		#' fluidRow(
238		#' column(3, actionButton("pxy", "Marks")),
239		#' column(
240		#' 3,
241		#' checkboxInput("tln", "Timeline", value = FALSE)
242		#' )
243		#' ),
244		#' echarts4rOutput("plot")
245		#' )
246		#'
247		#' server <- function(input, output) {
248		#' data(EuStockMarkets)
249		#'
250		#' bb <- as.data.frame(EuStockMarkets) \|>
251		#' slice_head(n = 150) \|>
252		#' mutate(day = 1:n())
253		#'
254		#' output$plot <- renderEcharts4r({
255		#' react()
256		#' })
257		#'
258		#' observeEvent(input$pxy, {
259		#' echarts4rProxy("plot", data = NULL) \|>
260		#' e_mark_p(
261		#' type = "line",
262		#' serie_index = 1,
263		#' data = list(type = "average"),
264		#' lineStyle = list(type = "dashed", color = "cyan")
265		#' ) \|>
266		#' e_mark_p(
267		#' serie_index = 2,
268		#' data = list(
269		#' xAxis = bb$day[60],
270		#' yAxis = bb$SMI[60],
271		#' value = "pnt"
272		#' )
273		#' ) \|>
274		#' e_mark_p(
275		#' type = "line",
276		#' serie_index = 2,
277		#' data = list(
278		#' list(xAxis = bb$day[10], yAxis = bb$SMI[10]),
279		#' list(xAxis = bb$day[37], yAxis = bb$SMI[37])
280		#' ),
281		#' lineStyle = list(type = "solid", color = "yellow")
282		#' ) \|>
283		#' e_mark_p(
284		#' type = "area",
285		#' serie_index = 1,
286		#' data = list(
287		#' list(xAxis = bb$day[95]),
288		#' list(xAxis = bb$day[105])
289		#' ),
290		#' itemStyle = list(color = "lightblue"),
291		#' label = list(formatter = "X-area", position = "middle")
292		#' ) \|>
293		#' e_merge()
294		#' })
295		#'
296		#' react <- eventReactive(input$tln, {
297		#' tmp <- bb
298		#' if (input$tln) tmp <- tmp \|> group_by(day < 75)
299		#'
300		#' tmp \|>
301		#' e_charts(
302		#' day,
303		#' backgroundColor = "#181818",
304		#' legend = list(textStyle = list(color = "#aaa")),
305		#' timeline = input$tln
306		#' ) \|>
307		#' e_y_axis(scale = TRUE, axisLabel = list(color = "#aaa")) \|>
308		#' e_line(CAC, symbol = "none", color = "#ff33b8") \|>
309		#' e_line(SMI, symbol = "none", color = "green")
310		#' })
311		#' }
312		#' if (interactive()) {
313		#' shinyApp(ui, server)
314		#' }
315		#' @name e_mark_p
316		#' @export
317	2x	e_mark_p <- function(e, type, serie_index, data, ...) UseMethod("e_mark_p")
318
319		#' @method e_mark_p echarts4r
320		#' @export
321		e_mark_p.echarts4r <- function(e, type = "point", serie_index = NULL, data = NULL, ...) {
322	1x	if (missing(e)) stop("must pass e", call. = FALSE)
323	2x	e_mark_p_(e, type, serie_index, data, ...)
324		}
325
326		#' @method e_mark_p echarts4rProxy
327		#' @export
328		e_mark_p.echarts4rProxy <- function(e, type = "point", serie_index = NULL, data = NULL, ...) {
329	!	e$chart <- e_mark_p_(e$chart, type, serie_index, data, ...)
330	!	return(e)
331		}
332
333		#' @rdname e_mark_p
334		#' @export
335		e_mark_p_ <- function(e, type, serie_index, data = NULL, ...) {
336	1x	if (missing(e)) stop("must pass e", call. = FALSE)
337	1x	if (missing(type)) stop("must pass type", call. = FALSE)
338	3x	mtype <- type
339
340	1x	if (!mtype %in% c("point", "line", "area")) stop("type must be line,point or area", call. = FALSE)
341	2x	if (!startsWith(mtype, "mark")) {
342	2x	mtype <- switch(type, "point" = "markPoint", "line" = "markLine", "area" = "markArea")
343		}
344
345	2x	index <- ifelse(is.null(serie_index), 1, as.numeric(serie_index))
346
347	2x	for (i in 1:index) {
348	2x	if (length(e$x$opts$series) < i) {
349	1x	e$x$opts$series[[i]] <- list()
350		} # init
351	!	if (i < index) next
352
353	2x	point <- list(...)
354
355	2x	if (!is.null(data)) point$data <- list(data)
356
357	2x	suppressWarnings( # eval generates redundant warnings
358	2x	if (e$x$tl) {
359	1x	if (mtype %in% names(e$x$opts$options[[i]]$series[[1]])) {
360	!	eval(parse(text = paste0("e$x$opts$options[[i]]$series[[1]]$", mtype, "$data <- append(e$x$opts$options[[i]]$series[[1]]$", mtype, "$data, point$data)")))
361		} else {
362	1x	eval(parse(text = paste0("e$x$opts$options[[i]]$series[[1]]$", mtype, " <- point")))
363		}
364		}
365		else {
366	1x	if (mtype %in% names(e$x$opts$series[[i]])) {
367	!	eval(parse(text = paste0("e$x$opts$series[[i]]$", mtype, "$data <- append(e$x$opts$series[[i]]$", mtype, "$data, point$data)")))
368		} else {
369	1x	eval(parse(text = paste0("e$x$opts$series[[i]]$", mtype, " <- point")))
370		}
371		}
372		)
373		}
374	2x	e
375		}

1		#' Graphic
2		#'
3		#' Low level API to define graphic elements.
4		#'
5		#' @inheritParams e_bar
6		#'
7		#' @section Functions:
8		#' \itemize{
9		#' \item{\code{e_graphic_g} to initialise graphics, entirely optional.}
10		#' \item{\code{e_group_g} to create group, the children of which will share attributes.}
11		#' \item{\code{e_image_g} to a png or jpg image.}
12		#' \item{\code{e_text_g} to add text.}
13		#' \item{\code{e_rect_g} to add a rectangle.}
14		#' \item{\code{e_circle_g} to add a circle.}
15		#' \item{\code{e_ring_g} to add a ring.}
16		#' \item{\code{e_sector_g}}
17		#' \item{\code{e_arc_g} to create an arc.}
18		#' \item{\code{e_polygon_g} to create a polygon.}
19		#' \item{\code{e_polyline_g} to create a polyline.}
20		#' \item{\code{e_line_g} to draw a line.}
21		#' \item{\code{e_bezier_curve_g} to draw a quadratic bezier curve or cubic bezier curve.}
22		#' }
23		#'
24		#' @note Some elements, i.e.: \code{e_image_g} may not display in the RStudio
25		#' browwser but will work fine in your browser, R markdown documents and Shiny
26		#' applications.
27		#'
28		#' @examples
29		#' # may not work in RStudio viewer
30		#' # Open in browser
31		#' cars \|>
32		#' e_charts(speed) \|>
33		#' e_scatter(dist) \|>
34		#' e_image_g(
35		#' right = 20,
36		#' top = 20,
37		#' z = -999,
38		#' style = list(
39		#' image = "https://www.r-project.org/logo/Rlogo.png",
40		#' width = 150,
41		#' height = 150,
42		#' opacity = .6
43		#' )
44		#' )
45		#'
46		#' anno_text <-
47		#' 'xAxis represents miles per gallon, yAxis represents weight in tonnes.'
48		#' # Position does change depending on window size.
49		#' mtcars \|>
50		#' e_charts(mpg) \|>
51		#' e_line(wt) \|>
52		#' e_group_g(
53		#' left = '18%',
54		#' top = '55%',
55		#' children = list(
56		#' # Background rectangle
57		#' list(
58		#' type = 'rect',
59		#' z = 100,
60		#' left = 'center',
61		#' top = 'middle',
62		#' shape = list(
63		#' width = 240,
64		#' height = 70
65		#' ),
66		#' style = list(
67		#' fill = '#fff',
68		#' stroke = '#555',
69		#' lineWidth = 1,
70		#' shadowBlur = 8,
71		#' shadowOffsetX = 3,
72		#' shadowOffsetY = 3,
73		#' shadowColor = 'rgba(0,0,0,0.2)'
74		#' )
75		#' ),
76		#' # Text element
77		#' list(
78		#' type = 'text',
79		#' z = 100,
80		#' left = 'center',
81		#' top = 'middle',
82		#' style = list(
83		#' fill = '#333',
84		#' width = 220,
85		#' overflow = 'break',
86		#' text = anno_text,
87		#' font = '14px Microsoft YaHei'
88		#' )
89		#' )
90		#' )
91		#' )
92		#' #' @seealso \href{https://echarts.apache.org/en/option.html#graphic}{official documentation}
93		#'
94		#' @rdname graphic
95		#' @export
96		e_graphic_g <- function(e, ...) {
97	3x	if (missing(e)) {
98	1x	stop("must pass e", call. = FALSE)
99		}
100
101	2x	if (!e$x$tl) {
102	1x	e$x$opts$graphic <- list(...)
103		} else {
104	1x	e$x$opts$baseOption$graphic <- list(...)
105		}
106	2x	e
107		}
108
109		#' @rdname graphic
110		#' @export
111		e_group_g <- function(e, ...) {
112	2x	if (missing(e)) {
113	1x	stop("must pass e", call. = FALSE)
114		}
115
116	1x	.e_graphic_elem(e, "group", ...)
117		}
118
119		#' @rdname graphic
120		#' @export
121		e_image_g <- function(e, ...) {
122	2x	if (missing(e)) {
123	1x	stop("must pass e", call. = FALSE)
124		}
125
126	1x	.e_graphic_elem(e, "image", ...)
127		}
128
129		#' @rdname graphic
130		#' @export
131		e_text_g <- function(e, ...) {
132	3x	if (missing(e)) {
133	1x	stop("must pass e", call. = FALSE)
134		}
135
136	2x	.e_graphic_elem(e, "text", ...)
137		}
138
139		#' @rdname graphic
140		#' @export
141		e_rect_g <- function(e, ...) {
142	2x	if (missing(e)) {
143	1x	stop("must pass e", call. = FALSE)
144		}
145
146	1x	.e_graphic_elem(e, "rect", ...)
147		}
148
149		#' @rdname graphic
150		#' @export
151		e_circle_g <- function(e, ...) {
152	2x	if (missing(e)) {
153	1x	stop("must pass e", call. = FALSE)
154		}
155
156	1x	.e_graphic_elem(e, "circle", ...)
157		}
158
159		#' @rdname graphic
160		#' @export
161		e_ring_g <- function(e, ...) {
162	2x	if (missing(e)) {
163	1x	stop("must pass e", call. = FALSE)
164		}
165
166	1x	.e_graphic_elem(e, "ring", ...)
167		}
168
169		#' @rdname graphic
170		#' @export
171		e_sector_g <- function(e, ...) {
172	2x	if (missing(e)) {
173	1x	stop("must pass e", call. = FALSE)
174		}
175
176	1x	.e_graphic_elem(e, "sector", ...)
177		}
178
179		#' @rdname graphic
180		#' @export
181		e_arc_g <- function(e, ...) {
182	2x	if (missing(e)) {
183	1x	stop("must pass e", call. = FALSE)
184		}
185
186	1x	.e_graphic_elem(e, "arc", ...)
187		}
188
189		#' @rdname graphic
190		#' @export
191		e_polygon_g <- function(e, ...) {
192	2x	if (missing(e)) {
193	1x	stop("must pass e", call. = FALSE)
194		}
195
196	1x	.e_graphic_elem(e, "polygon", ...)
197		}
198
199		#' @rdname graphic
200		#' @export
201		e_polyline_g <- function(e, ...) {
202	2x	if (missing(e)) {
203	1x	stop("must pass e", call. = FALSE)
204		}
205
206	1x	.e_graphic_elem(e, "polyline", ...)
207		}
208
209		#' @rdname graphic
210		#' @export
211		e_line_g <- function(e, ...) {
212	2x	if (missing(e)) {
213	1x	stop("must pass e", call. = FALSE)
214		}
215
216	1x	.e_graphic_elem(e, "line", ...)
217		}
218
219		#' @rdname graphic
220		#' @export
221		e_bezier_curve_g <- function(e, ...) {
222	2x	if (missing(e)) {
223	1x	stop("must pass e", call. = FALSE)
224		}
225
226	1x	.e_graphic_elem(e, "bezierCurve", ...)
227		}
228
229		#' Draft
230		#'
231		#' Add a draft watermark to your graph.
232		#'
233		#' @inheritParams e_bar
234		#' @param text Text to display.
235		#' @param size Font size of text.
236		#' @param opacity,color Opacity and color of text.
237		#'
238		#' @examples
239		#' cars \|>
240		#' e_charts(speed) \|>
241		#' e_scatter(dist) \|>
242		#' e_draft()
243		#' @export
244		e_draft <- function(e, text = "DRAFT", size = "120px", opacity = 0.4, color = "#d3d3d3") {
245	2x	if (missing(e)) {
246	1x	stop("must pass e", call. = FALSE)
247		}
248	1x	e \|>
249	1x	e_text_g(
250	1x	left = "center",
251	1x	top = "center",
252	1x	z = -1000,
253	1x	style = list(
254	1x	fill = color,
255	1x	text = text,
256	1x	font = paste(size, '"STHeiti", sans-serif'),
257	1x	opacity = opacity
258		)
259		)
260		}

1		# group2series
2		map_grps_ <- function(data, timeline = FALSE) {
3
4	613x	row.names(data) <- NULL
5
6	613x	if (dplyr::is.grouped_df(data)) {
7	124x	splat <- dplyr::group_split(data)
8	124x	keys <- dplyr::group_keys(data)[[1]]
9	124x	splat <- purrr::map(splat, as.data.frame)
10	124x	names(splat) <- keys
11
12	124x	data <- splat
13	489x	} else if (inherits(data, "grouped_tt")) {
14	1x	splat <- split(data, factor(data[[attr(data, "groups")]]))
15	1x	keys <- names(splat)
16	1x	splat <- purrr::map(splat, as.data.frame)
17	1x	names(splat) <- keys
18	1x	data <- splat
19		} else {
20	488x	if (inherits(data, "data.frame")) {
21	484x	data <- as.data.frame(data)
22		} # force data frame
23
24	488x	data <- list(data)
25		}
26
27		# Remove row names and now row.names is just the index
28	613x	.no_nm <- function(x) {
29	937x	row.names(x) <- NULL
30	937x	return(x)
31		}
32
33	613x	data <- lapply(data, .no_nm)
34
35	613x	return(data)
36		}

1		#' Themes
2		#'
3		#' Add a custom theme or apply a pre-built one.
4		#'
5		#' @inheritParams e_bar
6		#' @param theme Theme, A json string or a see below.
7		#' @param name Name of theme.
8		#'
9		#' @section Functions:
10		#' \itemize{
11		#' \item{\code{e_theme} - Use a default theme by name.}
12		#' \item{\code{e_theme_custom} - Use a custom theme.}
13		#' \item{\code{e_theme_register} - Register a theme globally in shiny or R markdown.}
14		#' }
15		#'
16		#' @details The function \code{e_theme_register} can be used to register the theme globally
17		#' in R markdown or shiny (UI). This is useful because 1) the \code{e_theme_custom} registers the
18		#' theme every time and is more computationally expensive.
19		#'
20		#' @examples
21		#' mtcars \|>
22		#' e_charts(mpg) \|>
23		#' e_line(disp) \|>
24		#' e_area(hp) \|>
25		#' e_x_axis(min = 10) -> p
26		#'
27		#' p \|> e_theme("chalk")
28		#' p \|> e_theme_custom('{"color":["#ff715e","#ffaf51"]}')
29		#' @seealso \href{https://echarts.apache.org/en/theme-builder.html}{create your own theme}.
30		#'
31		#' @rdname theme
32		#' @export
33		e_theme <- function(
34		e,
35		name = c("auritus", "azul", "bee-inspired", "blue", "caravan", "carp",
36		"chalk", "cool", "dark", "dark-blue", "dark-bold", "dark-digerati", "dark-fresh-cut",
37		"dark-mushroom", "eduardo", "essos", "forest", "fresh-cut",
38		"fruit", "gray", "green", "halloween", "helianthus", "infographic",
39		"inspired", "jazz", "london", "macarons", "macarons2", "mint",
40		"purple-passion", "rainbow", "red", "red-velvet", "roma", "royal", "sakura",
41		"shine", "tech-blue", "v5", "vintage", "walden", "wef", "weforum",
42		"westeros", "wonderland"
43		)
44		) {
45		# cannot match.arg we need to support custom themes
46	2x	name <- name[1]
47
48		# add name to register
49	2x	e$x$theme <- name
50
51		# add dependency
52	2x	path <- system.file("htmlwidgets/lib/echarts-6.1.0/themes", package = "echarts4r")
53	2x	dep <- htmltools::htmlDependency(
54	2x	name = name,
55	2x	version = "1.0.0",
56	2x	src = c(file = path),
57	2x	script = paste0(name, ".js")
58		)
59
60	2x	e$dependencies <- append(e$dependencies, list(dep))
61	2x	e
62		}
63
64		#' @rdname theme
65		#' @export
66		e_theme_custom <- function(e, theme, name = "custom") {
67	4x	if (missing(theme)) {
68	1x	stop("must pass `theme`", call. = FALSE)
69		}
70
71	3x	if (grepl("\\.json", theme)) {
72	1x	theme <- readLines(theme) # read the file
73	1x	theme <- paste0(theme, collapse = "") # collapse to a string
74		}
75
76	3x	e$x$theme2 <- TRUE
77	3x	e$x$customTheme <- theme
78	3x	e$x$theme <- "custom"
79	3x	e$x$theme_name <- name
80	3x	e
81		}
82
83		#' @rdname theme
84		#' @export
85		e_theme_register <- function(theme, name = "custom") {
86	5x	if (missing(theme)) {
87	1x	stop("must pass `theme`", call. = FALSE)
88		}
89
90	4x	if (grepl("\\.json", theme)) {
91	1x	theme <- readLines(theme) # read the file
92	1x	theme <- paste0(theme, collapse = "") # collapse to a string
93		}
94
95	4x	shiny::singleton(
96	4x	shiny::tags$head(
97	4x	shiny::tags$script(
98	4x	paste0("window.echarts.registerTheme('", name, "', ", theme, ");")
99		)
100		)
101		)
102		}

1		#' Timeline
2		#'
3		#' Set timeline options
4		#'
5		#' @inheritParams e_bar
6		#' @param axis_type Type of axis, \code{time}, \code{value}, or \code{category}.
7		#' @param index The index of the element to apply options to, see examples.
8		#' @param serie_index The index of the serie to add elements to.
9		#' @param ... Named options.
10		#'
11		#' @section Functions:
12		#' \itemize{
13		#' \item{\code{e_timeline_opts}: Pass general timeline options, see \href{https://echarts.apache.org/en/option.html#timeline}{official documentation}.}
14		#' \item{\code{e_timeline_serie}: Pass options to each serie, each options \emph{must} be a vector or list the same length as their are steps, see examples.}
15		#' \item{\code{e_timeline_make}: Helper function that wraps your data and \code{e_timeline_serie} to dynamically add options to series.}
16		#' }
17		#'
18		#' @examples
19		#' # general options
20		#' iris \|>
21		#' group_by(Species) \|>
22		#' e_charts(Sepal.Length, timeline = TRUE) \|>
23		#' e_line(Sepal.Width) \|>
24		#' e_timeline_opts(
25		#' autoPlay = TRUE,
26		#' rewind = TRUE
27		#' )
28		#'
29		#' # serie options
30		#' iris \|>
31		#' group_by(Species) \|>
32		#' e_charts(Sepal.Length, timeline = TRUE) \|>
33		#' e_line(Sepal.Width) \|>
34		#' e_timeline_serie(
35		#' title = list(
36		#' list(text = "setosa"),
37		#' list(text = "versicolor"),
38		#' list(text = "virginica")
39		#' )
40		#' )
41		#' @name timeline-opts
42		#' @export
43		e_timeline_opts <- function(e, axis_type = "category", ...) {
44	3x	if (missing(e)) {
45	1x	stop("must pass e", call. = FALSE)
46		}
47
48	2x	if (!e$x$tl) {
49	1x	warning("timeline not enabled in e_chart", call. = FALSE)
50		}
51
52	2x	e$x$opts$baseOption$timeline$axisType <- axis_type
53
54	2x	e$x$opts$baseOption$timeline <- append(e$x$opts$baseOption$timeline, list(...))
55
56	2x	e
57		}
58
59		#' @name timeline-opts
60		#' @export
61		e_timeline_serie <- function(e, ..., index = 1) {
62	16x	if (missing(e)) {
63	1x	stop("must pass e", call. = FALSE)
64		}
65
66	15x	args <- list(...)
67
68	15x	if (length(args) == 0) {
69	1x	stop("no arguments passed", call. = FALSE)
70		}
71
72	14x	for (i in seq_along(e$x$opts$options)) {
73	37x	for (j in seq_along(args)) {
74	37x	if (!length(e$x$opts$options[[i]][[names(args)[j]]]) < index) {
75	!	e$x$opts$options[[i]][[names(args)[j]]][[index]] <- list()
76		}
77	37x	e$x$opts$options[[i]][[names(args)[j]]][[index]] <- args[[j]][[i]]
78		}
79		}
80
81	13x	e
82		}
83
84		#' @name timeline-opts
85		#' @export
86		e_timeline_on_serie <- function(e, ..., serie_index) {
87	3x	if (missing(e) \|\| missing(serie_index)) {
88	1x	stop("must pass e or serie_index", call. = FALSE)
89		}
90
91	2x	args <- list(...)
92
93	2x	if (length(args) == 0) {
94	!	stop("no arguments passed", call. = FALSE)
95		}
96
97	2x	for (i in seq_along(e$x$opts$options)) {
98	6x	for (j in seq_along(args)) {
99	9x	if (!length(e$x$opts$options[[i]]$series[[serie_index]][[names(args)[j]]]) < serie_index) {
100	!	e$x$opts$options[[i]]$series[[serie_index]][[names(args)[j]]] <- list()
101		}
102	9x	e$x$opts$options[[i]]$series[[serie_index]][[names(args)[j]]] <- args[[j]][[i]]
103		}
104		}
105
106	2x	e
107		}

1		#' Leaflet
2		#'
3		#' Leaflet extension.
4		#'
5		#' @inheritParams e_bar
6		#' @param roam Whether to allow the user to roam.
7		#' @param template \code{urlTemplate}, should not be changed.
8		#' @param options List of options, including \code{attribution} and \code{label}.
9		#'
10		#' @examples
11		#' population \|>
12		#' dplyr::filter(value > 8) \|>
13		#' e_charts(lon) \|>
14		#' e_leaflet() \|>
15		#' e_leaflet_tile(options = list(maxZoom = 3)) \|>
16		#' e_scatter(lat, size = value, coord_system = "leaflet")
17		#'
18		#' @rdname leaflet
19		#' @export
20		e_leaflet <- function(e, roam = TRUE, ...) {
21	12x	leaf <- list(...)
22	12x	leaf$roam <- roam
23	12x	leaf$tiles <- list()
24
25		# remove axis
26	12x	e <- .rm_axis(e, TRUE, "x")
27	12x	e <- .rm_axis(e, TRUE, "y")
28
29	12x	e$x$opts$leaflet <- leaf
30
31		# add dependency
32	12x	path <- system.file("htmlwidgets/lib/echarts-6.1.0/plugins", package = "echarts4r")
33
34	12x	dep <- htmltools::htmlDependency(
35	12x	name = "leaflet",
36	12x	version = "1.9.4",
37	12x	src = c(file = path),
38	12x	stylesheet = "leaflet.css",
39	12x	script = "leaflet.js"
40		)
41
42	12x	dep2 <- htmltools::htmlDependency(
43	12x	name = "echarts-leaflet",
44	12x	version = "1.0.0",
45	12x	src = c(file = path),
46	12x	script = "echarts-leaflet.js"
47		)
48
49	12x	e$dependencies <- append(e$dependencies, htmlwidgets::getDependency("leaflet"))
50	12x	e$dependencies <- append(e$dependencies, list(dep, dep2))
51
52	12x	e
53		}
54
55		#' @rdname leaflet
56		#' @export
57		e_leaflet_tile <- function(
58		e,
59		template = "https://{s}.tile.openstreetmap.fr/hot/{z}/{x}/{y}.png",
60		options = NULL,
61		...
62		) {
63	8x	pkgs <- utils::installed.packages() \|> rownames()
64	8x	if (!"leaflet" %in% pkgs) {
65	1x	stop("Requires the `leaflet` package installed", call. = FALSE)
66		}
67
68	7x	if (!length(e$x$opts$leaflet$roam)) {
69	1x	e <- e_leaflet(e)
70		}
71
72	7x	tile <- list(...)
73	7x	tile$urlTemplate <- template
74
75	7x	if (!is.null(options)) {
76	2x	tile$options <- options
77		}
78
79	7x	e$x$opts$leaflet$tiles <- list(tile)
80
81	7x	e
82		}

1		#' Axis
2		#'
3		#' Customise axis.
4		#'
5		#' @inheritParams e_bar
6		#' @param axis Axis to customise.
7		#' @param serie Column name of serie to range the axis. If used the range of the serie is used as,
8		#' \code{min} an \code{max}.
9		#' @param margin Margin to apply to \code{serie}: \eqn{min = serie - margin} and
10		#' \eqn{max = serie + margin}
11		#' @param index Index of axis to customise.
12		#' @param formatter An axis formatter as returned by \code{\link{e_axis_formatter}}.
13		#' @param style Formatter style, one of \code{decimal}, \code{percent}, or \code{currency}.
14		#' @param currency Currency to to display.
15		#' @param digits Number of decimals.
16		#' @param locale Locale, if \code{NULL} then it is inferred from \code{Sys.getlocale}.
17		#'
18		#' @section Functions:
19		#' \itemize{
20		#' \item{\code{e_axis} to customise axis}
21		#' \item{\code{e_rm_axis} to remove axis}
22		#' }
23		#'
24		#' @details The \code{e_axis_formatter} may not work in RStudio,
25		#' open the plot in your browser. It will display just fine in
26		#' Rmarkdown and Shiny.
27		#'
28		#' @examples
29		#' # range axis based on serie
30		#' cars \|>
31		#' e_charts(speed) \|>
32		#' e_line(dist) \|>
33		#' e_x_axis(speed) \|>
34		#' e_y_axis(dist)
35		#'
36		#' # use formatter
37		#' cars \|>
38		#' dplyr::mutate(
39		#' speed = speed / 25
40		#' ) \|>
41		#' e_charts(speed) \|>
42		#' e_scatter(dist) \|>
43		#' e_y_axis(
44		#' formatter = e_axis_formatter("currency")
45		#' ) \|>
46		#' e_x_axis(
47		#' formatter = e_axis_formatter("percent", digits = 0)
48		#' )
49		#'
50		#' # plot all labels & rotate
51		#' USArrests \|>
52		#' head(10) \|>
53		#' tibble::rownames_to_column(var = "State") \|>
54		#' e_charts(State) \|>
55		#' e_area(Murder) \|>
56		#' e_x_axis(axisLabel = list(interval = 0, rotate = 45)) # rotate
57		#' @seealso \href{https://echarts.apache.org/en/option.html#xAxis}{Additional x arguments},
58		#' \href{https://echarts.apache.org/en/option.html#yAxis}{Additional y arguments}
59		#'
60		#' @rdname axis
61		#' @export
62		e_axis <- function(e, serie, axis = c("x", "y", "z"), index = 0, formatter = NULL, margin = 0, ...) {
63	44x	if (missing(serie)) {
64	43x	serie <- NULL
65		} else {
66	1x	serie <- deparse(substitute(serie))
67		}
68
69	44x	e_axis_(e, serie = serie, axis = axis, index = index, formatter = formatter, margin = margin, ...)
70		}
71
72		#' @rdname axis
73		#' @export
74		e_axis_ <- function(e, serie = NULL, axis = c("x", "y", "z"), index = 0, formatter = NULL, margin = 0, ...) {
75	86x	if (missing(e)) {
76	1x	stop("must pass e", call. = FALSE)
77		}
78
79	85x	axis <- .r2axis(axis[1])
80
81	85x	r.index <- index + 1
82	85x	max <- length(e$x$opts[[axis]])
83
84	85x	attrs <- list(...)
85
86	85x	if (!is.null(serie)) {
87	2x	dat <- .get_data(e, serie)
88	2x	if (inherits(dat, "numeric") \|\| inherits(dat, "integer")) {
89	2x	rng <- range(dat)
90		# If min or max is provided, that will replace the min/max in the data
91	2x	if(!is.null(attrs$min)){
92	1x	rng[1] <- attrs$min
93		}
94	2x	if(!is.null(attrs$max)){
95	1x	rng[2] <- attrs$max
96		}
97
98	2x	attrs$min <- rng[1] - margin
99	2x	attrs$max <- rng[2] + margin
100		}
101		}
102
103	85x	if (!is.null(formatter)) {
104	1x	attrs$axisLabel$formatter <- formatter
105		}
106
107	85x	if (!length(attrs)) {
108	1x	stop("no attribute", call. = FALSE)
109		}
110
111		# initiatlise if wrong index
112	84x	if (r.index > max) {
113	11x	r.index <- 1
114		}
115
116	84x	if (!e$x$tl) {
117	78x	dp <- .list_depth(e$x$opts[[axis]])
118		} else {
119	6x	dp <- .list_depth(e$x$opts$baseOption[[axis]])
120		}
121
122	84x	if (dp >= 2) {
123	77x	for (i in seq_along(attrs)) {
124	131x	arg <- names(attrs)[i]
125	131x	if (!e$x$tl) {
126	125x	e$x$opts[[axis]][[r.index]][[arg]] <- attrs[[i]]
127		} else {
128	6x	e$x$opts$baseOption[[axis]][[r.index]][[arg]] <- attrs[[i]]
129		}
130		}
131		} else {
132	7x	for (i in seq_along(attrs)) {
133	7x	arg <- names(attrs)[i]
134	7x	if (!e$x$tl) {
135	6x	e$x$opts[[axis]][[arg]] <- attrs[[i]]
136		} else {
137	1x	e$x$opts$baseOption[[axis]][[arg]] <- attrs[[i]]
138		}
139		}
140		}
141
142	84x	e
143		}
144
145		#' @rdname axis
146		#' @export
147		e_x_axis_ <- function(e, serie = NULL, index = 0, formatter = NULL, margin = 0, ...) {
148	2x	if (missing(e)) {
149	1x	stop("must pass e", call. = FALSE)
150		}
151	1x	e_axis_(e, serie, "x", index, formatter, margin = margin, ...)
152		}
153
154		#' @rdname axis
155		#' @export
156		e_y_axis_ <- function(e, serie = NULL, index = 0, formatter = NULL, margin = 0, ...) {
157	2x	if (missing(e)) {
158	1x	stop("must pass e", call. = FALSE)
159		}
160	1x	e_axis_(e = e, serie = serie, axis = "y", index = index, formatter, margin = margin, ...)
161		}
162
163		#' @rdname axis
164		#' @export
165		e_z_axis_ <- function(e, serie = NULL, index = 0, margin = 0, ...) {
166	2x	if (missing(e)) {
167	1x	stop("must pass e", call. = FALSE)
168		}
169	1x	e_axis_(e = e, serie = serie, axis = "z", index = index, margin = margin, ...)
170		}
171
172
173		#' @rdname axis
174		#' @export
175		e_x_axis <- function(e, serie, index = 0, formatter = NULL, margin = 0, ...) {
176	18x	if (missing(e)) {
177	1x	stop("must pass e", call. = FALSE)
178		}
179
180	17x	if (missing(serie)) {
181	17x	serie <- NULL
182		} else {
183	!	serie <- deparse(substitute(serie))
184		}
185
186	17x	e_axis_(e, serie, "x", index, formatter, margin = margin, ...)
187		}
188
189		#' @rdname axis
190		#' @export
191		e_y_axis <- function(e, serie, index = 0, formatter = NULL, margin = 0, ...) {
192	14x	if (missing(e)) {
193	1x	stop("must pass e", call. = FALSE)
194		}
195
196	13x	if (missing(serie)) {
197	13x	serie <- NULL
198		} else {
199	!	serie <- deparse(substitute(serie))
200		}
201
202	13x	e_axis_(e = e, serie = serie, axis = "y", index = index, formatter, margin = margin, ...)
203		}
204
205		#' @rdname axis
206		#' @export
207		e_z_axis <- function(e, serie, index = 0, margin = 0, ...) {
208	2x	if (missing(e)) {
209	1x	stop("must pass e", call. = FALSE)
210		}
211
212	1x	if (missing(serie)) {
213	1x	serie <- NULL
214		} else {
215	!	serie <- deparse(substitute(serie))
216		}
217
218	1x	e_axis_(e = e, serie = serie, axis = "z", index = index, margin = margin, ...)
219		}
220
221		#' @rdname axis
222		#' @export
223		e_rm_axis <- function(e, axis = c("x", "y", "z")) {
224	1x	match.arg(axis, c("x", "y", "z"))
225	1x	axis <- .r2axis(axis[1])
226
227	1x	e$x$opts[[axis]] <- NULL
228
229	1x	return(e)
230		}
231
232		#' @rdname axis
233		#' @export
234		e_axis_formatter <- function(
235		style = c("decimal", "percent", "currency"),
236		digits = 0,
237		locale = NULL,
238		currency = "USD"
239		) {
240	8x	if (rstudioapi::isAvailable()) {
241	1x	warning("`e_axis_formatter` breaks the plot in RStudio, open it in your browser.", call. = FALSE)
242		}
243
244	8x	if (is.null(locale)) {
245	7x	locale <- .get_locale()
246		}
247
248	8x	style <- match.arg(style)
249	8x	opts <- list(
250	8x	style = style,
251	8x	minimumFractionDigits = digits,
252	8x	maximumFractionDigits = digits,
253	8x	currency = currency
254		)
255	8x	htmlwidgets::JS(sprintf("function(value, index) {
256	8x	var fmt = new Intl.NumberFormat('%s', %s);
257	8x	return fmt.format(value);
258	8x	}", locale, jsonlite::toJSON(opts, auto_unbox = TRUE)))
259		}
260
261		#' Grid
262		#'
263		#' Customise grid.
264		#'
265		#' @inheritParams e_bar
266		#' @inheritParams e_axis
267		#'
268		#' @examples
269		#' USArrests \|>
270		#' e_charts(UrbanPop) \|>
271		#' e_line(Assault, smooth = TRUE) \|>
272		#' e_area(Murder, y_index = 1, x_index = 1) \|>
273		#' e_y_axis(gridIndex = 1) \|>
274		#' e_x_axis(gridIndex = 1) \|>
275		#' e_grid(height = "40%") \|>
276		#' e_grid(height = "40%", top = "55%")
277		#' @seealso \href{https://echarts.apache.org/en/option.html#grid}{Additional arguments}
278		#'
279		#' @export
280		e_grid <- function(e, index = NULL, ...) {
281	28x	if (missing(e)) {
282	1x	stop("must pass e", call. = FALSE)
283		}
284
285	27x	if (is.null(index)) {
286	27x	index <- length(e$x$opts[["grid"]]) + 1
287		}
288
289	27x	attrs <- list(...)
290
291		# initialise of not existing
292	27x	if (!e$x$tl) {
293	27x	if (!length(e$x$opts[["grid"]])) {
294	11x	e$x$opts$grid <- list()
295		}
296
297	27x	e$x$opts$grid <- append(e$x$opts$grid, list(attrs))
298		} else {
299	!	if (!length(e$x$opts$baseOption[["grid"]])) {
300	!	e$x$opts$baseOption$grid <- list()
301		}
302
303	!	e$x$opts$baseOption$grid <- append(e$x$opts$baseOption$grid, list(attrs))
304		}
305
306	27x	e
307		}
308
309		#' Radius axis
310		#'
311		#' Customise radius axis.
312		#'
313		#' @inheritParams e_bar
314		#' @param serie Serie to use as axis labels.
315		#' @param show Whether to display the axis.
316		#'
317		#' @examples
318		#' df <- data.frame(x = LETTERS[1:10], y = seq(1, 20, by = 2))
319		#'
320		#' df \|>
321		#' e_charts(x) \|>
322		#' e_polar() \|>
323		#' e_angle_axis() \|>
324		#' e_radius_axis(x) \|>
325		#' e_bar(y, coord_system = "polar")
326		#' @seealso \href{https://echarts.apache.org/en/option.html#radiusAxis}{Additional arguments}
327		#'
328		#' @export
329		#' @name radius_axis
330		e_radius_axis <- function(e, serie, show = TRUE, ...) {
331	10x	if (missing(e)) {
332	1x	stop("must pass e", call. = FALSE)
333		}
334
335	9x	opts <- list(show = show, ...)
336
337	9x	if (!missing(serie)) {
338	1x	sr <- deparse(substitute(serie))
339		}
340
341	9x	if (!missing(serie)) {
342	1x	opts$data <- e$x$data \|>
343	1x	purrr::map(sr) \|>
344	1x	unlist() \|>
345	1x	unname() \|>
346	1x	unique() \|>
347	1x	as.list()
348		}
349
350	9x	if (!e$x$tl) {
351	8x	e$x$opts$radiusAxis <- opts
352		} else {
353	1x	e$x$opts$baseOption$radiusAxis <- opts
354		}
355
356	9x	e
357		}
358
359		#' @rdname radius_axis
360		#' @export
361		e_radius_axis_ <- function(e, serie = NULL, show = TRUE, ...) {
362	3x	if (missing(e)) {
363	1x	stop("must pass e", call. = FALSE)
364		}
365
366	2x	opts <- list(show = show, ...)
367
368	2x	if (!is.null(serie)) {
369	1x	opts$data <- e$x$data \|>
370	1x	purrr::map(serie) \|>
371	1x	unlist() \|>
372	1x	unname() \|>
373	1x	unique() \|>
374	1x	as.list()
375		}
376
377	2x	if (!e$x$tl) {
378	2x	e$x$opts$radiusAxis <- opts
379		} else {
380	!	e$x$opts$baseOption$radiusAxis <- opts
381		}
382
383	2x	e
384		}
385
386		#' Angle axis
387		#'
388		#' Customise angle axis.
389		#'
390		#' @inheritParams e_bar
391		#' @param serie Serie to use as axis labels.
392		#' @param show Whether to display the axis.
393		#'
394		#' @examples
395		#' df <- data.frame(x = 1:100, y = seq(1, 200, by = 2))
396		#'
397		#' df \|>
398		#' e_charts(x) \|>
399		#' e_polar(FALSE) \|>
400		#' e_angle_axis(FALSE) \|>
401		#' e_radius_axis(FALSE) \|>
402		#' e_line(y, coord_system = "polar", smooth = TRUE) \|>
403		#' e_legend(show = FALSE)
404		#'
405		#' df <- data.frame(x = LETTERS[1:5], y = runif(5))
406		#'
407		#' df \|>
408		#' e_charts(x) \|>
409		#' e_polar() \|>
410		#' e_angle_axis(x) \|>
411		#' e_radius_axis() \|>
412		#' e_line(y, coord_system = "polar", smooth = TRUE)
413		#' @seealso \href{https://echarts.apache.org/en/option.html#angleAxis}{Additional arguments}
414		#'
415		#' @name angle_axis
416		#' @export
417		e_angle_axis <- function(e, serie, show = TRUE, ...) {
418	10x	if (missing(e)) {
419	1x	stop("must pass e", call. = FALSE)
420		}
421
422	9x	opts <- list(show = show, ...)
423
424	9x	if (!missing(serie)) {
425	8x	sr <- deparse(substitute(serie))
426		}
427
428	9x	if (!missing(serie)) {
429	8x	opts$data <- e$x$data \|>
430	8x	purrr::map(sr) \|>
431	8x	unlist() \|>
432	8x	unname() \|>
433	8x	unique() \|>
434	8x	as.list()
435		}
436
437	9x	if (!e$x$tl) {
438	8x	e$x$opts$angleAxis <- opts
439		} else {
440	1x	e$x$opts$baseOption$angleAxis <- opts
441		}
442
443	9x	e
444		}
445
446		#' @rdname angle_axis
447		#' @export
448		e_angle_axis_ <- function(e, serie = NULL, show = TRUE, ...) {
449	3x	if (missing(e)) {
450	1x	stop("must pass e", call. = FALSE)
451		}
452
453	2x	opts <- list(show = show, ...)
454
455	2x	if (!is.null(serie)) {
456	1x	opts$data <- e$x$data \|>
457	1x	purrr::map(serie) \|>
458	1x	unlist() \|>
459	1x	unname() \|>
460	1x	unique() \|>
461	1x	as.list()
462		}
463
464	2x	if (!e$x$tl) {
465	2x	e$x$opts$angleAxis <- opts
466		} else {
467	!	e$x$opts$baseOption$angleAxis <- opts
468		}
469
470	2x	e
471		}
472
473		#' Radar axis
474		#'
475		#' Radar axis setup and options.
476		#'
477		#' @inheritParams e_bar
478		#' @param index Index of axis to customise.
479		#'
480		#' @examples
481		#' df <- data.frame(
482		#' x = LETTERS[1:5],
483		#' y = runif(5, 1, 5),
484		#' z = runif(5, 3, 7)
485		#' )
486		#'
487		#' df \|>
488		#' e_charts(x) \|>
489		#' e_radar(y, max = 7) \|>
490		#' e_radar(z) \|>
491		#' e_radar_opts(center = c("25%", "25%")) \|>
492		#' e_tooltip(trigger = "item")
493		#' @export
494		e_radar_opts <- function(e, index = 0, ...) {
495	6x	if (missing(e)) {
496	1x	stop("must pass e", call. = FALSE)
497		}
498
499	5x	r.index <- index + 1
500	5x	max <- length(e$x$opts$radar)
501
502	5x	attrs <- list(...)
503
504	5x	if (!length(attrs)) {
505	1x	stop("no attribute", call. = FALSE)
506		}
507
508		# initiatlise if wrong index
509	4x	if (r.index > max) {
510	1x	r.index <- 1
511		# This part seemed to break the plot
512		# if (!e$x$tl) {
513		# e$x$opts$radar <- list(list())
514		# } else {
515		# e$x$opts$baseOption$radar <- list(list())
516		# }
517		}
518
519	4x	for (i in seq_along(attrs)) {
520	6x	arg <- names(attrs)[i]
521	6x	if (!e$x$tl) {
522	6x	e$x$opts$radar[[r.index]][[arg]] <- attrs[[i]]
523		} else {
524	!	e$x$opts$baseOption$radar[[r.index]][[arg]] <- attrs[[i]]
525		}
526		}
527
528	4x	e
529		}
530
531		#' Single Axis
532		#'
533		#' Setup single axis.
534		#'
535		#' @inheritParams e_bar
536		#' @param index Index of axis to customise.
537		#'
538		#' @examples
539		#' df <- data.frame(
540		#' axis = LETTERS[1:10],
541		#' value = runif(10, 3, 20),
542		#' size = runif(10, 3, 20)
543		#' )
544		#'
545		#' df \|>
546		#' e_charts(axis) \|>
547		#' e_single_axis() \|> # add the single axis
548		#' e_scatter(
549		#' value,
550		#' size,
551		#' coord_system = "singleAxis"
552		#' )
553		#' @export
554		e_single_axis <- function(e, index = 0, ...) {
555	11x	if (missing(e)) {
556	1x	stop("must pass e", call. = FALSE)
557		}
558
559	10x	r.index <- index + 1
560
561	10x	e$x$opts$xAxis <- NULL
562	10x	e$x$opts$yAxis <- NULL
563
564	10x	if (!e$x$tl) {
565	9x	if (!length(e$x$opts$singleAxis)) {
566	8x	e$x$opts$singleAxis <- list(...)
567		} else {
568	1x	e$x$opts$singleAxis <- append(e$x$opts$singleAxis, list(...))
569		}
570		} else {
571	1x	if (!length(e$x$opts$baseOption$singleAxis)) {
572	1x	e$x$opts$baseOption$singleAxis <- list(...)
573		} else {
574	!	e$x$opts$baseOption$singleAxis <- append(e$x$opts$baseOption$singleAxis, list(...))
575		}
576		}
577
578	10x	if (!is.null(e$x$mapping$x)) {
579	9x	type <- .get_type(e, e$x$mapping$x)
580
581	9x	if (!e$x$tl) {
582	8x	e$x$opts$singleAxis$type <- type
583		} else {
584	1x	e$x$opts$baseOption$singleAxis$type <- type
585		}
586
587	9x	if (type == "category" \|\| type == "time") {
588	8x	vect <- c()
589	8x	for (i in seq_along(e$x$data)) {
590	9x	dat <- e$x$data[[i]] \|>
591	9x	dplyr::select(e$x$mapping$x) \|>
592	9x	unlist()
593	9x	dat <- unname(dat)
594	9x	dat <- as.character(dat)
595
596	9x	vect <- append(vect, dat)
597		}
598
599	8x	vect <- unique(vect)
600
601	8x	if (!e$x$tl) {
602	7x	e$x$opts$singleAxis$data <- vect
603		} else {
604	1x	e$x$opts$baseOption$singleAxis$data <- vect
605		}
606		}
607		} else {
608	1x	warning("x not pass to e_charts", call. = FALSE)
609		}
610
611	10x	e
612		}
613
614		#' Axis Labels
615		#'
616		#' Convenience function to add axis labels.
617		#'
618		#' @inheritParams e_bar
619		#' @param x,y Labels of axes.
620		#'
621		#' @examples
622		#' cars \|>
623		#' e_charts(speed) \|>
624		#' e_scatter(dist) \|>
625		#' e_axis_labels(
626		#' x = "speed",
627		#' y = "distance"
628		#' )
629		#' @export
630		e_axis_labels <- function(e, x = "", y = "") {
631	2x	if (missing(e)) {
632	1x	stop("must pass e", call. = FALSE)
633		}
634	1x	e \|>
635	1x	e_x_axis(name = x) \|>
636	1x	e_y_axis(name = y)
637		}
638
639		#'' Hide Grid Lines
640		#'
641		#' A convenience function to easily hide grid lines.
642		#'
643		#' @inheritParams e_bar
644		#' @param which Which axis grid lines to hide.
645		#'
646		#' @examples
647		#' cars \|>
648		#' e_charts(speed) \|>
649		#' e_scatter(dist) \|>
650		#' e_hide_grid_lines()
651		#' @export
652		e_hide_grid_lines <- function(e, which = c("x", "y")) {
653	6x	if (missing(e)) {
654	1x	stop("must pass e", call. = FALSE)
655		}
656	5x	if ("x" %in% which) {
657	4x	if (!e$x$tl) {
658	3x	e$x$opts[["xAxis"]][[1]]$splitLine$show <- FALSE
659		} else {
660	1x	e$x$opts$baseOption[["xAxis"]][[1]]$splitLine$show <- FALSE
661		}
662		}
663
664	5x	if ("y" %in% which) {
665	4x	if (!e$x$tl) {
666	3x	e$x$opts[["yAxis"]][[1]]$splitLine$show <- FALSE
667		} else {
668	1x	e$x$opts$baseOption[["yAxis"]][[1]]$splitLine$show <- FALSE
669		}
670		}
671
672	5x	return(e)
673		}
674
675		#' Stagger Axis Labels
676		#'
677		#' Stagger axis labels.
678		#'
679		#' @inheritParams e_bar
680		#'
681		#' @examples
682		#' df <- data.frame(
683		#' x = c("a very long label", "Another long label"),
684		#' y = 1:2
685		#' )
686		#'
687		#' df \|>
688		#' e_charts(x, width = 150) \|>
689		#' e_bar(y) \|>
690		#' e_axis_stagger()
691		#' @export
692		e_axis_stagger <- function(e) {
693	4x	if (missing(e)) {
694	1x	stop("must pass e", call. = FALSE)
695		}
696	3x	form <- "function(value, index){
697	3x	if(index % 2){
698	3x	return('\\n' + value)
699		}
700
701	3x	return(value)
702		}" \|>
703	3x	htmlwidgets::JS()
704
705	3x	if (!e$x$tl) {
706	2x	e$x$opts[["xAxis"]][[1]]$axisLabel$formatter <- form
707		} else {
708	1x	e$x$opts$baseOption[["xAxis"]][[1]]$axisLabel$formatter <- form
709		}
710
711	3x	return(e)
712		}

1		#' Country names
2		#'
3		#' Convert country names to echarts format.
4		#'
5		#' @param data Data.frame in which to find column names.
6		#' @param input,output Input and output columns.
7		#' @param type Passed to \link[countrycode]{countrycode} \code{origin} parameter.
8		#' @param ... Any other parameter to pass to \link[countrycode]{countrycode}.
9		#'
10		#' @details Taiwan and Hong Kong cannot be plotted.
11		#'
12		#' @examples
13		#' cns <- data.frame(country = c("US", "BE"))
14		#'
15		#' # replace
16		#' e_country_names(cns, country)
17		#'
18		#' # specify output
19		#' e_country_names(cns, country, country_name)
20		#' @rdname e_country_names
21		#' @export
22		e_country_names <- function(data, input, output, type = "iso2c", ...) {
23	3x	if (missing(data) \|\| missing(input)) {
24	1x	stop("must pass data and input", call. = FALSE)
25		}
26
27	2x	if (missing(output)) {
28	1x	output <- NULL
29		} else {
30	1x	output <- deparse(substitute(output))
31		}
32
33	2x	e_country_names_(data, deparse(substitute(input)), output, type, ...)
34		}
35
36		#' @rdname e_country_names
37		#' @export
38		e_country_names_ <- function(data, input, output = NULL, type = "iso2c", ...) {
39	4x	if (missing(data) \|\| missing(input)) {
40	1x	stop("must pass data and input", call. = FALSE)
41		}
42
43	3x	src <- input
44	3x	cn <- countrycode::countrycode(data[[src]], origin = type, destination = "country.name", ...)
45
46	3x	if (is.null(output)) {
47	2x	output <- src
48		}
49
50	3x	data[[output]] <- .correct_countries(cn)
51	3x	data
52		}
53
54		#' Color range
55		#'
56		#' Build manual color range
57		#'
58		#' @param data Data.frame in which to find column names.
59		#' @param input,output Input and output columns.
60		#' @param colors Colors to pass to \code{\link{colorRampPalette}}.
61		#' @param ... Any other argument to pass to \code{\link{colorRampPalette}}.
62		#'
63		#' @examples
64		#' df <- data.frame(val = 1:10)
65		#'
66		#' e_color_range(df, val, colors)
67		#' @rdname e_color_range
68		#' @export
69		e_color_range <- function(data, input, output, colors = c("#bf444c", "#d88273", "#f6efa6"), ...) {
70	4x	if (missing(data) \|\| missing(input) \|\| missing(output)) {
71	1x	stop("must pass data, input and output", call. = FALSE)
72		}
73
74	3x	e_color_range_(data, deparse(substitute(input)), deparse(substitute(output)), colors, ...)
75		}
76
77		#' @rdname e_color_range
78		#' @export
79		e_color_range_ <- function(data, input, output, colors = c("#bf444c", "#d88273", "#f6efa6"), ...) {
80	4x	if (missing(data) \|\| missing(input) \|\| missing(output)) {
81	1x	stop("must pass data, input and output", call. = FALSE)
82		}
83
84	3x	serie <- data[[input]]
85	3x	if (inherits(serie, "factor") \|\| inherits(serie, "character")) {
86	1x	col <- scales::col_factor(colors, domain = (serie))(serie)
87		} else {
88	2x	col <- scales::col_numeric(colors, domain = range(serie))(serie)
89		}
90
91	3x	data[[output]] <- col
92	3x	data
93		}
94
95		#' Get data
96		#'
97		#' Get data passed to \code{\link{e_charts}}.
98		#'
99		#' @inheritParams e_bar
100		#'
101		#' @return A list of data.frames, one for each group.
102		#'
103		#' @examples
104		#' echart <- cars \|>
105		#' e_charts(speed) \|>
106		#' e_scatter(dist) \|>
107		#' e_lm(dist ~ speed)
108		#'
109		#' echart
110		#'
111		#' e_get_data(echart)[[1]]
112		#' @export
113		e_get_data <- function(e) {
114	1x	e$x$data
115		}
116
117		#' Formatters
118		#'
119		#' Simple formatters as helpers.
120		#'
121		#' @inheritParams e_bar
122		#' @param axis Axis to apply formatter to.
123		#' @param suffix,prefix Suffix and prefix of label.
124		#' @param ... Any other arguments to pass to \code{\link{e_axis}}.
125		#'
126		#' @examples
127		#' # Y = %
128		#' df <- data.frame(
129		#' x = 1:10,
130		#' y = round(
131		#' runif(10, 1, 100),
132		#' 2
133		#' )
134		#' )
135		#'
136		#' df \|>
137		#' e_charts(x) \|>
138		#' e_line(y) \|>
139		#' e_format_y_axis(suffix = "%") \|>
140		#' e_format_x_axis(prefix = "A")
141		#' @rdname formatters
142		#' @export
143		e_format_axis <- function(e, axis = "y", suffix = NULL, prefix = NULL, ...) {
144	4x	if (missing(e)) {
145	1x	stop("must pass e", call. = FALSE)
146		}
147
148	3x	if (is.null(suffix) && is.null(prefix)) {
149	1x	stop("missing formatting")
150		}
151
152	2x	fmt <- paste(prefix, "{value}", suffix)
153
154	2x	e <- e \|>
155	2x	e_axis(
156	2x	axis = axis,
157	2x	axisLabel = list(formatter = fmt),
158		...
159		)
160
161	2x	e
162		}
163
164		#' @rdname formatters
165		#' @export
166		e_format_x_axis <- function(e, suffix = NULL, prefix = NULL, ...) {
167	1x	e_format_axis(e, "x", suffix, prefix, ...)
168		}
169
170		#' @rdname formatters
171		#' @export
172		e_format_y_axis <- function(e, suffix = NULL, prefix = NULL, ...) {
173	1x	e_format_axis(e, "y", suffix, prefix, ...)
174		}
175
176		#' Format labels
177		#'
178		#' @inheritParams e_bar
179		#' @param show Set to \code{TRUE} to show the labels.
180		#' @param position Position of labels, see
181		#' \href{https://echarts.apache.org/en/option.html#series-line.label.position}{official documentation}
182		#' for the full list of options.
183		#' @param ... Any other options see
184		#' \href{https://echarts.apache.org/en/option.html#series-line.label}{documentation} for other options.
185		#'
186		#' @examples
187		#' mtcars \|>
188		#' e_chart(wt) \|>
189		#' e_scatter(qsec, cyl) \|>
190		#' e_labels(fontSize = 9)
191		#'
192		#' mtcars \|>
193		#' group_by(cyl) \|>
194		#' e_chart(wt) \|>
195		#' e_scatter(qsec, mpg) \|>
196		#' e_labels(fontSize = 9)
197		#'
198		#' # timeline
199		#' mtcars \|>
200		#' group_by(cyl) \|>
201		#' e_chart(wt, timeline = TRUE) \|>
202		#' e_scatter(qsec, mpg) \|>
203		#' e_labels(fontSize = 9)
204		#' @export
205		e_labels <- function(e, show = TRUE, position = "top", ...) {
206	3x	if (missing(e)) {
207	1x	stop("must pass e", call. = FALSE)
208		}
209
210	2x	opts <- list(
211	2x	show = show,
212	2x	position = position,
213		...
214		)
215
216	2x	if (!e$x$tl) {
217	1x	for (i in seq_along(e$x$opts$series)) {
218	1x	e$x$opts$series[[i]]$label <- opts
219		}
220		} else {
221	1x	for (i in seq_along(e$x$opts$baseOption$series)) {
222	1x	e$x$opts$baseOption$series[[i]]$label <- opts
223		}
224		}
225
226	2x	return(e)
227		}
228
229		#' List
230		#'
231		#' simply pass a list of options, similar to a \code{JSON}.
232		#'
233		#' @inheritParams e_bar
234		#' @param list A \code{list} of options passed to \code{setOptions}.
235		#' @param append if \code{TRUE} the \code{list} is appended to the options,
236		#' otherwise it \emph{overwrites} everything.
237		#'
238		#' @examples
239		#' N <- 20 # data points
240		#'
241		#' opts <- list(
242		#' xAxis = list(
243		#' type = "category",
244		#' data = LETTERS[1:N]
245		#' ),
246		#' yAxis = list(
247		#' type = "value"
248		#' ),
249		#' series = list(
250		#' list(
251		#' type = "line",
252		#' data = round(runif(N, 5, 20))
253		#' )
254		#' )
255		#' )
256		#'
257		#' e_charts() \|>
258		#' e_list(opts)
259		#' @export
260		e_list <- function(e, list, append = FALSE) {
261	3x	if (missing(e)) {
262	1x	stop("must pass e", call. = FALSE)
263		}
264	2x	if (missing(list)) {
265	1x	stop("missing list", call. = FALSE)
266		}
267
268	1x	if (isTRUE(append)) {
269	!	e$x$opts <- append(e$x$opts, list)
270		} else {
271	1x	e$x$opts <- list
272		}
273
274	1x	e
275		}
276
277		#' Aria
278		#'
279		#' W3C defined the Accessible Rich Internet Applications Suite (WAI-ARIA)
280		#' to make Web content and Web applications more accessible to the disabled.
281		#' From ECharts 4.0, echarts4r supports ARIA by generating description for
282		#' charts automatically.
283		#'
284		#' @details There should be an aria-label attribute on the chart DOM, which
285		#' can help the disabled understand the content of charts with the help of certain devices.
286		#'
287		#' @inheritParams e_bar
288		#' @param enabled Whether to enable aria helper text.
289		#'
290		#' @seealso \href{https://echarts.apache.org/en/option.html#aria}{official documentation}
291		#'
292		#' @export
293		e_aria <- function(e, enabled = TRUE, ...) {
294	1x	e$x$opts$aria <- list(
295	1x	enabled = enabled,
296		...
297		)
298
299	1x	return(e)
300		}
301
302		#' To & From JSON
303		#'
304		#' Get JSON options from an echarts4r object and build one from JSON.
305		#'
306		#' @inheritParams e_bar
307		#' @param json Whether to return the JSON, otherwise returns a \code{list}.
308		#' @param txt JSON character string, url, or file.
309		#' @param jswrapper Whether to wrap pure JS functions in \code{htmlwidgets::JS}, Default is FALSE.
310		#' @param ... Additional options to pass to \link[jsonlite]{toJSON}.
311		#'
312		#' @details \code{txt} should contain the full list of options required to build a chart.
313		#' This is subsequently passed to the \code{setOption} ECharts (JavaScript) function.
314		#'
315		#' @examples
316		#' p <- cars \|>
317		#' e_charts(dist) \|>
318		#' e_scatter(speed, symbol_size = 10)
319		#'
320		#' p # plot
321		#'
322		#' # extract the JSON
323		#' json <- p \|>
324		#' e_inspect(
325		#' json = TRUE,
326		#' pretty = TRUE
327		#' )
328		#'
329		#' # print json
330		#' json
331		#'
332		#' # rebuild plot
333		#' echarts_from_json(json) \|>
334		#' e_theme("dark") # modify
335		#' @return \code{e_inspect} Returns a \code{list} if \code{json} is \code{FALSE} and a
336		#' JSON string otherwise. \code{echarts_from_json} returns an object of class \code{echarts4r}.
337		#'
338		#' @note Must be passed as last option.
339		#'
340		#' @rdname echartsNJSON
341		#' @export
342		e_inspect <- function(e, json = FALSE, ...) {
343	2x	opts <- e$x$opts
344
345	2x	if (isTRUE(json)) {
346	2x	opts <- jsonlite::toJSON(opts, force = TRUE, auto_unbox = TRUE, null = "null", ...)
347		}
348
349	2x	return(opts)
350		}
351
352		#' @rdname echartsNJSON
353		#' @export
354		echarts_from_json <- function(txt, jswrapper = FALSE) {
355	1x	json <- jsonlite::fromJSON(txt, simplifyVector = FALSE)
356
357	1x	e <- e_charts()
358	1x	e$x$opts <- json
359	1x	if (isTRUE(jswrapper)) {
360	!	for (i in seq_along(e$x$opts$tooltip)) {
361
362	!	if (is.character(e$x$opts$tooltip[[i]]) && startsWith(e$x$opts$tooltip[[i]], "function")) {
363		# Wrap pure JS functions in htmlwidgets::JS
364	!	e$x$opts$tooltip[[i]] <- htmlwidgets::JS(e$x$opts$tooltip[[i]])
365		}
366
367		}
368		}
369
370	1x	e
371		}
372
373		#' Axis ZigZags
374		#'
375		#' helper function for generating axis break zigzags in chart
376		#'
377		#' @inheritParams e_bar
378		#' @param axis Axis to apply formatter to. Supports x and y axis
379		#' @param start,end Start and End point for boundary of zigzag. Also supports vectors for generating multiple breaks. Can also support time values.
380		#' @param gap Determines the visual size of the axis break area.
381		#' Supports Percentage(String) as proportional value relative to axis. Supports Absolute value(numeric) which refers to literal values in the axis similar to start,end (Not a pixel value).
382		#' @param zigzagAmplitude Amplitude of zigzag. Unit is pixels.
383		#' @param ... Any other arguments to pass to breakArea argument.
384		#'
385		#' @examples
386		#'
387		#' df <- data.frame(
388		#' x = c("a", "b", "c", "d", "c"),
389		#' y = c(100, 200, 200, 700, 300)
390		#' )
391		#'
392		#' df \|>
393		#' e_charts(x) \|>
394		#' e_bar(y) \|>
395		#' e_zigzag(axis = 'y', start = 400, end = 500)
396		#'
397		#' df \|>
398		#' e_charts(x) \|>
399		#' e_bar(y) \|>
400		#' e_zigzag(axis = 'y', start = c(125,400), end = c(150,500))
401		#' @seealso \href{https://echarts.apache.org/en/option.html#series-bar}{Additional arguments}
402		#'
403		#' @rdname e_zigzag
404		#' @export
405		e_zigzag <- function(e, axis = 'y', start, end, gap = "3%", zigzagAmplitude = 10, ...){
406
407	10x	if (missing(e)) {
408	1x	stop("must pass e", call. = FALSE)
409		}
410
411	9x	if (missing(axis)) {
412	1x	stop("must indicate which axis to zigzag. e.g. 'x' or 'y'", call. = FALSE)
413		}
414
415	8x	if (missing(start) \| missing(end)) {
416	2x	stop("must provide start and end values")
417		}
418
419	6x	df <- data.frame("starts" = start, "ends" = end, "gap" = gap)
420	6x	b <- .build_zigzags(df, starts = "starts", ends = "ends", gap = "gap")
421
422	6x	bA <- list(
423	6x	zigzagAmplitude = zigzagAmplitude,
424		...
425		)
426
427	6x	if(axis == 'y'){
428	5x	e <- e \|> e_y_axis(breaks = b, breakArea = bA)
429		}
430
431	6x	if(axis == 'x'){
432	1x	e <- e \|> e_x_axis(breaks = b, breakArea = bA)
433		}
434	6x	e
435		}
436
437
438		#' Axis Jitter
439		#'
440		#' helper function for generating jitter between points in a scatter plot. This is only applicable to e_scatter().
441		#'
442		#' @inheritParams e_bar
443		#' @param axis Axis to apply formatter to. Supports x and y axis
444		#' @param jitter Pixel units indicating the amount of random noise to add to each data point position.
445		#' @param jitterOverlap Boolean allowing overlap between data points. If false, overlap will not be allowed. For some cases, scatters may still overlap if there is no reasonable way to avoid.
446		#' @param jitterMargin When you have jitter and jiterOverlap is FALSE, this is the minimum distance in pixels between two data points.
447		#'
448		#' @examples
449		#'
450		#' df <- data.frame(
451		#' value = c(rnorm(50, mean = 5, sd = 1),
452		#' rnorm(50, mean = 10, sd = 1),
453		#' rnorm(50, mean = 15, sd = 1)),
454		#' group = rep(c("Group A", "Group B", "Group C"), each = 50)
455		#' )
456		#'
457		#' df \|> e_charts(group) \|> e_scatter(value) \|> e_jitter()
458		#' @seealso \href{https://echarts.apache.org/en/option.html#yAxis.jitter}{Additional arguments}
459		#'
460		#' @rdname e_jitter
461		#' @export
462		e_jitter <- function(e, axis = 'x', jitter = 20, jitterOverlap = FALSE, jitterMargin = 5){
463	5x	if(missing(e)) {
464	1x	stop("must pass e", call. = FALSE)
465		}
466
467	4x	if(is.null(axis)) {
468	1x	stop("must indicate which axis to apply jitter. e.g. 'x' or 'y'", call. = FALSE)
469		}
470
471	3x	if(e$x$opts$series[[1]]$type != 'scatter' \|\| is.null(e$x$opts$series[[1]]$type)){
472	1x	stop("jitter is only supported with scatter plots")
473		}
474
475	2x	if(axis == 'x'){
476	1x	e <- e \|> e_x_axis(jitter = jitter, jitterOverlap = jitterOverlap, jitterMargin = jitterMargin)
477		}
478
479	2x	if(axis == 'y'){
480	1x	e <- e \|> e_y_axis(jitter = jitter, jitterOverlap = jitterOverlap, jitterMargin = jitterMargin)
481		}
482	2x	e
483		}

1		#' Append Proxy
2		#'
3		#' Append data dynamically.
4		#'
5		#' @inheritParams e_highlight_p
6		#' @param series_index Index of serie to append to (starts from 0).
7		#' @param data Data.frame containing data to append.
8		#' @param x,y,z Columns names to plot.
9		#' @param name if using `bind` with e.g `e_scatter` this can be used to supply the colname for
10		#' the name attribute bind is mapping to
11		#' @param scale A scaling function as passed to \code{\link{e_scatter}}.
12		#' @param symbol_size Multiplier of scaling function as in \code{\link{e_scatter}}.
13		#'
14		#' @details Currently not all types of series supported incremental rendering when using appendData.
15		#' Only these types of series support it: \code{\link{e_scatter}} and \code{\link{e_line}} of pure echarts, and
16		#' \code{\link{e_scatter_3d}}, and \code{\link{e_line_3d}} of echarts-gl.
17		#'
18		#' @examples
19		#' \dontrun{
20		#' library(shiny)
21		#'
22		#' ui <- fluidPage(
23		#' actionButton("add", "Add Data to y"),
24		#' echarts4rOutput("plot"),
25		#' h4("Brush"),
26		#' verbatimTextOutput("selected"),
27		#' h4("Legend select change"),
28		#' verbatimTextOutput("legend")
29		#' )
30		#'
31		#' server <- function(input, output, session) {
32		#' data <- data.frame(x = rnorm(10, 5, 3), y = rnorm(10, 50, 12), z = rnorm(10, 5, 20))
33		#'
34		#' react <- eventReactive(input$add, {
35		#' set.seed(sample(1:1000, 1))
36		#' data.frame(x = rnorm(10, 5, 2), y = rnorm(10, 50, 10), z = rnorm(10, 5, 20))
37		#' })
38		#'
39		#' output$plot <- renderEcharts4r({
40		#' data \|>
41		#' e_charts(x) \|>
42		#' e_scatter(y, z, scale = NULL) \|>
43		#' e_scatter(z) \|>
44		#' e_brush()
45		#' })
46		#'
47		#' observeEvent(input$add, {
48		#'
49		#' echarts4rProxy("plot") \|>
50		#' e_append2_p(0, react(), x, y, z)
51		#' })
52		#'
53		#' output$selected <- renderPrint({
54		#' input$plot_brush
55		#' })
56		#'
57		#' output$legend <- renderPrint({
58		#' input$plot_legend_change
59		#' })
60		#' }
61		#'
62		#' shinyApp(ui, server)
63		#' }
64		#'
65		#' @rdname append
66		#' @export
67		e_append1_p <- function(proxy, series_index = NULL, data, x, y, name = NULL) {
68	2x	if (!"echarts4rProxy" %in% class(proxy)) {
69	1x	stop("must pass echarts4rProxy object", call. = FALSE)
70		}
71
72	1x	e_append1_p_(proxy, series_index, data, deparse(substitute(x)), deparse(substitute(y)), deparse(substitute(name)))
73		}
74
75		#' @rdname append
76		#' @export
77		e_append1_p_ <- function(proxy, series_index = NULL, data, x, y, name = NULL) {
78	3x	if (!"echarts4rProxy" %in% class(proxy)) {
79	1x	stop("must pass echarts4rProxy object", call. = FALSE)
80		}
81
82	2x	dlist <- data \|>
83	2x	dplyr::select(dplyr::all_of(c(x, y, name))) \|>
84	2x	unname() \|>
85	2x	apply(1, function(row){
86	20x	if(!is.null(name)){
87	20x	list(value=as.numeric(row[1:2]),name=row[3])
88		} else {
89	!	list(value=as.numeric(row[1:2]))
90		}
91		})
92
93	2x	opts <- list(id = proxy$id, seriesIndex = series_index, data = dlist)
94
95	2x	proxy$session$sendCustomMessage("e_append_p", opts)
96
97	2x	return(proxy)
98		}
99
100		#' @rdname append
101		#' @export
102		e_append2_p <- function(proxy, series_index = NULL, data, x, y, z, scale = NULL, symbol_size = 1) {
103	2x	if (!"echarts4rProxy" %in% class(proxy)) {
104	1x	stop("must pass echarts4rProxy object", call. = FALSE)
105		}
106
107	1x	e_append2_p_(
108	1x	proxy = proxy,
109	1x	series_index = series_index,
110	1x	data = data,
111	1x	x = deparse(substitute(x)),
112	1x	y = deparse(substitute(y)),
113	1x	z = deparse(substitute(z)),
114	1x	scale = scale,
115	1x	symbol_size = symbol_size
116		)
117		}
118
119		#' @rdname append
120		#' @export
121		e_append2_p_ <- function(proxy, series_index = NULL, data, x, y, z, scale = NULL, symbol_size = 1) {
122	3x	if (!"echarts4rProxy" %in% class(proxy)) {
123	1x	stop("must pass echarts4rProxy object", call. = FALSE)
124		}
125
126	2x	data <- data \|>
127	2x	dplyr::select(dplyr::all_of(c(x, y, z)))
128
129	2x	if (!is.null(scale)) {
130	!	data[[4]] <- scale(data[[3]]) * symbol_size
131		} else {
132	2x	data[[4]] <- data[[3]]
133		}
134
135	2x	data <- unname(data)
136
137	2x	dlist <- apply(data, 1, function(x) {
138	20x	list(value = unlist(x, use.names = FALSE))
139		})
140
141	2x	opts <- list(id = proxy$id, seriesIndex = series_index, data = dlist)
142
143	2x	proxy$session$sendCustomMessage("e_append_p", opts)
144
145	2x	return(proxy)
146		}
147
148		#' Remove Serie
149		#'
150		#' Remove a serie by name or precising its index.
151		#'
152		#' @inheritParams e_highlight_p
153		#' @param serie_index Index of serie to append to (starts from 0).
154		#' @param serie_name Name of serie to remove.
155		#'
156		#' @examples
157		#' library(shiny)
158		#'
159		#' ui <- fluidPage(
160		#' actionButton("rm", "Remove z serie"),
161		#' echarts4rOutput("plot")
162		#' )
163		#'
164		#' server <- function(input, output, session) {
165		#' data <- data.frame(
166		#' x = rnorm(10, 5, 3),
167		#' y = rnorm(10, 50, 12),
168		#' z = rnorm(10, 50, 5)
169		#' )
170		#'
171		#' output$plot <- renderEcharts4r({
172		#' data \|>
173		#' e_charts(x) \|>
174		#' e_scatter(y) \|>
175		#' e_scatter(z)
176		#' })
177		#'
178		#' observeEvent(input$rm, {
179		#' echarts4rProxy("plot") \|>
180		#' e_remove_serie_p(serie_name = "z")
181		#' })
182		#' }
183		#' \dontrun{
184		#' shinyApp(ui, server)
185		#' }
186		#'
187		#' @name e_remove
188		#' @export
189		e_remove_serie_p <- function(proxy, serie_name = NULL, serie_index = NULL) {
190	2x	if (is.null(serie_index) && is.null(serie_name)) {
191	1x	stop("Must define `serie_index` or `serie_name`")
192		}
193
194	1x	opts <- list(id = proxy$id, serie_index = serie_index, serie_name = serie_name)
195
196	1x	proxy$session$sendCustomMessage("e_remove_serie_p", opts)
197
198	1x	return(proxy)
199		}
200
201		#' @rdname e_remove
202		#' @export
203		e_remove_serie <- e_remove_serie_p
204
205		#' Send
206		#'
207		#' Send new series to chart.
208		#'
209		#' @inheritParams e_highlight_p
210		#'
211		#' @name e_execute
212		#' @export
213		e_execute <- function(proxy) {
214	44x	if (missing(proxy)) {
215	1x	stop("missing proxy", call. = FALSE)
216		}
217
218	43x	proxy$session$sendCustomMessage(
219	43x	"e_send_p",
220	43x	list(id = proxy$id, opts = proxy$chart$x$opts)
221		)
222	43x	return(proxy)
223		}
224
225		#' @rdname e_execute
226		#' @export
227		e_execute_p <- e_execute
228
229		#' Merge options in chart, used in e_mark
230		#'
231		#' @inheritParams e_highlight_p
232		#'
233		#' @name e_merge
234		#' @export
235		e_merge <- function(proxy) {
236	1x	if (missing(proxy)) stop("missing proxy", call. = FALSE)
237
238	1x	proxy$session$sendCustomMessage(
239	1x	"e_merge_p",
240	1x	list(id = proxy$id, opts = proxy$chart$x$opts)
241		)
242	1x	return(proxy)
243		}

1		#' Highlight & Downplay
2		#'
3		#' Highlight series
4		#'
5		#' @inheritParams e_bar
6		#' @param series_index,series_name Index or name of serie to highlight or
7		#' \code{list} or \code{vector} of series.
8		#' @param btn A \code{\link{e_button}} id.
9		#'
10		#' @examples
11		#' iris \|>
12		#' group_by(Species) \|>
13		#' e_charts(Sepal.Length) \|>
14		#' e_line(Sepal.Width) \|>
15		#' e_line(Petal.Length) \|>
16		#' e_highlight(series_name = "setosa") # highlight group
17		#' @name highlight_action
18		#' @export
19		e_highlight <- function(e, series_index = NULL, series_name = NULL, btn = NULL) {
20	8x	if (is.null(series_index) && is.null(series_name)) {
21	1x	stop("must set index or name", call. = FALSE)
22		}
23
24	7x	opts <- list()
25
26	7x	data <- list(type = "highlight")
27	5x	if (!is.null(series_index)) data$seriesIndex <- as.list(series_index)
28	2x	if (!is.null(series_name)) data$seriesName <- as.list(series_name)
29	7x	opts$data <- data
30
31	7x	e <- .actions_btn(e = e, opts = opts, btn = btn)
32
33	7x	return(e)
34		}
35
36		#' @name highlight_action
37		#' @export
38		e_downplay <- function(e, series_index = NULL, series_name = NULL, btn = NULL) {
39	8x	if (is.null(series_index) && is.null(series_name)) {
40	1x	stop("must set index or name", call. = FALSE)
41		}
42
43	7x	opts <- list()
44
45	7x	data <- list(type = "downplay")
46	5x	if (!is.null(series_index)) data$seriesIndex <- as.list(series_index)
47	2x	if (!is.null(series_name)) data$seriesName <- as.list(series_name)
48	7x	opts$data <- data
49
50	7x	e <- .actions_btn(e = e, opts = opts, btn = btn)
51
52	7x	return(e)
53		}
54
55		#' Show & Hide Tooltip
56		#'
57		#' Show or hide tooltip.
58		#'
59		#' @inheritParams e_bar
60		#' @param btn A \code{\link{e_button}} id.
61		#' @param ... Any options, see
62		#' \href{https://echarts.apache.org/en/api.html#action.tooltip}{official
63		#' documentation}
64		#'
65		#' @note The tooltip must be initialised with \code{\link{e_tooltip}} for this
66		#' to work.
67		#'
68		#' @examples
69		#' cars \|>
70		#' e_charts(dist) \|>
71		#' e_scatter(speed) \|>
72		#' e_tooltip() \|>
73		#' e_hidetip(btn = "btn") \|>
74		#' e_button("btn", "Hide tooltip")
75		#' @name tooltip_action
76		#' @export
77		e_showtip <- function(e, ..., btn = NULL) {
78	5x	opts <- list()
79	5x	data <- list(type = "showTip", ...)
80	5x	opts$data <- data
81
82	5x	e <- .actions_btn(e = e, opts = opts, btn = btn)
83
84	5x	return(e)
85		}
86
87		#' @name tooltip_action
88		#' @export
89		e_hidetip <- function(e, ..., btn = NULL) {
90	5x	opts <- list()
91	5x	data <- list(type = "hideTip", ...)
92	5x	opts$data <- data
93
94	5x	e <- .actions_btn(e = e, opts = opts, btn = btn)
95
96	5x	return(e)
97		}
98
99		#' Zoom
100		#'
101		#' Zoom on a region.
102		#'
103		#' @inheritParams e_bar
104		#' @param btn A \code{\link{e_button}} id.
105		#' @param ... Any options, see
106		#' \href{https://echarts.apache.org/en/api.html#action.dataZoom.dataZoom}{official
107		#' documentation}
108		#'
109		#' @examples
110		#' cars \|>
111		#' e_charts(dist) \|>
112		#' e_scatter(speed) \|>
113		#' e_datazoom() \|>
114		#' e_zoom(
115		#' dataZoomIndex = 0,
116		#' start = 20,
117		#' end = 40,
118		#' btn = "BUTTON"
119		#' ) \|>
120		#' e_button("BUTTON", "Zoom in")
121		#' @export
122		e_zoom <- function(e, ..., btn = NULL) {
123	1x	opts <- list()
124	1x	opts$data <- list(type = "dataZoom", ...)
125
126	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
127
128	1x	return(e)
129		}
130
131		#' Select Visual Map
132		#'
133		#' Selects data range of visual mapping.
134		#'
135		#' @inheritParams e_bar
136		#' @param btn A \code{\link{e_button}} id.
137		#' @param ... Any options, see
138		#' \href{https://echarts.apache.org/en/api.html#action.visualMap}{official
139		#' documentation}
140		#'
141		#' @examples
142		#' data("state")
143		#'
144		#' as.data.frame(state.x77) \|>
145		#' e_charts(Population) \|>
146		#' e_scatter(Income, Frost) \|>
147		#' e_visual_map(Frost, scale = e_scale) \|>
148		#' e_legend(FALSE) \|>
149		#' e_visual_map_range(
150		#' selected = list(60, 120)
151		#' )
152		#' @export
153		e_visual_map_range <- function(e, ..., btn = NULL) {
154	1x	opts <- list()
155	1x	if (!is.null(btn)) opts$id <- btn
156	1x	opts$data <- list(type = "selectDataRange", ...)
157
158	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
159
160	1x	return(e)
161		}
162
163		# TODO this works but I see nothing changing in the examples.
164		# There's also pieToggleSelect
165
166		#' Select & Unselect Pie
167		#'
168		#' Actions related to \code{\link{e_pie}}.
169		#'
170		#' @inheritParams e_bar
171		#' @param btn A \code{\link{e_button}} id.
172		#' @param ... Any options, see
173		#' \href{https://echarts.apache.org/en/api.html#action.pie}{official
174		#' documentation}
175		#'
176		#' @examples
177		#' mtcars \|>
178		#' head() \|>
179		#' tibble::rownames_to_column("model") \|>
180		#' e_charts(model) \|>
181		#' e_pie(carb) \|>
182		#' e_pie_select(dataIndex = 0)
183		#' @name pie_action
184		#' @export
185		e_pie_select <- function(e, ..., btn = NULL) {
186	1x	opts <- list()
187	1x	if (!is.null(btn)) opts$id <- btn
188	1x	opts$data <- list(type = "pieSelect", ...)
189
190	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
191
192	1x	return(e)
193		}
194
195		#' @rdname pie_action
196		#' @export
197		e_pie_unselect <- function(e, ..., btn = NULL) {
198	1x	opts <- list()
199	1x	if (!is.null(btn)) opts$id <- btn
200	1x	opts$data <- list(type = "pieUnSelect", ...)
201
202	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
203
204	1x	return(e)
205		}
206
207		#' Nodes Adjacency
208		#'
209		#' Actions related to \code{\link{e_graph}}.
210		#'
211		#' @inheritParams e_bar
212		#' @param btn A \code{\link{e_button}} id.
213		#' @param ... Any options, see
214		#' \href{https://echarts.apache.org/en/api.html#action.graph}{official
215		#' documentation}
216		#'
217		#' @examples
218		#' value <- rnorm(10, 10, 2)
219		#'
220		#' nodes <- data.frame(
221		#' name = sample(LETTERS, 10),
222		#' value = value,
223		#' size = value,
224		#' grp = rep(c("grp1", "grp2"), 5),
225		#' stringsAsFactors = FALSE
226		#' )
227		#'
228		#' edges <- data.frame(
229		#' source = sample(nodes$name, 20, replace = TRUE),
230		#' target = sample(nodes$name, 20, replace = TRUE),
231		#' stringsAsFactors = FALSE
232		#' )
233		#'
234		#' e_charts() \|>
235		#' e_graph() \|>
236		#' e_graph_nodes(nodes, name, value, size, grp) \|>
237		#' e_graph_edges(edges, source, target) \|>
238		#' e_focus_adjacency(
239		#' seriesIndex = 0,
240		#' dataIndex = 4
241		#' )
242		#' @name graph_action
243		#' @export
244		e_focus_adjacency <- function(e, ..., btn = NULL) {
245	1x	opts <- list()
246	1x	if (!is.null(btn)) opts$id <- btn
247	1x	opts$data <- list(type = "focusNodeAdjacency", ...)
248
249	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
250
251	1x	return(e)
252		}
253
254		#' @rdname graph_action
255		#' @export
256		e_unfocus_adjacency <- function(e, ..., btn = NULL) {
257	1x	opts <- list()
258	1x	if (!is.null(btn)) opts$id <- btn
259	1x	opts$data <- list(type = "unfocusNodeAdjacency", ...)
260
261	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
262
263	1x	return(e)
264		}
265
266		#' Legend
267		#'
268		#' @inheritParams e_bar
269		#' @param btn A \code{\link{e_button}} id.
270		#' @param name Legend name.
271		#' @param scroll_index Controle the scrolling of legend when \code{type =
272		#' "scroll"} in \code{e_legend}.
273		#' @param legend_id Id of legend.
274		#'
275		#' @examples
276		#' e <- CO2 \|>
277		#' group_by(Type) \|>
278		#' e_charts(conc) \|>
279		#' e_scatter(uptake)
280		#'
281		#' e \|>
282		#' e_legend_unselect("Quebec")
283		#'
284		#' e \|>
285		#' e_legend_unselect("Quebec", btn = "btn") \|>
286		#' e_button("btn", "Quebec")
287		#' @name legend_action
288		#' @export
289		e_legend_select <- function(e, name, btn = NULL) {
290	2x	if (missing(name)) {
291	1x	stop("missing name", call. = FALSE)
292		}
293
294	1x	opts <- list()
295	1x	if (!is.null(btn)) opts$id <- btn
296	1x	opts$data <- list(type = "legendSelect")
297
298	1x	if (!is.null(name)) {
299	1x	opts$data$name <- name
300		}
301
302	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
303
304	1x	return(e)
305		}
306
307		#' @rdname legend_action
308		#' @export
309		e_legend_unselect <- function(e, name, btn = NULL) {
310	3x	if (missing(name)) {
311	2x	stop("missing name", call. = FALSE)
312		}
313
314	1x	opts <- list()
315	1x	if (!is.null(btn)) opts$id <- btn
316	1x	opts$data <- list(type = "legendUnSelect")
317
318	1x	if (!is.null(name)) {
319	1x	opts$data$name <- name
320		}
321
322	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
323
324	1x	return(e)
325		}
326
327		#' @rdname legend_action
328		#' @export
329		e_legend_toggle_select <- function(e, name, btn = NULL) {
330	2x	if (missing(name)) {
331	1x	stop("missing name", call. = FALSE)
332		}
333
334	1x	opts <- list()
335	1x	if (!is.null(btn)) opts$id <- btn
336	1x	opts$data <- list(type = "legendToggleSelect")
337
338	1x	if (!is.null(name)) {
339	1x	opts$data$name <- name
340		}
341
342	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
343
344	1x	return(e)
345		}
346
347		#' @rdname legend_action
348		#' @export
349		e_legend_scroll <- function(e,
350		scroll_index = NULL,
351		legend_id = NULL,
352		btn = NULL
353		) {
354	1x	opts <- list()
355	1x	if (!is.null(btn)) opts$id <- btn
356	1x	opts$data <- list(type = "legendScroll")
357
358	1x	if (!is.null(scroll_index)) {
359	1x	opts$data$scrollDataIndex <- scroll_index
360		}
361
362	1x	if (!is.null(legend_id)) {
363	1x	opts$data$legendId <- legend_id
364		}
365
366	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
367
368	1x	return(e)
369		}
370
371		#' Restore Toolbox
372		#'
373		#' Restore Toolbox.
374		#'
375		#' @inheritParams e_bar
376		#' @param btn A \code{\link{e_button}} id.
377		#'
378		#' @examples
379		#' cars \|>
380		#' e_charts(speed) \|>
381		#' e_scatter(dist) \|>
382		#' e_datazoom() \|>
383		#' e_restore("btn") \|>
384		#' e_button("btn", "Reset")
385		#' @export
386		e_restore <- function(e, btn = NULL) {
387	1x	opts <- list()
388	1x	if (!is.null(btn)) opts$id <- btn
389	1x	opts$data <- list(type = "restore")
390
391	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
392
393	1x	return(e)
394		}
395
396		#' Map Actions
397		#'
398		#' Map-related actions.
399		#'
400		#' @inheritParams e_bar
401		#' @param btn A \code{\link{e_button}} id.
402		#' @param ... Any options, see
403		#' \href{https://echarts.apache.org/en/api.html#action.map}{official
404		#' documentation}
405		#'
406		#' @examples
407		#' choropleth <- data.frame(
408		#' countries = c(
409		#' "France",
410		#' "Brazil",
411		#' "China",
412		#' "Russia",
413		#' "Canada",
414		#' "India",
415		#' "United States",
416		#' "Argentina",
417		#' "Australia"
418		#' ),
419		#' values = round(runif(9, 10, 25))
420		#' )
421		#'
422		#' choropleth \|>
423		#' e_charts(countries) \|>
424		#' e_map(values) \|>
425		#' e_visual_map(min = 10, max = 25) \|>
426		#' e_map_toggle_select(name = "China", btn = "btn") \|>
427		#' e_button("btn", "Select China")
428		#' @seealso \code{\link{e_map_register}}
429		#'
430		#' @name map_actions
431		#' @export
432		e_map_select <- function(e, ..., btn = NULL) {
433	1x	opts <- list()
434	1x	if (!is.null(btn)) opts$id <- btn
435	1x	opts$data <- list(type = "mapSelect", ...)
436
437	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
438
439	1x	return(e)
440		}
441
442		#' @rdname map_actions
443		#' @export
444		e_map_unselect <- function(e, ..., btn = NULL) {
445	1x	opts <- list()
446	1x	if (!is.null(btn)) opts$id <- btn
447	1x	opts$data <- list(type = "mapUnSelect", ...)
448
449	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
450
451	1x	return(e)
452		}
453
454		#' @rdname map_actions
455		#' @export
456		e_map_toggle_select <- function(e, ..., btn = NULL) {
457	1x	opts <- list()
458	1x	if (!is.null(btn)) opts$id <- btn
459	1x	opts$data <- list(type = "mapToggleSelect", ...)
460
461	1x	e <- .actions_btn(e = e, opts = opts, btn = btn)
462
463	1x	return(e)
464		}

1		#' Add nested data
2		#'
3		#' Utility function to add data where the original JavaScript library expects nested data.
4		#'
5		#' @inheritParams e_bar
6		#' @param param The nested parameter to add data to.
7		#' @param .serie Serie's index to add the data to, if
8		#' `NULL` then it is added to all.
9		#' @param .data A dataset to use, if none are specified than
10		#' the original dataset passed to `e_charts` is used.
11		#' @param value The column to map to the parameter.
12		#'
13		#' @section Functions:
14		#'
15		#' - `e_add_nested`: Adds nested data, e.g.:
16		#' `e_add_nested("itemStyle", color, fontBold)` creates
17		#' `\{itemStyle: \{color: 'red', fontBold: 'bold'\}\}`.
18		#' - `e_add_unnested`: Adds unnested data, e.g.:
19		#' `e_add_unnested("symbolSize", size)` creates
20		#' `\{symbolSize: 4\}`.
21		#'
22		#' @details For instance, \code{\link{e_funnel}} lets you pass \code{values} and \code{labels}
23		#' (from your initial data.frame) which corresponds to \code{name} and \code{value} in the
24		#' \href{https://echarts.apache.org/en/option.html#series-heatmap.data}{original library}.
25		#' However the latter also takes, \code{label}, \code{itemStyle}, and \code{emphasis} but being JSON arrays
26		#' they translate to lists in R and dealing with nested data.frames is not ideal. \code{e_add} remedies to that.
27		#' It allows adding those nested data points, see the examples below.
28		#'
29		#' @examples
30		#' # funnel can take nested itemStyle
31		#' # https://echarts.apache.org/en/option.html#series-funnel.data
32		#' funnel <- data.frame(
33		#' stage = c("View", "Click", "Purchase"),
34		#' value = c(80, 30, 20),
35		#' color = c("blue", "red", "green")
36		#' )
37		#'
38		#' funnel \|>
39		#' e_charts() \|>
40		#' e_funnel(value, stage) \|>
41		#' e_add_nested("itemStyle", color)
42		#'
43		#' # Heatmap can take nested label
44		#' # https://echarts.apache.org/en/option.html#series-heatmap.data
45		#' v <- LETTERS[1:10]
46		#' matrix <- data.frame(
47		#' x = sample(v, 300, replace = TRUE),
48		#' y = sample(v, 300, replace = TRUE),
49		#' z = rnorm(300, 10, 1),
50		#' stringsAsFactors = FALSE
51		#' ) \|>
52		#' dplyr::group_by(x, y) \|>
53		#' dplyr::summarise(z = sum(z)) \|>
54		#' dplyr::ungroup() \|>
55		#' dplyr::mutate(
56		#' show = TRUE,
57		#' fontStyle = round(runif(dplyr::n(), 5, 12))
58		#' )
59		#'
60		#' matrix \|>
61		#' e_charts(x) \|>
62		#' e_heatmap(y, z) \|>
63		#' e_visual_map(z) \|>
64		#' e_add_nested(
65		#' "label",
66		#' show,
67		#' fontStyle
68		#' )
69		#'
70		#' @name nesting
71		#' @export
72		e_add <- function(e, param, ..., .serie = NULL, .data = NULL) {
73	1x	.Deprecated("e_add_nested", "echarts4r")
74	1x	e_add_nested(e, param, ..., .serie = NULL, .data = NULL)
75		}
76
77		#' @rdname nesting
78		#' @export
79		e_add_nested <- function(e, param, ..., .serie = NULL, .data = NULL) {
80	12x	if (missing(e) \|\| missing(param)) {
81	3x	stop("missing e or param", call. = FALSE)
82		}
83
84	9x	if(is.null(.data))
85	9x	ds <- e$x$data
86		else
87	!	ds <- map_grps_(.data, e$x$tl)
88
89	9x	for (i in seq_along(ds)) {
90	10x	data <- ds[[i]] \|>
91	10x	dplyr::select(...)
92
93	10x	data <- apply(data, 1, as.list)
94
95	10x	for (j in seq_along(data)) {
96
97	24x	if (!e$x$tl) {
98	20x	for(k in seq_along(e$x$opts$series)){
99	23x	if(!is.null(.serie) && .serie != k)
100	3x	next
101	20x	if(!is.numeric(e$x$opts$series[[k]]$data[[j]])){
102	17x	e$x$opts$series[[k]]$data[[j]][[param]] <- data[[j]]
103		} else {
104		# If polar, 'itemStyle' may be in a different location - this fixes that.
105	3x	e$x$opts$series[[k]]$data[[j]] <- c(
106	3x	list(value = e$x$opts$series[[k]]$data[[j]]),
107	3x	stats::setNames(list(data[[j]]), param)
108		)
109		}
110		}
111		} else {
112	4x	for(k in seq_along(e$x$opts$options[[i]]$series)){
113	4x	if(!is.null(.serie) && .serie != k)
114	!	next
115	4x	e$x$opts$options[[i]]$series[[k]]$data[[j]][[param]] <- data[[j]]
116		}
117		}
118		}
119		}
120	9x	e
121		}
122
123		#' @rdname nesting
124		#' @export
125		e_add_unnested <- function(e, param, value, .serie = NULL, .data = NULL) {
126	8x	if (missing(e) \|\| missing(param) \|\| missing(value)) {
127	3x	stop("missing e, param, or value", call. = FALSE)
128		}
129
130	5x	if(is.null(.data))
131	5x	ds <- e$x$data
132		else
133	!	ds <- map_grps_(.data, e$x$tl)
134
135	5x	for (i in seq_along(ds)) {
136	6x	data <- ds[[i]] \|>
137	6x	dplyr::pull({{ value }}) \|>
138	6x	unname()
139
140	6x	for (j in seq_along(data)) {
141	15x	if(!is.null(.serie) && .serie != j)
142	2x	next
143
144	13x	if (!e$x$tl) {
145	9x	if(!is.numeric(e$x$opts$series[[i]]$data[[j]])){
146	6x	e$x$opts$series[[i]]$data[[j]][[param]] <- data[j]
147		} else {
148		# If polar, 'itemStyle' may be in a different location - this fixes that.N
149	3x	e$x$opts$series[[i]]$data[[j]] <- c(
150	3x	list(value = e$x$opts$series[[i]]$data[[j]]),
151	3x	stats::setNames(list(data[[j]]), param)
152		)
153		}
154		} else {
155	4x	for(k in seq_along(e$x$opts$options[[i]]$series)){
156	4x	e$x$opts$options[[i]]$series[[k]]$data[[j]][[param]] <- data[j]
157		}
158		}
159		}
160		}
161	5x	e
162		}
163
164
165		#' Insert binded data
166		#'
167		#' Utility function to attach an existing column(s) from your data to an existing series
168		#'
169		#' @inheritParams e_bar
170		#' @param .serie Serie's index to add the data.
171		#' @param .data Column names for the new data.
172		#'
173		#' @details This inserts new data into a series's values which allows for use in mapping things like e_visual_map
174		#' or tooltip parameters. This function also works when using timelines.
175		#'
176		#' @examples
177		#' mtcars \|>
178		#' e_charts(mpg) \|>
179		#' e_scatter(wt, scale = e_scale) \|>
180		#' e_insert_data(.serie = 1, .data = "qsec") \|>
181		#' e_visual_map(qsec, scale = e_scale, dimension = 2) \|>
182		#' e_tooltip(trigger = "item",
183		#' formatter = htmlwidgets::JS("function(params) {
184		#' return 'mpg: ' + params.value[0] +
185		#' '<br />wt: ' + params.value[1] +
186		#' '<br />qsec: ' + params.value[2];
187		#' }")
188		#' )
189		#'
190		#' @name e_insert_data
191		#' @export
192		e_insert_data <- function(e, .serie, .data){
193	!	if(!e$x$tl){
194	!	for(i in seq_along(e$x$data)) {
195	!	bind <- e$x$data[[i]] \|>
196	!	dplyr::select(dplyr::all_of(.data)) \|>
197	!	unname() \|>
198	!	unlist()
199	!	for(j in seq_along(e$x$opts$series[[.serie]]$data)){
200	!	e$x$opts$series[[.serie]]$data[[j]]$value <- append(e$x$opts$series[[.serie]]$data[[j]]$value, bind[j])
201		}
202		}
203		} else {
204	!	for(i in seq_along(e$x$data)) {
205	!	bind <- e$x$data[[i]] \|>
206	!	dplyr::select(dplyr::all_of(.data)) \|>
207	!	unname() \|>
208	!	unlist()
209	!	for(j in seq_along(e$x$opts$options[[i]]$series[[.serie]]$data)){
210	!	e$x$opts$options[[i]]$series[[.serie]]$data[[j]]$value <- append(e$x$opts$options[[i]]$series[[.serie]]$data[[j]]$value, bind[j])
211		}
212		}
213		}
214	!	e
215		}

1	549x	`%\|\|%` <- function(a, b) if (is.null(a)) b else a
2
3		#' Add annotations to a chart
4		#'
5		#' @description
6		#'
7		#' Apache ECharts does not include a native annotation system. This is a custom
8		#' function that creates annotations using SVG. This currently only works in a
9		#' 'cartesian2d' coordinate system.
10		#'
11		#' Each annotation must be in a list with an x, y, and text. Styling can be
12		#' added - see @details. Because they are SVG, it takes SVG arguments, not
13		#' ECharts arguments for styling.
14		#'
15		#' In Shiny, to output an annotation position after dragging the box, use
16		#' \code{input$id_dragged_annotation} or see \link{echarts4r-shiny}. This
17		#' captures the annotation parameters - not any of the styles.
18		#'
19		#' @details annotations can take the following styles to change the defaults. To
20		#' remove any element use "none".
21		#'
22		#' - \strong{rectStyle} Styles the annotation box. It also takes \strong{shape} that uses \href{https://echarts.apache.org/en/option.html#graphic.elements-rect.shape}{echarts graphic.elements-rect.shape attributes} that controls rectangle width, height and corner radius.
23		#'
24		#' - \strong{textStyle}, Styles the annotation text. This supports limited HTML tags using tspan. Supported tags are: \code{b, strong, i, em, u, br, span}. Styling inside \code{span} can use \code{color, fontSize, fontWeight, fontStyle}. \code{x} and \code{y} attributes are automatically determined based on box size, unless specified. \code{padding_trbl} was also added to add padding - this must be a list of exactly 4 integers - in the order of top, right, bottom, and left padding. This padding just pushes the text in that direction.
25		#'
26		#' - \strong{lineStyle} Styles the line that connects the annotation box to the arrow using \href{https://www.w3schools.com/graphics/svg_stroking.asp}{SVG stroke attributes}
27		#'
28		#' - \strong{arrowStyle}: Styles the arrow. size was added that automatically adjusts the vertices of the triangle.
29		#'
30		#' @param e An echarts4r object
31		#' @param annotations list of annotations to plot
32		#' @param .facet integer; facet's index. Only needed for faceted plots. Defaults to first plot.
33		#' panel.
34		#' @param legend Whether to add annotations to legend.
35		#' @param name name of the legend
36		#' @param legend_color color of the legend box
37		#' @param default_color color of all SVG elements, unless specified in each
38		#' style. It colors text, line, arrow, and rectable outline.
39		#' @param draggable booleon; if TRUE, annotations can be dragged by the user
40		#' @note HTML tags may not apply in RStudio viewer, open in browser.
41		#'
42		#' @examples
43		#' # May not work render HTML correctly in RStudio viewer
44		#' # Open in browser
45		#' mtcars \|>
46		#' e_charts(mpg) \|>
47		#' e_scatter(wt) \|>
48		#' e_annotations(
49		#' annotations = list(
50		#' list(
51		#' id = 0,
52		#' x = 15,
53		#' y = 3,
54		#' text = 'An annotation<br>with <i>style</i>',
55		#' offsetX = 0,
56		#' offsetY = -50,
57		#' textStyle = list(
58		#' "font-size" = 14,
59		#' "font-weight" = 'bold',
60		#' color = "#394",
61		#' padding_trbl = list(0, 0, 5, 0)
62		#' ),
63		#' rectStyle = list(
64		#' `stroke-dasharray` = c(35, 10),
65		#' `stroke-width` = 2,
66		#' # Shadow can be added!
67		#' shadow = list(
68		#' dx= 0,
69		#' dy= 2,
70		#' blur= 4,
71		#' color= '#000',
72		#' opacity= 0.3
73		#' ),
74		#' shape = list(width = 105, height = 50, r = 0)
75		#' ),
76		#' lineStyle = list(`stroke-width` = 2),
77		#' arrowStyle = list(size = 8)
78		#' ),
79		#' # No styles, will just show text
80		#' list(
81		#' id = 0,
82		#' x = 25,
83		#' y = 1,
84		#' text = 'No styles',
85		#' lineStyle = "none",
86		#' rectStyle = "none",
87		#' arrowStyle = "none"
88		#' ),
89		#' # Default style
90		#' list(
91		#' id = 2,
92		#' x = 25,
93		#' y = 4.5,
94		#' text = "Default style",
95		#' offsetX = 0,
96		#' offsetY = -40
97		#' ),
98		#' # left-aligned annotation
99		#' list(
100		#' id = 2,
101		#' x = 0,
102		#' y = 0.5,
103		#' text = "I'm left<br>aligned!",
104		#' offsetX = 60,
105		#' offsetY = -40,
106		#' textStyle = list(
107		#' "text-anchor" = "start",
108		#' padding_trbl = list(0, 0, 6, 10)
109		#' )
110		#' )
111		#' ))
112		#' @seealso
113		#'
114		#' - \href{https://www.w3schools.com/graphics/svg_text.asp}{Additional arguments for textStyle}
115		#'
116		#' - \href{https://www.w3schools.com/graphics/svg_stroking.asp}{Additional arguments for rectStyle}
117		#'
118		#' - \href{https://www.w3schools.com/graphics/svg_stroking.asp}{Additional
119		#' arguments for lineStyle}
120		#'
121		#' - \href{https://www.w3schools.com/graphics/svg_fill.asp}{Additional
122		#' arguments for arrowStyle}
123		#'
124		#' - \href{https://developer.mozilla.org/en-US/docs/Web/SVG/Reference/Attribute}{Even more arguments for SVG attributes}
125		#'
126		#' @rdname e_annotations
127		#' @export
128		e_annotations <- function(
129		e,
130		annotations,
131		.facet = NULL,
132		legend = TRUE,
133		name = "Annotations",
134		legend_color = '#738DE4',
135		default_color = '#738DE4',
136		draggable = TRUE
137		) {
138	8x	if (missing(e)) {
139	1x	stop("must pass e", call. = FALSE)
140		}
141
142	7x	if (missing(annotations)) {
143	1x	stop("must provide list of annotations")
144		}
145
146	6x	if (!is.list(annotations) \|\| !is.list(annotations[[1]])) {
147	2x	stop("annotations must be a list")
148		}
149
150	4x	if(!is.null(.facet) && !is.numeric(.facet)){
151	!	stop(".facet must be an integer, The first facet (.facet = 1) is the default when facet is NULL.")
152		}
153
154
155	4x	if (!is.null(.facet)) {
156		# facet number (1-based R indexing)
157	!	grid_idx <- .facet - 1
158		} else {
159	4x	grid_idx <- 0
160		}
161
162
163
164	4x	new_annos <- lapply(annotations, function(ann) {
165	4x	processed <- process_single_annotation(ann, default_color, draggable)
166	4x	processed$gridIndex <- ann$gridIndex %\|\|% grid_idx
167	4x	processed$legend_name <- ann$legend_name %\|\|% name
168	4x	processed
169		})
170
171		# Get existing annotations from chart object
172	4x	existing_annos <- e$x$annotations %\|\|% list()
173
174		# Add new annotation to list
175	4x	if (is.null(existing_annos) \|\| length(existing_annos) == 0) {
176	3x	all_annos <- new_annos
177		} else {
178	1x	all_annos <- existing_annos
179	1x	for (new_anno in new_annos) {
180	1x	all_annos[[length(all_annos) + 1]] <- new_anno
181		}
182		}
183
184		# Store back in chart object
185	4x	e$x$annotations <- all_annos
186
187		# ADD DUMMY SERIES FOR LEGEND
188	4x	if (legend) {
189		# Extract unique legend groups
190	4x	legend_info <- list()
191
192	4x	for (i in seq_along(all_annos)) {
193	5x	ann <- all_annos[[i]]
194
195		# Get color
196	5x	color <- legend_color
197
198		# Get grid
199	5x	grid_idx <- if (!is.null(ann$gridIndex)) {
200	5x	ann$gridIndex
201		} else {
202	!	0
203		}
204		# Store first occurrence
205	5x	if (is.null(legend_info[[name]])) {
206	4x	legend_info[[name]] <- list(
207	4x	color = color,
208	4x	gridIndex = grid_idx
209		)
210		}
211		}
212
213		# Add a dummy series for each unique legend group
214	4x	if (is.null(e$x$opts$series)) {
215	!	e$x$opts$series <- list()
216		}
217
218	4x	for (group_name in names(legend_info)) {
219	4x	info <- legend_info[[group_name]]
220
221	4x	dummy_series <- list(
222	4x	type = "scatter",
223	4x	name = group_name,
224	4x	data = list(), # Empty data
225	4x	symbol = "rect",
226	4x	symbolSize = 8,
227	4x	itemStyle = list(
228	4x	color = info$color
229		),
230	4x	gridIndex = info$gridIndex,
231	4x	xAxisIndex = info$gridIndex,
232	4x	yAxisIndex = info$gridIndex,
233	4x	tooltip = list(show = FALSE),
234	4x	silent = TRUE,
235	4x	animation = FALSE,
236	4x	isAnnotationLegend = TRUE
237		)
238
239	4x	if (isTRUE(e$x$tl)) {
240	!	e$x$opts$baseOption$series[[
241	!	length(e$x$opts$baseOption$series) + 1
242	!	]] <- dummy_series
243		} else {
244		# Append to series
245	4x	e$x$opts$series[[length(e$x$opts$series) + 1]] <- dummy_series
246		}
247		}
248		}
249
250		# Adding this solves the issue for the SVG line to get messed up when
251		# `shiny::fluidRow(echarts4r::echarts4rOutput("chart"))` with no e_tooltip().
252		# I don't understand why this fixes it.
253	4x	if (!e$x$tl & is.null(e$x$opts$tooltip)) {
254	3x	e$x$opts$tooltip <- list(trigger = 'fake')
255	1x	} else if ((e$x$tl & is.null(e$x$opts$tooltip))) {
256	!	e$x$opts$baseOption$tooltip <- list(trigger = 'fake')
257		}
258
259	4x	dep <-
260	4x	htmltools::htmlDependency(
261	4x	name = "echarts-annotations",
262	4x	version = "1.0.0",
263	4x	src = system.file("htmlwidgets/lib/echarts-6.1.0/plugins/", package = "echarts4r"),
264	4x	script = "echarts-annotations.js"
265		)
266
267	4x	e$dependencies <- append(e$dependencies, list(dep))
268
269	4x	e \|>
270	4x	htmlwidgets::onRender(
271	4x	"function(el, x, data) {
272	4x	function initWhenReady() {
273	4x	if (typeof EChartsAnnotations === 'undefined') {
274	4x	setTimeout(initWhenReady, 50);
275	4x	return;
276		}
277
278	4x	EChartsAnnotations.initialize(el, x, data);
279		}
280
281	4x	initWhenReady();
282		}"
283		)
284
285		}
286		# R function with multiple positioning options
287		#' @keywords internal
288		find_text_position <- function(
289		box_shape,
290		position = "middle"
291		) {
292
293		# Calculate base positions
294	23x	x_left <- box_shape$x
295	23x	x_middle <- box_shape$x + (box_shape$width / 2)
296	23x	x_right <- box_shape$x + box_shape$width
297
298	23x	y_top <- box_shape$y
299	23x	y_middle <- box_shape$y + (box_shape$height / 2)
300	23x	y_bottom <- box_shape$y + box_shape$height
301
302		# Choose position
303	23x	pos <- switch(
304	23x	position,
305	23x	"middle" = list(
306	23x	x = x_middle,
307	23x	y = y_middle
308		),
309	23x	"start" = list(x = x_left,
310	23x	y = y_middle),
311	23x	"end" = list(
312	23x	x = x_right,
313	23x	y = y_middle
314		),
315		# default to middle
316	23x	list(x = x_middle, y = y_middle)
317		)
318	23x	pos
319		}
320
321		# Process a single annotation with all styles so js can read it.
322		#' @keywords internal
323		process_single_annotation <- function(
324		ann,
325		default_color = "#738DE4",
326		draggable = TRUE
327		) {
328		# Required fields
329	26x	if (is.null(ann$x) \|\| is.null(ann$y) \|\| is.null(ann$text)) {
330	3x	stop("Annotation must have x, y, and text fields")
331		}
332
333		# Default Properties --
334		# For these, better to use ann$arrowStyle[["fill"]] evaluation as opposed to ann$arrowStyle$fill so it does do a partial match.
335
336	23x	default_text_style <- list(
337	23x	"font-size" = 11,
338	23x	"font-weight" = 'bold',
339	23x	"text-anchor" = ann$textStyle[["text-anchor"]] %\|\|% "middle",
340	23x	"dominant-baseline" = ann$textStyle[["dominant-baseline"]] %\|\|% "central"
341		)
342
343	23x	if (if_style_is_not_none(ann$lineStyle)) {
344	22x	default_line_style <- list(
345	22x	`stroke-width` = 2,
346	22x	stroke = ann$lineStyle[["stroke"]] %\|\|% default_color
347		)
348		} else {
349	1x	default_line_style <- list()
350	1x	ann$lineStyle <- NULL
351		}
352
353	23x	if (if_style_is_not_none(ann$arrowStyle)) {
354	22x	default_arrow_style <- list(
355	22x	fill = ann$arrowStyle[["fill"]] %\|\|% default_color,
356	22x	size = ann$arrowStyle[["size"]] %\|\|% 8
357		)
358		} else {
359	1x	default_arrow_style <- list(size = 0)
360	1x	ann$arrowStyle <- NULL
361		}
362
363	23x	if (if_style_is_not_none(ann$rectStyle)) {
364	22x	default_box_style <- list(
365	22x	stroke = ann$rectStyle[["stroke"]] %\|\|% default_color,
366	22x	fill = '#ffffff',
367	22x	"stroke-width" = 2
368		)
369		} else {
370		# Fully transparent
371	1x	default_box_style <- list(fill = "rgba(255, 255, 255, 0)")
372	1x	ann$rectStyle <- NULL
373		}
374
375	23x	default_box_width <- 80
376	23x	default_box_height <- 40
377	23x	default_box_radius <- 3
378
379	23x	padding <- ann$textStyle$padding_trbl
380
381	23x	if(!is.null(padding) && length(padding) > 0){
382	2x	isPadNumber <- is.numeric(unlist(padding))
383
384	2x	if(length(padding) != 4 \|\| isPadNumber == FALSE){
385	2x	stop("padding_trbl must be a list with 4 numbers")
386		}
387		}
388
389	21x	pad_top <- padding[[1]] %\|\|% 0
390	21x	pad_right <- padding[[2]] %\|\|% 0
391	21x	pad_bot <- padding[[3]] %\|\|% 0
392	21x	pad_left <- padding[[4]] %\|\|% 0
393
394		# Find box position --
395
396		# None of these should ever be NA
397	21x	box_width <- ann$rectStyle$shape[["width"]] %\|\|% default_box_width
398	21x	box_height <- ann$rectStyle$shape[["height"]] %\|\|% default_box_height
399	21x	box_radius <- ann$rectStyle$shape[["r"]] %\|\|% default_box_radius
400	21x	box_x <- ann$rectStyle$shape[["x"]] %\|\|% -box_width / 2
401	21x	box_y <- ann$rectStyle$shape[["y"]] %\|\|% -box_height / 2
402
403		# Box shape.
404		# x and y make the line connect in the middle.
405	21x	box_shape <- list(
406	21x	x = box_x,
407	21x	y = box_y,
408	21x	width = box_width,
409	21x	height = box_height,
410	21x	r = box_radius
411		)
412
413		# Calculate text position (start, end, middle)
414	21x	text_pos <- find_text_position(
415	21x	box_shape,
416	21x	position = default_text_style[["text-anchor"]]
417		)
418
419	21x	final_text_style <- utils::modifyList(
420	21x	default_text_style,
421	21x	c(
422	21x	ann$textStyle %\|\|% list(),
423	21x	list(
424	21x	x = (ann$textStyle$x %\|\|% text_pos$x) + pad_left - pad_right,
425	21x	y = (ann$textStyle$y %\|\|% text_pos$y) + pad_top - pad_bot,
426	21x	text = as.character(ann$text),
427	21x	fill = ann$textStyle[["color"]] %\|\|% default_color
428		)
429		)
430		)
431
432	21x	final_box_style <- utils::modifyList(
433	21x	default_box_style,
434	21x	c(
435	21x	ann$rectStyle %\|\|% list()
436		)
437		)
438
439	21x	final_line_style <- utils::modifyList(
440	21x	default_line_style,
441	21x	c(
442	21x	ann$lineStyle %\|\|% list()
443		)
444		)
445
446	21x	final_arrow_style <- utils::modifyList(
447	21x	default_arrow_style,
448	21x	c(
449	21x	ann$arrowStyle %\|\|% list()
450		)
451		)
452
453	21x	arrow_size <- final_arrow_style$size
454
455	21x	arrow_vertices <- list(
456	21x	c(-arrow_size / 2, -arrow_size),
457	21x	c(arrow_size / 2, -arrow_size),
458	21x	c(0, 0)
459		)
460
461	21x	list(
462	21x	id = ann$id %\|\|% 0,
463	21x	x = ann$x,
464	21x	y = ann$y,
465	21x	text = ann$text,
466	21x	offsetX = ann$offsetX %\|\|% 0,
467	21x	offsetY = ann$offsetY %\|\|% 0,
468	21x	rectShape = box_shape,
469	21x	rectStyle = final_box_style,
470	21x	textStyle = final_text_style,
471	21x	lineStyle = final_line_style,
472	21x	arrowStyle = final_arrow_style,
473	21x	arrowVertices = arrow_vertices,
474	21x	arrowTip = -arrow_size,
475	21x	draggable = draggable
476		)
477		}
478
479		#' Determine if first element is none, then no style
480		#'The first element could be NULL, a style, or a vector so we must account for all these.
481		#' style = NULL
482		#' style = list(lineWidth = 5)
483		#' style = list(shape = list(width = 100))
484		#' @keywords internal
485		if_style_is_not_none <- function(style) {
486	73x	is.null(style) \|\|
487	73x	!(is.character(style[[1]]) && style[[1]] == "none")
488		}

1		.onAttach <- function(libname, pkgname) {
2	2x	shiny::registerInputHandler("echarts4rParse", function(data, ...) {
3	!	jsonlite::fromJSON(jsonlite::toJSON(data, auto_unbox = TRUE))
4	2x	}, force = TRUE)
5
6	2x	options(
7	2x	"ECHARTS4R_THEME" = NULL,
8	2x	"ECHARTS4R_FONT_FAMILY" = NULL
9		)
10		}
11
12		.onLoad <- function(libname, pkgname) {
13	!	shiny::registerInputHandler("echarts4rParse", function(data, ...) {
14	!	jsonlite::fromJSON(jsonlite::toJSON(data, auto_unbox = TRUE))
15	!	}, force = TRUE)
16
17	!	options(
18	!	"ECHARTS4R_THEME" = NULL,
19	!	"ECHARTS4R_FONT_FAMILY" = NULL
20		)
21		}

1		#' Highlight & Downplay Proxy
2		#'
3		#' Proxies to highlight and downplay series.
4		#'
5		#' @param proxy An echarts4r proxy as returned by \code{\link{echarts4rProxy}}.
6		#' @param series_index Series index, can be a vector.
7		#' @param series_name Series Name, can be vector.
8		#'
9		#' @examples
10		#' \dontrun{
11		#' library(shiny)
12		#'
13		#' ui <- fluidPage(
14		#' fluidRow(
15		#' column(
16		#' 3,
17		#' actionButton("highlightmpg", "Highlight MPG")
18		#' ),
19		#' column(
20		#' 3,
21		#' actionButton("highlighthp", "Highlight HP")
22		#' ),
23		#' column(
24		#' 3,
25		#' actionButton("downplaympg", "Downplay MPG")
26		#' ),
27		#' column(
28		#' 3,
29		#' actionButton("downplayhp", "Downplay HP")
30		#' )
31		#' ),
32		#' echarts4rOutput("plot")
33		#' )
34		#'
35		#' server <- function(input, output, session) {
36		#' output$plot <- renderEcharts4r({
37		#' mtcars \|>
38		#' e_charts(mpg) \|>
39		#' e_line(disp) \|>
40		#' e_line(hp, name = "HP") # explicitly pass name
41		#' })
42		#'
43		#' # highlight
44		#'
45		#' observeEvent(input$highlightmpg, {
46		#' echarts4rProxy("plot") \|>
47		#' e_highlight_p(series_index = 0) # using index
48		#' })
49		#'
50		#' observeEvent(input$highlighthp, {
51		#' echarts4rProxy("plot") \|>
52		#' e_highlight_p(series_name = "HP") # using name
53		#' })
54		#'
55		#' # downplay
56		#'
57		#' observeEvent(input$downplaympg, {
58		#' echarts4rProxy("plot") \|>
59		#' e_downplay_p(series_name = "disp")
60		#' })
61		#'
62		#' observeEvent(input$downplayhp, {
63		#' echarts4rProxy("plot") \|>
64		#' e_downplay_p(series_index = 1)
65		#' })
66		#' }
67		#'
68		#' if (interactive()) {
69		#' shinyApp(ui, server)
70		#' }
71		#' }
72		#'
73		#' @rdname highlight_proxy
74		#' @export
75		e_highlight_p <- function(proxy, series_index = NULL, series_name = NULL) {
76	7x	if (!"echarts4rProxy" %in% class(proxy)) {
77	2x	stop("must pass echarts4rProxy object", call. = FALSE)
78		}
79
80	5x	data <- list(id = proxy$id)
81	3x	if (!is.null(series_index)) data$seriesIndex <- series_index
82	3x	if (!is.null(series_name)) data$seriesName <- series_name
83
84	5x	proxy$session$sendCustomMessage("e_highlight_p", data)
85
86	5x	return(proxy)
87		}
88
89		#' @rdname highlight_proxy
90		#' @export
91		e_downplay_p <- function(proxy, series_index = NULL, series_name = NULL) {
92	2x	if (!"echarts4rProxy" %in% class(proxy)) {
93	1x	stop("must pass echarts4rProxy object", call. = FALSE)
94		}
95
96	1x	data <- list(id = proxy$id)
97	!	if (!is.null(series_index)) data$seriesIndex <- series_index
98	!	if (!is.null(series_name)) data$seriesName <- series_name
99
100	1x	proxy$session$sendCustomMessage("e_downplay_p", data)
101
102	1x	return(proxy)
103		}
104
105		#' Tooltip Proxy
106		#'
107		#' Proxies to show or hide tooltip.
108		#'
109		#' @inheritParams e_highlight_p
110		#' @param ... Any other option, see \href{https://echarts.apache.org/en/api.html#action.tooltip}{showTip}.
111		#'
112		#' @examples
113		#' \dontrun{
114		#' library(shiny)
115		#'
116		#' ui <- fluidPage(
117		#' fluidRow(
118		#' actionButton("show", "Show tooltip"),
119		#' actionButton("hide", "Hide tooltip")
120		#' ),
121		#' fluidRow(
122		#' echarts4rOutput("plot"),
123		#' h3("clicked Data"),
124		#' verbatimTextOutput("clickedData"),
125		#' h3("clicked Serie"),
126		#' verbatimTextOutput("clickedSerie"),
127		#' h3("clicked Row"),
128		#' verbatimTextOutput("clickedRow")
129		#' )
130		#' )
131		#'
132		#' server <- function(input, output, session) {
133		#' output$plot <- renderEcharts4r({
134		#' mtcars \|>
135		#' e_charts(mpg) \|>
136		#' e_line(disp, bind = carb, name = "displacement") \|>
137		#' e_line(hp) \|>
138		#' e_x_axis(min = 10) \|>
139		#' e_tooltip(show = FALSE) \|>
140		#' e_theme("westeros")
141		#' })
142		#'
143		#' observeEvent(input$show, {
144		#' echarts4rProxy("plot") \|>
145		#' e_showtip_p(
146		#' name = "displacement",
147		#' position = list(5, 5)
148		#' )
149		#' })
150		#'
151		#' observeEvent(input$hide, {
152		#' echarts4rProxy("plot") \|>
153		#' e_hidetip_p()
154		#' })
155		#'
156		#' output$clickedData <- renderPrint({
157		#' input$plot_clicked_data
158		#' })
159		#'
160		#' output$clickedSerie <- renderPrint({
161		#' input$plot_clicked_serie
162		#' })
163		#'
164		#' output$clickedRow <- renderPrint({
165		#' input$plot_clicked_row
166		#' })
167		#' }
168		#'
169		#' if (interactive()) {
170		#' shinyApp(ui, server)
171		#' }
172		#' }
173		#'
174		#' @rdname tooltip_proxy
175		#' @export
176		e_showtip_p <- function(proxy, ...) {
177	2x	if (!"echarts4rProxy" %in% class(proxy)) {
178	1x	stop("must pass echarts4rProxy object", call. = FALSE)
179		}
180
181	1x	data <- list(
182	1x	id = proxy$id,
183	1x	opts = list(
184	1x	type = "showTip",
185		...
186		)
187		)
188
189	1x	proxy$session$sendCustomMessage("e_showtip_p", data)
190
191	1x	return(proxy)
192		}
193
194		#' @rdname tooltip_proxy
195		#' @export
196		e_hidetip_p <- function(proxy) {
197	2x	if (!"echarts4rProxy" %in% class(proxy)) {
198	1x	stop("must pass echarts4rProxy object", call. = FALSE)
199		}
200
201	1x	data <- list(id = proxy$id)
202
203	1x	proxy$session$sendCustomMessage("e_hidetip_p", data)
204
205	1x	return(proxy)
206		}
207
208		#' Node Adjacency
209		#'
210		#' Focus or unfocus on node adjacency.
211		#'
212		#' @inheritParams e_highlight_p
213		#' @param index One or more node index to focus on.
214		#' @param ... Any other options, see
215		#' \href{https://echarts.apache.org/en/api.html#action.graph}{official documentation} and details.
216		#'
217		#' @details Must pass \code{seriesId}, \code{seriesIndex}, or \code{seriesName}, generally \code{seriesIndex = 0} will work.
218		#'
219		#' @examples
220		#' value <- rnorm(10, 10, 2)
221		#'
222		#' nodes <- data.frame(
223		#' name = sample(LETTERS, 10),
224		#' value = value,
225		#' size = value,
226		#' grp = rep(c("grp1", "grp2"), 5),
227		#' stringsAsFactors = FALSE
228		#' )
229		#'
230		#' edges <- data.frame(
231		#' source = sample(nodes$name, 20, replace = TRUE),
232		#' target = sample(nodes$name, 20, replace = TRUE),
233		#' stringsAsFactors = FALSE
234		#' )
235		#' \dontrun{
236		#'
237		#' library(shiny)
238		#'
239		#' ui <- fluidPage(
240		#' fluidRow(
241		#' column(
242		#' 2,
243		#' numericInput("index", "Node", value = 3, min = 1, max = 9)
244		#' ),
245		#' column(
246		#' 2,
247		#' br(),
248		#' actionButton("focus", "Focus")
249		#' ),
250		#' column(
251		#' 2,
252		#' br(),
253		#' actionButton("unfocus", "Unfocus")
254		#' )
255		#' ),
256		#' fluidRow(
257		#' column(12, echarts4rOutput("graph"))
258		#' )
259		#' )
260		#'
261		#' server <- function(input, output, session) {
262		#' output$graph <- renderEcharts4r({
263		#' e_charts() \|>
264		#' e_graph() \|>
265		#' e_graph_nodes(nodes, name, value, size, grp) \|>
266		#' e_graph_edges(edges, source, target)
267		#' })
268		#'
269		#' observeEvent(input$focus, {
270		#' echarts4rProxy("graph") \|>
271		#' e_focus_adjacency_p(
272		#' seriesIndex = 0,
273		#' index = input$index
274		#' )
275		#' })
276		#'
277		#' observeEvent(input$unfocus, {
278		#' echarts4rProxy("graph") \|>
279		#' e_unfocus_adjacency_p(seriesIndex = 0)
280		#' })
281		#' }
282		#'
283		#' if (interactive()) {
284		#' shinyApp(ui, server)
285		#' }
286		#' }
287		#'
288		#' @rdname node_adjacency
289		#' @export
290		e_focus_adjacency_p <- function(proxy, index, ...) {
291	!	.Deprecated("Dropped in v5 use: emphasis = list(focus = 'adjacency')")
292	!	if (!"echarts4rProxy" %in% class(proxy)) {
293	!	stop("must pass echarts4rProxy object", call. = FALSE)
294		}
295
296	!	args <- list(...)
297
298	!	hasArgs <- c("seriesId", "seriesIndex", "seriesName") %in% names(args)
299
300	!	if (sum(hasArgs) != 1) {
301	!	stop("Must pass one of seriesId, seriesIndex, or seriesName", call. = FALSE)
302		}
303
304	!	data <- purrr::map(index, function(i, id) {
305	!	list(
306	!	id = id,
307	!	opts = list(
308	!	type = "focusNodeAdjacency",
309	!	dataIndex = i,
310		...
311		)
312		)
313	!	}, id = proxy$id)
314
315	!	proxy$session$sendCustomMessage("e_focus_node_adjacency_p", data)
316
317	!	return(proxy)
318		}
319
320		#' @rdname node_adjacency
321		#' @export
322		e_unfocus_adjacency_p <- function(proxy, ...) {
323	!	.Deprecated("Dropped in v5 use: emphasis = list(focus = 'adjacency')")
324	!	if (!"echarts4rProxy" %in% class(proxy)) {
325	!	stop("must pass echarts4rProxy object", call. = FALSE)
326		}
327
328	!	args <- list(...)
329
330	!	hasArgs <- c("seriesId", "seriesIndex", "seriesName") %in% names(args)
331
332	!	if (sum(hasArgs) != 1) {
333	!	stop("Must pass one of seriesId, seriesIndex, or seriesName", call. = FALSE)
334		}
335
336	!	data <- list(
337	!	id = proxy$id,
338	!	opts = list(
339	!	type = "unfocusNodeAdjacency",
340		...
341		)
342		)
343
344	!	proxy$session$sendCustomMessage("e_unfocus_node_adjacency_p", data)
345
346	!	return(proxy)
347		}
348
349		#' Dispatch Action
350		#'
351		#' Create your own proxies, essentially a wrapper around the
352		#' \href{https://echarts.apache.org/en/api.html#action}{action API}.
353		#'
354		#' @inheritParams e_highlight_p
355		#' @param type Type of action to dispatch, i.e.: \code{highlight}.
356		#' @param ... Named options.
357		#'
358		#' @examples
359		#' \dontrun{
360		#'
361		#' library(shiny)
362		#'
363		#' ui <- fluidPage(
364		#' fluidRow(
365		#' column(8, echarts4rOutput("chart")),
366		#' column(4, actionButton("zoom", "Zoom"))
367		#' )
368		#' )
369		#'
370		#' server <- function(input, output, session) {
371		#' output$chart <- renderEcharts4r({
372		#' cars \|>
373		#' e_charts(speed) \|>
374		#' e_scatter(dist) \|>
375		#' e_datazoom()
376		#' })
377		#'
378		#' observe({
379		#' req(input$zoom)
380		#'
381		#' echarts4rProxy("chart") \|>
382		#' e_dispatch_action_p("dataZoom", startValue = 1, endValue = 10)
383		#' })
384		#' }
385		#'
386		#' if (interactive()) {
387		#' shinyApp(ui, server)
388		#' }
389		#' }
390		#'
391		#' @export
392		e_dispatch_action_p <- function(proxy, type, ...) {
393	3x	if (missing(proxy) \|\| missing(type)) {
394	1x	stop("must pass proxy and type", call. = FALSE)
395		}
396
397	2x	if (!"echarts4rProxy" %in% class(proxy)) {
398	1x	stop("must pass echarts4rProxy object", call. = FALSE)
399		}
400
401	1x	data <- list(id = proxy$id, opts = list(type = type, ...))
402
403	1x	proxy$session$sendCustomMessage("e_dispatch_action_p", data)
404		}
405
406
407		#' Capture event
408		#'
409		#' Add an event capture.
410		#'
411		#' @inheritParams e_bar
412		#' @param event An event name from the \href{https://echarts.apache.org/en/api.html#events}{event documentation}.
413		#'
414		#' @details Many events can be captured, however not all are integrated, you can pass one that is not implemented with this function.
415		#'
416		#' @examples
417		#' \dontrun{
418		#' # add datazoom
419		#' library(shiny)
420		#'
421		#' ui <- fluidPage(
422		#' echarts4rOutput("chart"),
423		#' verbatimTextOutput("zoom")
424		#' )
425		#'
426		#' server <- function(input, output) {
427		#' output$chart <- renderEcharts4r({
428		#' mtcars \|>
429		#' e_charts(mpg) \|>
430		#' e_scatter(qsec) \|>
431		#' e_datazoom() \|>
432		#' e_capture("datazoom")
433		#' })
434		#'
435		#' output$zoom <- renderPrint({
436		#' input$chart_datazoom
437		#' })
438		#' }
439		#'
440		#' if (interactive()) {
441		#' shinyApp(ui, server)
442		#' }
443		#' }
444		#'
445		#' @export
446		e_capture <- function(e, event) {
447	1x	e$x$capture <- event
448	1x	e
449		}
450
451		#' Draw
452		#'
453		#' Draw the chart.
454		#'
455		#' @inheritParams e_highlight_p
456		#'
457		#' @examples
458		#' \dontrun{
459		#' library(shiny)
460		#'
461		#' ui <- fluidPage(
462		#' echarts4rOutput("chart"),
463		#' actionButton("draw", "draw")
464		#' )
465		#'
466		#' server <- function(input, output) {
467		#' output$chart <- renderEcharts4r({
468		#' mtcars \|>
469		#' e_charts(mpg, draw = FALSE) \|>
470		#' e_scatter(qsec) \|>
471		#' e_datazoom()
472		#' })
473		#'
474		#' observeEvent(input$draw, {
475		#' echarts4rProxy("chart") \|>
476		#' e_draw_p()
477		#' })
478		#' }
479		#'
480		#' if (interactive()) {
481		#' shinyApp(ui, server)
482		#' }
483		#' }
484		#'
485		#' @details Useful if you set \code{draw} to \code{FALSE} in \code{\link{e_charts}}.
486		#'
487		#' @export
488		e_draw_p <- function(proxy) {
489	3x	if (missing(proxy)) {
490	1x	stop("must pass proxy and type", call. = FALSE)
491		}
492
493	2x	if (!"echarts4rProxy" %in% class(proxy)) {
494	1x	stop("must pass echarts4rProxy object", call. = FALSE)
495		}
496
497	1x	data <- list(id = proxy$id)
498
499	1x	proxy$session$sendCustomMessage("e_draw_p", data)
500		}
501
502		#' Resize
503		#'
504		#' Force resize the chart.
505		#'
506		#' @inheritParams e_highlight_p
507		#'
508		#' @export
509	1x	e_resize <- function(proxy) UseMethod("e_resize")
510
511		#' @export
512		#' @method e_resize echarts4rProxy
513		e_resize.echarts4rProxy <- function(proxy) {
514	1x	data <- list(id = proxy$id)
515	1x	proxy$session$sendCustomMessage("e_resize", data)
516	1x	return(proxy)
517		}

1		#' Facet
2		#'
3		#' Create facets for multiple plots.
4		#'
5		#' @inheritParams e_bar
6		#' @param rows,cols Number of rows and columns. If both are `NULL` the number of rows and columns
7		#' will be determined automatically.
8		#' @param legend_pos Position of the legend. One of "top", "right", "bottom", "left". Determines
9		#' to which side the `legend_space` argument applies.
10		#' @param legend_space Space between legend and plot area. The entered number will be used
11		#' as percentage.
12		#' @param margin_trbl Adjusts the size of the outside margin around the plotting area. Default is
13		#' `c(t = 2, r = 2, b = 5, l = 2)`. Numbers are used as percentage of total plotting area. To
14		#' change only e.g. two sides `c("r" = 8, "l" = 8)` could be used, other sides will use
15		#' defaults.
16		#' @param h_panel_space,v_panel_space Horizontal and vertical spacing between the individual grid
17		#' elements. Expects numeric input, which will be used as percentage of total plotting area.
18		#' Default `NULL` will automatically add some panel spacing for low dimensional grids.
19		#'
20		#'
21		#' @examples
22		#' group_size <- 20
23		#' n_groups <- 13
24		#' df <- data.frame("day" = rep(1:group_size, times=n_groups),
25		#' "temperature" = runif(group_size * n_groups, 10, 40),
26		#' "location" = rep(LETTERS[1:n_groups], each=group_size))
27		#'
28		#' df \|>
29		#' group_by(location) \|>
30		#' e_charts(day) \|>
31		#' e_line(temperature) \|>
32		#' e_facet(rows = 4, cols=4, legend_pos = "top", legend_space = 12)
33		#'
34		#' @details Each serie, i.e.: \code{\link{e_bar}} will be plotted against a facet.
35		#'
36		#'
37		#' @importFrom grDevices n2mfrow
38		#'
39		#'
40		#' @export
41		#' @importFrom grDevices n2mfrow
42		e_facet <- function(e,
43		rows = NULL,
44		cols = NULL,
45		legend_pos = "top",
46		legend_space = 10,
47		margin_trbl = c(t = 2, r = 2, b = 5, l = 2),
48		h_panel_space = NULL,
49		v_panel_space = NULL) {
50
51
52		# Generate default values ---------------------------------------------------------------------
53
54		# number of series
55	15x	nseries <- length(e$x$opts$series)
56
57	15x	if (is.null(rows) && is.null(cols)) {
58		# Automatically generate grid dimensions
59	1x	dims <- n2mfrow(nseries)
60	1x	rows <- dims[2]
61	1x	cols <- dims[1]
62	14x	} else if (is.null(rows) \|\| is.null(cols)) {
63	2x	stop("Must provide both the number of rows and columns.")
64		} else {
65		# Do series match the grid?
66	12x	if (nseries > rows * cols) {
67	1x	warning(paste0(nseries, " series exceed the number of panels created by ",
68	1x	rows, " rows and ", cols, " columns."))
69		}
70		}
71
72		# Specified margins
73	13x	spec_margin <- c("t", "r", "b", "l") %in% names(margin_trbl) # see which elements are present
74	13x	margin_trbl <- c(margin_trbl, # add missing elements
75	13x	c(t = 2, r = 2, b = 5, l = 5)[!spec_margin])
76
77		# Calculate spacings ------------------------------------------------------
78
79		# introduce some spacing between panels for low dimensional grids
80	13x	if (is.null(v_panel_space)) {
81	12x	v_panel_space <- if (rows < 10) 10 - rows else 0
82		} else {
83	1x	v_panel_space
84		}
85
86	13x	if (is.null(h_panel_space)) {
87	12x	h_panel_space <- if (cols < 10) 10 - cols else 0
88		} else {
89	1x	h_panel_space
90		}
91
92
93		# Maximum space for facets (depends on legend position, and space for axis labels)
94	13x	if (legend_pos %in% c("top", "bottom")) {
95	10x	w_max <- 100 - margin_trbl[["l"]] - margin_trbl[["r"]]
96	10x	h_max <- 100 - legend_space - margin_trbl[["b"]] - margin_trbl[["t"]]
97	3x	} else if (legend_pos %in% c("left", "right")){
98	2x	w_max <- 100 - legend_space - margin_trbl[["l"]] - margin_trbl[["r"]]
99	2x	h_max <- 100 - margin_trbl[["b"]] -margin_trbl[["t"]]
100		} else {
101	1x	w_max <- 100 - margin_trbl[["l"]] - margin_trbl[["r"]]
102	1x	h_max <- 100 - margin_trbl[["b"]] - margin_trbl[["t"]]
103		}
104
105		# Total space for panels, taking between-panel spacing, legend space, and
106		# extra space for axis labels into account
107	13x	rows_h_max <- h_max - (v_panel_space * (rows-1))
108	13x	cols_w_max <- w_max - (h_panel_space * (cols-1))
109
110		# Dimensions of each panel
111	13x	height <- rows_h_max / rows
112	13x	width <- cols_w_max / cols
113
114
115		# Panel positions ---------------------------------------------------------
116
117		# Offset only when legend is left or top
118	13x	top_offset <- 0
119	13x	left_offset <- 0
120	13x	if (legend_pos == "top") {
121	9x	top_offset <- legend_space
122		}
123	13x	if (legend_pos == "left") {
124	1x	left_offset <- legend_space
125		}
126
127		# Generate a vector for positions from the top
128	13x	top_pos_values <- vapply(
129	13x	X = seq_len(rows),
130	13x	FUN = function(x) {
131	22x	margin_trbl[["t"]] + top_offset + ((x - 1) * (height + v_panel_space))
132		},
133	13x	FUN.VALUE = numeric(1)
134		)
135
136	13x	top_positions <- rep(top_pos_values, each=cols)[1:nseries]
137
138		# Generate a vector for positions from the left
139	13x	left_pos_values <- vapply(
140	13x	X = seq_len(cols),
141	13x	FUN = function(x) {
142	26x	margin_trbl[["l"]] + left_offset + ((x-1) * (width + h_panel_space))
143		},
144	13x	FUN.VALUE = numeric(1)
145		)
146
147	13x	left_positions <- rep(left_pos_values, times=rows)[1:nseries]
148
149
150		# Create grid -------------------------------------------------------------
151
152		# Act differently depending on chart types
153	13x	chart_type <- e$x$opts$series[[1]]$type
154
155		# No chart type found
156	1x	if (is.null(chart_type)) stop("No chart type found for first series")
157
158		# When it is a pie chart
159	12x	if (chart_type == "pie") {
160	1x	for (i in 1:nseries) {
161
162	2x	e$x$opts$series[[i]]$height <- paste0(height, "%")
163	2x	e$x$opts$series[[i]]$width <- paste0(width, "%")
164	2x	e$x$opts$series[[i]]$top <- paste0(top_positions[i], "%")
165	2x	e$x$opts$series[[i]]$left <- paste0(left_positions[i], "%")
166	2x	e$x$opts$series[[i]]$avoidLabelOverlap <- FALSE # I noticed that many labels stay hidden when this is on the default: TRUE
167
168		}
169		}
170
171		# For any other chart type, might not always produce desired results
172		else {
173
174	11x	for (i in 1:nseries) {
175		# Create new grid elements
176	27x	e <- e \|>
177	27x	e_grid(
178	27x	height = paste0(height, "%"),
179	27x	width = paste0(width, "%"),
180	27x	top = paste0(top_positions[i], "%"),
181	27x	left = paste0(left_positions[i], "%")
182		)
183
184		# Create new axes for the series, that mimic the first axes
185	27x	e$x$opts$xAxis[[i]] <- e$x$opts$xAxis[[1]]
186	27x	e$x$opts$yAxis[[i]] <- e$x$opts$yAxis[[1]]
187
188		# Assign the new axes to the new grid element
189	27x	e$x$opts$xAxis[[i]]$gridIndex <- i - 1
190	27x	e$x$opts$yAxis[[i]]$gridIndex <- i - 1
191
192		# Dictate to which grid panel the series will be assigned
193	27x	e$x$opts$series[[i]]$yAxisIndex <- i - 1
194	27x	e$x$opts$series[[i]]$xAxisIndex <- i - 1
195
196		}
197		}
198
199	12x	e
200		}

1		#' Choropleth
2		#'
3		#' Draw maps.
4		#'
5		#' @inheritParams e_bar
6		#' @param serie Values to plot.
7		#' @param map Map type.
8		#' @param coord_system Coordinate system to use, one of \code{cartesian3D}, \code{geo3D}, \code{globe}.
9		#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
10		#' @param id,value,height Columns corresponding to registered map.
11		#'
12		#' @examples
13		#' \dontrun{
14		#' choropleth <- data.frame(
15		#' countries = c(
16		#' "France",
17		#' "Brazil",
18		#' "China",
19		#' "Russia",
20		#' "Canada",
21		#' "India",
22		#' "United States",
23		#' "Argentina",
24		#' "Australia"
25		#' ),
26		#' values = round(runif(9, 10, 25))
27		#' )
28		#'
29		#' choropleth \|>
30		#' e_charts(countries) \|>
31		#' e_map(values) \|>
32		#' e_visual_map(min = 10, max = 25)
33		#'
34		#' choropleth \|>
35		#' e_charts(countries) \|>
36		#' e_map_3d(values, shading = "lambert") \|>
37		#' e_visual_map(min = 10, max = 30)
38		#'
39		#' # custom
40		#' buildings <- jsonlite::read_json(
41		#' paste0(
42		#' "https://echarts.apache.org/examples/",
43		#' "data-gl/asset/data/buildings.json"
44		#' )
45		#' )
46		#'
47		#' heights <- purrr::map(buildings$features, "properties") \|>
48		#' purrr::map("height") \|>
49		#' unlist()
50		#'
51		#' names <- purrr::map(buildings$features, "properties") \|>
52		#' purrr::map("name") \|>
53		#' unlist()
54		#'
55		#' data <- dplyr::tibble(
56		#' name = names,
57		#' value = round(runif(length(names), 0, 1), 6),
58		#' height = heights / 10
59		#' )
60		#'
61		#' data \|>
62		#' e_charts() \|>
63		#' e_map_register("buildings", buildings) \|>
64		#' e_map_3d_custom(name, value, height) \|>
65		#' e_visual_map(
66		#' show = FALSE,
67		#' min = 0.4,
68		#' max = 1
69		#' )
70		#'
71		#' # timeline
72		#' choropleth <- data.frame(
73		#' countries = rep(choropleth$countries, 3)
74		#' ) \|>
75		#' dplyr::mutate(
76		#' grp = c(
77		#' rep(2016, nrow(choropleth)),
78		#' rep(2017, nrow(choropleth)),
79		#' rep(2018, nrow(choropleth))
80		#' ),
81		#' values = runif(27, 1, 10)
82		#' )
83		#'
84		#' choropleth \|>
85		#' group_by(grp) \|>
86		#' e_charts(countries, timeline = TRUE) \|>
87		#' e_map(values) \|>
88		#' e_visual_map(min = 1, max = 10)
89		#'
90		#' choropleth \|>
91		#' group_by(grp) \|>
92		#' e_charts(countries, timeline = TRUE) \|>
93		#' e_map_3d(values) \|>
94		#' e_visual_map(min = 1, max = 10)
95		#' }
96		#'
97		#' @seealso \code{\link{e_country_names}},
98		#' \href{https://echarts.apache.org/en/option.html#series-map}{Additional map arguments},
99		#' \href{https://echarts.apache.org/en/option-gl.html#series-map3D}{Additional map 3D arguments}
100		#'
101		#' @rdname map
102		#' @export
103		e_map <- function(e, serie, map = "world", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
104	7x	if (missing(e)) {
105	1x	stop("must pass e", call. = FALSE)
106		}
107
108	6x	if (!missing(serie)) {
109	6x	sr <- deparse(substitute(serie))
110		} else {
111	!	sr <- NULL
112		}
113
114	6x	e_map_(e, sr, map, name, rm_x, rm_y, ...)
115		}
116
117		#' @rdname map
118		#' @export
119		e_map_ <- function(e, serie = NULL, map = "world", name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
120	9x	if (missing(e)) {
121	1x	stop("must pass e", call. = FALSE)
122		}
123
124	8x	e <- .rm_axis(e, rm_x, "x")
125	8x	e <- .rm_axis(e, rm_y, "y")
126
127	8x	for (i in seq_along(e$x$data)) {
128	12x	app <- list(
129	12x	type = "map",
130	12x	map = map,
131	12x	name = name,
132		...
133		)
134
135	12x	app_data <- list()
136	12x	if (!is.null(serie)) {
137	12x	data <- .build_data2(e$x$data[[i]], serie)
138	12x	data <- .add_bind2(e, data, e$x$mapping$x, i = i)
139	12x	app_data <- list(data = data)
140		}
141
142	12x	if (!e$x$tl) {
143	7x	if (is.null(name) && !is.null(serie)) {
144	7x	app$name <- serie
145		}
146
147	7x	app <- append(app, app_data)
148
149	7x	e$x$opts$series <- append(e$x$opts$series, list(app))
150		} else {
151	5x	e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(app_data))
152		}
153		}
154
155	8x	if(length(e$x$data) == 0){
156	!	app <- list(
157	!	type = "map",
158	!	map = map,
159	!	name = name,
160		...
161		)
162	!	e$x$opts$series <- append(e$x$opts$series, list(app))
163		}
164
165	8x	if (isTRUE(e$x$tl)) {
166	1x	e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(app))
167		}
168
169	8x	if (map == "world") {
170		# add dependency
171	7x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
172	7x	dep <- htmltools::htmlDependency(
173	7x	name = "echarts-world",
174	7x	version = "1.0.0",
175	7x	src = c(file = path),
176	7x	script = "world.js"
177		)
178
179	7x	e$dependencies <- append(e$dependencies, list(dep))
180		}
181
182	8x	e
183		}
184
185		#' @rdname map
186		#' @export
187		e_svg <- e_map
188
189		#' @rdname map
190		#' @export
191		e_svg_ <- e_map_
192
193		#' @rdname map
194		#' @export
195		e_map_3d <- function(e, serie, map = "world", name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
196	2x	if (missing(e)) {
197	1x	stop("must pass e", call. = FALSE)
198		}
199
200	1x	if (!missing(serie)) {
201	1x	sr <- deparse(substitute(serie))
202		} else {
203	!	sr <- NULL
204		}
205
206	1x	e_map_3d_(e = e, serie = sr, map, name, coord_system, rm_x, rm_y, ...)
207		}
208
209		#' @rdname map
210		#' @export
211		e_map_3d_ <- function(e, serie = NULL, map = "world", name = NULL, coord_system = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
212	4x	if (missing(e)) {
213	1x	stop("must pass e", call. = FALSE)
214		}
215
216	3x	e <- .rm_axis(e, rm_x, "x")
217	3x	e <- .rm_axis(e, rm_y, "y")
218
219	3x	for (i in seq_along(e$x$data)) {
220	7x	if (!is.null(serie)) {
221	7x	data <- .build_data2(e$x$data[[i]], serie)
222	7x	data <- .add_bind2(e, data, e$x$mapping$x, i = i)
223	7x	dat <- data
224		}
225
226	7x	app <- list(
227	7x	type = "map3D",
228	7x	map = map,
229	7x	coordinateSystem = coord_system,
230	7x	name = name,
231		...
232		)
233
234	7x	app_data <- list(data = data)
235
236	7x	if (!e$x$tl) {
237	2x	if (is.null(name) && !is.null(serie)) {
238	2x	app$name <- serie
239		}
240
241	2x	app <- append(app, app_data)
242
243	2x	e$x$opts$series <- append(e$x$opts$series, list(app))
244		} else {
245	5x	e$x$opts$options[[i]]$series <- append(e$x$opts$options[[i]]$series, list(app_data))
246		}
247		}
248
249	3x	if (isTRUE(e$x$tl)) {
250	1x	e$x$opts$baseOption$series <- append(e$x$opts$baseOption$series, list(app))
251		}
252
253	3x	if (map == "world") {
254		# add dependency
255	3x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
256	3x	dep <- htmltools::htmlDependency(
257	3x	name = "echarts-world",
258	3x	version = "1.0.0",
259	3x	src = c(file = path),
260	3x	script = "world.js"
261		)
262
263	3x	e$dependencies <- append(e$dependencies, list(dep))
264		}
265
266		# add dependency
267	3x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
268	3x	dep <- htmltools::htmlDependency(
269	3x	name = "echarts-gl",
270	3x	version = "1.1.2",
271	3x	src = c(file = path),
272	3x	script = "echarts-gl.min.js"
273		)
274
275	3x	e$dependencies <- append(e$dependencies, list(dep))
276
277	3x	e
278		}
279
280		#' @rdname map
281		#' @export
282		e_map_3d_custom <- function(e, id, value, height, map = NULL, name = NULL, rm_x = TRUE, rm_y = TRUE, ...) {
283	8x	if (missing(e)) {
284	1x	stop("must pass e", call. = FALSE)
285		}
286
287	7x	if (missing(id) \|\| missing(value) \|\| missing(height)) {
288	1x	stop("must pass id, value, and height", call. = FALSE)
289		}
290
291	6x	if (is.null(map) && length(e$x$registerMap[[1]]$mapName)) {
292	5x	map <- unlist(e$x$registerMap[[1]]$mapName)
293	1x	} else if (is.null(map)) { # fix when map value is not NULL
294	1x	stop("not map registered, see e_map_register", call. = FALSE)
295		}
296
297	5x	e$x$mainOpts$renderer <- "webgl" # 'canvas' works also, maybe even more efficient
298
299	5x	e <- .rm_axis(e, rm_x, "x")
300	5x	e <- .rm_axis(e, rm_y, "y")
301
302	5x	app <- list(
303	5x	type = "map3D",
304	5x	map = map,
305		...
306		)
307
308	5x	if (!is.null(name)) {
309	2x	app$name <- name
310		}
311
312	5x	name_quo <- dplyr::enquo(id)
313	5x	value_quo <- dplyr::enquo(value)
314	5x	height_quo <- dplyr::enquo(height)
315
316	5x	data <- e$x$data[[1]] \|>
317	5x	dplyr::select(
318	5x	c(name = !!name_quo,
319	5x	value = !!value_quo,
320	5x	height = !!height_quo)
321		) \|>
322	5x	apply(1, as.list)
323
324	5x	app$data <- data
325
326	5x	e$x$opts$series <- append(e$x$opts$series, list(app))
327
328		# add dependency
329	5x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
330	5x	dep <- htmltools::htmlDependency(
331	5x	name = "echarts-gl",
332	5x	version = "1.1.2",
333	5x	src = c(file = path),
334	5x	script = "echarts-gl.min.js"
335		)
336	5x	e$dependencies <- append(e$dependencies, list(dep))
337
338	5x	e
339		}
340
341		#' Register map
342		#'
343		#' Register a \href{https://geojson.org/}{geojson} map.
344		#'
345		#' @param e An \code{echarts4r} object as returned by \code{\link{e_charts}}.
346		#' @param name Name of map, to used in \code{\link{e_map}}.
347		#' @param json,svg \href{https://geojson.org/}{Geojson}, or SVG.
348		#' @param async Whether to read the file asynchronously.
349		#' @param session A valid Shiny session.
350		#' @param ... Additional options passed to \href{https://echarts.apache.org/en/api.html#echarts.registerMap}{registerMap}.
351		#'
352		#' @details \code{e_map_register_p} is not truly a proxy as it does not require
353		#' a chart to function. While the function \code{e_map_register_ui} is meant to
354		#' register the map globally in the Shiny UI, not that then \code{json} must be accessible
355		#' from the UI (generally www folder).
356		#'
357		#' @examples
358		#' \dontrun{
359		#' json <- jsonlite::read_json("https://echarts.apache.org/examples/data/asset/geo/USA.json")
360		#'
361		#' USArrests \|>
362		#' tibble::rownames_to_column("states") \|>
363		#' e_charts(states) \|>
364		#' e_map_register("USA", json) \|>
365		#' e_map(Murder, map = "USA") \|>
366		#' e_visual_map(Murder)
367		#' }
368		#'
369		#' @rdname e_map_register
370		#' @export
371	6x	e_map_register <- function(e, name, json, ...) UseMethod("e_map_register")
372
373		#' @export
374		#' @method e_map_register echarts4r
375		e_map_register.echarts4r <- function(e, name, json, ...) {
376	6x	if (!length(e$x$registerMap)) {
377	6x	e$x$registerMap <- list()
378		}
379
380	6x	opts <- list(
381	6x	mapName = name,
382	6x	geoJSON = json
383		)
384
385	6x	extra <- list(...)
386	6x	if(length(extra) > 0)
387	!	opts$extra <- extra
388
389	6x	e$x$registerMap <- append(e$x$registerMap, list(opts))
390	6x	e
391		}
392
393		#' @rdname e_map_register
394		#' @export
395	4x	e_svg_register <- function(e, name, svg) UseMethod("e_svg_register")
396
397		#' @export
398		#' @method e_svg_register echarts4r
399		e_svg_register.echarts4r <- function(e, name, svg) {
400	4x	if (!length(e$x$registerMap)) {
401	3x	e$x$registerMap <- list()
402		}
403
404	4x	opts <- list(
405	4x	mapName = name,
406	4x	geoJSON = list(svg = svg)
407		)
408
409	4x	e$x$registerMap <- append(e$x$registerMap, list(opts))
410	4x	e
411		}
412
413		#' @rdname e_map_register
414		#' @export
415		e_map_register_p <- function(name, json, async = FALSE, session = shiny::getDefaultReactiveDomain()) {
416	2x	opts <- list(
417	2x	mapAsync = async,
418	2x	mapName = name,
419	2x	geoJSON = json
420		)
421
422	2x	session$sendCustomMessage("e_register_map", opts)
423	2x	invisible()
424		}
425
426		#' @rdname e_map_register
427		#' @export
428		e_map_register_ui <- function(name, json, async = FALSE) {
429	1x	async <- paste0(tolower(async))
430	1x	script <- paste0("
431	1x	$.ajax({
432	1x	url: '", json, "',
433	1x	dataType: 'json',
434	1x	async: ", async, ",
435	1x	success: function(map){
436	1x	echarts.registerMap('", name, "', map);
437		}
438		});")
439	1x	shiny::tags$script(
440	1x	script[1]
441		)
442		}
443
444		#' Mapbox
445		#'
446		#' Use mapbox.
447		#'
448		#' @inheritParams e_bar
449		#' @param token Your mapbox token from \href{https://www.mapbox.com/}{mapbox}.
450		#' @param ... Any option.
451		#'
452		#' @examples
453		#' \dontrun{
454		#' url <- paste0(
455		#' "https://echarts.apache.org/examples/",
456		#' "data-gl/asset/data/population.json"
457		#' )
458		#' data <- jsonlite::fromJSON(url)
459		#' data <- as.data.frame(data)
460		#' names(data) <- c("lon", "lat", "value")
461		#'
462		#' data \|>
463		#' e_charts(lon) \|>
464		#' e_mapbox(
465		#' token = "YOUR_MAPBOX_TOKEN",
466		#' style = "mapbox://styles/mapbox/dark-v9"
467		#' ) \|>
468		#' e_bar_3d(lat, value, coord_system = "mapbox") \|>
469		#' e_visual_map()
470		#' }
471		#'
472		#' @note Mapbox may not work properly in the RSudio console.
473		#'
474		#' @seealso \href{https://echarts.apache.org/en/option-gl.html#mapbox3D.style}{Official documentation},
475		#' \href{https://docs.mapbox.com/mapbox-gl-js/api/}{mapbox documentation}
476		#'
477		#' @name mapbox
478		#' @export
479		e_mapbox <- function(e, token, ...) {
480	2x	if (missing(token)) {
481	1x	stop("missing token", call. = FALSE)
482		}
483
484	1x	e$x$mapboxToken <- token
485
486	1x	if (!e$x$tl) {
487	1x	e$x$opts$mapbox <- list(...)
488		} else {
489	!	e$x$opts$baseOption$mapbox <- list(...)
490		}
491
492		# add dependency
493	1x	path <- system.file("htmlwidgets/lib/mapbox", package = "echarts4r")
494	1x	dep <- htmltools::htmlDependency(
495	1x	name = "echarts-mapbox",
496	1x	version = "3.17.0",
497	1x	src = c(file = path),
498	1x	script = "mapbox-gl.js",
499	1x	stylesheet = "mapbox-gl.css"
500		)
501
502	1x	e$dependencies <- append(e$dependencies, list(dep))
503
504	1x	e
505		}

1		#' General options
2		#'
3		#' @param font_family Font family.
4		#' @param theme A theme.
5		#'
6		#' @export
7		e_common <- function(font_family = NULL, theme = NULL) {
8	4x	options(
9	4x	"ECHARTS4R_THEME" = theme,
10	4x	"ECHARTS4R_FONT_FAMILY" = font_family
11		)
12		}

1		#' Color
2		#'
3		#' Customise chart and background colors.
4		#'
5		#' @inheritParams e_bar
6		#' @param color Vector of colors.
7		#' @param background Background color.
8		#' @param append Only applicable to `echarts4rProxy`.
9		#' Whether to append the `color` to the existing
10		#' array (vector) or colors or to replace it.
11		#'
12		#' @examples
13		#' mtcars \|>
14		#' e_charts(drat) \|>
15		#' e_line(mpg) \|>
16		#' e_area(qsec) \|>
17		#' e_color(
18		#' c("red", "blue"),
19		#' "#d3d3d3"
20		#' )
21		#' @seealso \code{\link{e_theme}},
22		#' \href{https://echarts.apache.org/en/option.html#color}{Official color documentation},
23		#' \href{https://echarts.apache.org/en/option.html#backgroundColor}{Official background documentation}
24		#'
25		#' @name e_color
26		#' @export
27	6x	e_color <- function(e, color = NULL, background = NULL, append = TRUE) UseMethod("e_color")
28
29		#' @rdname e_color
30		#' @export
31		e_color.echarts4r <- function(e, color = NULL, background = NULL, append = TRUE) {
32	5x	if (!e$x$tl) {
33	2x	if (!is.null(color)) e$x$opts$color <- as.list(color)
34	2x	if (!is.null(background)) e$x$opts$backgroundColor <- background
35		} else {
36	1x	if (!is.null(color)) e$x$opts$baseOption$color <- color
37	1x	if (!is.null(background)) e$x$opts$baseOption$backgroundColor <- background
38		}
39	5x	e
40		}
41
42		#' @rdname e_color
43		#' @export
44		e_color.echarts4rProxy <- function(e, color = NULL, background = NULL, append = TRUE) {
45	1x	if (!is.null(color)) e$chart$x$opts$color <- as.list(color)
46	1x	if (!is.null(background)) e$chart$x$opts$backgroundColor <- background
47	1x	e$chart$x$opts$appendColor <- append
48
49	1x	e
50		}

1		#' Axis 3D
2		#'
3		#' Customise 3D axis.
4		#'
5		#' @inheritParams e_bar
6		#' @param axis Axis to customise.
7		#' @param index Index of axis to customise.
8		#'
9		#' @examples
10		#' # phony data
11		#' v <- LETTERS[1:10]
12		#' matrix <- data.frame(
13		#' x = sample(v, 300, replace = TRUE),
14		#' y = sample(v, 300, replace = TRUE),
15		#' z1 = rnorm(300, 10, 1),
16		#' z2 = rnorm(300, 10, 1),
17		#' stringsAsFactors = FALSE
18		#' ) \|>
19		#' dplyr::group_by(x, y) \|>
20		#' dplyr::summarise(
21		#' z1 = sum(z1),
22		#' z2 = sum(z2)
23		#' ) \|>
24		#' dplyr::ungroup()
25		#'
26		#' trans <- list(opacity = 0.4) # transparency
27		#' emphasis <- list(itemStyle = list(color = "#313695"))
28		#'
29		#' matrix \|>
30		#' e_charts(x) \|>
31		#' e_bar_3d(y, z1, stack = "stack", name = "Serie 1", itemStyle = trans, emphasis = emphasis) \|>
32		#' e_bar_3d(y, z2, stack = "stack", name = "Serie 2", itemStyle = trans, emphasis = emphasis) \|>
33		#' e_x_axis_3d(axisLine = list(lineStyle = list(color = "blue")))
34		#' @seealso \href{https://echarts.apache.org/en/option-gl.html#xAxis3D}{Additional x arguments},
35		#' \href{https://echarts.apache.org/en/option-gl.html#yAxis3D}{Additional y arguments},
36		#' \href{https://echarts.apache.org/en/option-gl.html#zAxis3D}{Additional z arguments}
37		#'
38		#' @rdname axis3d
39		#' @export
40		e_axis_3d <- function(e, axis = c("x", "y", "z"), index = 0, ...) {
41	6x	if (missing(e)) {
42	1x	stop("missing e", call. = FALSE)
43		}
44
45	5x	axis <- .r2axis3D(axis[1])
46
47	5x	r.index <- index + 1
48
49	5x	x_data <- if(e$x$tl){
50	1x	e$x$opts$baseOption[[axis]]
51		} else {
52	4x	e$x$opts[[axis]]}
53
54	5x	max <- length(x_data)
55
56	5x	if (r.index > max) {
57	1x	stop("invalid axis", call. = FALSE)
58		}
59
60	4x	attrs <- list(...)
61
62	4x	if (!length(attrs)) {
63	1x	stop("no attribute", call. = FALSE)
64		}
65
66	3x	for (i in seq_along(attrs)) {
67	3x	arg <- names(attrs)[i]
68
69	3x	if (!e$x$tl) {
70	2x	e$x$opts[[axis]][[r.index]][[arg]] <- attrs[[i]]
71		} else {
72	1x	e$x$opts$baseOption[[axis]][[r.index]][[arg]] <- attrs[[i]]
73		}
74		}
75
76	3x	e
77		}
78
79		#' @rdname axis3d
80		#' @export
81		e_x_axis_3d <- function(e, index = 0, ...) {
82	2x	if (missing(e)) {
83	1x	stop("missing e", call. = FALSE)
84		}
85	1x	e <- e_axis_3d(e, axis = "x", index = index, ...)
86	1x	e
87		}
88
89		#' @rdname axis3d
90		#' @export
91		e_y_axis_3d <- function(e, index = 0, ...) {
92	1x	if (missing(e)) {
93	1x	stop("missing e", call. = FALSE)
94		}
95	!	e <- e_axis_3d(e = e, axis = "y", index = index, ...)
96	!	e
97		}
98
99		#' @rdname axis3d
100		#' @export
101		e_z_axis_3d <- function(e, index = 0, ...) {
102	1x	if (missing(e)) {
103	1x	stop("missing e", call. = FALSE)
104		}
105	!	e <- e_axis_3d(e = e, axis = "z", index = index, ...)
106	!	e
107		}
108
109		#' Grid
110		#'
111		#' Customise grid.
112		#'
113		#' @inheritParams e_bar
114		#' @inheritParams e_axis
115		#'
116		#' @examples
117		#' # phony data
118		#' v <- LETTERS[1:10]
119		#' matrix <- data.frame(
120		#' x = sample(v, 300, replace = TRUE),
121		#' y = sample(v, 300, replace = TRUE),
122		#' z1 = rnorm(300, 10, 1),
123		#' z2 = rnorm(300, 10, 1),
124		#' stringsAsFactors = FALSE
125		#' ) \|>
126		#' dplyr::group_by(x, y) \|>
127		#' dplyr::summarise(
128		#' z1 = sum(z1),
129		#' z2 = sum(z2)
130		#' ) \|>
131		#' dplyr::ungroup()
132		#'
133		#' trans <- list(opacity = 0.4) # transparency
134		#' emphasis <- list(itemStyle = list(color = "#313695"))
135		#'
136		#' matrix \|>
137		#' e_charts(x) \|>
138		#' e_bar_3d(y, z1, stack = "stack", name = "Serie 1", itemStyle = trans, emphasis = emphasis) \|>
139		#' e_bar_3d(y, z2, stack = "stack", name = "Serie 2", itemStyle = trans, emphasis = emphasis) \|>
140		#' e_grid_3d(splitLine = list(lineStyle = list(color = "blue")))
141		#' @seealso \href{https://echarts.apache.org/en/option-gl.html#grid3D}{Additional arguments}
142		#'
143		#' @export
144		e_grid_3d <- function(e, index = 0, ...) {
145	6x	if (missing(e)) {
146	1x	stop("missing e", call. = FALSE)
147		}
148
149	5x	r.index <- index + 1
150
151		# initialise if not existing
152	5x	if (!e$x$tl) {
153	4x	if (!length(e$x$opts[["grid3D"]])) {
154	1x	e$x$opts$grid3D <- list(NULL)
155		}
156		} else {
157	1x	if (!length(e$x$opts$baseOption[["grid3D"]])) {
158	!	e$x$opts$baseOption$grid3D <- list(NULL)
159		}
160		}
161
162	5x	attrs <- list(...)
163
164	5x	if (!length(attrs)) {
165	1x	stop("no attribute", call. = FALSE)
166		}
167
168	4x	for (i in seq_along(attrs)) {
169	4x	arg <- names(attrs)[i]
170
171	4x	if (!e$x$tl) {
172	3x	e$x$opts$grid3D[[r.index]][[arg]] <- attrs[[i]]
173		} else {
174	1x	e$x$opts$baseOption$grid3D[[r.index]][[arg]] <- attrs[[i]]
175		}
176		}
177
178	4x	e
179		}

1		#' Geo 3D
2		#'
3		#' Initialise geo 3D.
4		#'
5		#' @inheritParams e_bar
6		#' @param color Color.
7		#' @param type Map type.
8		#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
9		#'
10		#' @examples
11		#' choropleth <- data.frame(
12		#' countries = c(
13		#' "France",
14		#' "Brazil",
15		#' "China",
16		#' "Russia",
17		#' "Canada",
18		#' "India",
19		#' "United States",
20		#' "Argentina",
21		#' "Australia"
22		#' ),
23		#' height = runif(9, 1, 5),
24		#' color = c(
25		#' "#F7FBFF",
26		#' "#DEEBF7",
27		#' "#C6DBEF",
28		#' "#9ECAE1",
29		#' "#6BAED6",
30		#' "#4292C6",
31		#' "#2171B5",
32		#' "#08519C",
33		#' "#08306B"
34		#' )
35		#' )
36		#'
37		#' choropleth \|>
38		#' e_charts(countries) \|>
39		#' e_geo_3d(height, color)
40		#' @seealso \code{\link{e_country_names}},
41		#' \href{https://echarts.apache.org/en/option-gl.html#geo3D}{Additional arguments}
42		#'
43		#' @rdname e_geo_3d
44		#' @export
45		e_geo_3d <- function(e, serie, color, type = "world", rm_x = TRUE, rm_y = TRUE, ...) {
46	3x	if (missing(e)) {
47	1x	stop("must pass e", call. = FALSE)
48		}
49
50	2x	if (!missing(serie)) {
51	1x	sr <- deparse(substitute(serie))
52		} else {
53	1x	sr <- NULL
54		}
55
56	2x	if (!missing(color)) {
57	1x	cl <- deparse(substitute(color))
58		} else {
59	1x	cl <- NULL
60		}
61
62	2x	e_geo_3d_(e, sr, cl, type, rm_x, rm_y, ...)
63		}
64
65		#' @rdname e_geo_3d
66		#' @export
67		e_geo_3d_ <- function(e, serie = NULL, color = NULL, type = "world", rm_x = TRUE, rm_y = TRUE, ...) {
68	4x	if (missing(e)) {
69	1x	stop("must pass e", call. = FALSE)
70		}
71
72	3x	e <- .rm_axis(e, rm_x, "x")
73	3x	e <- .rm_axis(e, rm_y, "y")
74
75	3x	series <- list(
76	3x	map = type,
77		...
78		)
79
80	3x	if (!is.null(color) && !is.null(serie)) {
81	1x	series$regions <- .build_height(e, serie, color, j = 1)
82	2x	} else if (is.null(color) && !is.null(serie)) {
83	!	series$regions <- .build_height(e, serie, j = 1)
84		}
85
86	3x	if (!e$x$tl) {
87	3x	e$x$opts$geo3D <- series
88		} else {
89	!	e$x$opts$baseOption$geo3D <- series
90		}
91
92	3x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
93	3x	dep <- htmltools::htmlDependency(
94	3x	name = "echarts-gl",
95	3x	version = "1.1.2",
96	3x	src = c(file = path),
97	3x	script = "echarts-gl.min.js"
98		)
99
100	3x	e$dependencies <- append(e$dependencies, list(dep))
101
102	3x	if (type == "world") {
103		# add dependency
104	3x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
105	3x	dep <- htmltools::htmlDependency(
106	3x	name = "echarts-world",
107	3x	version = "1.0.0",
108	3x	src = c(file = path),
109	3x	script = "world.js"
110		)
111
112	3x	e$dependencies <- append(e$dependencies, list(dep))
113		}
114
115	3x	e
116		}
117
118		#' Geo
119		#'
120		#' Initialise geo.
121		#'
122		#' @inheritParams e_bar
123		#' @param map Map type.
124		#' @param rm_x,rm_y Whether to remove x and y axis, defaults to \code{TRUE}.
125		#'
126		#' @examples
127		#' flights \|>
128		#' e_charts() \|>
129		#' e_geo() \|>
130		#' e_lines(
131		#' start_lon,
132		#' start_lat,
133		#' end_lon,
134		#' end_lat,
135		#' name = "flights",
136		#' lineStyle = list(normal = list(curveness = 0.3))
137		#' )
138		#' @seealso \href{https://echarts.apache.org/en/option.html#geo}{Additional arguments}
139		#'
140		#' @export
141		e_geo <- function(e, map = "world", ..., rm_x = TRUE, rm_y = TRUE) {
142	5x	opts <- list(
143	5x	map = map,
144		...
145		)
146
147	5x	e <- .rm_axis(e, rm_x, "x")
148	5x	e <- .rm_axis(e, rm_y, "y")
149
150	5x	if (!e$x$tl) {
151	4x	e$x$opts$geo <- opts
152		} else {
153	1x	e$x$opts$baseOption$geo <- opts
154		}
155
156	5x	if (map == "world") {
157		# add dependency
158	5x	path <- system.file("htmlwidgets/lib/echarts-6.1.0", package = "echarts4r")
159	5x	dep <- htmltools::htmlDependency(
160	5x	name = "echarts-world",
161	5x	version = "1.0.0",
162	5x	src = c(file = path),
163	5x	script = "world.js"
164		)
165
166	5x	e$dependencies <- append(e$dependencies, list(dep))
167		}
168
169	5x	e
170		}

1		#' Morphing
2		#'
3		#' __This is experimental__
4		#'
5		#' Morph between graphs.
6		#'
7		#' @param e,... Graphs (from `e_graph`).
8		#' @param callback JavaScript callback function as a
9		#' character string (vector of length 1).
10		#' This function has access to the `chart` object, as well
11		#' as `opts` an array containing the options of the charts
12		#' passed to `e` and `...`.
13		#' @param default Default chart to show.
14		#'
15		#' @examples
16		#' mtcars2 <- mtcars \|>
17		#' head() \|>
18		#' tibble::rownames_to_column("model")
19		#'
20		#' e1 <- mtcars2 \|>
21		#' e_charts(model) \|>
22		#' e_bar(
23		#' carb,
24		#' universalTransition = TRUE,
25		#' animationDurationUpdate = 1000L
26		#' )
27		#'
28		#' e2 <- mtcars2 \|>
29		#' e_charts(model) \|>
30		#' e_pie(
31		#' carb,
32		#' universalTransition = TRUE,
33		#' animationDurationUpdate = 1000L
34		#' )
35		#'
36		#' cb <- "() => {
37		#' let x = 0;
38		#' setInterval(() => {
39		#' x++
40		#' chart.setOption(opts[x % 2], true);
41		#' }, 3000);
42		#' }"
43		#'
44		#' e_morph(e1, e2, callback = cb)
45		#'
46		#' @export
47		e_morph <- \(e, ..., callback, default = 1L) {
48	4x	warning("This is experimental")
49
50	4x	if(...length() < 1)
51	1x	stop("Must pass at least two charts")
52
53	3x	if(missing(callback))
54	1x	stop("Missing callback")
55
56	2x	opts <- lapply(list(e, ...), \(p) {
57	4x	p$x$opts
58		}) \|>
59	2x	unname()
60
61	2x	e$x$opts <- list(opts)
62	2x	e$x$morphed <- list(
63	2x	callback = callback,
64	2x	default = default - 1L
65		)
66
67	2x	return(e)
68		}

1		#' Calendar
2		#'
3		#' @inheritParams e_bar
4		#' @param range Range of calendar format, string or vector.
5		#'
6		#' @examples
7		#' dates <- seq.Date(as.Date("2017-01-01"), as.Date("2019-12-31"), by = "day")
8		#' values <- rnorm(length(dates), 20, 6)
9		#' year <- data.frame(date = dates, values = values)
10		#'
11		#' year \|>
12		#' e_charts(date) \|>
13		#' e_calendar(range = "2017") \|>
14		#' e_visual_map(max = 30) \|>
15		#' e_heatmap(values, coord_system = "calendar")
16		#'
17		#' # month
18		#' year \|>
19		#' e_charts(date) \|>
20		#' e_calendar(range = "2017-01") \|>
21		#' e_visual_map(max = 30) \|>
22		#' e_heatmap(values, coord_system = "calendar")
23		#'
24		#' # range
25		#' year \|>
26		#' e_charts(date) \|>
27		#' e_calendar(range = c("2018-01", "2018-07")) \|>
28		#' e_visual_map(max = 30) \|>
29		#' e_heatmap(values, coord_system = "calendar")
30		#'
31		#' @seealso \href{https://echarts.apache.org/en/option.html#calendar}{Additional arguments}
32		#'
33		#' @export
34		e_calendar <- function(e, range, ...) {
35	4x	if (missing(e) \|\| missing(range)) {
36	2x	stop("missing e or range", call. = FALSE)
37		}
38
39		# initialise
40	2x	if (!length(e$x$opts$calendar)) {
41	2x	e$x$opts$calendar <- list()
42		}
43
44	2x	cal <- list(range = range, ...)
45
46	2x	if (!e$x$tl) {
47	1x	e$x$opts$calendar <- append(e$x$opts$calendar, list(cal))
48		} else {
49	1x	e$x$opts$baseOption$calendar <- append(e$x$opts$baseOption$calendar, list(cal))
50		}
51
52	2x	e
53		}

1		#' Callbacks
2		#'
3		#' Binds events to chart interactions.
4		#'
5		#' @inheritParams e_bar
6		#' @param query Condition that triggers the handler
7		#' @param handler Javascript handler, passed to \link[htmlwidgets]{JS}.
8		#' @param event Event that triggers the handler.
9		#'
10		#' @examples
11		#' cars \|>
12		#' e_charts(speed) \|>
13		#' e_scatter(dist) \|>
14		#' e_on(
15		#' list(seriesName = "dist"),
16		#' "function(){alert('Serie clicked')}"
17		#' )
18		#' @seealso
19		#' \href{https://echarts.apache.org/en/api.html#echartsInstance.on}{official
20		#' documentation}
21		#'
22		#' @name callbacks
23		#' @export
24		e_on <- function(e, query, handler, event = "click") {
25	5x	if (missing(query) \|\| missing(handler)) {
26	2x	stop("must pass query and handler", call. = FALSE)
27		}
28
29	3x	if (!length(e$x$on)) {
30	3x	e$x$on <- list()
31		}
32
33	3x	opts <- list(
34	3x	event = event,
35	3x	query = query,
36	3x	handler = htmlwidgets::JS(handler)
37		)
38
39	3x	e$x$on <- append(e$x$on, list(opts))
40
41	3x	e
42		}
43
44		#' @rdname callbacks
45		#' @export
46		e_off <- function(e, query, handler, event = "click") {
47	5x	if (missing(query) \|\| missing(handler)) {
48	2x	stop("must pass query and handler", call. = FALSE)
49		}
50
51	3x	if (!length(e$x$off)) {
52	3x	e$x$off <- list()
53		}
54
55	3x	opts <- list(
56	3x	event = event,
57	3x	query = query,
58	3x	handler = htmlwidgets::JS(handler)
59		)
60
61	3x	e$x$off <- append(e$x$off, list(opts))
62
63	3x	e
64		}
65
66
67		#' Blank Area
68		#'
69		#' Use this function to capture a click on a
70		#' blank area of the canvas.
71		#' Note that this may stops other "click" events
72		#' from working.
73		#'
74		#' @inheritParams e_bar
75		#' @export
76		e_get_zr <- function(e){
77	1x	e$x$zr <- TRUE
78	1x	e
79		}

1		#' Globe
2		#'
3		#' Add globe.
4		#'
5		#' @inheritParams e_bar
6		#' @param environment Texture of background.
7		#' @param base_texture Base texture of globe.
8		#' @param height_texture Texture of height.
9		#'
10		#' @examples
11		#' \dontrun{
12		#' url <- paste0(
13		#' "https://echarts.apache.org/examples/",
14		#' "data-gl/asset/data/population.json"
15		#' )
16		#' data <- jsonlite::fromJSON(url)
17		#' data <- as.data.frame(data)
18		#' names(data) <- c("lon", "lat", "value")
19		#'
20		#' data \|>
21		#' e_charts(lon) \|>
22		#' e_globe(
23		#' displacementScale = 0.04
24		#' ) \|>
25		#' e_bar_3d(lat, value, "globe") \|>
26		#' e_visual_map(show = FALSE)
27		#' }
28		#'
29		#' @seealso \code{\link{e_country_names}}, \href{https://echarts.apache.org/en/option-gl.html#globe}{Additional arguments}
30		#'
31		#' @export
32		e_globe <- function(e, environment = NULL, base_texture = NULL, height_texture = NULL, ...) {
33	5x	if (missing(e)) {
34	1x	stop("must pass e", call. = FALSE)
35		}
36
37	4x	if (is.null(base_texture)) {
38	4x	message("`base_texture` is `NULL`, see echarts4r-assets.john-coene.com")
39		}
40
41	4x	e$x$mainOpts$renderer <- "webgl"
42
43	4x	ls <- list(
44	4x	environment = environment,
45	4x	heightTexture = height_texture,
46	4x	baseTexture = base_texture,
47	4x	series = list(),
48		...
49		)
50
51	4x	if (!e$x$tl) {
52	3x	e$x$opts$globe <- ls
53		} else {
54	1x	e$x$opts$baseOption$globe <- ls
55		}
56
57	4x	e
58		}

1		#' Loading
2		#'
3		#' Show or hide loading.
4		#'
5		#' @inheritParams e_bar
6		#' @param hide_overlay Hides the white overlay that appears in shiny when a plot is recalculating.
7		#' @param text Text to display.
8		#' @param color Color of spinner.
9		#' @param text_color Color of text.
10		#' @param mask_color Color of mask.
11		#' @param zlevel Z level.
12		#'
13		#' @details This only applies to Shiny.
14		#'
15		#' @examples
16		#' \dontrun{
17		#'
18		#' # no redraw
19		#' # no loading
20		#' library(shiny)
21		#' ui <- fluidPage(
22		#' fluidRow(
23		#' column(12, actionButton("update", "Update"))
24		#' ),
25		#' fluidRow(
26		#' column(12, echarts4rOutput("plot"))
27		#' )
28		#' )
29		#'
30		#' server <- function(input, output) {
31		#' data <- eventReactive(input$update, {
32		#' data.frame(
33		#' x = 1:10,
34		#' y = rnorm(10)
35		#' )
36		#' })
37		#'
38		#' output$plot <- renderEcharts4r({
39		#' data() \|>
40		#' e_charts(x) \|>
41		#' e_bar(y)
42		#' })
43		#' }
44		#'
45		#' if (interactive()) {
46		#' shinyApp(ui, server)
47		#' }
48		#'
49		#' # add loading
50		#' server <- function(input, output) {
51		#' data <- eventReactive(input$update, {
52		#' Sys.sleep(1) # sleep one second to show loading
53		#' data.frame(
54		#' x = 1:10,
55		#' y = rnorm(10)
56		#' )
57		#' })
58		#'
59		#' output$plot <- renderEcharts4r({
60		#' data() \|>
61		#' e_charts(x) \|>
62		#' e_bar(y) \|>
63		#' e_show_loading()
64		#' })
65		#' }
66		#'
67		#' if (interactive()) {
68		#' shinyApp(ui, server)
69		#' }
70		#' }
71		#'
72		#' @rdname loading
73		#' @export
74		e_show_loading <- function(
75		e,
76		hide_overlay = TRUE,
77		text = "loading",
78		color = "#c23531",
79		text_color = "#000",
80		mask_color = "rgba(255, 255, 255, 0.8)",
81		zlevel = 0
82		) {
83	1x	e$x$loading <- TRUE
84	1x	e$x$hideWhite <- hide_overlay
85	1x	opts <- list(
86	1x	text = text,
87	1x	color = color,
88	1x	textColor = text_color,
89	1x	maskColor = mask_color,
90	1x	zlevel = zlevel
91		)
92	1x	e$x$loadingOpts <- opts
93	1x	e
94		}
95
96		#' @rdname loading
97		#' @export
98		e_hide_loading <- function(e) {
99	1x	e$x$loading <- FALSE
100	1x	e
101		}

1		#' Button
2		#'
3		#' Add a button to your visualisation.
4		#'
5		#' @inheritParams e_bar
6		#' @param position Position of button, \code{top} or \code{bottom}.
7		#' @param tag A Valid \code{htmltools::tags} function.
8		#' @param id A valid CSS id.
9		#' @param ... Content of the button, complient with \code{htmltools}.
10		#'
11		#' @examples
12		#' iris \|>
13		#' group_by(Species) \|>
14		#' e_charts(Sepal.Length) \|>
15		#' e_line(Sepal.Width) \|>
16		#' e_line(Petal.Length) \|>
17		#' e_highlight(series_name = "setosa", btn = "myBtn") \|>
18		#' e_button("myBtn", "highlight stuff")
19		#' @export
20		e_button <- function(e, id, ..., position = "top", tag = htmltools::tags$button) {
21	25x	if (missing(id)) {
22	1x	stop("missing id", call. = FALSE)
23		}
24
25	24x	if (!id %in% names(e$x$buttons)) {
26	15x	e$x$buttons[[id]] <- list()
27		}
28
29	24x	if (position == "top") {
30	23x	htmlwidgets::prependContent(e, tag(id = id, ...))
31		} else {
32	1x	htmlwidgets::appendContent(e, tag(id = id, ...))
33		}
34		}