more tests
This commit is contained in:
parent
cf81488f56
commit
5ac0087461
|
@ -136,13 +136,13 @@ config_update <- function(series_animate = TRUE,
|
||||||
#' @importFrom htmlwidgets shinyWidgetOutput shinyRenderWidget
|
#' @importFrom htmlwidgets shinyWidgetOutput shinyRenderWidget
|
||||||
#'
|
#'
|
||||||
#' @example examples/apexcharter-shiny.R
|
#' @example examples/apexcharter-shiny.R
|
||||||
apexchartOutput <- function(outputId, width = "100%", height = "400px"){
|
apexchartOutput <- function(outputId, width = "100%", height = "400px") { # nocov start
|
||||||
htmlwidgets::shinyWidgetOutput(outputId, "apexcharter", width, height, package = "apexcharter")
|
htmlwidgets::shinyWidgetOutput(outputId, "apexcharter", width, height, package = "apexcharter")
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
#' @rdname apexcharter-shiny
|
#' @rdname apexcharter-shiny
|
||||||
#' @export
|
#' @export
|
||||||
renderApexchart <- function(expr, env = parent.frame(), quoted = FALSE) {
|
renderApexchart <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start
|
||||||
if (!quoted) { expr <- substitute(expr) } # force quoted
|
if (!quoted) { expr <- substitute(expr) } # force quoted
|
||||||
htmlwidgets::shinyRenderWidget(expr, apexchartOutput, env, quoted = TRUE)
|
htmlwidgets::shinyRenderWidget(expr, apexchartOutput, env, quoted = TRUE)
|
||||||
}
|
} # nocov end
|
||||||
|
|
12
R/facets.R
12
R/facets.R
|
@ -346,7 +346,7 @@ apexfacetOutput <- function(outputId) {
|
||||||
#'
|
#'
|
||||||
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency
|
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency
|
||||||
#' @importFrom htmltools renderTags resolveDependencies
|
#' @importFrom htmltools renderTags resolveDependencies
|
||||||
renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) {
|
renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start
|
||||||
func <- exprToFunction(expr, env, quoted)
|
func <- exprToFunction(expr, env, quoted)
|
||||||
createRenderFunction(
|
createRenderFunction(
|
||||||
func = func,
|
func = func,
|
||||||
|
@ -371,7 +371,7 @@ renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) {
|
||||||
)
|
)
|
||||||
}, apexfacetOutput, list()
|
}, apexfacetOutput, list()
|
||||||
)
|
)
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -380,15 +380,15 @@ renderApexfacet <- function(expr, env = parent.frame(), quoted = FALSE) {
|
||||||
# Print methods -----------------------------------------------------------
|
# Print methods -----------------------------------------------------------
|
||||||
|
|
||||||
#' @export
|
#' @export
|
||||||
print.apex_facet <- function(x, ...) {
|
print.apex_facet <- function(x, ...) { # nocov start
|
||||||
TAG <- build_facet_tag(x)
|
TAG <- build_facet_tag(x)
|
||||||
print(htmltools::browsable(TAG))
|
print(htmltools::browsable(TAG))
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
knit_print.apex_facet <- function(x, ..., options = NULL) {
|
knit_print.apex_facet <- function(x, ..., options = NULL) { # nocov start
|
||||||
TAG <- build_facet_tag(x)
|
TAG <- build_facet_tag(x)
|
||||||
knitr::knit_print(htmltools::browsable(TAG), options = options, ...)
|
knitr::knit_print(htmltools::browsable(TAG), options = options, ...)
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
8
R/grid.R
8
R/grid.R
|
@ -160,7 +160,7 @@ apexgridOutput <- function(outputId) {
|
||||||
#'
|
#'
|
||||||
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency
|
#' @importFrom shiny exprToFunction createRenderFunction createWebDependency
|
||||||
#' @importFrom htmltools renderTags resolveDependencies
|
#' @importFrom htmltools renderTags resolveDependencies
|
||||||
renderApexgrid <- function(expr, env = parent.frame(), quoted = FALSE) {
|
renderApexgrid <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start
|
||||||
func <- exprToFunction(expr, env, quoted)
|
func <- exprToFunction(expr, env, quoted)
|
||||||
createRenderFunction(
|
createRenderFunction(
|
||||||
func = func,
|
func = func,
|
||||||
|
@ -193,14 +193,14 @@ renderApexgrid <- function(expr, env = parent.frame(), quoted = FALSE) {
|
||||||
)
|
)
|
||||||
}, apexgridOutput, list()
|
}, apexgridOutput, list()
|
||||||
)
|
)
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# Print methods -----------------------------------------------------------
|
# Print methods -----------------------------------------------------------
|
||||||
|
# nocov start
|
||||||
#' @export
|
#' @export
|
||||||
print.apex_grid <- function(x, ...) {
|
print.apex_grid <- function(x, ...) {
|
||||||
TAG <- build_grid(
|
TAG <- build_grid(
|
||||||
|
@ -227,7 +227,7 @@ knit_print.apex_grid <- function(x, ..., options = NULL) {
|
||||||
)
|
)
|
||||||
knitr::knit_print(htmltools::browsable(TAG), options = options, ...)
|
knitr::knit_print(htmltools::browsable(TAG), options = options, ...)
|
||||||
}
|
}
|
||||||
|
# nocov end
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -103,14 +103,14 @@ spark_box <- function(data,
|
||||||
|
|
||||||
#' @rdname apexcharter-shiny
|
#' @rdname apexcharter-shiny
|
||||||
#' @export
|
#' @export
|
||||||
sparkBoxOutput <- function(outputId, width = "100%", height = "160px"){
|
sparkBoxOutput <- function(outputId, width = "100%", height = "160px") { # nocov start
|
||||||
htmlwidgets::shinyWidgetOutput(outputId, "apexcharter", width, height, package = "apexcharter")
|
htmlwidgets::shinyWidgetOutput(outputId, "apexcharter", width, height, package = "apexcharter")
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
#' @rdname apexcharter-shiny
|
#' @rdname apexcharter-shiny
|
||||||
#' @export
|
#' @export
|
||||||
renderSparkBox <- function(expr, env = parent.frame(), quoted = FALSE) {
|
renderSparkBox <- function(expr, env = parent.frame(), quoted = FALSE) { # nocov start
|
||||||
if (!quoted) { expr <- substitute(expr) } # force quoted
|
if (!quoted) { expr <- substitute(expr) } # force quoted
|
||||||
htmlwidgets::shinyRenderWidget(expr, apexchartOutput, env, quoted = TRUE)
|
htmlwidgets::shinyRenderWidget(expr, apexchartOutput, env, quoted = TRUE)
|
||||||
}
|
} # nocov end
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,91 @@
|
||||||
|
test_that("add_shade works", {
|
||||||
|
|
||||||
|
ax <- apex(consumption, aes(date, value, group = type), "spline") %>%
|
||||||
|
add_shade(from = "2020-01-06", to = "2020-01-20")
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$xaxis, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_shade_weekend works", {
|
||||||
|
|
||||||
|
ax <- apex(consumption, aes(date, value, group = type), "spline") %>%
|
||||||
|
add_shade_weekend()
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$xaxis, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_event works", {
|
||||||
|
|
||||||
|
ax <- apex(consumption, aes(date, value, group = type), "spline") %>%
|
||||||
|
add_event(when = c("2020-01-11", "2020-01-29"))
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$xaxis, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_event_marker works", {
|
||||||
|
|
||||||
|
ax <- apex(consumption, aes(date, value, group = type), "spline") %>%
|
||||||
|
add_event_marker(when = "2020-01-22", y = 1805)
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$points, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_hline works", {
|
||||||
|
|
||||||
|
ax <- apex(consumption, aes(date, value, group = type), "spline") %>%
|
||||||
|
add_hline(value = 2100)
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$yaxis, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_vline works", {
|
||||||
|
|
||||||
|
ax <- apex(consumption, aes(date, value, group = type), "spline") %>%
|
||||||
|
add_vline(value = 2100)
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$xaxis, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_point works", {
|
||||||
|
|
||||||
|
ax <- apex(
|
||||||
|
data = iris,
|
||||||
|
aes(Sepal.Length, Sepal.Width),
|
||||||
|
"scatter"
|
||||||
|
) %>%
|
||||||
|
add_point(
|
||||||
|
x = mean(iris$Sepal.Length),
|
||||||
|
y = mean(iris$Sepal.Width)
|
||||||
|
)
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$annotations, "list")
|
||||||
|
expect_is(ax$x$ax_opts$annotations$points, "list")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
test_that("label & marker works", {
|
||||||
|
|
||||||
|
expect_is(label(), "list")
|
||||||
|
expect_is(marker(), "list")
|
||||||
|
})
|
||||||
|
|
|
@ -46,6 +46,11 @@ test_that("set_scale works", {
|
||||||
expect_true(is.null(ax$x$ax_opts$xaxis$min))
|
expect_true(is.null(ax$x$ax_opts$xaxis$min))
|
||||||
expect_true(is.null(ax$x$ax_opts$xaxis$max))
|
expect_true(is.null(ax$x$ax_opts$xaxis$max))
|
||||||
|
|
||||||
|
ax <- set_scale(apexchart(), 1:100, scales = "free_x", axis = "x")
|
||||||
|
expect_true(is.null(ax$x$ax_opts$xaxis))
|
||||||
|
expect_true(is.null(ax$x$ax_opts$xaxis$min))
|
||||||
|
expect_true(is.null(ax$x$ax_opts$xaxis$max))
|
||||||
|
|
||||||
ax <- set_scale(apexchart(), 1:100, scales = "fixed", axis = "y")
|
ax <- set_scale(apexchart(), 1:100, scales = "fixed", axis = "y")
|
||||||
expect_true(!is.null(ax$x$ax_opts$yaxis))
|
expect_true(!is.null(ax$x$ax_opts$yaxis))
|
||||||
expect_true(!is.null(ax$x$ax_opts$yaxis$min))
|
expect_true(!is.null(ax$x$ax_opts$yaxis$min))
|
||||||
|
@ -56,6 +61,10 @@ test_that("set_scale works", {
|
||||||
expect_true(is.null(ax$x$ax_opts$yaxis$min))
|
expect_true(is.null(ax$x$ax_opts$yaxis$min))
|
||||||
expect_true(is.null(ax$x$ax_opts$yaxis$max))
|
expect_true(is.null(ax$x$ax_opts$yaxis$max))
|
||||||
|
|
||||||
|
ax <- set_scale(apexchart(), 1:100, scales = "free_y", axis = "y")
|
||||||
|
expect_true(is.null(ax$x$ax_opts$yaxis))
|
||||||
|
expect_true(is.null(ax$x$ax_opts$yaxis$min))
|
||||||
|
expect_true(is.null(ax$x$ax_opts$yaxis$max))
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
@ -79,7 +88,7 @@ test_that("ax_facet_wrap works", {
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
test_that("ax_facet_grid works", {
|
test_that("ax_facet_grid works with row", {
|
||||||
|
|
||||||
ax <- apex(mtcars, aes(disp, wt), type = "scatter") %>%
|
ax <- apex(mtcars, aes(disp, wt), type = "scatter") %>%
|
||||||
ax_facet_grid(vars(cyl))
|
ax_facet_grid(vars(cyl))
|
||||||
|
@ -98,3 +107,22 @@ test_that("ax_facet_grid works", {
|
||||||
})
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("ax_facet_grid works with row and col", {
|
||||||
|
|
||||||
|
ax <- apex(mtcars, aes(disp, wt), type = "scatter") %>%
|
||||||
|
ax_facet_grid(vars(cyl), vars(carb))
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax, "apex_facet")
|
||||||
|
expect_true(!is.null(ax$x$facet))
|
||||||
|
|
||||||
|
facet <- build_facets(ax)
|
||||||
|
expect_is(facet, "list")
|
||||||
|
expect_identical(facet$type, "grid")
|
||||||
|
expect_length(facet$facets, length(unique(mtcars$cyl)) * length(unique(mtcars$carb)))
|
||||||
|
|
||||||
|
TAG <- build_facet_tag(ax)
|
||||||
|
expect_is(TAG, "shiny.tag")
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,13 @@
|
||||||
|
test_that("apex_grid works", {
|
||||||
|
|
||||||
|
ax <- apex_grid(
|
||||||
|
apexchart(),
|
||||||
|
apexchart(),
|
||||||
|
apexchart(),
|
||||||
|
apexchart(),
|
||||||
|
grid_area = c("1 / 1 / 3 / 2", "1 / 2 / 2 / 4", "2 / 2 / 3 / 4", "2 / 2 / 3 / 4"),
|
||||||
|
ncol = 2, nrow = 2,
|
||||||
|
height = "600px"
|
||||||
|
)
|
||||||
|
expect_is(ax, "apex_grid")
|
||||||
|
})
|
|
@ -0,0 +1,32 @@
|
||||||
|
test_that("add_line works with column chart", {
|
||||||
|
|
||||||
|
ax <- apex(climate_paris, aes(month, precipitation), type = "column") %>%
|
||||||
|
add_line(aes(month, temperature))
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$series, "list")
|
||||||
|
expect_length(ax$x$ax_opts$series, 2)
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_line works with scatter chart", {
|
||||||
|
|
||||||
|
ax <- apex(cars, aes(speed, dist), type = "scatter") %>%
|
||||||
|
add_line(aes(x, y), data = lowess(cars), serie_name = "lowess")
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$series, "list")
|
||||||
|
expect_length(ax$x$ax_opts$series, 2)
|
||||||
|
})
|
||||||
|
|
||||||
|
|
||||||
|
test_that("add_smooth_line works with scatter chart", {
|
||||||
|
|
||||||
|
ax <- apex(cars, aes(speed, dist), type = "scatter") %>%
|
||||||
|
add_smooth_line(model = "loess", span = 1)
|
||||||
|
|
||||||
|
expect_is(ax, "apex")
|
||||||
|
expect_is(ax$x$ax_opts$series, "list")
|
||||||
|
expect_length(ax$x$ax_opts$series, 2)
|
||||||
|
})
|
||||||
|
|
|
@ -0,0 +1,17 @@
|
||||||
|
test_that("spark_box works", {
|
||||||
|
spark_data <- data.frame(
|
||||||
|
date = Sys.Date() + 1:20,
|
||||||
|
var1 = round(rnorm(20, 50, 10)),
|
||||||
|
var2 = round(rnorm(20, 50, 10)),
|
||||||
|
var3 = round(rnorm(20, 50, 10))
|
||||||
|
)
|
||||||
|
|
||||||
|
sb <- spark_box(
|
||||||
|
data = spark_data,
|
||||||
|
title = mean(spark_data$var1),
|
||||||
|
subtitle = "Variable 1"
|
||||||
|
)
|
||||||
|
|
||||||
|
expect_is(sb, "apexcharter")
|
||||||
|
expect_true(!identical(sb$x$sparkbox, FALSE))
|
||||||
|
})
|
Loading…
Reference in New Issue