Nothing
context("test_tree")
library(shiny)
library(jsonlite)
test_that("get_flatList", {
li <- list(abc = 123, def = 456)
res <- shinyTree:::get_flatList(li)
expect_is(res, "list")
expect_length(res, 2)
expect_true(all(unlist(lapply(res, class)) == "list"))
expect_true(all(unlist(lapply(res, length)) == 5))
expect_true(res[[1]]$text == "abc" && res[[2]]$text == "def")
expect_true(all(unlist(res[[1]]$state) == FALSE))
## example 01 #################
li <- list(
root1 = "",
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
),
root3 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
res <- shinyTree:::get_flatList(li)
expect_is(res, "list")
expect_length(res, 17)
expect_true(all(unlist(lapply(res, class)) == "list"))
expect_true(all(unlist(lapply(res, length)) == 5))
## example 01 with custom attribute #################
li <- list(
root1 = structure("123", stselected = T, stsomethingelse = T),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
res <- shinyTree:::get_flatList(li)
expect_is(res, "list")
expect_length(res, 9)
expect_true(all(unlist(lapply(res, class)) == "list"))
expect_true(all(unlist(lapply(res, length)) == 5))
})
test_that("renderTree", {
res <- renderTree({
list(
root1 = "",
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
),
root3 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
})
expect_is(res, "function")
})
test_that("renderTreeAsync", {
res <- renderTreeAsync({
list(
root1 = "",
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
),
root3 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
})
expect_is(res, "function")
})
test_that("Rlist2json", {
li <- list(abc = 123, def = 456)
res <- shinyTree:::Rlist2json(li)
expect_is(res, "character")
expect_true(jsonlite::validate(res))
expect_length(res, 1)
## example 01 #################
li <- list(
root1 = "",
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
),
root3 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
res <- shinyTree:::Rlist2json(li)
expect_is(res, "character")
expect_true(jsonlite::validate(res))
expect_length(res, 1)
})
test_that("fixIconName", {
expect_true(is.null(shinyTree:::fixIconName(NULL)))
expect_true(shinyTree:::fixIconName("/images/ball.jpg") == "/images/ball.jpg")
g1 <- shinyTree:::fixIconName("glyphicon glyphicon-file")
g2 <- shinyTree:::fixIconName("glyphicon-file")
expect_true(g1 == "glyphicon glyphicon-file")
expect_identical(g1, g2)
f1 <- shinyTree:::fixIconName("fa fa-file")
f2 <- shinyTree:::fixIconName("fa-file")
f3 <- shinyTree:::fixIconName("file")
expect_true(f1 == "fa fa-file")
expect_identical(f1, f2)
expect_identical(f1, f3)
})
test_that("shinyTree", {
unlistShinytagList <- function(res, checkbox=F, search=F, dnd=F,
themeicon=T, themedots=T, themestripes=F,
multiple=T, animation=200, sort=F, unique=F,
wholerow=F, types=F, contextmenu=F,
options = '{"setState":{},"refresh":{}}',
theme="default") {
## Function defaults are the same as shinyTree defaults
resattr <- res[[3]]$attribs
unlist(list(
checkbox = resattr[["data-st-checkbox"]] == checkbox,
search = resattr[["data-st-search"]] == search,
dnd = resattr[["data-st-dnd"]] == dnd,
themeicon = resattr[["data-st-theme-icons"]] == themeicon,
themedots = resattr[["data-st-theme-dots"]] == themedots,
themestripes = resattr[["data-st-theme-stripes"]] == themestripes,
multiple = resattr[["data-st-multiple"]] == multiple,
animation = resattr[["data-st-animation"]] == animation,
sort = resattr[["data-st-sort"]] == sort,
unique = resattr[["data-st-unique"]] == unique,
wholerow = resattr[["data-st-wholerow"]] == wholerow,
types = resattr[["data-st-types"]] == types,
contextmenu = resattr[["data-st-contextmenu"]] == contextmenu,
theme = resattr[["data-st-theme"]] == theme,
options = as.character(resattr[["options"]]) == options,
options_valid = jsonlite::validate(resattr[["options"]])
))
}
## Default shinyTree ############
res <- shinyTree("tree")
expect_is(res, "shiny.tag.list")
expect_true(all(unlistShinytagList(res)))
## Custom shinyTree with search = TRUE ############
res <- shinyTree("tree", search = TRUE)
expect_is(res, "shiny.tag.list")
expect_true(all(unlistShinytagList(res, search = TRUE)))
## Custom shinyTree with no animation ############
res <- shinyTree("tree", animation = FALSE)
expect_is(res, "shiny.tag.list")
expect_true(all(unlistShinytagList(res, animation = "false")))
## Custom shinyTree ############
res <- shinyTree("tree", checkbox = T, search = "searchid", searchtime = 1000, dragAndDrop = T,
theme = "default", themeIcons = T, themeDots = T, sort = T, unique = T,
wholerow = T, stripes = T, multiple = T, animation = T)
expect_is(res, "shiny.tag.list")
expect_identical(res[[2]]$children[[2]]$children[[1]],
HTML("shinyTree.initSearch('tree','searchid', 1000);"))
expect_true(all(
unlistShinytagList(res, checkbox = T, search = T, dnd = T, themeicon = T,
themedots = T, themestripes = T, animation = T, sort = T,
unique = T, wholerow = T)))
## Custom shinyTree with longer animation time ############
res <- shinyTree("tree", animation = 1000)
expect_true(all(unlistShinytagList(res, animation = 1000)))
## Custom shinyTree with types ############
typs <- "{
'#': { 'max_children' : 2, 'max_depth' : 4, 'valid_children' : ['root'] },
'root' : { 'icon' : 'fa fa-signal', 'valid_children' : ['file'] },
'default' : { 'valid_children' : ['default','file'] },
'file' : { 'icon' : 'glyphicon glyphicon-file', 'valid_children' : [] }
}"
res <- shinyTree("tree", types = typs)
expect_true(all(unlistShinytagList(res, types = TRUE)))
expect_identical(res[[1]]$children[[6]]$children[[1]],
HTML(paste("tree_sttypes =", typs)))
## Custom shinyTree with different themes ############
res <- shinyTree("tree", theme = "default-dark")
# print(unlistShinytagList(res, theme = "default-dark"))
expect_true(all(unlistShinytagList(res, theme = "default-dark")))
res <- shinyTree("tree", theme = "proton")
# print(unlistShinytagList(res, theme = "proton"))
expect_true(all(unlistShinytagList(res, theme = "proton")))
## ERROR: wrong theme ############
expect_error(shinyTree("tree", theme = "nonexisting"))
## WARNING: Checkbox and Contextmenu dont work properly together ############
expect_warning(shinyTree("tree", checkbox = T, contextmenu = T))
})
test_that("get_selected_names", {
## No Selection ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree)
expect_is(sel, "list")
expect_length(sel, 0)
## 1 Selection ( root1 ) ##############
tree <- list(
root1 = structure("123", stselected = T),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree)
expect_is(sel, "list")
expect_length(sel, 1)
expect_true(sel[[1]][1] == "root1")
expect_true(length(attr(sel[[1]], "ancestry")) == 0)
expect_true(attr(sel[[1]], "stselected"))
## 1 Selection ( leaf1 ) ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = structure("", stselected=TRUE), leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree)
expect_is(sel, "list")
expect_length(sel, 1)
expect_true(sel[[1]][1] == "leaf1")
expect_true(all(attr(sel[[1]], "ancestry") == c("root2", "SubListA")))
expect_true(attr(sel[[1]], "stselected"))
## 2 Selections ( leaf1 / leafB ) ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = structure("", stselected=TRUE), leaf2 = "", leaf3=""),
SubListB = list(leafA = structure("", stselected=TRUE), leafB = "")
)
)
sel <- get_selected(tree)
expect_is(sel, "list")
expect_length(sel, 2)
expect_true(sel[[1]][1] == "leaf1")
expect_true(all(attr(sel[[1]], "ancestry") == c("root2", "SubListA")))
expect_true(attr(sel[[1]], "stselected"))
expect_true(sel[[2]][1] == "leafA")
expect_true(all(attr(sel[[2]], "ancestry") == c("root2", "SubListB")))
expect_true(attr(sel[[2]], "stselected"))
})
test_that("get_selected_slices", {
## No Selection ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree, "slices")
expect_is(sel, "list")
expect_length(sel, 0)
## 1 Selection ( root1 ) ##############
tree <- list(
root1 = structure("123", stselected = T),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree, "slices")
expect_is(sel, "list")
expect_length(sel, 1)
expect_true(names(sel[[1]]) == "root1")
## 1 Selection ( leaf1 ) ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = structure("", stselected=TRUE), leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree, "slices")
expect_is(sel, "list")
expect_length(sel, 1)
expect_true(names(sel[[1]]) == "root2")
expect_true(names(sel[[1]][[1]]) == "SubListA")
expect_true(names(sel[[1]][[1]][[1]]) == "leaf1")
## 2 Selections ( leaf1 / leafB ) ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = structure("", stselected=TRUE), leaf2 = "", leaf3=""),
SubListB = list(leafA = structure("", stselected=TRUE), leafB = "")
)
)
sel <- get_selected(tree, "slices")
expect_is(sel, "list")
expect_length(sel, 2)
expect_true(names(sel[[1]]) == "root2")
expect_true(names(sel[[1]][[1]]) == "SubListA")
expect_true(names(sel[[1]][[1]][[1]]) == "leaf1")
expect_true(names(sel[[2]]) == "root2")
expect_true(names(sel[[2]][[1]]) == "SubListB")
expect_true(names(sel[[2]][[1]][[1]]) == "leafA")
})
test_that("get_selected_classid", {
## No Selection ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree, "classid")
expect_is(sel, "list")
expect_length(sel, 0)
## 1 Selection ( root1 ) ##############
tree <- list(
root1 = structure("123", stselected = T),
root2 = list(
SubListA = list(leaf1 = "", leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree, "classid")
expect_is(sel, "list")
expect_length(sel, 1)
expect_true(sel[[1]] == "root1")
## 1 Selection ( leaf1 ) ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = structure("", stselected=TRUE), leaf2 = "", leaf3=""),
SubListB = list(leafA = "", leafB = "")
)
)
sel <- get_selected(tree, "classid")
expect_is(sel, "list")
expect_length(sel, 1)
expect_true(sel[[1]] == "leaf1")
## 2 Selections ( leaf1 / leafB ) ##############
tree <- list(
root1 = structure("123"),
root2 = list(
SubListA = list(leaf1 = structure("", stselected=TRUE), leaf2 = "", leaf3=""),
SubListB = list(leafA = structure("", stselected=TRUE), leafB = "")
)
)
sel <- get_selected(tree, "classid")
expect_is(sel, "list")
expect_length(sel, 2)
expect_true(sel[[1]] == "leaf1")
expect_true(sel[[2]] == "leafA")
})
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.