Merge pull request #38 from dreamRs/mixed-candlestick
Mixed candlestick
This commit is contained in:
commit
5e3be7068a
4
R/apex.R
4
R/apex.R
|
@ -113,7 +113,7 @@ apex <- function(data, mapping, type = "column", ...,
|
||||||
|
|
||||||
|
|
||||||
# Construct series
|
# Construct series
|
||||||
make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL) {
|
make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL, force_datetime_names = FALSE) {
|
||||||
if (identical(type, "candlestick")) {
|
if (identical(type, "candlestick")) {
|
||||||
if (!all(c("x", "open", "high", "low", "close") %in% names(mapping)))
|
if (!all(c("x", "open", "high", "low", "close") %in% names(mapping)))
|
||||||
stop("For candlestick charts 'x', 'open', 'high', 'low', and 'close' aesthetics must be provided.", call. = FALSE)
|
stop("For candlestick charts 'x', 'open', 'high', 'low', and 'close' aesthetics must be provided.", call. = FALSE)
|
||||||
|
@ -141,7 +141,7 @@ make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL) {
|
||||||
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)) {
|
||||||
add_names <- FALSE
|
add_names <- force_datetime_names
|
||||||
x_order <- sort(x_order)
|
x_order <- sort(x_order)
|
||||||
} else {
|
} else {
|
||||||
add_names <- names(mapping)
|
add_names <- names(mapping)
|
||||||
|
|
|
@ -31,8 +31,8 @@ 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")))
|
if (!isTRUE(apex_type %in% c("line", "bar", "scatter", "candlestick")))
|
||||||
stop("add_line: apex() must be a column or scatter chart.", call. = FALSE)
|
stop("add_line: apex() must be a column, scatter or candlestick chart.", call. = FALSE)
|
||||||
ax$x$ax_opts$chart$type <- "line"
|
ax$x$ax_opts$chart$type <- "line"
|
||||||
if (is.null(data))
|
if (is.null(data))
|
||||||
data <- ax$x$data
|
data <- ax$x$data
|
||||||
|
@ -40,7 +40,7 @@ add_line <- function(ax,
|
||||||
mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
|
mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
|
||||||
ax$x$ax_opts$series <- c(
|
ax$x$ax_opts$series <- c(
|
||||||
ax$x$ax_opts$series,
|
ax$x$ax_opts$series,
|
||||||
make_series(mapdata, mapping, type, serie_name)
|
make_series(mapdata, mapping, type, serie_name, force_datetime_names = c("x", "y"))
|
||||||
)
|
)
|
||||||
if (identical(apex_type, "scatter")) {
|
if (identical(apex_type, "scatter")) {
|
||||||
if (is.null(ax$x$ax_opts$markers$size)) {
|
if (is.null(ax$x$ax_opts$markers$size)) {
|
||||||
|
@ -56,6 +56,13 @@ add_line <- function(ax,
|
||||||
ax$x$ax_opts$stroke$width <- c(ax$x$ax_opts$stroke$width, 4)
|
ax$x$ax_opts$stroke$width <- c(ax$x$ax_opts$stroke$width, 4)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
if (identical(apex_type, "candlestick")) {
|
||||||
|
if (is.null(ax$x$ax_opts$stroke$width)) {
|
||||||
|
ax$x$ax_opts$stroke$width <- c(1, 4)
|
||||||
|
} else {
|
||||||
|
ax$x$ax_opts$stroke$width <- c(ax$x$ax_opts$stroke$width, 4)
|
||||||
|
}
|
||||||
|
}
|
||||||
if (identical(type, "line")) {
|
if (identical(type, "line")) {
|
||||||
ax$x$ax_opts$stroke$curve <- "straight"
|
ax$x$ax_opts$stroke$curve <- "straight"
|
||||||
} else if (identical(type, "spline")) {
|
} else if (identical(type, "spline")) {
|
||||||
|
|
|
@ -31,10 +31,10 @@ parse_df <- function(data, add_names = FALSE) {
|
||||||
X = data[],
|
X = data[],
|
||||||
FUN = function(x) {
|
FUN = function(x) {
|
||||||
if (inherits(x, "Date")) {
|
if (inherits(x, "Date")) {
|
||||||
# as.numeric(x) * 86400000
|
# js_date(x)
|
||||||
# format(x)
|
as.numeric(x) * 1000 * 60*60*24
|
||||||
js_date(x)
|
|
||||||
} else if (inherits(x, "POSIXt")) {
|
} else if (inherits(x, "POSIXt")) {
|
||||||
|
# js_date(x)
|
||||||
as.numeric(x) * 1000
|
as.numeric(x) * 1000
|
||||||
} else if (inherits(x, "factor")) {
|
} else if (inherits(x, "factor")) {
|
||||||
as.character(x)
|
as.character(x)
|
||||||
|
@ -112,12 +112,14 @@ parse_timeline_data <- function(.list) {
|
||||||
|
|
||||||
parse_candlestick_data <- function(.list) {
|
parse_candlestick_data <- function(.list) {
|
||||||
list(list(
|
list(list(
|
||||||
|
type = "candlestick",
|
||||||
data = lapply(
|
data = lapply(
|
||||||
X = seq_len(length(.list[[1]])),
|
X = seq_len(length(.list[[1]])),
|
||||||
FUN = function(i) {
|
FUN = function(i) {
|
||||||
val <- lapply(.list, `[[`, i)
|
val <- lapply(.list, `[[`, i)
|
||||||
list(
|
list(
|
||||||
x = js_date(val$x)[[1]],
|
# x = js_date(val$x)[[1]],
|
||||||
|
x = as.numeric(val$x) * 1000,
|
||||||
y = c(val$open, val$high, val$low, val$close)
|
y = c(val$open, val$high, val$low, val$close)
|
||||||
)
|
)
|
||||||
}
|
}
|
||||||
|
|
|
@ -44,11 +44,11 @@ test_that("parse_df works with Date/POSIXt", {
|
||||||
)
|
)
|
||||||
res <- parse_df(x, add_names = TRUE)
|
res <- parse_df(x, add_names = TRUE)
|
||||||
|
|
||||||
expect_is(res[[1]]$date, "JS_EVAL")
|
expect_is(res[[1]]$date, "numeric")
|
||||||
expect_is(res[[1]]$datetime, "numeric")
|
expect_is(res[[1]]$datetime, "numeric")
|
||||||
|
|
||||||
res <- parse_df(x, add_names = FALSE)
|
res <- parse_df(x, add_names = FALSE)
|
||||||
expect_is(res[[1]][[1]], "JS_EVAL")
|
expect_is(res[[1]][[1]], "numeric")
|
||||||
expect_is(res[[1]][[2]], "numeric")
|
expect_is(res[[1]][[2]], "numeric")
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue