diff --git a/R/colors.R b/R/colors.R index 97e6fa4..2ba4f69 100644 --- a/R/colors.R +++ b/R/colors.R @@ -38,7 +38,7 @@ get_groups <- function(ax) { if (!inherits(ax, "apexcharter")) stop("ax must be an apexcharter htmlwidget") if (is.null(ax$x$ax_opts$series)) - stop("ax must have a series of data") + stop("ax must have a serie of data") groups <- lapply(ax$x$ax_opts$series, `[[`, "name") groups <- unlist(groups) as.character(groups) diff --git a/R/onLoad.R b/R/onLoad.R index a5bafda..d9c0ea9 100644 --- a/R/onLoad.R +++ b/R/onLoad.R @@ -1,6 +1,6 @@ #' @importFrom shiny registerInputHandler -.onLoad <- function(...) { +.onLoad <- function(...) { # nocov start shiny::registerInputHandler("apex_click", function(data, ...) { if (is.null(data)) { NULL @@ -37,4 +37,4 @@ }, force = TRUE) register_s3_method("knitr", "knit_print", "apex_facet") register_s3_method("knitr", "knit_print", "apex_grid") -} +} # nocov end diff --git a/R/shiny-input.R b/R/shiny-input.R index 1dbeaee..54be0f4 100644 --- a/R/shiny-input.R +++ b/R/shiny-input.R @@ -180,14 +180,14 @@ set_input_selection <- function(ax, inputId, type = c("x", "xy", "y"), #' #' @example examples/export-2.R set_input_export <- function(ax, inputId, - session = shiny::getDefaultReactiveDomain()) { + session = shiny::getDefaultReactiveDomain()) { # nocov start if (is.null(session)) session <- list(ns = identity) ax$x$shinyEvents$export <- list( inputId = session$ns(inputId) ) ax -} +} # nocov end @@ -196,7 +196,7 @@ set_input_export <- function(ax, inputId, # Demo -------------------------------------------------------------------- - +# nocov start #' Run Shiny input events examples #' @@ -214,7 +214,7 @@ set_input_export <- function(ax, inputId, #' run_demo_input("selection") #' #' } -run_demo_input <- function(example = c("click", "zoom", "selection")) { +run_demo_input <- function(example = c("click", "zoom", "selection")) { example <- match.arg(example) shiny::shinyAppFile( appFile = system.file("examples-input", example, "app.R", package = "apexcharter"), @@ -264,3 +264,4 @@ run_demo_sparkbox <- function() { ) } +# nocov end diff --git a/tests/testthat/test-apex.R b/tests/testthat/test-apex.R index b9b7175..a1e7a37 100644 --- a/tests/testthat/test-apex.R +++ b/tests/testthat/test-apex.R @@ -22,6 +22,39 @@ test_that("apex works", { expect_is(pie, "apexcharter") expect_identical(pie$x$ax_opts$chart$type, "pie") expect_false(is.null(pie$x$ax_opts$series)) + + candlestick <- apex( + candles, + aes(x = datetime, open = open, close = close, low = low, high = high), + type = "candlestick" + ) + expect_is(candlestick, "apexcharter") + expect_identical(candlestick$x$ax_opts$chart$type, "candlestick") + expect_false(is.null(candlestick$x$ax_opts$series)) + + tl <- data.frame( + x = month.abb, + start = Sys.Date() + 1:12, + end = Sys.Date() + 1:12 * 3 + ) + timeline <- apex(tl, aes(x = x, start = start, end = end), "timeline") + expect_is(timeline, "apexcharter") + expect_identical(timeline$x$ax_opts$chart$type, "rangeBar") + expect_false(is.null(timeline$x$ax_opts$series)) + + + hm <- expand.grid(year = 2000:2010, month = month.name) + hm$value <- sample.int(1e4, nrow(hm)) + heatmap <- apex( + data = hm, + type = "heatmap", + mapping = aes(x = year, y = month, fill = value) + ) %>% + ax_dataLabels(enabled = FALSE) %>% + ax_colors("#008FFB") + expect_is(heatmap, "apexcharter") + expect_identical(heatmap$x$ax_opts$chart$type, "heatmap") + expect_false(is.null(heatmap$x$ax_opts$series)) }) @@ -93,3 +126,14 @@ test_that("make_series works with group (mtcars)", { as.list(unlist(tapply(mapdata$fill, factor(mapdata$fill, levels = unique(mapdata$fill)), length, simplify = FALSE), use.names = FALSE)) ) }) + + + +test_that("compute count", { + ax <- apex(data = mtcars, type = "column", mapping = aes(x = vs)) + expect_is(ax, "apex") + + ax <- apex(data = mtcars, type = "column", mapping = aes(x = vs, fill = gear)) + expect_is(ax, "apex") +}) + diff --git a/tests/testthat/test-colors.R b/tests/testthat/test-colors.R new file mode 100644 index 0000000..49a36ea --- /dev/null +++ b/tests/testthat/test-colors.R @@ -0,0 +1,25 @@ +test_that("ax_colors_manual works", { + ax1 <- apex( + data = mtcars, + type = "scatter", + mapping = aes(x = wt, y = mpg, fill = cyl) + ) %>% + ax_colors_manual(list( + "4" = "steelblue", + "6" = "firebrick", + "8" = "forestgreen" + )) + ax2 <- apex( + data = mtcars, + type = "scatter", + mapping = aes(x = wt, y = mpg, fill = cyl) + ) %>% + ax_colors_manual(list( + "4" = "steelblue", + "8" = "forestgreen", + "6" = "firebrick" + )) + expect_is(ax1$x$ax_opts$colors, "list") + expect_length(ax1$x$ax_opts$colors, 3) + expect_identical(ax1$x$ax_opts$colors, ax2$x$ax_opts$colors) +}) diff --git a/tests/testthat/test-facets.R b/tests/testthat/test-facets.R index 92f501e..d4002f2 100644 --- a/tests/testthat/test-facets.R +++ b/tests/testthat/test-facets.R @@ -126,3 +126,31 @@ test_that("ax_facet_grid works with row and col", { }) +test_that("complete_mapdata works", { + + cmd <- complete_mapdata( + mapdata = list(x = c("April", "June", "September"), y = 1:3), + mapall = list(x = month.name) + ) + + expect_is(cmd, "list") + expect_length(cmd$x, 12) +}) + +test_that("complete_data works", { + + cd <- complete_data( + data = data.frame( + var1 = c("a", "a", "b", "b", "c"), + var2 = c("A", "B", "A", "C", "A"), + value = 1:5 + ), + vars = c("var1", "var2"), + fill_var = "value", + fill_value = 0 + ) + + expect_is(cd, "data.frame") +}) + + diff --git a/tests/testthat/test-proxy.R b/tests/testthat/test-proxy.R new file mode 100644 index 0000000..67d9449 --- /dev/null +++ b/tests/testthat/test-proxy.R @@ -0,0 +1,68 @@ +test_that("apexchartProxy works", { + proxy <- apexchartProxy("chart", session = list(ns = identity)) + + expect_is(proxy, "apexchart_Proxy") + + expect_error(apexchartProxy("chart", NULL)) +}) + + +test_that("ax_proxy_series works", { + + session <- as.environment(list( + ns = identity, + sendCustomMessage = function(type, message) { + session$lastCustomMessage = list(type = type, message = message) + } + )) + + proxy <- apexchartProxy("chart", session = session) %>% + ax_proxy_series(1:10) + + expect_is(session$lastCustomMessage, "list") + expect_identical(session$lastCustomMessage$type, "update-apexchart-series") + expect_identical(session$lastCustomMessage$message$id, "chart") +}) + + +test_that("ax_proxy_options works", { + + session <- as.environment(list( + ns = identity, + sendCustomMessage = function(type, message) { + session$lastCustomMessage = list(type = type, message = message) + } + )) + + proxy <- apexchartProxy("chart", session = session) %>% + ax_proxy_options(list( + xaxis = list( + labels = list(show = TRUE) + ), + yaxis = list( + title = list(text = FALSE) + ) + )) + + expect_is(session$lastCustomMessage, "list") + expect_identical(session$lastCustomMessage$type, "update-apexchart-options") + expect_identical(session$lastCustomMessage$message$id, "chart") +}) + + +test_that("ax_proxy_toggle_series works", { + + session <- as.environment(list( + ns = identity, + sendCustomMessage = function(type, message) { + session$lastCustomMessage = list(type = type, message = message) + } + )) + + proxy <- apexchartProxy("chart", session = session) %>% + ax_proxy_toggle_series("serie1") + + expect_is(session$lastCustomMessage, "list") + expect_identical(session$lastCustomMessage$type, "update-apexchart-toggle-series") + expect_identical(session$lastCustomMessage$message$id, "chart") +})