diff --git a/NAMESPACE b/NAMESPACE index 7097128..639e083 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/apexcharter.R b/R/apexcharter.R index 8fa1bf6..5325631 100644 --- a/R/apexcharter.R +++ b/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. diff --git a/R/format.R b/R/format.R index 614c82a..a71dab2 100644 --- a/R/format.R +++ b/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 diff --git a/R/parse-data.R b/R/parse-data.R index d70e8ae..3be3278 100644 --- a/R/parse-data.R +++ b/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)) { diff --git a/tests/testthat/test-apex-config.R b/tests/testthat/test-apex-config.R index cd34e80..07f9789 100644 --- a/tests/testthat/test-apex-config.R +++ b/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()) }) diff --git a/tests/testthat/test-apex-utils.R b/tests/testthat/test-apex-utils.R index 14ec001..d6ea6cc 100644 --- a/tests/testthat/test-apex-utils.R +++ b/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")) }) diff --git a/tests/testthat/test-apex.R b/tests/testthat/test-apex.R index 18c1d83..f885762 100644 --- a/tests/testthat/test-apex.R +++ b/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")) +}) diff --git a/tests/testthat/test-apexcharter.R b/tests/testthat/test-apexcharter.R new file mode 100644 index 0000000..c5aeef6 --- /dev/null +++ b/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") +}) + diff --git a/tests/testthat/test-labs.R b/tests/testthat/test-labs.R index c2db4bc..b6c5b62 100644 --- a/tests/testthat/test-labs.R +++ b/tests/testthat/test-labs.R @@ -1,4 +1,4 @@ -context("test-labs") +context("labs") test_that("ax_labs works", { diff --git a/tests/testthat/test-parse_df.R b/tests/testthat/test-parse-data.R similarity index 65% rename from tests/testthat/test-parse_df.R rename to tests/testthat/test-parse-data.R index ff1304e..4d53f2b 100644 --- a/tests/testthat/test-parse_df.R +++ b/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) +}) + + + diff --git a/tests/testthat/test-shiny-input.R b/tests/testthat/test-shiny-input.R new file mode 100644 index 0000000..164b06e --- /dev/null +++ b/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") +}) +