rewrite and added tests

NAMESPACE

@@ -53,6 +53,7 @@ importFrom(htmlwidgets,createWidget)
 importFrom(htmlwidgets,shinyRenderWidget)
 importFrom(htmlwidgets,shinyWidgetOutput)
 importFrom(htmlwidgets,sizingPolicy)
+importFrom(jsonlite,fromJSON)
 importFrom(magrittr,"%>%")
 importFrom(rlang,as_label)
 importFrom(rlang,eval_tidy)

R/apexcharter.R

@@ -34,7 +34,7 @@ apexchart <- function(ax_opts = list(), auto_update = TRUE, width = NULL, height
     height = height,
     package = "apexcharter",
     elementId = elementId,
-    preRenderHook = add_locale,
+    preRenderHook = add_locale_apex,
     sizingPolicy = htmlwidgets::sizingPolicy(
       defaultWidth = "100%",
       defaultHeight = "100%",
@@ -51,8 +51,8 @@ apexchart <- function(ax_opts = list(), auto_update = TRUE, width = NULL, height
   )
 }
 
-
-add_locale <- function(widget) {
+#' @importFrom jsonlite fromJSON
+add_locale_apex <- function(widget) {
   if (!is.null(widget$x$ax_opts$chart$defaultLocale)) {
     defaultLocale <- widget$x$ax_opts$chart$defaultLocale
     defaultLocale <- match.arg(
@@ -79,7 +79,6 @@ add_locale <- function(widget) {
 
 
 
-
 #' Configuration for auto update
 #'
 #' @param series_animate Should the chart animate on re-rendering.

R/format.R

@@ -15,7 +15,7 @@
 #'
 #' @example examples/format.R
 format_num <- function(format, prefix = "", suffix = "", locale = "en-US") {
-  check_locale(locale)
+  check_locale_d3(locale)
   path <- system.file(file.path("htmlwidgets/lib/d3-format/locale", paste0(locale, ".json")), package = "apexcharter")
   if (path != "") {
     locale <- paste(readLines(con = path, encoding = "UTF-8"), collapse = "")
@@ -27,7 +27,7 @@ format_num <- function(format, prefix = "", suffix = "", locale = "en-US") {
 }
 
 
-check_locale <- function(x) {
+check_locale_d3 <- function(x) {
   json <- list.files(system.file("htmlwidgets/lib/d3-format/locale", package = "apexcharter"))
   njson <- gsub("\\.json", "", json)
   if (!x %in% njson) {
@@ -41,6 +41,7 @@ check_locale <- function(x) {
 
 
 
+
 #' Format date in JS
 #'
 #' @param x Date to use in JavaScript

R/parse-data.R

@@ -78,7 +78,7 @@ parse_timeline_data <- function(.list) {
       FUN = function(i) {
         val <- lapply(.list, `[[`, i)
         l <- list(
-          x = val$x,
+          x = as.character(val$x),
           y = js_date(c(val$start, val$end))
         )
         if (!is.null(val$fill)) {

tests/testthat/test-apex-config.R

@@ -33,12 +33,30 @@ test_that("config_line works", {
 })
 
 
+test_that("config_scatter works", {
+  
+  scatter <- config_scatter(NULL, NULL)
+  
+  expect_is(scatter, "list")
+  expect_identical(scatter$xaxis$type, "numeric")
+})
+
+
+test_that("config_timeline works", {
+  
+  timeline <- config_timeline()
+  
+  expect_is(timeline, "list")
+  expect_identical(timeline$xaxis$type, "datetime")
+})
+
 
 
 test_that("choose_config works", {
   
   mapdata <- list(
-    x = Sys.Date()
+    x = c(Sys.Date(), Sys.Date() + 10),
+    y = c(1, 10)
   )
   
   expect_identical(choose_config("bar", mapdata), config_bar(horizontal = TRUE))
@@ -48,6 +66,10 @@ test_that("choose_config works", {
   expect_identical(choose_config("area", mapdata), config_line(datetime = TRUE))
   expect_identical(choose_config("spline", mapdata), config_line(curve = "smooth", datetime = TRUE))
   
+  expect_identical(choose_config("scatter", mapdata), config_scatter(range_num(mapdata$x), range_num(mapdata$y)))
+  expect_identical(choose_config("bubble", mapdata), config_scatter(range_num(mapdata$x), range_num(mapdata$y)))
+  
+  expect_identical(choose_config("timeline", mapdata), config_timeline())
   
   expect_identical(choose_config("plop", mapdata), list())
 })

tests/testthat/test-apex-utils.R

@@ -1,44 +1,33 @@
-context("test-apex-utils")
-
-test_that("is_x_datetime works", {
-  expect_true(is_x_datetime(list(x = Sys.Date())))
-  expect_true(is_x_datetime(list(x = Sys.time())))
-  expect_false(is_x_datetime(list(x = letters)))
-})
+context("apex-utils")
 
 
-test_that("list1 works", {
-  expect_is(list1(1), "list")
-  expect_is(list1(1:2), "integer")
-  expect_length(list1(1:2), 2)
-})
+test_that("all apex utilities works", {
+  
+  ax_utils <- c("ax_annotations", "ax_chart", "ax_colors", "ax_dataLabels", 
+                "ax_fill", "ax_grid", "ax_labels", "ax_labels2", "ax_legend", 
+                "ax_markers", "ax_noData", "ax_plotOptions", "ax_responsive", 
+                "ax_series", "ax_series2", "ax_states", "ax_stroke", "ax_subtitle", 
+                "ax_theme", "ax_title", "ax_tooltip", "ax_xaxis", "ax_yaxis", 
+                "ax_yaxis2")
+  
+  lapply(
+    X = ax_utils,
+    FUN = function(fun) {
+      ax_fun <- get(fun)
+      
+      if (grepl("2$", fun)) {
+        ax <- apexchart() %>% 
+          ax_fun("ARG")
+      } else {
+        ax <- apexchart() %>% 
+          ax_fun()
+      }
+      
+      expect_is(ax, "apexcharter")
+      
+    }
+  )
 
-
-test_that("correct_type works", {
-  expect_identical(correct_type("bar"), "bar")
-  expect_identical(correct_type("column"), "bar")
-  expect_identical(correct_type("line"), "line")
-  expect_identical(correct_type("spline"), "line")
-  expect_identical(correct_type("pie"), "pie")
-})
-
-
-test_that("make_series works", {
-  serie <- make_series(iris, aes(x = Sepal.Length, y = Sepal.Width))
-  expect_is(serie, "list")
-  expect_length(serie, 1)
-  expect_length(serie[[1]], 2)
-  expect_named(serie[[1]], c("name", "data"))
-})
-
-test_that("make_series works with group", {
-  mapping <- aes(x = Sepal.Length, y = Sepal.Width, fill = Species)
-  mapdata <- lapply(mapping, rlang::eval_tidy, data = iris)
-  serie <- make_series(mapdata, mapping)
-  expect_is(serie, "list")
-  expect_length(serie, 3)
-  expect_length(serie[[1]], 2)
-  expect_named(serie[[1]], c("name", "data"))
 })
 
 

tests/testthat/test-apex.R

@@ -1,4 +1,4 @@
-context("test-apex")
+context("apex")
 
 test_that("apex works", {
   
@@ -23,3 +23,46 @@ test_that("apex works", {
   expect_identical(pie$x$ax_opts$chart$type, "pie")
   expect_false(is.null(pie$x$ax_opts$series))
 })
+
+
+
+test_that("is_x_datetime works", {
+  expect_true(is_x_datetime(list(x = Sys.Date())))
+  expect_true(is_x_datetime(list(x = Sys.time())))
+  expect_false(is_x_datetime(list(x = letters)))
+})
+
+
+test_that("list1 works", {
+  expect_is(list1(1), "list")
+  expect_is(list1(1:2), "integer")
+  expect_length(list1(1:2), 2)
+})
+
+
+test_that("correct_type works", {
+  expect_identical(correct_type("bar"), "bar")
+  expect_identical(correct_type("column"), "bar")
+  expect_identical(correct_type("line"), "line")
+  expect_identical(correct_type("spline"), "line")
+  expect_identical(correct_type("pie"), "pie")
+})
+
+
+test_that("make_series works", {
+  serie <- make_series(iris, aes(x = Sepal.Length, y = Sepal.Width))
+  expect_is(serie, "list")
+  expect_length(serie, 1)
+  expect_length(serie[[1]], 2)
+  expect_named(serie[[1]], c("name", "data"))
+})
+
+test_that("make_series works with group", {
+  mapping <- aes(x = Sepal.Length, y = Sepal.Width, fill = Species)
+  mapdata <- lapply(mapping, rlang::eval_tidy, data = iris)
+  serie <- make_series(mapdata, mapping)
+  expect_is(serie, "list")
+  expect_length(serie, 3)
+  expect_length(serie[[1]], 2)
+  expect_named(serie[[1]], c("name", "data"))
+})

tests/testthat/test-apexcharter.R

@@ -0,0 +1,17 @@
+context("apexcharter")
+
+test_that("apexchart works", {
+  
+  ax <- apexchart(list())
+  expect_is(ax, "apexcharter")
+})
+
+
+test_that("add_locale_apex works", {
+  
+  ax <- apexchart(list(chart = list(defaultLocale = "fr"))) %>% 
+    add_locale_apex
+  expect_is(ax, "apexcharter")
+  expect_is(ax$x$ax_opts$chart$locales, "list")
+})
+

tests/testthat/test-labs.R

@@ -1,4 +1,4 @@
-context("test-labs")
+context("labs")
 
 test_that("ax_labs works", {
   

tests/testthat/test-parse-data.R

@@ -1,4 +1,4 @@
-context("test-parse_df")
+context("parse-data")
 
 test_that("parse_df works", {
   
@@ -53,3 +53,32 @@ test_that("parse_df works with Date/POSIXt", {
 })
 
 
+
+
+test_that("parse_timeline_data work", {
+  
+  timeline1 <- data.frame(
+    x = LETTERS,
+    start = Sys.Date() + 1:26,
+    end = Sys.Date() + 10 + 1:26
+  )
+  t1 <- parse_timeline_data(timeline1)
+  
+  expect_is(t1, "list")
+  expect_length(t1, 26)
+  
+  timeline2 <- data.frame(
+    x = LETTERS,
+    start = Sys.Date() + 1:26,
+    end = Sys.Date() + 10 + 1:26,
+    group = rep(c("gr1", "gr2"), each = 13)
+  )
+  t2 <- parse_timeline_data(timeline2)
+  
+  expect_is(t2, "list")
+  expect_length(t2, 2)
+  expect_length(t2[[1]]$data, 13)
+})
+
+
+

tests/testthat/test-shiny-input.R

@@ -0,0 +1,70 @@
+context("shiny-input")
+
+test_that("ununlist works", {
+  
+  bar_single <- list("Aug")
+  bar_multiple <- list("May", "Jun")
+  bar_series_single <- list(Y = list("Apr"))
+  bar_series_multiple <- list(`Y-1` = list("Mar"), Y = list("Apr"))
+  pie <- list("Yes")
+  ts <- list(-2.97216e+11)
+  scatter_single <- list(x = list(5.345), y = list(14.7))
+  scatter_multiple <- list(x = list(3.19, 3.845), y = list(24.4, 19.2))
+  scatter_series_multiple <- list(
+    setosa = list(x = list(5.2), y = list(3.5)),
+    versicolor = list(x = list(5.4, 5.2), y = list(3L, 2.7))
+  )
+  scatter_series_single <- list(virginica = list(x = list(7.2), y = list(3.6)))
+  heatmap_single <- list(Lyon = list("Jul"))
+  heatmap_multiple <- list(Paris = list("May"), Marseille = list("May"), Lyon = list("Nov"))
+  
+  
+  
+  expect_is(ununlist(bar_single), "character")
+  expect_length(ununlist(bar_single), 1)
+  expect_is(ununlist(bar_multiple), "character")
+  expect_length(ununlist(bar_multiple), 2)
+  
+  expect_is(ununlist(bar_series_single), "list")
+  expect_is(ununlist(bar_series_single)[[1]], "character")
+  
+})
+
+test_that("to_posix works", {
+  
+  expect_is(to_posix(-2.97216e+11), "POSIXct")
+  
+})
+
+
+test_that("set_input_click works", {
+  
+  ax <- apexchart(list()) %>% 
+    set_input_click("ID")
+  
+  expect_is(ax, "apexcharter")
+  expect_is(ax$x$ax_opts$states, "list")
+  expect_is(ax$x$shinyEvents$click, "list")
+})
+
+
+test_that("set_input_zoom works", {
+  
+  ax <- apexchart(list()) %>% 
+    set_input_zoom("ID")
+  
+  expect_is(ax, "apexcharter")
+  expect_is(ax$x$shinyEvents$zoomed, "list")
+})
+
+
+test_that("set_input_selection works", {
+  
+  ax <- apexchart(list()) %>% 
+    set_input_selection("ID")
+  
+  expect_is(ax, "apexcharter")
+  expect_is(ax$x$ax_opts$chart$selection, "list")
+  expect_is(ax$x$shinyEvents$selection, "list")
+})
+