basic support for rangeArea charts
This commit is contained in:
parent
a9914aa702
commit
d0d234baee
17
R/apex.R
17
R/apex.R
|
@ -45,6 +45,7 @@ apex <- function(data, mapping,
|
||||||
"column", "bar",
|
"column", "bar",
|
||||||
"line", "spline", "step",
|
"line", "spline", "step",
|
||||||
"area", "area-spline", "area-step",
|
"area", "area-spline", "area-step",
|
||||||
|
"rangeArea",
|
||||||
"pie", "donut",
|
"pie", "donut",
|
||||||
"radialBar",
|
"radialBar",
|
||||||
"radar",
|
"radar",
|
||||||
|
@ -66,7 +67,7 @@ apex <- function(data, mapping,
|
||||||
type <- "bubble"
|
type <- "bubble"
|
||||||
}
|
}
|
||||||
mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
|
mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
|
||||||
if (is.null(mapdata$y) & !type %in% c("candlestick", "timeline", "heatmap")) {
|
if (is.null(mapdata$y) & !type %in% c("candlestick", "timeline", "heatmap", "rangeArea")) {
|
||||||
mapdata <- compute_count(mapdata)
|
mapdata <- compute_count(mapdata)
|
||||||
}
|
}
|
||||||
if (type %in% c("pie", "donut", "radialBar", "polarArea")) {
|
if (type %in% c("pie", "donut", "radialBar", "polarArea")) {
|
||||||
|
@ -132,6 +133,15 @@ make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL, force_
|
||||||
series <- parse_timeline_data(mapdata)
|
series <- parse_timeline_data(mapdata)
|
||||||
} else {
|
} else {
|
||||||
mapdata <- as.data.frame(mapdata, stringsAsFactors = FALSE)
|
mapdata <- as.data.frame(mapdata, stringsAsFactors = FALSE)
|
||||||
|
if (all(rlang::has_name(mapdata, c("ymin", "ymax")))) {
|
||||||
|
mapdata$y <- lapply(
|
||||||
|
X = seq_len(nrow(mapdata)),
|
||||||
|
FUN = function(i) {
|
||||||
|
list(mapdata$ymin[i], mapdata$ymax[i])
|
||||||
|
}
|
||||||
|
)
|
||||||
|
mapdata$ymin <- mapdata$ymax <- NULL
|
||||||
|
}
|
||||||
if (isTRUE(type %in% c("scatter", "bubble"))) {
|
if (isTRUE(type %in% c("scatter", "bubble"))) {
|
||||||
complete <- complete.cases(mapdata[c("x", "y")])
|
complete <- complete.cases(mapdata[c("x", "y")])
|
||||||
n_missing <- sum(!complete)
|
n_missing <- sum(!complete)
|
||||||
|
@ -143,7 +153,7 @@ make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL, force_
|
||||||
if (is.character(mapdata$x))
|
if (is.character(mapdata$x))
|
||||||
mapdata$x[is.na(mapdata$x)] <- "NA"
|
mapdata$x[is.na(mapdata$x)] <- "NA"
|
||||||
x_order <- unique(mapdata$x)
|
x_order <- unique(mapdata$x)
|
||||||
if (is_x_datetime(mapdata)) {
|
if (is_x_datetime(mapdata) & !identical(type, "rangeArea")) {
|
||||||
add_names <- force_datetime_names
|
add_names <- force_datetime_names
|
||||||
x_order <- sort(x_order)
|
x_order <- sort(x_order)
|
||||||
} else {
|
} else {
|
||||||
|
@ -248,7 +258,7 @@ correct_type <- function(type) {
|
||||||
multi_type <- function(x) {
|
multi_type <- function(x) {
|
||||||
multis <- c("column", "area", "line",
|
multis <- c("column", "area", "line",
|
||||||
"spline", "step", "scatter",
|
"spline", "step", "scatter",
|
||||||
"bubble")
|
"bubble", "rangeArea")
|
||||||
if (isTRUE(x %in% multis)) {
|
if (isTRUE(x %in% multis)) {
|
||||||
correct_type(x)
|
correct_type(x)
|
||||||
} else {
|
} else {
|
||||||
|
@ -304,6 +314,7 @@ choose_config <- function(type, mapdata) {
|
||||||
"column" = config_bar(horizontal = FALSE, datetime = datetime),
|
"column" = config_bar(horizontal = FALSE, datetime = datetime),
|
||||||
"line" = config_line(datetime = datetime),
|
"line" = config_line(datetime = datetime),
|
||||||
"area" = config_line(datetime = datetime),
|
"area" = config_line(datetime = datetime),
|
||||||
|
"rangeArea" = config_line(datetime = datetime),
|
||||||
"spline" = config_line(curve = "smooth", datetime = datetime),
|
"spline" = config_line(curve = "smooth", datetime = datetime),
|
||||||
"step" = config_line(curve = "stepline", datetime = datetime),
|
"step" = config_line(curve = "stepline", datetime = datetime),
|
||||||
"area-spline" = config_line(curve = "smooth", datetime = datetime),
|
"area-spline" = config_line(curve = "smooth", datetime = datetime),
|
||||||
|
|
|
@ -30,9 +30,10 @@ add_line <- function(ax,
|
||||||
} else {
|
} else {
|
||||||
apex_type <- ax$x$mixed_type
|
apex_type <- ax$x$mixed_type
|
||||||
}
|
}
|
||||||
if (!isTRUE(apex_type %in% c("line", "bar", "scatter", "candlestick")))
|
if (!isTRUE(apex_type %in% c("line", "bar", "scatter", "candlestick", "rangeArea")))
|
||||||
stop("add_line: apex() must be a column, scatter or candlestick chart.", call. = FALSE)
|
stop("add_line: apex() must be a column, scatter or candlestick chart.", call. = FALSE)
|
||||||
ax$x$ax_opts$chart$type <- "line"
|
if (!identical(apex_type, "rangeArea"))
|
||||||
|
ax$x$ax_opts$chart$type <- "line"
|
||||||
if (is.null(data))
|
if (is.null(data))
|
||||||
data <- ax$x$data
|
data <- ax$x$data
|
||||||
data <- as.data.frame(data)
|
data <- as.data.frame(data)
|
||||||
|
|
Loading…
Reference in New Issue