-
Notifications
You must be signed in to change notification settings - Fork 7
/
jsTree.R
190 lines (175 loc) · 6.86 KB
/
jsTree.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
#' @title Htmlwidget for the jsTree Javascript library
#' @description Htmlwidget for the jsTree Javascript library
#' @param obj character, vector of directory tree
#' @param sep character, separator for \code{'obj'} which defines the hierarchy, Default: \code{'/'}.
#' @param sep_fixed boolean, to treat the sep character(s) as fixed when seperating, Default: TRUE.
#' @param core list, additional parameters to pass to core of jsTree, default: NULL
#' @param tooltips character, named vector of tooltips for elements in the tree, Default: NULL
#' @param nodestate boolean, vector the length of obj that initializes tree open to true values, Default: NULL
#' @param ... parameters that are passed to the vcs package (see details)
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
#' \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
#' string and have \code{'px'} appended.
#' @param elementId The input slot that will be used to access the element.
#' @param file character, html filename to save output to,
#' Default: tempfile(pattern = 'jstree-',fileext = '.html').
#' @param browse whether to open a browser to view the html, Default: TRUE
#' @details
#'
#' valid core objects can be found in the jsTree javascript library api
#' \href{https://www.jstree.com/api/}{homepage}.
#'
#' All objects that are children of 'jstree.defaults.core' are valid inputs,
#' except 'jstree.defaults.core.data' which is constructed internally by the R function call.
#' The R list object is translated internally into a valid javascript object.
#'
#' parameters in ... that can be passed on to the vcs package are:
#'
#' \strong{remote_repo} a character object that defines the remote user/repository
#'
#' \strong{remote_branch} character object that defines the branch of remote_repo (ussually 'master')
#'
#' \strong{vcs} character object that defines for vcs which version control system to attach
#' (github, bitbucket, svn)
#'
#' \strong{preview.search} character object that defines a search term to initialize to in the
#' preview pane searchbox
#'
#' if \strong{remote_repo} is given a preview pane of a selected file from the tree will appear to
#' the right of the tree
#'
#' \strong{preview.search} is only relevant for vcs in (github,bitbucket) where file
#' previewing is available
#'
#' For more information on the vcs package go to \url{https://github.com/yonicd/vcs}
#'
#' @examples
#' if(interactive()){
#'
#' data(states)
#' data(state_bird)
#'
#' #collapse columns to text (with sep "/")
#' nested_string <- apply(states,1,paste,collapse='/')
#' jsTree(nested_string)
#'
#' #pass additional parameters to core
#' jsTree(nested_string,core=list(multiple=FALSE))
#'
#' # Add tooltips to state names with the state bird
#' jsTree(nested_string,tooltips = state_bird)
#'
#' #initialize tree with checked boxes for certain fields
#' nodestate1 <- states$variable=='Area'
#' jsTree(nested_string,nodestate=nodestate1)
#'
#' nodestate2 <- states$variable=='Area'&grepl('^M',states$state.name)
#' jsTree(nested_string,nodestate=nodestate2)
#'
#' nodestate3 <- states$variable %in% c('Murder') & states$value >= 10
#' nodestate4 <- states$variable %in% c('HS.Grad') & states$value <= 55
#' jsTree(nested_string,nodestate=nodestate3|nodestate4)
#'
#' #change the order of the hierarchy
#' nested_string2 <- apply(states[,c(4,1,2,3,5)],1,paste,collapse='/')
#'
#' jsTree(nested_string2)
#'
#' #use jsTree to visualize folder structure
#'
#' jsTree(list.files(full.names = TRUE,recursive = FALSE))
#'
#' \dontrun{
#' # This may be too long for example if running from ~.
#' jsTree(list.files(full.names = TRUE,recursive = TRUE))
#' }
#' }
#'
#' @import htmlwidgets
#' @importFrom jsonlite toJSON
#' @importFrom htmltools save_html browsable
#' @export
jsTree <- function(obj,
sep = '/',
sep_fixed = TRUE,
core=NULL,
tooltips=NULL,
nodestate=NULL,
... ,
width = NULL,
height = NULL,
elementId = NULL,
file = tempfile(pattern = 'jstree-',fileext = '.html'),
browse = TRUE) {
preview.search <- NULL
list2env(list(...),envir = environment())
if(!'remote_repo'%in%names(match.call())) remote_repo <- NULL
if(!'vcs'%in%names(match.call())) vcs <- 'github'
if(!'remote_branch'%in%names(match.call())) remote_branch <- 'master'
obj.in <- nest(l = obj,
root = ifelse(!is.null(remote_repo),
ifelse(vcs=='svn',
remote_repo,
paste(remote_repo,remote_branch,sep='/')
),
'.'),
nodestate = nodestate,
tooltips = tooltips,
sep = sep,
sep_fixed = sep_fixed
)
# forward options using x
x <- list(core = jsonlite::toJSON(c(list(data=obj.in),core),auto_unbox = TRUE),
vcs = vcs,
sep = sep)
if( 'preview.search'%in%names(match.call()) ) {
x$forcekey <- preview.search
}
if( !is.null(remote_repo) ){
x$uri <- switch(vcs,
github = sprintf('https://raw.githubusercontent.com/%s/%s',remote_repo,remote_branch),
bitbucket = sprintf('https://bitbucket.org/%s/raw/%s',remote_repo,remote_branch)
)
}
# create widget
w <- htmlwidgets::createWidget(
name = 'jsTree',
x,
width = width,
height = height,
package = 'jsTree',
elementId = elementId
)
if (browse) {
w
}else{
htmltools::save_html(htmltools::browsable(w), file)
invisible(file)
}
}
#' Shiny bindings for jsTree
#'
#' Output and render functions for using jsTree within Shiny
#' applications and interactive Rmd documents.
#'
#' @param outputId output variable to read from
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
#' \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
#' string and have \code{'px'} appended.
#' @param expr An expression that generates a jsTree
#' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#' is useful if you want to save an expression in a variable.
#'
#' @name jsTree-shiny
#'
#' @export
jsTreeOutput <- function(outputId, width = '100%', height = '400px'){
htmlwidgets::shinyWidgetOutput(outputId, 'jsTree', width, height, package = 'jsTree')
}
#' @rdname jsTree-shiny
#' @export
renderJsTree <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) { expr <- substitute(expr) } # force quoted
htmlwidgets::shinyRenderWidget(expr, jsTreeOutput, env, quoted = TRUE)
}