context("canvasXpress BASE")
# Data preparation
data1.df <- data.frame(a = c(1:3),
b = c("A", "B", "C"),
row.names = c("row1", "row2", "row3"))
data1.m <- matrix(1:20, nrow = 5)
data1.l <- list(y = data1.df, data2 = data1.df)
data1.var <- data.frame(row1 = c(10:12), row2 = c(20:22), row3 = c(30:32))
data1.smp <- data.frame(a = c(30:32), b = c(40:42))
# Positive Tests
test_that("Object Structure Tests", {
testobj <- canvasXpress(data = data1.df)
expect_equal(testobj$width, 600)
expect_equal(testobj$height, 400)
expect_equivalent(class(testobj), c("canvasXpress", "htmlwidget"))
expect_true("data" %in% names(testobj$x))
expect_true("config" %in% names(testobj$x))
expect_true("isR" %in% names(testobj$x$config))
expect_true("graphType" %in% names(testobj$x$config))
})
test_that("Allowed Null Data GraphTypes", {
expect_silent(canvasXpress(data = NULL, graphType = "Map"))
})
test_that("Correct Data Types", {
expect_silent(canvasXpress(data = data1.df))
expect_silent(canvasXpress(data = data1.m))
expect_silent(canvasXpress(data = data1.l))
})
test_that("destroy", {
testobj <- canvasXpress(destroy = TRUE)
expect_equivalent(class(testobj), c("canvasXpress", "htmlwidget"))
expect_true(is.null(testobj$width))
expect_true(is.null(testobj$height))
})
# Negative Tests
test_that("Missing Data", {
expect_error(canvasXpress(data = NULL),
regexp = "data cannot be NULL!")
})
test_that("Incorrect Data Types", {
expect_error(canvasXpress(data = "'Test'"))
expect_error(canvasXpress(data = c(1, 2, 3)),
regexp = "data must be a data.frame, matrix, or named list")
})
test_that("Missing GraphType", {
expect_error(canvasXpress(data = data1.df, graphType = NULL),
regexp = "graphType cannot be NULL!")
})
test_that("Incorrect GraphType", {
expect_error(canvasXpress(data = data1.df, graphType = ""),
regexp = "graphType is invalid, must be one of <.*")
expect_error(canvasXpress(data = data1.df, graphType = "Scatter4d"),
regexp = "graphType is invalid, must be one of <.*")
})
test_that("Name mismatches", {
expect_error(canvasXpress(data = data1.df,
smpAnnot = data1.var),
regexp = "Row names in smpAnnot are different from column names in data")
expect_silent(canvasXpress(data = data1.df,
smpAnnot = data1.smp))
expect_error(canvasXpress(data = data1.df,
varAnnot = data1.smp),
regexp = "Row names in varAnnot are different from row names in data")
expect_silent(canvasXpress(data = data1.df,
varAnnot = data1.var))
})
test_that("piping - non missing smpAnnot or varAnnot", {
expect_error(canvasXpress(data = iris) %>% canvasXpress(smpAnnot = "test"),
regexp = "Primary object data changes are not supported when modifying a canvasXpress object (ie piping) - ie changes to the data, varAnnot or smpAnnot parameters.",
fixed = TRUE)
})
test_that("piping - missing original cx", {
cxobj <- canvasXpress(destroy = TRUE)
cxobj$x <- NULL
expect_error(cxobj %>% canvasXpress(x = NULL),
regexp = "Original canvasXpress object is invalid and cannot be read",
fixed = TRUE)
})
test_that("piping - missing graph type", {
cxobj <- canvasXpress(iris)
cxobj <- cxobj %>% canvasXpress(graphType = NULL)
expect_equivalent(class(cxobj), c("canvasXpress", "htmlwidget"))
})
# Shiny Functionality
test_that("Shiny Render", {
testthat::skip_if_not_installed("shiny")
expect_s3_class(renderCanvasXpress(NULL), "shiny.render.function")
})
test_that("Shiny Examples", {
expect_error(cxShinyExample("badexample"),
regexp = "Valid examples are: 'example1', 'example2', 'example3', 'example4'")
expect_message(cxShinyExample(NULL),
regexp = "Valid examples are: 'example1', 'example2', 'example3', 'example4'")
})
test_that("Shiny Input", {
skip_if_not_installed("htmlwidgets", "1.6.3")
skip_on_cran()
expect_equal(as.character(canvasXpressOutput("test_id")),
'<div class="canvasXpress html-widget html-widget-output shiny-report-size html-fill-item" id="test_id" style="width:100%;height:400px;"></div>')
})
test_that("canvasXpressOutput", {
cx_output <- canvasXpressOutput("outputId")
expect_true(is.list(cx_output))
})
# json function
test_that("canvasXpress.json - destroy ", {
cx_output <- canvasXpress.json(json = NULL, destroy = TRUE)
expect_equivalent(class(cx_output), c("canvasXpress", "htmlwidget"))
expect_true(is.null(cx_output$width))
expect_true(is.null(cx_output$height))
})
test_that("canvasXpress.json - null json ", {
expect_error(canvasXpress.json(json = NULL),
regexp = "json must be supplied and be a character or json object",
fixed = TRUE)
})
test_that("canvasXpress.json - valid json ", {
my_json <- '{ "data": {"y": { "vars": ["Performance"],
"smps": ["January"],
"data": [[85]] }},
"config": { "graphType": "Meter",
"meterType": "gauge" }}'
expect_equivalent(class(canvasXpress.json(json = my_json)), c("canvasXpress", "htmlwidget"))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.