Skip to content

Commit f450c97

Browse files
thothalthothal
committed
Add parser from data.tree to shinyTree
Allow the user to pass a data.tree instead of a nested list to shinyTree. To keep changes minimal, this is achieved by writing a JSON parser, which converts a data.tree into a jsTree compliant JSON format, which in turn can be used by renderTree and updateTree. Closes: shinyTree#88
1 parent 16c77d0 commit f450c97

File tree

5 files changed

+204
-17
lines changed

5 files changed

+204
-17
lines changed

‎NAMESPACE

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ export(renderEmptyTree)
55
export(renderTree)
66
export(renderTreeAsync)
77
export(shinyTree)
8+
export(treeToJSON)
89
export(updateTree)
910
importFrom(htmlwidgets,shinyRenderWidget)
1011
importFrom(jsonlite,toJSON)

‎R/data.tree-conversion.R

Lines changed: 95 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,95 @@
1+
#' Converts a data.tree to a JSON format
2+
#'
3+
#' Walk through a \code{\link{data.tree}} and constructs a JSON string,
4+
#' which can be rendered by shinyTree. The JSON string generated follows the
5+
#' \href{https://www.jstree.com/docs/json}{jsTree specifications}. In particular
6+
#' it encodes children nodes via the \sQuote{children} slot.
7+
#'
8+
#' All atomic or list slots of a node in the tree are stored in a data slot in
9+
#' the resulting JSON.
10+
#'
11+
#' If the user wants to store some slots not in the data slot but on the top
12+
#' level of the node, parameter \code{topLevelSlots} can be used. This is useful
13+
#' for additional parameters such as \sQuote{icon}, \sQuote{li_attr} or
14+
#' \sQuote{a_attr}, which jsTree expect to be on the top level of the node.
15+
#'
16+
#' An example of how to make use of this functionality can be found in the
17+
#' example folder of this library.
18+
#'
19+
#' @param tree, the data.tree which should be parses
20+
#' @param topLevelSlots, a vector of slot names which should not be stored in
21+
#' the resulting data slot but on the top level of the node
22+
#' @param pretty, logical. If \code{TRUE} the resulting JSON is prettified
23+
#'
24+
#' @return a JSON string representing the data.tree
25+
#' @section Note:
26+
#' \code{\link{updateTree}} and \code{\link{renderTree}} need an unevaluated JSON
27+
#' string. Hence, this function returns a string rather than the JSON object itself.
28+
#' @author Thorn Thaler, \email{thorn.thaler@@thothal.at}
29+
#' @export
30+
treeToJSON <- function(tree,
31+
topLevelSlots = c("id", "text", "icon", "state",
32+
"li_attr", "a_attr"),
33+
pretty = FALSE) {
34+
node_to_list <- function(node,
35+
node_name = NULL) {
36+
fields <- mget(node$fields, node)
37+
NOK <- sapply(fields, function(slot) !is.atomic(slot) && !is.list(slot))
38+
if (any(NOK)) {
39+
msg <- sprintf(ngettext(length(which(NOK)),
40+
"unsupported slot of type %s at position %s",
41+
"unsupported slots of types %s at positions %s"),
42+
paste0(dQuote(sapply(fields[NOK], typeof)),
43+
collapse = ", "),
44+
paste0(sQuote(names(fields)[NOK]),
45+
collapse = ", "))
46+
warning(msg,
47+
domain = NA)
48+
fields[NOK] <- NULL
49+
}
50+
if (is.null(fields$text)) {
51+
fields$text <- if(!is.null(fields$name)) fields$name else node_name
52+
}
53+
fields$icon <- fixIconName(fields$icon)
54+
if (!is.null(fields$state)) {
55+
valid_states <- c("opened", "disabled", "selected")
56+
NOK <- !names(fields$state) %in% valid_states
57+
if (any(NOK)) {
58+
msg <- sprintf(ngettext(length(which(NOK)),
59+
"invalid state %s",
60+
"invalid states %s"),
61+
paste0(dQuote(names(fields$state)[NOK]),
62+
collapse = ", "))
63+
warning(msg,
64+
domain = NA)
65+
}
66+
fields$state <- fields$state[!NOK]
67+
}
68+
slots_to_move <- names(fields)[!names(fields) %in% topLevelSlots]
69+
data_slot <- fields[slots_to_move]
70+
if (length(data_slot)) {
71+
fields$data <- data_slot
72+
fields[slots_to_move] <- NULL
73+
}
74+
if (!is.null(node$children)) {
75+
fields$children <- unname(lapply(names(node$children), function(i) node_to_list(node$children[[i]],
76+
i)))
77+
}
78+
fields
79+
}
80+
## clone tree as we do not want to alter the original tree
81+
tree <- Clone(tree)
82+
nodes <- Traverse(tree, filterFun = isNotRoot)
83+
old_ids <- Get(nodes, "id")
84+
if (any(!is.na(old_ids))) {
85+
warning(glue("slot {dQuote('id')} will be stored in {dQuote('id.orig')}"),
86+
domain = NA)
87+
Set(nodes, id.orig = old_ids)
88+
}
89+
Set(nodes, id = seq_along(nodes))
90+
## use as.character b/c updateTree needs an unparsed JSON string, as
91+
## the parsing is done in shinyTree.js
92+
as.character(jsonlite::toJSON(node_to_list(tree)$children,
93+
auto_unbox = TRUE,
94+
pretty = pretty))
95+
}

‎README.md

Lines changed: 25 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -29,7 +29,7 @@ Getting Started
2929

3030
```
3131
library(shiny)
32-
runApp(system.file("examples/01-simple", package="shinyTree"))
32+
runApp(system.file("examples/01-simple", package = "shinyTree"))
3333
```
3434

3535
A simple example to demonstrate the usage of the shinyTree package.
@@ -38,7 +38,7 @@ A simple example to demonstrate the usage of the shinyTree package.
3838

3939
```
4040
library(shiny)
41-
runApp(system.file("examples/02-attributes", package="shinyTree"))
41+
runApp(system.file("examples/02-attributes", package = "shinyTree"))
4242
```
4343

4444
Manage properties of your tree by adding attributes to your list when rendering.
@@ -47,7 +47,7 @@ Manage properties of your tree by adding attributes to your list when rendering.
4747

4848
```
4949
library(shiny)
50-
runApp(system.file("examples/03-checkbox", package="shinyTree"))
50+
runApp(system.file("examples/03-checkbox", package = "shinyTree"))
5151
```
5252

5353
Use checkboxes to allow users to more easily manage which nodes are selected.
@@ -56,7 +56,7 @@ Use checkboxes to allow users to more easily manage which nodes are selected.
5656

5757
```
5858
library(shiny)
59-
runApp(system.file("examples/04-selected", package="shinyTree"))
59+
runApp(system.file("examples/04-selected", package = "shinyTree"))
6060
```
6161

6262
An example demonstrating how to set an `input` to the value of the currently selected node in the tree.
@@ -65,7 +65,7 @@ An example demonstrating how to set an `input` to the value of the currently sel
6565

6666
```
6767
library(shiny)
68-
runApp(system.file("examples/05-structure", package="shinyTree"))
68+
runApp(system.file("examples/05-structure", package = "shinyTree"))
6969
```
7070

7171
Demonstrates the low-level usage of a shinyTree as an input in which all attributes describing the state of the tree can be read.
@@ -75,7 +75,7 @@ Demonstrates the low-level usage of a shinyTree as an input in which all attribu
7575

7676
```
7777
library(shiny)
78-
runApp(system.file("examples/06-search", package="shinyTree"))
78+
runApp(system.file("examples/06-search", package = "shinyTree"))
7979
```
8080

8181
An example showing the use of the search plugin to allow users to more easily navigate the nodes in your tree.
@@ -84,7 +84,7 @@ An example showing the use of the search plugin to allow users to more easily na
8484

8585
```
8686
library(shiny)
87-
runApp(system.file("examples/07-drag-and-drop", package="shinyTree"))
87+
runApp(system.file("examples/07-drag-and-drop", package = "shinyTree"))
8888
```
8989

9090
An example demonstrating the use of the drag-and-drop feature which allows the user to reorder the nodes in the tree.
@@ -93,7 +93,7 @@ An example demonstrating the use of the drag-and-drop feature which allows the u
9393

9494
```
9595
library(shiny)
96-
runApp(system.file("examples/08-class", package="shinyTree"))
96+
runApp(system.file("examples/08-class", package = "shinyTree"))
9797
```
9898

9999
An example demonstrating the use of the ability to style nodes using custom classes.
@@ -102,7 +102,7 @@ An example demonstrating the use of the ability to style nodes using custom clas
102102

103103
```
104104
library(shiny)
105-
runApp(system.file("examples/09-themes", package="shinyTree"))
105+
runApp(system.file("examples/09-themes", package = "shinyTree"))
106106
```
107107

108108
An example demonstrating the use of built-in tree themes.
@@ -111,7 +111,7 @@ An example demonstrating the use of built-in tree themes.
111111

112112
```
113113
library(shiny)
114-
runApp(system.file("examples/10-node-ids", package="shinyTree"))
114+
runApp(system.file("examples/10-node-ids", package = "shinyTree"))
115115
```
116116

117117
An example demonstrating the ability to label and return node identifiers and classes.
@@ -120,7 +120,7 @@ An example demonstrating the ability to label and return node identifiers and cl
120120

121121
```
122122
library(shiny)
123-
runApp(system.file("examples/11-tree-update", package="shinyTree"))
123+
runApp(system.file("examples/11-tree-update", package = "shinyTree"))
124124
```
125125

126126
An example demonstrating the ability to update a tree with a new tree model. This was broken in the original version as the tree was destroyed upon initialization.
@@ -129,7 +129,7 @@ An example demonstrating the ability to update a tree with a new tree model. Th
129129

130130
```
131131
library(shiny)
132-
runApp(system.file("examples/12-types", package="shinyTree"))
132+
runApp(system.file("examples/12-types", package = "shinyTree"))
133133
```
134134

135135
An example demonstrating node types with custom icons.
@@ -138,7 +138,7 @@ An example demonstrating node types with custom icons.
138138

139139
```
140140
library(shiny)
141-
runApp(system.file("examples/13-icons", package="shinyTree"))
141+
runApp(system.file("examples/13-icons", package = "shinyTree"))
142142
```
143143

144144
An example demonstrating various ways to use icons on nodes.
@@ -147,7 +147,7 @@ An example demonstrating various ways to use icons on nodes.
147147

148148
```
149149
library(shiny)
150-
runApp(system.file("examples/14-files", package="shinyTree"))
150+
runApp(system.file("examples/14-files", package = "shinyTree"))
151151
```
152152

153153
Demonstrates how to create a file browser tree.
@@ -156,7 +156,7 @@ Demonstrates how to create a file browser tree.
156156

157157
```
158158
library(shiny)
159-
runApp(system.file("examples/15-data", package="shinyTree"))
159+
runApp(system.file("examples/15-data", package = "shinyTree"))
160160
```
161161

162162
Demonstrates how to attach and retreive metadata from a node.
@@ -165,7 +165,7 @@ Demonstrates how to attach and retreive metadata from a node.
165165

166166
```
167167
library(shiny)
168-
runApp(system.file("examples/16-async", package="shinyTree"))
168+
runApp(system.file("examples/16-async", package = "shinyTree"))
169169
```
170170

171171
Demonstrates how to render a tree asynchronously.
@@ -174,11 +174,19 @@ Demonstrates how to render a tree asynchronously.
174174

175175
```
176176
library(shiny)
177-
runApp(system.file("examples/17-contextmenu", package="shinyTree"))
177+
runApp(system.file("examples/17-contextmenu", package = shinyTree"))
178178
```
179179

180180
Demonstrates how to enable the contextmenu.
181181

182+
#### 19-data.tree
183+
```
184+
library(shiny)
185+
runApp(syste,.file("examples/19-data.tree", package = "shinyTree"))
186+
```
187+
188+
Demonstrates how to pass a data.tree to shinyTree.
189+
182190
Known Bugs
183191
----------
184192

‎inst/examples/19-data.tree/app.R

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
library(data.tree)
2+
library(shiny)
3+
library(shinyTree)
4+
5+
data(acme)
6+
acme$IT$li_attr <- list(class = "myl")
7+
acme$IT$state <- list(opened = TRUE)
8+
acme$Accounting$icon <- "file"
9+
acme$IT$Outsource$state <- list(opened = TRUE)
10+
options(shinyTree.defaultParser = "tree")
11+
12+
ui <- fluidPage(
13+
tags$head(
14+
tags$style(HTML(".myl {color: red}"))),
15+
shinyTree("tree", dragAndDrop = TRUE),
16+
fluidRow(
17+
column(width = 6,
18+
h3("Tree"),
19+
verbatimTextOutput("str_tree")),
20+
column(width = 6,
21+
h3("json"),
22+
verbatimTextOutput("str_json")
23+
)
24+
))
25+
26+
server <- function(input, output, session) {
27+
get_json <- reactive({
28+
treeToJSON(acme, pretty = TRUE)
29+
})
30+
output$tree <- renderTree(get_json())
31+
output$str_json <- renderPrint(cat(get_json()))
32+
output$str_tree <- renderPrint(do.call(print, c(x = req(input$tree),
33+
as.list(input$tree$fieldsAll))))
34+
}
35+
36+
shinyApp(ui, server)

‎man/treeToJSON.Rd

Lines changed: 47 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)