-
Notifications
You must be signed in to change notification settings - Fork 24
/
d3tree.R
145 lines (134 loc) · 4.04 KB
/
d3tree.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
#' Create an Interactive Treemap (Version 1)
#'
#' \code{d3tree} is the primary function for creating interactive d3.js treemaps from
#' various data types in R. Easily use \code{\link[treemap]{treemap}} plots customized with
#' \code{treemap}, or supply a \code{list} for a more typical \code{d3.js} experience, or
#' blend the two.
#'
#' @param data the data to be plotted as either
#' the result of \code{\link[treemap]{treemap}} or
#' a \code{list} or \code{JSON} as \code{character} or \code{file}
#' in the form of a \code{d3.js} hierarchy.
#' @param rootname \code{character} for the name of the root if \code{data} is a
#' \code{treemap} object.
#' @param id \code{character} of the name or id. The default is \code{"id"}. Often
#' \code{d3.js} hierarchies will use \code{"name"} instead of \code{"id"}. We will use
#' \code{id} as the default to allow nodes with non-unique names.
#' @param celltext \code{character} of the field that contains the title for each cell. The
#' default is \code{"name"}.
#' @param valueField \code{character} of the name of the field containing the value on which
#' you would like your treemap based. The default is \code{"size"}.
#' @param width,height a valid \code{CSS} size for the width and height of the container.
#' Percentage values work also by supplying as \code{character} such as \code{width = "100\%"}
#'
#' @examples
#' \dontrun{
#' ##### designed to work seamlessly with treemap
#' library(treemap)
#' library(d3treeR)
#'
#' # example 1 from ?treemap
#' data(GNI2010)
#' d3tree(
#' treemap(
#' GNI2010
#' ,index=c("continent", "iso3")
#' ,vSize="population"
#' ,vColor="GNI"
#' ,type="value"
#' )
#' , rootname = "World"
#' )
#' }
#'
#' # last example from ?treemap
#' data(business)
#' # Brewer's Red-White-Grey palette reversed with predefined range
#' business$employees.growth <- business$employees - business$employees.prev
#' d3tree(
#' treemap(business,
#' index=c("NACE1", "NACE2"),
#' vSize="employees",
#' vColor="employees.growth",
#' type="value",
#' palette="-RdGy",
#' range=c(-30000,30000))
#' , rootname="Fictitious Business Data"
#' )
#' ####
#'
#' #### also works with d3.js json
#' library(d3tree)
#' d3tree(
#' "http://bl.ocks.org/mbostock/raw/4063269/flare.json"
#' ,id = "name"
#' )
#' ####
#'
#' @importFrom jsonlite fromJSON toJSON
#'
#' @export
d3tree <- function(
data = NULL
, rootname = NULL
, id = "id"
, celltext = "name"
, valueField = "size"
, width = NULL
, height = NULL
) {
meta = NULL
legend = NULL
# accept treemap
if( inherits(data,"list" ) && names(data)[1] == "tm" ){
meta = data[-1]
data = convert_treemap(
data$tm
, ifelse(!is.null(rootname),rootname,deparse(substitute(data)))
)
legend = extract_legend()
}
# accept data.frame
# accept data.tree
# accept JSON string
if( inherits(data,c("character","connection")) ){
data = jsonlite::toJSON(
jsonlite::fromJSON( data )
, auto_unbox = TRUE
, dataframe = "rows"
)
}
# accept list
# here we shouldn't need to do anything
# forward options using x
x = list(
data = data
,meta = meta
,options = list(
id = id
,celltext = celltext
,valueField = valueField
)
)
# create widget
htmlwidgets::createWidget(
name = 'd3tree',
x,
width = width,
height = height,
package = 'd3treeR'
)
}
#' Widget output function for use in Shiny
#'
#' @export
d3treeOutput <- function(outputId, width = '100%', height = '400px'){
htmlwidgets::shinyWidgetOutput(outputId, 'd3tree', width, height, package = 'd3treeR')
}
#' Widget render function for use in Shiny
#'
#' @export
renderD3tree <- function(expr, env = parent.frame(), quoted = FALSE) {
if (!quoted) { expr <- substitute(expr) } # force quoted
htmlwidgets::shinyRenderWidget(expr, d3treeOutput, env, quoted = TRUE)
}