# NOT RUN {
# displaying a folder ####
library(jsTreeR)
library(shiny)
library(jsonlite)
# make the nodes list from a vector of file paths
makeNodes <- function(leaves){
dfs <- lapply(strsplit(leaves, "/"), function(s){
item <-
Reduce(function(a,b) paste0(a,"/",b), s[-1], s[1], accumulate = TRUE)
data.frame(
item = item,
parent = c("root", item[-length(item)]),
stringsAsFactors = FALSE
)
})
dat <- dfs[[1]]
for(i in 2:length(dfs)){
dat <- merge(dat, dfs[[i]], all = TRUE)
}
f <- function(parent){
i <- match(parent, dat$item)
item <- dat$item[i]
children <- dat$item[dat$parent==item]
label <- tail(strsplit(item, "/")[[1]], 1)
if(length(children)){
list(
text = label,
data = list(value = item),
children = lapply(children, f)
)
}else{
list(text = label, data = list(value = item))
}
}
lapply(dat$item[dat$parent == "root"], f)
}
folder <-
list.files(system.file("www", "shared", package = "shiny"), recursive = TRUE)
nodes <- makeNodes(folder)
ui <- fluidPage(
br(),
fluidRow(
column(
width = 4,
jstreeOutput("jstree")
),
column(
width = 4,
tags$fieldset(
tags$legend("Selections - JSON format"),
verbatimTextOutput("treeSelected_json")
)
),
column(
width = 4,
tags$fieldset(
tags$legend("Selections - R list"),
verbatimTextOutput("treeSelected_R")
)
)
)
)
server <- function(input, output){
output[["jstree"]] <-
renderJstree(
jstree(nodes, search = TRUE, checkboxes = TRUE)
)
output[["treeSelected_json"]] <- renderPrint({
toJSON(input[["jstree_selected"]], pretty = TRUE, auto_unbox = TRUE)
})
output[["treeSelected_R"]] <- renderPrint({
input[["jstree_selected"]]
})
}
if(interactive()){
shinyApp(ui, server)
}
# drag-and-drop, checkboxes, proton theme, fontawesome icons ####
library(jsTreeR)
library(shiny)
library(jsonlite)
nodes <- list(
list(
text = "RootA",
data = list(value = 999),
icon = "far fa-moon red",
children = list(
list(
text = "ChildA1",
icon = "fa fa-leaf green"
),
list(
text = "ChildA2",
icon = "fa fa-leaf green"
)
)
),
list(
text = "RootB",
icon = "far fa-moon red",
children = list(
list(
text = "ChildB1",
icon = "fa fa-leaf green"
),
list(
text = "ChildB2",
icon = "fa fa-leaf green"
)
)
)
)
ui <- fluidPage(
tags$head(
tags$style(
HTML(c(
".red {color: red;}",
".green {color: green;}",
".jstree-proton {font-weight: bold;}",
".jstree-anchor {font-size: medium;}"
))
)
),
titlePanel("Drag and drop the nodes"),
fluidRow(
column(
width = 4,
jstreeOutput("jstree")
),
column(
width = 4,
tags$fieldset(
tags$legend("All nodes"),
verbatimTextOutput("treeState")
)
),
column(
width = 4,
tags$fieldset(
tags$legend("Selected nodes"),
verbatimTextOutput("treeSelected")
)
)
)
)
server <- function(input, output){
output[["jstree"]] <- renderJstree({
jstree(nodes, dragAndDrop = TRUE, checkboxes = TRUE, theme = "proton")
})
output[["treeState"]] <- renderPrint({
toJSON(input[["jstree"]], pretty = TRUE, auto_unbox = TRUE)
})
output[["treeSelected"]] <- renderPrint({
toJSON(input[["jstree_selected"]], pretty = TRUE, auto_unbox = TRUE)
})
}
if(interactive()){
shinyApp(ui, server)
}
# Super tiny icons, with 'search' options ####
library(jsTreeR)
library(shiny)
library(jsonlite)
nodes <- fromJSON(
system.file(
"htmlwidgets",
"SuperTinyIcons",
"SuperTinyIcons.json",
package = "jsTreeR"
),
simplifyDataFrame = FALSE
)
ui <- fluidPage(
tags$head(tags$style(HTML("#jstree {background-color: #fff5ee;"))),
titlePanel("Super tiny icons"),
fluidRow(
column(
width = 12,
jstreeOutput("jstree", height = "auto")
)
)
)
server <- function(input, output){
output[["jstree"]] <- renderJstree({
jstree(nodes, search = list(
show_only_matches = TRUE,
case_sensitive = TRUE,
search_leaves_only = TRUE
))
})
}
if(interactive()){
shinyApp(ui, server)
}
# grid example ####
library(jsTreeR)
library(shiny)
nodes <- list(
list(
text = "Fruits",
type = "fruit",
icon = "supertinyicon-transparent-raspberry_pi",
a_attr = list(class = "helvetica"),
children = list(
list(
text = "Apple",
type = "fruit",
data = list(
price = 0.1,
quantity = 20,
cssclass = "lightorange"
)
),
list(
text = "Banana",
type = "fruit",
data = list(
price = 0.2,
quantity = 31,
cssclass = "lightorange"
)
),
list(
text = "Grapes",
type = "fruit",
data = list(
price = 1.99,
quantity = 34,
cssclass = "lightorange"
)
),
list(
text = "Mango",
type = "fruit",
data = list(
price = 0.5,
quantity = 8,
cssclass = "lightorange"
)
),
list(
text = "Melon",
type = "fruit",
data = list(
price = 0.8,
quantity = 4,
cssclass = "lightorange"
)
),
list(
text = "Pear",
type = "fruit",
data = list(
price = 0.1,
quantity = 30,
cssclass = "lightorange"
)
),
list(
text = "Strawberry",
type = "fruit",
data = list(
price = 0.15,
quantity = 32,
cssclass = "lightorange"
)
)
),
state = list(
opened = TRUE
)
),
list(
text = "Vegetables",
type = "vegetable",
icon = "supertinyicon-transparent-vegetarian",
a_attr = list(class = "helvetica"),
children = list(
list(
text = "Aubergine",
type = "vegetable",
data = list(
price = 0.5,
quantity = 8,
cssclass = "lightgreen"
)
),
list(
text = "Broccoli",
type = "vegetable",
data = list(
price = 0.4,
quantity = 22,
cssclass = "lightgreen"
)
),
list(
text = "Carrot",
type = "vegetable",
data = list(
price = 0.1,
quantity = 32,
cssclass = "lightgreen"
)
),
list(
text = "Cauliflower",
type = "vegetable",
data = list(
price = 0.45,
quantity = 18,
cssclass = "lightgreen"
)
),
list(
text = "Potato",
type = "vegetable",
data = list(
price = 0.2,
quantity = 38,
cssclass = "lightgreen"
)
)
)
)
)
grid <- list(
columns = list(
list(
width = 200,
header = "Product",
headerClass = "bolditalic yellow centered",
wideValueClass = "cssclass"
),
list(
width = 150,
value = "price",
header = "Price",
wideValueClass = "cssclass",
headerClass = "bolditalic yellow centered",
wideCellClass = "centered"
),
list(
width = 150,
value = "quantity",
header = "Quantity",
wideValueClass = "cssclass",
headerClass = "bolditalic yellow centered",
wideCellClass = "centered"
)
),
width = 600
)
types <- list(
fruit = list(
a_attr = list(
class = "lightorange"
),
icon = "supertinyicon-transparent-symantec"
),
vegetable = list(
a_attr = list(
class = "lightgreen"
),
icon = "supertinyicon-transparent-symantec"
)
)
ui <- fluidPage(
tags$head(
tags$style(
HTML(c(
".lightorange {background-color: #fed8b1;}",
".lightgreen {background-color: #98ff98;}",
".bolditalic {font-weight: bold; font-style: italic; font-size: large;}",
".yellow {background-color: yellow !important;}",
".centered {text-align: center; font-family: cursive;}",
".helvetica {font-weight: 700; font-family: Helvetica; font-size: larger;}"
))
)
),
titlePanel("jsTree grid"),
jstreeOutput("jstree")
)
server <- function(input, output){
output[["jstree"]] <-
renderJstree(jstree(nodes, grid = grid, types = types))
}
if(interactive()){
shinyApp(ui, server)
}
# }
Run the code above in your browser using DataLab