Merge pull request #38 from dreamRs/mixed-candlestick

Mixed candlestick

R/apex.R

@@ -113,7 +113,7 @@ apex <- function(data, mapping, type = "column", ...,
 
 
 # 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 (!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)
@@ -141,7 +141,7 @@ make_series <- function(mapdata, mapping, type = NULL, serie_name = NULL) {
       mapdata$x[is.na(mapdata$x)] <- "NA"
     x_order <- unique(mapdata$x)
     if (is_x_datetime(mapdata)) {
-      add_names <- FALSE
+      add_names <- force_datetime_names
       x_order <- sort(x_order)
     } else {
       add_names <- names(mapping)

R/mixed-charts.R

@@ -31,8 +31,8 @@ add_line <- function(ax,
   } else {
     apex_type <- ax$x$mixed_type
   }
-  if (!isTRUE(apex_type %in% c("line", "bar", "scatter")))
-    stop("add_line: apex() must be a column or scatter chart.", call. = FALSE)
+  if (!isTRUE(apex_type %in% c("line", "bar", "scatter", "candlestick")))
+    stop("add_line: apex() must be a column, scatter or candlestick chart.", call. = FALSE)
   ax$x$ax_opts$chart$type <- "line"
   if (is.null(data))
     data <- ax$x$data
@@ -40,7 +40,7 @@ add_line <- function(ax,
   mapdata <- lapply(mapping, rlang::eval_tidy, data = data)
   ax$x$ax_opts$series <- c(
     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 (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)
     }
   }
+  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")) {
     ax$x$ax_opts$stroke$curve <- "straight"
   } else if (identical(type, "spline")) {

R/parse-data.R

@@ -31,10 +31,10 @@ parse_df <- function(data, add_names = FALSE) {
     X = data[],
     FUN = function(x) {
       if (inherits(x, "Date")) {
-        # as.numeric(x) * 86400000
-        # format(x)
-        js_date(x)
+        # js_date(x)
+        as.numeric(x) * 1000 * 60*60*24
       } else if (inherits(x, "POSIXt")) {
+        # js_date(x)
         as.numeric(x) * 1000
       } else if (inherits(x, "factor")) {
         as.character(x)
@@ -112,12 +112,14 @@ parse_timeline_data <- function(.list) {
 
 parse_candlestick_data <- function(.list) {
   list(list(
+    type = "candlestick",
     data = lapply(
       X = seq_len(length(.list[[1]])),
       FUN = function(i) {
         val <- lapply(.list, `[[`, i)
         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)
         )
       }

tests/testthat/test-parse-data.R

@@ -44,11 +44,11 @@ test_that("parse_df works with Date/POSIXt", {
   )
   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")
   
   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")
 })