Nothing
remove_text <- function(x) {
# Colors are problematic because a slight change in color will lead to test
# failing -- this helper function removes them.
x$colorscale <- x$colorscale[[1]]
# Text is problematic because it is sensitive to precision because has numbers in it
x$text <- length(x$text)
x
}
replace_text <- function(x) {
x$data <- lapply(x$data, remove_text)
x
}
# modified from testhat expect_equal_to_reference
expect_ihm_equal_to_reference <- function(object, file, ..., exclude = NULL, info = NULL) {
lab_exp <- paste0("reference from `", file, "`")
if (!file.exists(file)) {
# first time always succeeds
saveRDS(object, file)
succeed()
} else {
reference <- readRDS(file)
objectsub <- replace_text(object$x[c("data","layout")])
referencesub <- replace_text(reference$x[c("data","layout")])
objectsub <- lapply(objectsub, function(x) setdiff(names(x), exclude))
referencesub <- lapply(referencesub, function(x) setdiff(names(x), exclude))
comp <- testthat::compare(objectsub, referencesub, tolerance = 0.1, ...)
expect(
comp$equal,
sprintf("Not equal to %s.\n%s", lab_exp, comp$message),
info = info
)
}
invisible(object)
}
expect_iheatmap <- function(test_plot, ref_name,
orientation = c("horizontal","vertical"), ...){
test_widget <- test_plot %>% to_widget()
orientation <- match.arg(orientation)
if (orientation == "horizontal"){
expect_is(test_plot,"IheatmapHorizontal")
} else{
expect_is(test_plot,"IheatmapVertical")
}
expect_is(test_widget,"htmlwidget")
expect_is(test_widget,"iheatmapr")
expect_ihm_equal_to_reference(test_widget, paste0("reference/",
ref_name,".rds"), ...)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.