├── .Rbuildignore ├── .gitignore ├── CRAN-SUBMISSION ├── DESCRIPTION ├── NAMESPACE ├── R ├── Shiny.R ├── collapsibleTree.R ├── collapsibleTree.data.frame.R ├── collapsibleTree.data.tree.R ├── collapsibleTreeNetwork.R └── collapsibleTreeSummary.R ├── README-example-1.PNG ├── README-example-2.PNG ├── README-example-3.PNG ├── README-example-4.PNG ├── README-example-5.PNG ├── README.Rmd ├── README.md ├── collapsibleTree.Rproj ├── cran-comments.md ├── docs ├── Shiny │ ├── app.R │ └── rsconnect │ │ └── shinyapps.io │ │ └── adeelk93 │ │ └── collapsibletree.dcf ├── index.Rmd └── index.html ├── inst ├── examples │ ├── 01rmd │ │ ├── Example01.Rmd │ │ └── Example01.html │ ├── 02shiny │ │ └── app.R │ ├── 03shiny │ │ └── app.R │ └── 04rmd │ │ ├── Example04.Rmd │ │ └── Example04.html ├── extdata │ ├── Geography.rda │ ├── Superstore_Sales.rda │ └── species.csv └── htmlwidgets │ ├── collapsibleTree.js │ ├── collapsibleTree.yaml │ └── lib │ ├── collapsibleTree.css │ └── d3-4.10.2 │ ├── LICENSE │ └── d3.min.js ├── man ├── collapsibleTree-shiny.Rd ├── collapsibleTree.Rd ├── collapsibleTreeNetwork.Rd └── collapsibleTreeSummary.Rd └── tests ├── testthat.R └── testthat ├── test-error.R ├── test-margin.R ├── test-na.R ├── test-network.R └── test-root.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^README\.Rmd$ 4 | ^README-.*\.PNG$ 5 | ^docs$ 6 | ^cran-comments\.md$ 7 | ^CRAN-SUBMISSION$ 8 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .DS_Store 6 | -------------------------------------------------------------------------------- /CRAN-SUBMISSION: -------------------------------------------------------------------------------- 1 | Version: 0.1.8 2 | Date: 2023-11-13 05:25:09 UTC 3 | SHA: ff5aa60567654a1d5f3129dcd58c22252d615020 4 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: collapsibleTree 2 | Type: Package 3 | Title: Interactive Collapsible Tree Diagrams using 'D3.js' 4 | Version: 0.1.8 5 | Authors@R: c( 6 | person("Adeel", "Khan", email = "AdeelK@gwu.edu", role = c("aut", "cre")), 7 | person("Dhrumin", "Shah", role = "ctb"), 8 | person("Mike", "Bostock", role = c("ctb", "cph"), comment = "D3.js library, http://d3js.org") 9 | ) 10 | Maintainer: Adeel Khan 11 | Description: 12 | Interactive Reingold-Tilford tree diagrams created using 'D3.js', where every node can be expanded and collapsed by clicking on it. 13 | Tooltips and color gradients can be mapped to nodes using a numeric column in the source data frame. 14 | See 'collapsibleTree' website for more information and examples. 15 | License: GPL (>= 3) 16 | URL: https://github.com/AdeelK93/collapsibleTree, https://AdeelK93.github.io/collapsibleTree/ 17 | BugReports: https://github.com/AdeelK93/collapsibleTree/issues 18 | Encoding: UTF-8 19 | Depends: 20 | R (>= 3.0.0) 21 | Imports: 22 | htmlwidgets, 23 | data.tree, 24 | stats, 25 | methods 26 | Enhances: knitr, shiny 27 | LazyData: true 28 | RoxygenNote: 7.2.3 29 | Suggests: 30 | colorspace, 31 | RColorBrewer, 32 | dplyr, 33 | testthat, 34 | tibble 35 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(collapsibleTree,Node) 4 | S3method(collapsibleTree,data.frame) 5 | export(collapsibleTree) 6 | export(collapsibleTreeNetwork) 7 | export(collapsibleTreeOutput) 8 | export(collapsibleTreeSummary) 9 | export(renderCollapsibleTree) 10 | import(htmlwidgets) 11 | importFrom(data.tree,Aggregate) 12 | importFrom(data.tree,Do) 13 | importFrom(data.tree,FromDataFrameNetwork) 14 | importFrom(data.tree,Sort) 15 | importFrom(data.tree,ToDataFrameTree) 16 | importFrom(data.tree,ToListExplicit) 17 | importFrom(data.tree,Traverse) 18 | importFrom(data.tree,as.Node) 19 | importFrom(methods,is) 20 | importFrom(stats,complete.cases) 21 | importFrom(stats,median) 22 | -------------------------------------------------------------------------------- /R/Shiny.R: -------------------------------------------------------------------------------- 1 | #' Shiny bindings for collapsibleTree 2 | #' 3 | #' Output and render functions for using collapsibleTree within Shiny 4 | #' applications and interactive Rmd documents. 5 | #' 6 | #' @param outputId output variable to read from 7 | #' @param width,height Must be a valid CSS unit (like \code{'100\%'}, 8 | #' \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a 9 | #' string and have \code{'px'} appended. 10 | #' @param expr An expression that generates a collapsibleTree 11 | #' @param env The environment in which to evaluate \code{expr}. 12 | #' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This 13 | #' is useful if you want to save an expression in a variable. 14 | #' 15 | #' @examples 16 | #' if(interactive()) { 17 | #' 18 | #' # Shiny Interaction 19 | #' shiny::runApp(system.file("examples/02shiny", package = "collapsibleTree")) 20 | #' 21 | #' # Interactive Gradient Mapping 22 | #' shiny::runApp(system.file("examples/03shiny", package = "collapsibleTree")) 23 | #' 24 | #' } 25 | #' @name collapsibleTree-shiny 26 | #' 27 | #' @export 28 | collapsibleTreeOutput <- function(outputId, width = "100%", height = "400px") { 29 | shinyWidgetOutput(outputId, "collapsibleTree", width, height, package = "collapsibleTree") 30 | } 31 | 32 | #' @rdname collapsibleTree-shiny 33 | #' @export 34 | renderCollapsibleTree <- function(expr, env = parent.frame(), quoted = FALSE) { 35 | if (!quoted) { expr <- substitute(expr) } # force quoted 36 | shinyRenderWidget(expr, collapsibleTreeOutput, env, quoted = TRUE) 37 | } 38 | -------------------------------------------------------------------------------- /R/collapsibleTree.R: -------------------------------------------------------------------------------- 1 | #' Create Interactive Collapsible Tree Diagrams 2 | #' 3 | #' Interactive Reingold-Tilford tree diagram created using D3.js, 4 | #' where every node can be expanded and collapsed by clicking on it. 5 | #' 6 | #' @param df a \code{data.frame} from which to construct a nested list 7 | #' (where every row is a leaf) or a preconstructed \code{data.tree} 8 | #' @param hierarchy a character vector of column names that define the order 9 | #' and hierarchy of the tree network. Applicable only for \code{data.frame} input. 10 | #' @param hierarchy_attribute name of the \code{data.tree} attribute that contains 11 | #' hierarchy information of the tree network. Applicable only for \code{data.tree} input. 12 | #' @param root label for the root node 13 | #' @param inputId the input slot that will be used to access the selected node (for Shiny). 14 | #' Will return a named list of the most recently clicked node, 15 | #' along with all of its parents. 16 | #' @param attribute numeric column not listed in hierarchy that will be used 17 | #' for tooltips, if applicable. Defaults to 'leafCount', 18 | #' which is the cumulative count of a node's children 19 | #' @param aggFun aggregation function applied to the attribute column to determine 20 | #' values of parent nodes. Defaults to \code{sum}, but \code{mean} also makes sense. 21 | #' @param fill either a single color or a mapping of colors: 22 | #' \itemize{ 23 | #' \item For \code{data.frame} input, a vector of colors the same length as the number 24 | #' of nodes. By default, vector should be ordered by level, such that the root color is 25 | #' described first, then all the children's colors, and then all the grandchildren's colors 26 | #' \item For \code{data.tree} input, a tree attribute containing the color for each node 27 | #' } 28 | #' @param fillByLevel which order to assign fill values to nodes. 29 | #' \code{TRUE}: Filling by level; will assign fill values to nodes vertically. 30 | #' \code{FALSE}: Filling by order; will assign fill values to nodes horizontally. 31 | #' @param linkLength length of the horizontal links that connect nodes in pixels. 32 | #' (optional, defaults to automatic sizing) 33 | #' @param fontSize font size of the label text in pixels 34 | #' @param tooltip tooltip shows the node's label and attribute value. 35 | #' @param tooltipHtml column name (possibly containing html) to override default tooltip 36 | #' contents, allowing for more advanced customization. Applicable only for \code{data.tree} input. 37 | #' @param nodeSize numeric column that will be used to determine relative node size. 38 | #' Default is to have a constant node size throughout. 'leafCount' can also 39 | #' be used here (cumulative count of a node's children), or 'count' 40 | #' (count of node's immediate children). 41 | #' @param collapsed the tree's children will start collapsed by default 42 | #' \itemize{ 43 | #' \item For \code{data.frame} input, can also be a vector of logical values the same length 44 | #' as the number of nodes. Follows the same logic as the fill vector. 45 | #' \item For \code{data.tree} input, can also be a tree attribute for conditionally collapsing nodes 46 | #' } 47 | #' @param zoomable pan and zoom by dragging and scrolling 48 | #' @param width width in pixels (optional, defaults to automatic sizing) 49 | #' @param height height in pixels (optional, defaults to automatic sizing) 50 | #' @param ... other arguments to pass onto S3 methods that implement 51 | #' this generic function - \code{collapsibleTree.data.frame}, \code{collapsibleTree.Node} 52 | #' @examples 53 | #' collapsibleTree(warpbreaks, c("wool", "tension", "breaks")) 54 | #' 55 | #' # Data from US Forest Service DataMart 56 | #' species <- read.csv(system.file("extdata/species.csv", package = "collapsibleTree")) 57 | #' collapsibleTree(df = species, c("REGION", "CLASS", "NAME"), fill = "green") 58 | #' 59 | #' # Visualizing the order in which the node colors are filled 60 | #' library(RColorBrewer) 61 | #' collapsibleTree( 62 | #' warpbreaks, c("wool", "tension"), 63 | #' fill = brewer.pal(9, "RdBu"), 64 | #' fillByLevel = TRUE 65 | #' ) 66 | #' collapsibleTree( 67 | #' warpbreaks, c("wool", "tension"), 68 | #' fill = brewer.pal(9, "RdBu"), 69 | #' fillByLevel = FALSE 70 | #' ) 71 | #' 72 | #' # Tooltip can be mapped to an attribute, or default to leafCount 73 | #' collapsibleTree( 74 | #' warpbreaks, c("wool", "tension", "breaks"), 75 | #' tooltip = TRUE, 76 | #' attribute = "breaks" 77 | #' ) 78 | #' 79 | #' # Node size can be mapped to any numeric column, or to leafCount 80 | #' collapsibleTree( 81 | #' warpbreaks, c("wool", "tension", "breaks"), 82 | #' nodeSize = "breaks" 83 | #' ) 84 | #' 85 | #' # collapsibleTree.Node example 86 | #' data(acme, package="data.tree") 87 | #' acme$Do(function(node) node$cost <- data.tree::Aggregate(node, attribute = "cost", aggFun = sum)) 88 | #' acme$Do(function(node) node$lessThanMillion <- node$cost < 10^6) 89 | #' collapsibleTree( 90 | #' acme, 91 | #' nodeSize = "cost", 92 | #' attribute = "cost", 93 | #' tooltip = TRUE, 94 | #' collapsed = "lessThanMillion" 95 | #' ) 96 | #' 97 | #' # Emulating collapsibleTree.data.frame using collapsibleTree.Node 98 | #' species <- read.csv(system.file("extdata/species.csv", package = "collapsibleTree")) 99 | #' hierarchy <- c("REGION", "CLASS", "NAME") 100 | #' species$pathString <- paste( 101 | #' "species", 102 | #' apply(species[,hierarchy], 1, paste, collapse = "//"), 103 | #' sep = "//" 104 | #' ) 105 | #' df <- data.tree::as.Node(species, pathDelimiter = "//") 106 | #' collapsibleTree(df) 107 | #' 108 | #' @source Christopher Gandrud: \url{http://christophergandrud.github.io/networkD3/}. 109 | #' @source d3noob: \url{https://bl.ocks.org/d3noob/43a860bc0024792f8803bba8ca0d5ecd}. 110 | #' 111 | #' @import htmlwidgets 112 | #' @importFrom methods is 113 | #' @importFrom data.tree ToDataFrameTree ToListExplicit as.Node 114 | #' @importFrom data.tree Traverse Do Aggregate 115 | #' @importFrom stats complete.cases median 116 | #' @rdname collapsibleTree 117 | #' @export 118 | collapsibleTree <- function(df, ..., inputId = NULL, attribute = "leafCount", 119 | aggFun = sum, fill = "lightsteelblue", 120 | linkLength = NULL, fontSize = 10, tooltip = FALSE, 121 | tooltipHtml = NULL,nodeSize = NULL, collapsed = TRUE, 122 | zoomable = TRUE, width = NULL, height = NULL 123 | ) { 124 | UseMethod("collapsibleTree") 125 | } 126 | -------------------------------------------------------------------------------- /R/collapsibleTree.data.frame.R: -------------------------------------------------------------------------------- 1 | #' @rdname collapsibleTree 2 | #' @method collapsibleTree data.frame 3 | #' @export 4 | collapsibleTree.data.frame <- function(df, hierarchy, root = deparse(substitute(df)), 5 | inputId = NULL, attribute = "leafCount", 6 | aggFun = sum, fill = "lightsteelblue", 7 | fillByLevel = TRUE, linkLength = NULL, fontSize = 10, 8 | tooltip = FALSE, nodeSize = NULL, collapsed = TRUE, 9 | zoomable = TRUE, width = NULL, height = NULL, 10 | ...) { 11 | 12 | # preserve this name before evaluating df 13 | root <- root 14 | 15 | # acceptable inherent node attributes 16 | nodeAttr <- c("leafCount", "count") 17 | 18 | # reject bad inputs 19 | if(!is.data.frame(df)) stop("df must be a data frame") 20 | if(!is.character(hierarchy)) stop("hierarchy must be a character vector") 21 | if(!is.character(fill)) stop("fill must be a character vector") 22 | if(length(hierarchy) <= 1) stop("hierarchy vector must be greater than length 1") 23 | if(!all(hierarchy %in% colnames(df))) stop("hierarchy column names are incorrect") 24 | if(!(attribute %in% c(colnames(df), nodeAttr))) stop("attribute column name is incorrect") 25 | if(!is.null(nodeSize)) if(!(nodeSize %in% c(colnames(df), nodeAttr))) stop("nodeSize column name is incorrect") 26 | if(!(attribute %in% nodeAttr)) { 27 | if(any(is.na(df[attribute]))) stop("attribute must not have NAs") 28 | } 29 | 30 | # if df has NAs, coerce them into character columns and replace them with "" 31 | if(sum(complete.cases(df[hierarchy])) != nrow(df)) { 32 | df[hierarchy] <- lapply(df[hierarchy], as.character) 33 | df[is.na(df)] <- "" 34 | } 35 | 36 | # calculate the right and left margins in pixels 37 | leftMargin <- nchar(root) 38 | rightLabelVector <- as.character(df[[hierarchy[length(hierarchy)]]]) 39 | rightMargin <- max(sapply(rightLabelVector, nchar)) 40 | 41 | # create a list that contains the options 42 | options <- list( 43 | hierarchy = hierarchy, 44 | input = inputId, 45 | attribute = attribute, 46 | linkLength = linkLength, 47 | fontSize = fontSize, 48 | tooltip = tooltip, 49 | collapsed = collapsed, 50 | zoomable = zoomable, 51 | margin = list( 52 | top = 20, 53 | bottom = 20, 54 | left = (leftMargin * fontSize/2) + 25, 55 | right = (rightMargin * fontSize/2) + 25 56 | ) 57 | ) 58 | 59 | # these are the fields that will ultimately end up in the json 60 | jsonFields <- NULL 61 | 62 | # the hierarchy that will be used to create the tree 63 | df$pathString <- paste( 64 | root, 65 | apply(df[,hierarchy], 1, paste, collapse = "//"), 66 | sep="//" 67 | ) 68 | 69 | # convert the data frame into a data.tree node 70 | node <- data.tree::as.Node(df, pathDelimiter = "//") 71 | 72 | # fill in the node colors, traversing down the tree 73 | if(length(fill)>1) { 74 | if(length(fill) != node$totalCount) { 75 | stop(paste("Expected fill vector of length", node$totalCount, "but got", length(fill))) 76 | } 77 | node$Set(fill = fill, traversal = ifelse(fillByLevel, "level", "pre-order")) 78 | jsonFields <- c(jsonFields, "fill") 79 | } else { 80 | options$fill <- fill 81 | } 82 | 83 | # only necessary to perform these calculations if there is a tooltip 84 | if(tooltip) { 85 | # traverse down the tree and compute the weights of each node for the tooltip 86 | t <- data.tree::Traverse(node, "pre-order") 87 | data.tree::Do(t, function(x) { 88 | x$WeightOfNode <- data.tree::Aggregate(x, attribute, aggFun) 89 | # make the tooltips look nice 90 | x$WeightOfNode <- prettyNum( 91 | x$WeightOfNode, big.mark = ",", digits = 3, scientific = FALSE 92 | ) 93 | }) 94 | jsonFields <- c(jsonFields, "WeightOfNode") 95 | } 96 | 97 | # collapse the nodes, traversing down the tree 98 | if(length(collapsed)>1) { 99 | if(length(collapsed) != node$totalCount) { 100 | stop(paste("Expected collapsed vector of length", node$totalCount, "but got", length(collapsed))) 101 | } 102 | node$Set(collapsed = collapsed, traversal = ifelse(fillByLevel, "level", "pre-order")) 103 | jsonFields <- c(jsonFields, "collapsed") 104 | options$collapsed <- "collapsed" 105 | } 106 | 107 | # only necessary to perform these calculations if there is a nodeSize specified 108 | if(!is.null(nodeSize)) { 109 | # Scale factor to keep the median leaf size around 10 110 | scaleFactor <- 10/data.tree::Aggregate(node, nodeSize, stats::median) 111 | # traverse down the tree and compute the weights of each node for the tooltip 112 | t <- data.tree::Traverse(node, "pre-order") 113 | data.tree::Do(t, function(x) { 114 | x$SizeOfNode <- data.tree::Aggregate(x, nodeSize, aggFun) 115 | # scale node growth to area rather than radius and round 116 | x$SizeOfNode <- round(sqrt(x$SizeOfNode*scaleFactor)*pi, 2) 117 | }) 118 | # update left margin based on new root size 119 | options$margin$left <- options$margin$left + node$SizeOfNode - 10 120 | jsonFields <- c(jsonFields, "SizeOfNode") 121 | } 122 | 123 | # keep only the JSON fields that are necessary 124 | if(is.null(jsonFields)) jsonFields <- NA 125 | data <- data.tree::ToListExplicit(node, unname = TRUE, keepOnly = jsonFields) 126 | 127 | # pass the data and options using 'x' 128 | x <- list( 129 | data = data, 130 | options = options 131 | ) 132 | 133 | # create the widget 134 | htmlwidgets::createWidget( 135 | "collapsibleTree", x, width = width, height = height, 136 | htmlwidgets::sizingPolicy(viewer.padding = 0) 137 | ) 138 | } 139 | -------------------------------------------------------------------------------- /R/collapsibleTree.data.tree.R: -------------------------------------------------------------------------------- 1 | #' @rdname collapsibleTree 2 | #' @method collapsibleTree Node 3 | #' @export 4 | collapsibleTree.Node <- function(df, hierarchy_attribute = "level", 5 | root = df$name, inputId = NULL, attribute = "leafCount", 6 | aggFun = sum, fill = "lightsteelblue", 7 | linkLength = NULL, fontSize = 10, tooltip = FALSE, 8 | tooltipHtml = NULL,nodeSize = NULL, collapsed = TRUE, 9 | zoomable = TRUE, width = NULL, height = NULL, ...) { 10 | 11 | # acceptable inherent node attributes 12 | nodeAttr <- c("leafCount", "count") 13 | 14 | # reject bad inputs 15 | if(!is(df) %in% "Node") stop("df must be a data tree object") 16 | if(!is.character(fill)) stop("fill must be a either a color or column name") 17 | if(is.character(collapsed) & !(collapsed %in% c(df$attributes, nodeAttr))) stop("collapsed column name is incorrect") 18 | if(!is.null(tooltipHtml)) if(!(tooltipHtml %in% df$attributes)) stop("tooltipHtml column name is incorrect") 19 | if(!is.null(nodeSize)) if(!(nodeSize %in% c(df$attributes, nodeAttr))) stop("nodeSize column name is incorrect") 20 | 21 | # calculate the right and left margins in pixels 22 | leftMargin <- nchar(root) 23 | rightLabelVector <- df$Get("name", filterFun = function(x) x$level==df$height) 24 | rightMargin <- max(sapply(rightLabelVector, nchar)) 25 | 26 | # Deriving hierarchy variable from data.tree input 27 | hierarchy <- unique(ToDataFrameTree(df, hierarchy_attribute)[[hierarchy_attribute]]) 28 | if(length(hierarchy) <= 1) stop("hierarchy vector must be greater than length 1") 29 | 30 | # create a list that contains the options 31 | options <- list( 32 | hierarchy = hierarchy, 33 | input = inputId, 34 | attribute = attribute, 35 | linkLength = linkLength, 36 | fontSize = fontSize, 37 | tooltip = tooltip, 38 | collapsed = collapsed, 39 | zoomable = zoomable, 40 | margin = list( 41 | top = 20, 42 | bottom = 20, 43 | left = (leftMargin * fontSize/2) + 25, 44 | right = (rightMargin * fontSize/2) + 25 45 | ) 46 | ) 47 | 48 | # these are the fields that will ultimately end up in the json 49 | jsonFields <- NULL 50 | 51 | if(fill %in% df$attributes) { 52 | # fill in node colors based on column name 53 | df$Do(function(x) x$fill <- x[[fill]]) 54 | jsonFields <- c(jsonFields, "fill") 55 | } else { 56 | # default to using fill value as literal color name 57 | options$fill <- fill 58 | } 59 | 60 | # only necessary to perform these calculations if there is a tooltip 61 | if(tooltip & is.null(tooltipHtml)) { 62 | t <- data.tree::Traverse(df, hierarchy_attribute) 63 | if(substitute(identity)=="identity") { 64 | # for identity, leave the tooltips as is 65 | data.tree::Do(t, function(x) { 66 | x$WeightOfNode <- x[[attribute]] 67 | }) 68 | } else { 69 | # traverse down the tree and compute the weights of each node for the tooltip 70 | data.tree::Do(t, function(x) { 71 | x$WeightOfNode <- data.tree::Aggregate(x, attribute, aggFun) 72 | # make the tooltips look nice 73 | x$WeightOfNode <- prettyNum( 74 | x$WeightOfNode, big.mark = ",", digits = 3, scientific = FALSE 75 | ) 76 | }) 77 | } 78 | jsonFields <- c(jsonFields, "WeightOfNode") 79 | } 80 | 81 | # if tooltipHtml is specified, pass it on in the data 82 | if(tooltip & !is.null(tooltipHtml)) { 83 | df$Do(function(x) x$tooltip <- x[[tooltipHtml]]) 84 | jsonFields <- c(jsonFields, "tooltip") 85 | } 86 | 87 | # if collapsed is specified, pass it on in the data 88 | if(is.character(collapsed)) jsonFields <- c(jsonFields, collapsed) 89 | 90 | # only necessary to perform these calculations if there is a nodeSize specified 91 | if(!is.null(nodeSize)) { 92 | # Scale factor to keep the median leaf size around 10 93 | scaleFactor <- 10/data.tree::Aggregate(df, nodeSize, stats::median) 94 | t <- data.tree::Traverse(df, hierarchy_attribute) 95 | # traverse down the tree and compute the size of each node 96 | data.tree::Do(t, function(x) { 97 | x$SizeOfNode <- data.tree::Aggregate(x, nodeSize, aggFun) 98 | # scale node growth to area rather than radius and round 99 | x$SizeOfNode <- round(sqrt(x$SizeOfNode*scaleFactor)*pi, 2) 100 | }) 101 | # update left margin based on new root size 102 | options$margin$left <- options$margin$left + df$SizeOfNode - 10 103 | jsonFields <- c(jsonFields, "SizeOfNode") 104 | } 105 | 106 | # keep only the JSON fields that are necessary 107 | if(is.null(jsonFields)) jsonFields <- NA 108 | data <- data.tree::ToListExplicit(df, unname = TRUE, keepOnly = jsonFields) 109 | 110 | # pass the data and options using 'x' 111 | x <- list( 112 | data = data, 113 | options = options 114 | ) 115 | 116 | # create the widget 117 | htmlwidgets::createWidget( 118 | "collapsibleTree", x, width = width, height = height, 119 | htmlwidgets::sizingPolicy(viewer.padding = 0) 120 | ) 121 | } 122 | -------------------------------------------------------------------------------- /R/collapsibleTreeNetwork.R: -------------------------------------------------------------------------------- 1 | #' Create Network Interactive Collapsible Tree Diagrams 2 | #' 3 | #' Interactive Reingold-Tilford tree diagram created using D3.js, 4 | #' where every node can be expanded and collapsed by clicking on it. 5 | #' This function serves as a convenience wrapper for network style data frames 6 | #' containing the node's parent in the first column, node parent in the second 7 | #' column, and additional attributes in the rest of the columns. The root node 8 | #' is denoted by having an \code{NA} for a parent. There must be exactly 1 root. 9 | #' 10 | #' @param df a network data frame (where every row is a node) 11 | #' from which to construct a nested list 12 | #' \itemize{ 13 | #' \item First column must be the parent (\code{NA} for root node) 14 | #' \item Second column must be the child 15 | #' \item Additional columns are passed on as attributes for other parameters 16 | #' \item There must be exactly 1 root node 17 | #' } 18 | #' @param inputId the input slot that will be used to access the selected node (for Shiny). 19 | #' Will return a named list of the most recently clicked node, 20 | #' along with all of its parents. 21 | #' (For \code{collapsibleTreeNetwork} the names of the list are tree depth) 22 | #' @param attribute numeric column not listed in hierarchy that will be used 23 | #' as weighting to define the color gradient across nodes. Defaults to 'leafCount', 24 | #' which colors nodes by the cumulative count of its children 25 | #' @param aggFun aggregation function applied to the attribute column to determine 26 | #' values of parent nodes. Defaults to \code{sum}, but \code{mean} also makes sense. 27 | #' @param fill either a single color or a column name with the color for each node 28 | #' @param linkLength length of the horizontal links that connect nodes in pixels. 29 | #' (optional, defaults to automatic sizing) 30 | #' @param fontSize font size of the label text in pixels 31 | #' @param tooltip tooltip shows the node's label and attribute value. 32 | #' @param tooltipHtml column name (possibly containing html) to override 33 | #' default tooltip contents, allowing for more advanced customization 34 | #' @param nodeSize numeric column that will be used to determine relative node size. 35 | #' Default is to have a constant node size throughout. 'leafCount' can also 36 | #' be used here (cumulative count of a node's children), or 'count' 37 | #' (count of node's immediate children). 38 | #' @param collapsed the tree's children will start collapsed by default. 39 | #' Can also be a logical value found in the data for conditionally collapsing nodes. 40 | #' @param zoomable pan and zoom by dragging and scrolling 41 | #' @param width width in pixels (optional, defaults to automatic sizing) 42 | #' @param height height in pixels (optional, defaults to automatic sizing) 43 | #' 44 | #' @examples 45 | #' # Create a simple org chart 46 | #' org <- data.frame( 47 | #' Manager = c( 48 | #' NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 49 | #' "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 50 | #' ), 51 | #' Employee = c( 52 | #' "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 53 | #' "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 54 | #' ), 55 | #' Title = c( 56 | #' "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 57 | #' "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 58 | #' "Analyst", "Director", "Accountant", "Accountant" 59 | #' ) 60 | #' ) 61 | #' collapsibleTreeNetwork(org, attribute = "Title") 62 | #' 63 | #' # Add in colors and sizes 64 | #' org$Color <- org$Title 65 | #' levels(org$Color) <- colorspace::rainbow_hcl(11) 66 | #' collapsibleTreeNetwork( 67 | #' org, 68 | #' attribute = "Title", 69 | #' fill = "Color", 70 | #' nodeSize = "leafCount", 71 | #' collapsed = FALSE 72 | #' ) 73 | #' 74 | #' # Use unsplash api to add in random photos to tooltip 75 | #' org$tooltip <- paste0( 76 | #' org$Employee, 77 | #' "
Title: ", 78 | #' org$Title, 79 | #' "
" 80 | #' ) 81 | #' 82 | #' collapsibleTreeNetwork( 83 | #' org, 84 | #' attribute = "Title", 85 | #' fill = "Color", 86 | #' nodeSize = "leafCount", 87 | #' tooltipHtml = "tooltip", 88 | #' collapsed = FALSE 89 | #' ) 90 | #' 91 | #' @source Christopher Gandrud: \url{http://christophergandrud.github.io/networkD3/}. 92 | #' @source d3noob: \url{https://bl.ocks.org/d3noob/43a860bc0024792f8803bba8ca0d5ecd}. 93 | #' @seealso \code{\link[data.tree]{FromDataFrameNetwork}} for underlying function 94 | #' that constructs trees from the network data frame 95 | #' 96 | #' @import htmlwidgets 97 | #' @importFrom data.tree ToListExplicit FromDataFrameNetwork 98 | #' @importFrom data.tree Traverse Do Aggregate 99 | #' @export 100 | collapsibleTreeNetwork <- function(df, inputId = NULL, attribute = "leafCount", 101 | aggFun = sum, fill = "lightsteelblue", 102 | linkLength = NULL, fontSize = 10, tooltip = TRUE, 103 | tooltipHtml = NULL, nodeSize = NULL, collapsed = TRUE, 104 | zoomable = TRUE, width = NULL, height = NULL) { 105 | 106 | # acceptable inherent node attributes 107 | nodeAttr <- c("leafCount", "count") 108 | 109 | # reject bad inputs 110 | if(!is.data.frame(df)) stop("df must be a data frame") 111 | if(sum(is.na(df[,1])) != 1) stop("there must be 1 NA for root in the first column") 112 | if(!is.character(fill)) stop("fill must be a either a color or column name") 113 | if(!(attribute %in% c(colnames(df), nodeAttr))) stop("attribute column name is incorrect") 114 | if(is.character(collapsed) & !(collapsed %in% c(colnames(df), nodeAttr))) stop("collapsed column name is incorrect") 115 | if(!is.null(tooltipHtml)) if(!(tooltipHtml %in% colnames(df))) stop("tooltipHtml column name is incorrect") 116 | if(!is.null(nodeSize)) if(!(nodeSize %in% c(colnames(df), nodeAttr))) stop("nodeSize column name is incorrect") 117 | 118 | # root is the node with NA as a parent 119 | root <- df[is.na(df[,1]),] 120 | tree <- df[!is.na(df[,1]),] 121 | 122 | # convert the data frame network into a data.tree node 123 | if (nrow(df)==1) { 124 | # Special case of single node tree 125 | root[1,1] <- "Fake" 126 | node <- data.tree::FromDataFrameNetwork(root) 127 | node <- node$children[[1]] 128 | collapsed <- FALSE 129 | } else { 130 | # Normal tree 131 | node <- data.tree::FromDataFrameNetwork(tree) 132 | } 133 | 134 | # apply root attributes from df to the node (data.tree doesn't automatically do this) 135 | rootAttr <- root[-(1:2)] 136 | Map(function(value, name) node[[name]] <- value, rootAttr, names(rootAttr)) 137 | 138 | # calculate the right and left margins in pixels 139 | leftMargin <- nchar(node$name) 140 | rightLabelVector <- node$Get("name", filterFun = function(x) x$level==node$height) 141 | # required for single node trees 142 | if (is.null(rightLabelVector)) rightLabelVector <- "" 143 | rightMargin <- max(sapply(rightLabelVector, nchar)) 144 | 145 | # create a list that contains the options 146 | options <- list( 147 | hierarchy = 1:node$height, 148 | input = inputId, 149 | attribute = attribute, 150 | linkLength = linkLength, 151 | fontSize = fontSize, 152 | tooltip = tooltip, 153 | collapsed = collapsed, 154 | zoomable = zoomable, 155 | margin = list( 156 | top = 20, 157 | bottom = 20, 158 | left = (leftMargin * fontSize/2) + 25, 159 | right = (rightMargin * fontSize/2) + 25 160 | ) 161 | ) 162 | 163 | # these are the fields that will ultimately end up in the json 164 | jsonFields <- NULL 165 | 166 | if(fill %in% colnames(df)) { 167 | # fill in node colors based on column name 168 | node$Do(function(x) x$fill <- x[[fill]]) 169 | jsonFields <- c(jsonFields, "fill") 170 | } else { 171 | # default to using fill value as literal color name 172 | options$fill <- fill 173 | } 174 | 175 | # only necessary to perform these calculations if there is a tooltip 176 | if(tooltip & is.null(tooltipHtml)) { 177 | if (is.numeric(df[[attribute]]) & substitute(aggFun)!="identity") { 178 | # traverse down the tree and compute the weights of each node for the tooltip 179 | t <- data.tree::Traverse(node, "pre-order") 180 | data.tree::Do(t, function(x) { 181 | x$WeightOfNode <- data.tree::Aggregate(x, attribute, aggFun) 182 | # make the tooltips look nice 183 | x$WeightOfNode <- prettyNum( 184 | x$WeightOfNode, big.mark = ",", digits = 3, scientific = FALSE 185 | ) 186 | }) 187 | } else { 188 | # Can't perform an aggregation on non-numeric 189 | node$Do(function(x) x$WeightOfNode <- x[[attribute]]) 190 | } 191 | jsonFields <- c(jsonFields, "WeightOfNode") 192 | } 193 | 194 | # if tooltipHtml is specified, pass it on in the data 195 | if(tooltip & !is.null(tooltipHtml)) { 196 | node$Do(function(x) x$tooltip <- x[[tooltipHtml]]) 197 | jsonFields <- c(jsonFields, "tooltip") 198 | } 199 | 200 | # if collapsed is specified, pass it on in the data 201 | if(is.character(collapsed)) jsonFields <- c(jsonFields, collapsed) 202 | 203 | # only necessary to perform these calculations if there is a nodeSize specified 204 | if(!is.null(nodeSize)) { 205 | # Scale factor to keep the median leaf size around 10 206 | scaleFactor <- 10/data.tree::Aggregate(node, nodeSize, stats::median) 207 | # traverse down the tree and compute the weights of each node for the tooltip 208 | t <- data.tree::Traverse(node, "pre-order") 209 | # can't use substitute inside a subfunction 210 | aggFunIsIdentity <- substitute(aggFun)=="identity" 211 | data.tree::Do(t, function(x) { 212 | if (aggFunIsIdentity) x$SizeOfNode <- x[[nodeSize]] 213 | else x$SizeOfNode <- data.tree::Aggregate(x, nodeSize, sum) 214 | # scale node growth to area rather than radius and round 215 | x$SizeOfNode <- round(sqrt(x$SizeOfNode*scaleFactor)*pi, 2) 216 | }) 217 | # update left margin based on new root size 218 | options$margin$left <- options$margin$left + node$SizeOfNode - 10 219 | jsonFields <- c(jsonFields, "SizeOfNode") 220 | } 221 | 222 | # keep only the JSON fields that are necessary 223 | if(is.null(jsonFields)) jsonFields <- NA 224 | data <- data.tree::ToListExplicit(node, unname = TRUE, keepOnly = jsonFields) 225 | 226 | # pass the data and options using 'x' 227 | x <- list( 228 | data = data, 229 | options = options 230 | ) 231 | 232 | # create the widget 233 | htmlwidgets::createWidget( 234 | "collapsibleTree", x, width = width, height = height, 235 | htmlwidgets::sizingPolicy(viewer.padding = 0) 236 | ) 237 | } 238 | -------------------------------------------------------------------------------- /R/collapsibleTreeSummary.R: -------------------------------------------------------------------------------- 1 | #' Create Summary Interactive Collapsible Tree Diagrams 2 | #' 3 | #' Interactive Reingold-Tilford tree diagram created using D3.js, 4 | #' where every node can be expanded and collapsed by clicking on it. 5 | #' This function serves as a convenience wrapper to add color gradients to nodes 6 | #' either by counting that node's children (default) or specifying another numeric 7 | #' column in the input data frame. 8 | #' 9 | #' @param df a data frame (where every row is a leaf) from which to construct a nested list 10 | #' @param hierarchy a character vector of column names that define the order 11 | #' and hierarchy of the tree network 12 | #' @param root label for the root node 13 | #' @param inputId the input slot that will be used to access the selected node (for Shiny). 14 | #' Will return a named list of the most recently clicked node, 15 | #' along with all of its parents. 16 | #' @param attribute numeric column not listed in hierarchy that will be used 17 | #' as weighting to define the color gradient across nodes. Defaults to 'leafCount', 18 | #' which colors nodes by the cumulative count of its children 19 | #' @param fillFun function that takes its first argument and returns a vector 20 | #' of colors of that length. \link[colorspace]{rainbow_hcl} is a good example. 21 | #' @param maxPercent highest weighting percent to use in color scale mapping. 22 | #' All numbers above this value will be treated as the same maximum value for the 23 | #' sake of coloring in the nodes (but not the ordering of nodes). Setting this value 24 | #' too high will make it difficult to tell the difference between nodes with many 25 | #' children. 26 | #' @param percentOfParent toggle attribute tooltip to be percent of parent 27 | #' rather than the actual value of attribute 28 | #' @param linkLength length of the horizontal links that connect nodes in pixels. 29 | #' (optional, defaults to automatic sizing) 30 | #' @param fontSize font size of the label text in pixels 31 | #' @param tooltip tooltip shows the node's label and attribute value. 32 | #' @param nodeSize numeric column that will be used to determine relative node size. 33 | #' Default is to have a constant node size throughout. 'leafCount' can also 34 | #' be used here (cumulative count of a node's children), or 'count' 35 | #' (count of node's immediate children). 36 | #' @param collapsed the tree's children will start collapsed by default 37 | #' (There is no conditional collapsing in this function yet, but it could be implemented 38 | #' if there's sufficient demand) 39 | #' @param zoomable pan and zoom by dragging and scrolling 40 | #' @param width width in pixels (optional, defaults to automatic sizing) 41 | #' @param height height in pixels (optional, defaults to automatic sizing) 42 | #' @param ... other arguments passed on to \code{fillFun}, such declaring a 43 | #' palette for \link[RColorBrewer]{brewer.pal} 44 | #' 45 | #' @examples 46 | #' # Color in by number of children 47 | #' collapsibleTreeSummary(warpbreaks, c("wool", "tension", "breaks"), maxPercent = 50) 48 | #' 49 | #' # Color in by the value of breaks and use the terrain_hcl gradient 50 | #' collapsibleTreeSummary( 51 | #' warpbreaks, 52 | #' c("wool", "tension", "breaks"), 53 | #' attribute = "breaks", 54 | #' fillFun = colorspace::terrain_hcl, 55 | #' maxPercent = 50 56 | #' ) 57 | #' @source Christopher Gandrud: \url{http://christophergandrud.github.io/networkD3/}. 58 | #' @source d3noob: \url{https://bl.ocks.org/d3noob/43a860bc0024792f8803bba8ca0d5ecd}. 59 | #' 60 | #' @import htmlwidgets 61 | #' @importFrom data.tree ToListExplicit as.Node 62 | #' @importFrom data.tree Traverse Do Aggregate Sort 63 | #' @importFrom stats complete.cases 64 | #' @export 65 | collapsibleTreeSummary <- function(df, hierarchy, root = deparse(substitute(df)), 66 | inputId = NULL, attribute = "leafCount", 67 | fillFun = colorspace::heat_hcl, maxPercent = 25, 68 | percentOfParent = FALSE, linkLength = NULL, 69 | fontSize = 10, tooltip = TRUE, nodeSize = NULL, 70 | collapsed = TRUE, zoomable = TRUE, width = NULL, 71 | height = NULL, ...) { 72 | 73 | # preserve this name before evaluating df 74 | root <- root 75 | 76 | # acceptable inherent node attributes 77 | nodeAttr <- c("leafCount", "count") 78 | 79 | # reject bad inputs 80 | if(!is.data.frame(df)) stop("df must be a data frame") 81 | if(!is.character(hierarchy)) stop("hierarchy must be a character vector") 82 | if(!is.function(fillFun)) stop("fill must be a function") 83 | if(length(hierarchy) <= 1) stop("hierarchy vector must be greater than length 1") 84 | if(!all(hierarchy %in% colnames(df))) stop("hierarchy column names are incorrect") 85 | if(!(attribute %in% c(colnames(df), nodeAttr))) stop("attribute column name is incorrect") 86 | if(!is.null(nodeSize)) if(!(nodeSize %in% c(colnames(df), nodeAttr))) stop("nodeSize column name is incorrect") 87 | if(!(attribute %in% nodeAttr)) { 88 | if(any(is.na(df[attribute]))) stop("attribute must not have NAs") 89 | } 90 | 91 | # if df has NAs, coerce them into character columns and replace them with "" 92 | if(sum(complete.cases(df[hierarchy])) != nrow(df)) { 93 | df[hierarchy] <- lapply(df[hierarchy], as.character) 94 | df[is.na(df)] <- "" 95 | } 96 | 97 | # calculate the right and left margins in pixels 98 | leftMargin <- nchar(root) 99 | rightLabelVector <- as.character(df[[hierarchy[length(hierarchy)]]]) 100 | rightMargin <- max(sapply(rightLabelVector, nchar)) 101 | 102 | # create a list that contains the options 103 | options <- list( 104 | hierarchy = hierarchy, 105 | input = inputId, 106 | attribute = attribute, 107 | linkLength = linkLength, 108 | fontSize = fontSize, 109 | tooltip = tooltip, 110 | collapsed = collapsed, 111 | zoomable = zoomable, 112 | margin = list( 113 | top = 20, 114 | bottom = 20, 115 | left = (leftMargin * fontSize/2) + 25, 116 | right = (rightMargin * fontSize/2) + 25 117 | ) 118 | ) 119 | 120 | # these are the fields that will ultimately end up in the json 121 | jsonFields <- "fill" 122 | 123 | # the hierarchy that will be used to create the tree 124 | df$pathString <- paste( 125 | root, 126 | apply(df[,hierarchy], 1, paste, collapse = "//"), 127 | sep="//" 128 | ) 129 | 130 | # convert the data frame into a data.tree node 131 | node <- data.tree::as.Node(df, pathDelimiter = "//") 132 | 133 | # traverse down the tree and compute the weights of each node 134 | t <- data.tree::Traverse(node, "pre-order") 135 | data.tree::Do(t, function(x) { 136 | x$WeightOfNode <- data.tree::Aggregate(x, attribute, sum) 137 | }) 138 | data.tree::Do(t, function(x) { 139 | x$WeightOfParent <- 100*(x$WeightOfNode / x$parent$WeightOfNode) 140 | # Round for color matching logic 141 | x$WeightOfParentRnd <- round(x$WeightOfParent) 142 | }) 143 | 144 | # Sort the tree by weight 145 | data.tree::Sort(node, "WeightOfNode", recursive = TRUE, decreasing = TRUE) 146 | 147 | # vector of colors to choose from, up to the maxPercent 148 | fill <- rev(fillFun(maxPercent, ...)) 149 | node$Do(function(self) { 150 | # color in the root 151 | if(!length(self$WeightOfParentRnd)) self$fill <- fill[maxPercent] 152 | # handle parent and child both being 0 (NaN) 153 | else if(is.nan(self$WeightOfParentRnd)) { 154 | warning("NaNs generated in node aggregation, node will be colored white") 155 | self$fill <- "#FFFFFF" 156 | } 157 | # color in high values 158 | else if(self$WeightOfParentRnd >= maxPercent) self$fill <- fill[maxPercent] 159 | # negative percents are just going to be treated like 0 for now 160 | else if(self$WeightOfParentRnd < 0) self$fill <- fill[1] 161 | # all other cases 162 | else self$fill <- fill[self$WeightOfParentRnd+1] 163 | }) 164 | 165 | if(tooltip) { 166 | # make the tooltips look nice, only necessary if there is a tooltip 167 | if(percentOfParent) { 168 | data.tree::Do(t, function(x) { 169 | # root does not have a WeightOfParent 170 | if (!length(x$WeightOfParent)) x$WeightOfNode <- "100%" 171 | else x$WeightOfNode <- paste0(round(x$WeightOfParent, 2), "%") 172 | }) 173 | } else { 174 | data.tree::Do(t, function(x) { 175 | x$WeightOfNode <- prettyNum( 176 | x$WeightOfNode, big.mark = ",", digits = 3, scientific = FALSE 177 | ) 178 | }) 179 | } 180 | jsonFields <- c(jsonFields, "WeightOfNode") 181 | } 182 | 183 | # only necessary to perform these calculations if there is a nodeSize specified 184 | if(!is.null(nodeSize)) { 185 | # Scale factor to keep the median leaf size around 10 186 | scaleFactor <- 10/data.tree::Aggregate(node, nodeSize, stats::median) 187 | # traverse down the tree and compute the weights of each node for the tooltip 188 | t <- data.tree::Traverse(node, "pre-order") 189 | data.tree::Do(t, function(x) { 190 | x$SizeOfNode <- data.tree::Aggregate(x, nodeSize, sum) 191 | # scale node growth to area rather than radius and round 192 | x$SizeOfNode <- round(sqrt(x$SizeOfNode*scaleFactor)*pi, 2) 193 | }) 194 | # update left margin based on new root size 195 | options$margin$left <- options$margin$left + node$SizeOfNode - 10 196 | jsonFields <- c(jsonFields, "SizeOfNode") 197 | } 198 | 199 | # keep only the JSON fields that are necessary 200 | data <- data.tree::ToListExplicit(node, unname = TRUE, keepOnly = jsonFields) 201 | 202 | # pass the data and options using 'x' 203 | x <- list( 204 | data = data, 205 | options = options 206 | ) 207 | 208 | # create the widget 209 | htmlwidgets::createWidget( 210 | "collapsibleTree", x, width = width, height = height, 211 | htmlwidgets::sizingPolicy(viewer.padding = 0) 212 | ) 213 | } 214 | -------------------------------------------------------------------------------- /README-example-1.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/README-example-1.PNG -------------------------------------------------------------------------------- /README-example-2.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/README-example-2.PNG -------------------------------------------------------------------------------- /README-example-3.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/README-example-3.PNG -------------------------------------------------------------------------------- /README-example-4.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/README-example-4.PNG -------------------------------------------------------------------------------- /README-example-5.PNG: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/README-example-5.PNG -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: 3 | md_document: 4 | variant: gfm 5 | --- 6 | 7 | 8 | 9 | ```{r, echo = FALSE} 10 | knitr::opts_chunk$set( 11 | collapse = TRUE, 12 | comment = "#>", 13 | fig.path = "README-" 14 | ) 15 | ``` 16 | 17 | # collapsibleTree `r packageVersion("collapsibleTree")` 18 | 19 | [![CRAN_Status_Badge](http://www.r-pkg.org/badges/version/collapsibleTree)](https://cran.r-project.org/package=collapsibleTree) [![CRAN downloads](http://cranlogs.r-pkg.org/badges/collapsibleTree)](https://cran.r-project.org/package=collapsibleTree) 20 | 21 | 22 | collapsibleTree is an R [htmlwidget](http://www.htmlwidgets.org/) that allows you to create interactive collapsible Reingold-Tilford tree diagrams using D3.js, adapted from Mike Bostock's [example](https://bl.ocks.org/mbostock/4339083). Turn your data frame into a hierarchical visualization without worrying about nested lists or JSON objects! 23 | 24 | If you're using [Shiny](https://shiny.posit.co/), you can bind the most recently clicked node to a Shiny input, allowing for easier interaction with complex nested objects. The input will return a named list containing the most recently selected node, as well as all of its parents. See the [Shiny example](https://adeelk93.shinyapps.io/collapsibletree/) for more info. 25 | 26 | ## Installation 27 | 28 | ```{r eval=FALSE} 29 | # Install package from CRAN: 30 | install.packages("collapsibleTree") 31 | 32 | # Alternately, install the latest development version from GitHub: 33 | # install.packages("devtools") 34 | devtools::install_github("AdeelK93/collapsibleTree") 35 | ``` 36 | 37 | [Changelog can be found here](https://github.com/AdeelK93/collapsibleTree/releases). 38 | 39 | ## Usage 40 | 41 | When working with data in R, it makes sense (at least to me) to represent everything as a data frame. I'm a big fan of [tidy data](https://cran.r-project.org/package=tidyr/vignettes/tidy-data.html), but this structure does not lend itself to easily designing hierarchical networks. 42 | 43 | collapsibleTree uses [data.tree](https://cran.r-project.org/package=data.tree/vignettes/data.tree.html) to handle all of that, freeing you from a lot of recursive list construction. 44 | 45 | [Click here](https://adeelk93.github.io/collapsibleTree/) to see some interactive charts. 46 | 47 | ```{r eval=FALSE} 48 | library(collapsibleTree) 49 | 50 | collapsibleTree(warpbreaks, c("wool", "tension", "breaks")) 51 | ``` 52 | 53 | [![Collapsible Tree](README-example-1.PNG)](https://adeelk93.github.io/collapsibleTree/) 54 | 55 | The color of each node can be customized to draw attention to the levels of hierarchy. Thanks to Ryan Derickson for the implementation idea! Colors can be constants or generated from a gradient function. 56 | 57 | ```{r eval=FALSE} 58 | # Data from US Forest Service DataMart 59 | species <- read.csv("https://apps.fs.usda.gov/fia/datamart/CSV/REF_SPECIES_GROUP.csv") 60 | 61 | collapsibleTree( 62 | species, 63 | hierarchy = c("REGION", "CLASS", "NAME"), 64 | fill = c( 65 | # The root 66 | "seashell", 67 | # Unique regions 68 | rep("brown", length(unique(species$REGION))), 69 | # Unique classes per region 70 | rep("khaki", length(unique(paste(species$REGION, species$CLASS)))), 71 | # Unique names per region 72 | rep("forestgreen", length(unique(paste(species$NAME, species$REGION)))) 73 | ) 74 | ) 75 | ``` 76 | 77 | [![Collapsible Tree Colored](README-example-2.PNG)](https://adeelk93.github.io/collapsibleTree/) 78 | 79 | Gradients can be mapped to a column in the data frame to help visualize relative weightings of nodes. Node weighting can also be mapped to a tooltip. 80 | 81 | ```{r eval=FALSE} 82 | collapsibleTreeSummary( 83 | warpbreaks, 84 | c("wool", "tension", "breaks"), 85 | attribute = "breaks", 86 | maxPercent = 50 87 | ) 88 | ``` 89 | 90 | [![Collapsible Tree Gradient](README-example-3.PNG)](https://adeelk93.github.io/collapsibleTree/) 91 | 92 | Likewise, node size can also be mapped to a column in the data frame to help visualize relative weightings of nodes. 93 | 94 | ```{r eval=FALSE} 95 | collapsibleTreeSummary( 96 | warpbreaks, 97 | c("wool", "tension", "breaks"), 98 | attribute = "breaks", 99 | maxPercent = 50, 100 | nodeSize = "breaks", 101 | collapsed = FALSE 102 | ) 103 | ``` 104 | 105 | [![Collapsible Tree Gradient](README-example-4.PNG)](https://adeelk93.github.io/collapsibleTree/) 106 | 107 | Parent-child relationships can be mapped to the tree to give more customizability for each node, such as passing custom html elements to each node. 108 | 109 | ```{r eval=FALSE} 110 | # Create a simple org chart 111 | org <- data.frame( 112 | Manager = c( 113 | NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 114 | "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 115 | ), 116 | Employee = c( 117 | "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 118 | "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 119 | ), 120 | Title = c( 121 | "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 122 | "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 123 | "Analyst", "Director", "Accountant", "Accountant" 124 | ) 125 | ) 126 | 127 | # Add in colors and sizes 128 | org$Color <- org$Title 129 | levels(org$Color) <- colorspace::rainbow_hcl(11) 130 | 131 | # Use unsplash api to add in random photos to tooltip 132 | org$tooltip <- paste0( 133 | org$Employee, 134 | "
Title: ", 135 | org$Title, 136 | "
" 137 | ) 138 | 139 | collapsibleTreeNetwork( 140 | org, 141 | attribute = "Title", 142 | fill = "Color", 143 | nodeSize = "leafCount", 144 | tooltipHtml = "tooltip" 145 | ) 146 | ``` 147 | 148 | [![Collapsible Tree Network](README-example-5.PNG)](https://adeelk93.github.io/collapsibleTree/) 149 | 150 | ## Shiny Interaction 151 | 152 | An interactive Shiny demo is also included. For example, you could use the collapsibleTree htmlwidget to select a portion of a larger categorical dataset, with your filter being as deep or shallow as you'd prefer. You can find a live demo [here](https://adeelk93.shinyapps.io/collapsibletree/), or run the included examples locally. 153 | 154 | ```{r eval=FALSE} 155 | # Basic Shiny Interaction 156 | shiny::runApp(system.file("examples/02shiny", package = "collapsibleTree")) 157 | 158 | # Interactive Gradient Mapping 159 | shiny::runApp(system.file("examples/03shiny", package = "collapsibleTree")) 160 | ``` 161 | 162 | ## Issues and Suggestions 163 | 164 | Feel free to submit an issue if you run into any bugs or have any feature suggestions! Would love to hear your comments. 165 | 166 | ## Test Results 167 | 168 | ```{r} 169 | library(collapsibleTree) 170 | date() 171 | 172 | testthat::test_dir("tests/testthat", reporter = testthat::SummaryReporter) 173 | ``` 174 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | # collapsibleTree 0.1.7 4 | 5 | [![CRAN\_Status\_Badge](http://www.r-pkg.org/badges/version/collapsibleTree)](https://cran.r-project.org/package=collapsibleTree) 6 | [![CRAN 7 | downloads](http://cranlogs.r-pkg.org/badges/collapsibleTree)](https://cran.r-project.org/package=collapsibleTree) 8 | 9 | collapsibleTree is an R [htmlwidget](http://www.htmlwidgets.org/) that 10 | allows you to create interactive collapsible Reingold-Tilford tree 11 | diagrams using D3.js, adapted from Mike Bostock’s 12 | [example](https://bl.ocks.org/mbostock/4339083). Turn your data frame 13 | into a hierarchical visualization without worrying about nested lists or 14 | JSON objects\! 15 | 16 | If you’re using [Shiny](https://shiny.posit.co/), you can bind the 17 | most recently clicked node to a Shiny input, allowing for easier 18 | interaction with complex nested objects. The input will return a named 19 | list containing the most recently selected node, as well as all of its 20 | parents. See the [Shiny 21 | example](https://adeelk93.shinyapps.io/collapsibletree/) for more info. 22 | 23 | ## Installation 24 | 25 | ``` r 26 | # Install package from CRAN: 27 | install.packages("collapsibleTree") 28 | 29 | # Alternately, install the latest development version from GitHub: 30 | # install.packages("devtools") 31 | devtools::install_github("AdeelK93/collapsibleTree") 32 | ``` 33 | 34 | [Changelog can be found 35 | here](https://github.com/AdeelK93/collapsibleTree/releases). 36 | 37 | ## Usage 38 | 39 | When working with data in R, it makes sense (at least to me) to 40 | represent everything as a data frame. I’m a big fan of [tidy 41 | data](https://cran.r-project.org/package=tidyr/vignettes/tidy-data.html), 42 | but this structure does not lend itself to easily designing hierarchical 43 | networks. 44 | 45 | collapsibleTree uses 46 | [data.tree](https://cran.r-project.org/package=data.tree/vignettes/data.tree.html) 47 | to handle all of that, freeing you from a lot of recursive list 48 | construction. 49 | 50 | [Click here](https://adeelk93.github.io/collapsibleTree/) to see some 51 | interactive charts. 52 | 53 | ``` r 54 | library(collapsibleTree) 55 | 56 | collapsibleTree(warpbreaks, c("wool", "tension", "breaks")) 57 | ``` 58 | 59 | [![Collapsible 60 | Tree](README-example-1.PNG)](https://adeelk93.github.io/collapsibleTree/) 61 | 62 | The color of each node can be customized to draw attention to the levels 63 | of hierarchy. Thanks to Ryan Derickson for the implementation idea\! 64 | Colors can be constants or generated from a gradient function. 65 | 66 | ``` r 67 | # Data from US Forest Service DataMart 68 | species <- read.csv("https://apps.fs.usda.gov/fia/datamart/CSV/REF_SPECIES_GROUP.csv") 69 | 70 | collapsibleTree( 71 | species, 72 | hierarchy = c("REGION", "CLASS", "NAME"), 73 | fill = c( 74 | # The root 75 | "seashell", 76 | # Unique regions 77 | rep("brown", length(unique(species$REGION))), 78 | # Unique classes per region 79 | rep("khaki", length(unique(paste(species$REGION, species$CLASS)))), 80 | # Unique names per region 81 | rep("forestgreen", length(unique(paste(species$NAME, species$REGION)))) 82 | ) 83 | ) 84 | ``` 85 | 86 | [![Collapsible Tree 87 | Colored](README-example-2.PNG)](https://adeelk93.github.io/collapsibleTree/) 88 | 89 | Gradients can be mapped to a column in the data frame to help visualize 90 | relative weightings of nodes. Node weighting can also be mapped to a 91 | tooltip. 92 | 93 | ``` r 94 | collapsibleTreeSummary( 95 | warpbreaks, 96 | c("wool", "tension", "breaks"), 97 | attribute = "breaks", 98 | maxPercent = 50 99 | ) 100 | ``` 101 | 102 | [![Collapsible Tree 103 | Gradient](README-example-3.PNG)](https://adeelk93.github.io/collapsibleTree/) 104 | 105 | Likewise, node size can also be mapped to a column in the data frame to 106 | help visualize relative weightings of nodes. 107 | 108 | ``` r 109 | collapsibleTreeSummary( 110 | warpbreaks, 111 | c("wool", "tension", "breaks"), 112 | attribute = "breaks", 113 | maxPercent = 50, 114 | nodeSize = "breaks", 115 | collapsed = FALSE 116 | ) 117 | ``` 118 | 119 | [![Collapsible Tree 120 | Gradient](README-example-4.PNG)](https://adeelk93.github.io/collapsibleTree/) 121 | 122 | Parent-child relationships can be mapped to the tree to give more 123 | customizability for each node, such as passing custom html elements to 124 | each node. 125 | 126 | ``` r 127 | # Create a simple org chart 128 | org <- data.frame( 129 | Manager = c( 130 | NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 131 | "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 132 | ), 133 | Employee = c( 134 | "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 135 | "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 136 | ), 137 | Title = c( 138 | "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 139 | "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 140 | "Analyst", "Director", "Accountant", "Accountant" 141 | ) 142 | ) 143 | 144 | # Add in colors and sizes 145 | org$Color <- org$Title 146 | levels(org$Color) <- colorspace::rainbow_hcl(11) 147 | 148 | # Use unsplash api to add in random photos to tooltip 149 | org$tooltip <- paste0( 150 | org$Employee, 151 | "
Title: ", 152 | org$Title, 153 | "
" 154 | ) 155 | 156 | collapsibleTreeNetwork( 157 | org, 158 | attribute = "Title", 159 | fill = "Color", 160 | nodeSize = "leafCount", 161 | tooltipHtml = "tooltip" 162 | ) 163 | ``` 164 | 165 | [![Collapsible Tree 166 | Network](README-example-5.PNG)](https://adeelk93.github.io/collapsibleTree/) 167 | 168 | ## Shiny Interaction 169 | 170 | An interactive Shiny demo is also included. For example, you could use 171 | the collapsibleTree htmlwidget to select a portion of a larger 172 | categorical dataset, with your filter being as deep or shallow as you’d 173 | prefer. You can find a live demo 174 | [here](https://adeelk93.shinyapps.io/collapsibletree/), or run the 175 | included examples locally. 176 | 177 | ``` r 178 | # Basic Shiny Interaction 179 | shiny::runApp(system.file("examples/02shiny", package = "collapsibleTree")) 180 | 181 | # Interactive Gradient Mapping 182 | shiny::runApp(system.file("examples/03shiny", package = "collapsibleTree")) 183 | ``` 184 | 185 | ## Issues and Suggestions 186 | 187 | Feel free to submit an issue if you run into any bugs or have any 188 | feature suggestions\! Would love to hear your comments. 189 | 190 | ## Test Results 191 | 192 | ``` r 193 | library(collapsibleTree) 194 | date() 195 | #> [1] "Mon Nov 12 10:26:36 2018" 196 | 197 | testthat::test_dir("tests/testthat", reporter = testthat::SummaryReporter) 198 | #> Error handling: ......... 199 | #> Margin sizing: ................ 200 | #> Missing values: .... 201 | #> Network: ......... 202 | #> Root labelling: .......... 203 | #> 204 | #> ══ DONE ═══════════════════════════════════════════════════════════════════════════════ 205 | #> You are a coding rockstar! 206 | ``` 207 | -------------------------------------------------------------------------------- /collapsibleTree.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: Sweave 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | PackageCheckArgs: --as-cran 22 | PackageRoxygenize: rd,collate,namespace 23 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## Test environments 2 | * OS X 10.13.6, R 3.5.0 3 | 4 | ## R CMD check results 5 | 6 | 0 errors | 0 warnings | 0 notes 7 | 8 | R CMD check succeeded 9 | 10 | ## Reverse dependencies 11 | 12 | No ERRORs or WARNINGs found :) 13 | -------------------------------------------------------------------------------- /docs/Shiny/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(collapsibleTree) 3 | require(colorspace) 4 | # Dataset is from https://community.tableau.com/docs/DOC-1236 5 | load(system.file("extdata/Superstore_Sales.rda", package = "collapsibleTree")) 6 | # For the sake of speed, let's only plot sales in Ontario 7 | Superstore_Sales <- Superstore_Sales[Superstore_Sales$Region=="Ontario",] 8 | 9 | # Define UI for application that draws a collapsible tree 10 | ui <- fluidPage( 11 | 12 | # Application title 13 | titlePanel("Collapsible Tree Example: Gradient Mapping"), 14 | 15 | # Sidebar with a select input for the root node 16 | sidebarLayout( 17 | sidebarPanel( 18 | selectInput( 19 | "hierarchy", "Tree hierarchy", 20 | choices = c( 21 | "Customer Segment", "Product Category", "Product Sub-Category", 22 | "Order Priority", "Product Container" 23 | ), 24 | selected = c("Customer Segment","Product Category", "Product Sub-Category"), 25 | multiple = TRUE 26 | ), 27 | selectInput( 28 | "fill", "Node color", 29 | choices = c("Order Quantity", "Sales", "Unit Price"), 30 | selected = "Sales" 31 | ), 32 | tags$p("The node you most recently clicked:"), 33 | verbatimTextOutput("str"), 34 | tags$br(), 35 | tags$a(href = "https://community.tableau.com/docs/DOC-1236", "Sample dataset from Tableau") 36 | ), 37 | 38 | # Show a tree diagram with the selected root node 39 | mainPanel( 40 | collapsibleTreeOutput("plot", height = "500px") 41 | ) 42 | ) 43 | ) 44 | 45 | # Define server logic required to draw a collapsible tree diagram 46 | server <- function(input, output) { 47 | output$plot <- renderCollapsibleTree({ 48 | collapsibleTreeSummary( 49 | Superstore_Sales, 50 | hierarchy = input$hierarchy, 51 | inputId = "node", 52 | root = input$fill, 53 | attribute = input$fill 54 | ) 55 | }) 56 | 57 | output$str <- renderPrint(str(input$node)) 58 | } 59 | 60 | # Run the application 61 | shinyApp(ui = ui, server = server) 62 | -------------------------------------------------------------------------------- /docs/Shiny/rsconnect/shinyapps.io/adeelk93/collapsibletree.dcf: -------------------------------------------------------------------------------- 1 | name: collapsibletree 2 | title: collapsibleTree 3 | username: 4 | account: adeelk93 5 | server: shinyapps.io 6 | hostUrl: https://api.shinyapps.io/v1 7 | appId: 164943 8 | bundleId: 1550010 9 | url: https://adeelk93.shinyapps.io/collapsibletree/ 10 | when: 1534996883.64757 11 | asMultiple: FALSE 12 | asStatic: FALSE 13 | -------------------------------------------------------------------------------- /docs/index.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'Collapsible Tree: Geography Example' 3 | author: "Adeel Khan" 4 | date: "`r Sys.Date()`" 5 | output: html_document 6 | --- 7 | 8 | ```{r setup, include=FALSE} 9 | knitr::opts_chunk$set(echo = TRUE) 10 | library(collapsibleTree) 11 | load(system.file("extdata/Geography.rda", package = "collapsibleTree")) 12 | ``` 13 | 14 | ## Overview 15 | 16 | collapsibleTree is an R [htmlwidget](http://www.htmlwidgets.org/) that allows you to create interactive collapsible Reingold-Tilford tree diagrams using D3.js, adapted from Mike Bostock's [example](https://bl.ocks.org/mbostock/4339083). Turn your data frame into a hierarchical visualization without worrying about nested lists or JSON objects! 17 | 18 | If you're using [Shiny](https://shiny.posit.co/), you can bind the most recently clicked node to a Shiny input, allowing for easier interaction with complex nested objects. The input will return a named list containing the most recently selected node, as well as all of its parents. See the [Shiny example](https://adeelk93.shinyapps.io/collapsibletree/) for more info. 19 | 20 | ## Installation 21 | 22 | ```{r eval=FALSE} 23 | # Install package from CRAN: 24 | install.packages("collapsibleTree") 25 | 26 | # Alternately, install the latest development version from GitHub: 27 | # install.packages("devtools") 28 | devtools::install_github("AdeelK93/collapsibleTree") 29 | ``` 30 | 31 | ## Data frames, not lists 32 | 33 | When working with data in R, it makes sense (at least to me) to represent everything as a data frame. I'm a big fan of [tidy data](https://cran.r-project.org/package=tidyr/vignettes/tidy-data.html), but this structure does not lend itself to easily designing hierarchical networks. 34 | 35 | collapsibleTree uses [data.tree](https://cran.r-project.org/web/packages/data.tree/vignettes/data.tree.html) to handle all of that, freeing you from a lot of recursive list construction. 36 | 37 | Here is an example geography dataset from [data.world](https://data.world/glx/geography-table): 38 | 39 | ```{r summary} 40 | summary(Geography) 41 | ``` 42 | 43 | ## Rendering the plot 44 | 45 | With your data frame in hand, and a vector of columns to graph, creating an interactive collapsible tree diagram can be done like so: 46 | 47 | ```{r plot} 48 | collapsibleTree( 49 | Geography, 50 | hierarchy = c("continent", "type", "country"), 51 | width = 800, 52 | zoomable = FALSE 53 | ) 54 | ``` 55 | 56 | ## Basing Gradients on a Numeric Column 57 | 58 | Throw in some gradients if you'd like! Each node can have its own distinct color. Let's use some `dplyr` to help us with the data aggregation and use `colorspace` to make some nice looking palettes. 59 | 60 | We can create a new column in the source data frame for the total number of countries on each continent, and map that column to the fill gradient of the nodes. `collapsibleTreeSummary` serves as a convenience function around `collapsibleTree`. 61 | 62 | Looking at this chart, you can tell that Africa has roughly the same number of countries as Europe, and that most countries are... countries. Hovering over the node can confirm this fact. 63 | 64 | Also note that the nodes are a little bit further apart on this example, due to individual countries not being represented. Link length and chart margins are automatically calculated based on the number of nodes and the length of the labels. 65 | 66 | ```{r plotsummary, warning=FALSE, message=FALSE} 67 | library(dplyr) 68 | 69 | Geography %>% 70 | group_by(continent, type) %>% 71 | summarize(`Number of Countries` = n()) %>% 72 | collapsibleTreeSummary( 73 | hierarchy = c("continent", "type"), 74 | root = "Geography", 75 | width = 800, 76 | attribute = "Number of Countries", 77 | zoomable = FALSE 78 | ) 79 | ``` 80 | 81 | ## Varying Tree Depths using NAs 82 | 83 | Sometimes you need to represent trees with varying levels of depth. In the below example, every continent besides Antartica has a subregion. Antartica has an `NA` for its subregion, so no leafs will be drawn. 84 | 85 | ```{r NAs} 86 | collapsibleTree( 87 | Geography, 88 | hierarchy = c("continent", "sub_region"), 89 | width = 800 90 | ) 91 | ``` 92 | 93 | ## Converting a data frame to a tree 94 | 95 | A large amount of rectangular data that people want to convert into a tree follows the following model: Every column is a hierarchy level and every row is a leaf. In the previous examples, this model holds up nicely. Let's try an example where it doesn't: an org chart. 96 | 97 | ```{r org} 98 | org <- data.frame( 99 | Manager = c( 100 | NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 101 | "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 102 | ), 103 | Employee = c( 104 | "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 105 | "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 106 | ), 107 | Title = c( 108 | "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 109 | "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 110 | "Analyst", "Director", "Accountant", "Accountant" 111 | ) 112 | ) 113 | ``` 114 | 115 | If we use the regular `collapsibleTree` function here and consider every row as a leaf, what we end up is a series of manager-employee relationships. The first level contains all people who manage others, and the second contains all the people who are managed. We also do not have a way of mapping titles to any employee in particular since the rows map to manager-employee relationships rather than the employees themselves. 116 | 117 | ```{r collapsibleTree} 118 | collapsibleTree(org, c("Manager", "Employee"), collapsed = FALSE) 119 | ``` 120 | 121 | This isn't necessarily worthless, but what we want is an org chart. Let's try a different model: The first column is the parent, the second is the node itself, and all other columns are attributes describing that node. We can now map titles to employees in tooltips. 122 | 123 | ```{r basic} 124 | collapsibleTreeNetwork(org, attribute = "Title", collapsed = FALSE) 125 | ``` 126 | 127 | Note that in the original data frame, we denoted Ana as the root by giving her an `NA` as a manager. Every tree must have exactly one root. 128 | 129 | In addition to title, we can also easily map colors and sizes to our org chart. It's not always easy to get our data in this structure, but if we can, it allows us a much greater degree of customizability over our chart. 130 | 131 | ```{r color} 132 | org$Color <- org$Title 133 | levels(org$Color) <- colorspace::rainbow_hcl(11) 134 | collapsibleTreeNetwork( 135 | org, 136 | attribute = "Title", 137 | fill = "Color", 138 | nodeSize = "leafCount", 139 | collapsed = FALSE 140 | ) 141 | ``` 142 | 143 | It's also possible to assign custom html tooltips to each node since we now have so much more control over the nodes. Images used in the tooltips are from the Unsplash API. 144 | 145 | ```{r unsplash} 146 | org$tooltip <- paste0( 147 | org$Employee, 148 | "
Title: ", 149 | org$Title, 150 | "
" 151 | ) 152 | 153 | collapsibleTreeNetwork( 154 | org, 155 | attribute = "Title", 156 | fill = "Color", 157 | nodeSize = "leafCount", 158 | tooltipHtml = "tooltip", 159 | collapsed = FALSE 160 | ) 161 | ``` 162 | -------------------------------------------------------------------------------- /inst/examples/01rmd/Example01.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'Collapsible Tree Example 1: R Markdown' 3 | author: "Adeel Khan" 4 | output: html_document 5 | --- 6 | 7 | ```{r setup, include=FALSE} 8 | knitr::opts_chunk$set(echo = TRUE) 9 | library(collapsibleTree) 10 | load(system.file("extdata/Geography.rda", package = "collapsibleTree")) 11 | ``` 12 | 13 | ## Data frames, not lists 14 | 15 | When working with data in R, it makes sense (at least to me) to represent everything as a data frame. I'm a big fan of [tidy data](https://cran.r-project.org/web/packages/tidyr/vignettes/tidy-data.html), but this structure does not lend itself to easily designing hierarchical networks. 16 | 17 | collapsibleTree uses [data.tree](https://cran.r-project.org/web/packages/data.tree/vignettes/data.tree.html) to handle all of that, freeing you from a lot of recursive list construction. 18 | 19 | Here is an example geography dataset from [data.world](https://data.world/glx/geography-table): 20 | 21 | ```{r summary} 22 | summary(Geography) 23 | ``` 24 | 25 | ## Rendering the plot 26 | 27 | With your data frame in hand, and a vector of columns to graph, creating an interactive collapsible tree diagram can be done like so: 28 | 29 | ```{r plot} 30 | collapsibleTree( 31 | Geography, 32 | hierarchy = c("continent", "type", "country"), 33 | width = 800 34 | ) 35 | ``` 36 | 37 | ## Adding Colors 38 | 39 | You can add colors to each node in the diagram manually by declaring a `fill` value. Fill is declared as a hierarchy, applied down the tree. In order to get your vectors to the right length for complex trees (this one has 385 nodes), you could use a pattern like this: 40 | 41 | ```{r plotcolored} 42 | collapsibleTree( 43 | Geography, 44 | hierarchy = c("continent", "type", "country"), 45 | width = 800, 46 | fill = c( 47 | # The root 48 | "white", 49 | # Unique continents 50 | rep("firebrick", length(unique(Geography$continent))), 51 | # Unique types per continent 52 | rep("steelblue", length(unique(paste(Geography$continent, Geography$type)))), 53 | # Unique countries 54 | rep("green", length(unique(Geography$country))) 55 | ) 56 | ) 57 | ``` 58 | 59 | ## Using Gradients 60 | 61 | Throw in some gradients if you'd like! Each node can have its own distinct color. Let's use some `dplyr` to help us with the data aggregation and use `RColorBrewer` and `colorspace` to make some nice looking palettes. 62 | 63 | The fill order is depends on the order of the data frame. This time we'll sort alphabetically rather than using the order the dataset originally came in. 64 | 65 | ```{r plotgradient, warning=FALSE} 66 | library(dplyr, warn.conflicts = FALSE) 67 | 68 | # Continents are a simple gradient 69 | continentColors <- RColorBrewer::brewer.pal(length(unique(Geography$continent)), "Reds") 70 | # Types will be a gradient that resets between continents 71 | typeColors <- Geography %>% 72 | arrange(continent, type) %>% 73 | group_by(continent) %>% 74 | distinct(type) %>% 75 | mutate(colors = colorspace::sequential_hcl(length(type))[seq_along(type)]) 76 | # Countries will also be a gradient that resets between continents, but not types 77 | countryColors <- Geography %>% 78 | arrange(continent, type) %>% 79 | group_by(continent) %>% 80 | distinct(country) %>% 81 | mutate(colors = colorspace::rainbow_hcl(length(country))[seq_along(country)]) 82 | 83 | Geography %>% 84 | arrange(continent, type, country) %>% 85 | collapsibleTree( 86 | hierarchy = c("continent", "type", "country"), 87 | root = "Geography", 88 | width = 800, 89 | fill = c("white", continentColors, typeColors$colors, countryColors$colors) 90 | ) 91 | ``` 92 | 93 | ## Basing Gradients on a Numeric Column 94 | 95 | Using `dplyr` and `colorspace` again, we can create a new column in the source data frame for the total number of countries on each continent, and map that column to the fill gradient of the nodes. `collapsibleTreeSummary` serves as a convenience function around `collapsibleTree`. 96 | 97 | Looking at this chart, you can tell that Africa has roughly the same number of countries as Europe, and that most countries are... countries. Hovering over the node can confirm this fact. 98 | 99 | Also note that the nodes are a little bit further apart on this example, due to individual countries not being represented. Link length and chart margins are automatically calculated based on the number of nodes and the length of the labels. 100 | 101 | ```{r plotsummary, warning=FALSE} 102 | Geography %>% 103 | group_by(continent, type) %>% 104 | summarise(`Number of Countries` = n()) %>% 105 | collapsibleTreeSummary( 106 | hierarchy = c("continent", "type"), 107 | root = "Geography", 108 | width = 800, 109 | attribute = "Number of Countries" 110 | ) 111 | ``` 112 | 113 | ## Varying Tree Depths using NAs 114 | 115 | Sometimes you need to represent trees with varying levels of depth. In the below example, every continent besides Antartica has a subregion. Antartica has an `NA` for its subregion, so no leafs will be drawn. 116 | 117 | ```{r NAs} 118 | collapsibleTree( 119 | Geography, 120 | hierarchy = c("continent", "sub_region"), 121 | width = 800 122 | ) 123 | ``` 124 | -------------------------------------------------------------------------------- /inst/examples/02shiny/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(collapsibleTree) 3 | 4 | # Define UI for application that draws a collapsible tree 5 | ui <- fluidPage( 6 | 7 | # Application title 8 | titlePanel("Collapsible Tree Example 2: Shiny Interaction"), 9 | 10 | # Sidebar with a select input for the root node 11 | sidebarLayout( 12 | sidebarPanel( 13 | selectInput("root", "Root node", c("wool", "tension")), 14 | tags$p("The node you most recently clicked:"), 15 | verbatimTextOutput("str") 16 | ), 17 | 18 | # Show a tree diagram with the selected root node 19 | mainPanel( 20 | collapsibleTreeOutput("plot") 21 | ) 22 | ) 23 | ) 24 | 25 | # Define server logic required to draw a collapsible tree diagram 26 | server <- function(input, output) { 27 | 28 | output$plot <- renderCollapsibleTree({ 29 | if(input$root=="wool") { 30 | hierarchy <- c("wool","tension","breaks") 31 | } else { 32 | hierarchy <- c("tension","wool","breaks") 33 | } 34 | collapsibleTree( 35 | warpbreaks, hierarchy, input$root, 36 | inputId = "node", linkLength = 100 37 | ) 38 | }) 39 | output$str <- renderPrint(str(input$node)) 40 | } 41 | 42 | # Run the application 43 | shinyApp(ui = ui, server = server) 44 | -------------------------------------------------------------------------------- /inst/examples/03shiny/app.R: -------------------------------------------------------------------------------- 1 | library(shiny) 2 | library(collapsibleTree) 3 | require(colorspace) 4 | # Dataset is from https://community.tableau.com/docs/DOC-1236 5 | load(system.file("extdata/Superstore_Sales.rda", package = "collapsibleTree")) 6 | # For the sake of speed, let's only plot sales in Ontario 7 | Superstore_Sales <- Superstore_Sales[Superstore_Sales$Region=="Ontario",] 8 | 9 | # Define UI for application that draws a collapsible tree 10 | ui <- fluidPage( 11 | 12 | # Application title 13 | titlePanel("Collapsible Tree Example 3: Gradient Mapping"), 14 | 15 | # Sidebar with a select input for the root node 16 | sidebarLayout( 17 | sidebarPanel( 18 | selectInput( 19 | "hierarchy", "Tree hierarchy", 20 | choices = c( 21 | "Customer Segment", "Product Category", "Product Sub-Category", 22 | "Order Priority", "Product Container" 23 | ), 24 | selected = c("Customer Segment","Product Category", "Product Sub-Category"), 25 | multiple = TRUE 26 | ), 27 | selectInput( 28 | "fill", "Node color", 29 | choices = c("Order Quantity", "Sales", "Unit Price"), 30 | selected = "Sales" 31 | ), 32 | tags$p("The node you most recently clicked:"), 33 | verbatimTextOutput("str"), 34 | tags$br(), 35 | tags$a(href = "https://community.tableau.com/docs/DOC-1236", "Sample dataset from Tableau") 36 | ), 37 | 38 | # Show a tree diagram with the selected root node 39 | mainPanel( 40 | collapsibleTreeOutput("plot", height = "500px") 41 | ) 42 | ) 43 | ) 44 | 45 | # Define server logic required to draw a collapsible tree diagram 46 | server <- function(input, output) { 47 | output$plot <- renderCollapsibleTree({ 48 | collapsibleTreeSummary( 49 | Superstore_Sales, 50 | hierarchy = input$hierarchy, 51 | inputId = "node", 52 | root = input$fill, 53 | attribute = input$fill 54 | ) 55 | }) 56 | 57 | output$str <- renderPrint(str(input$node)) 58 | } 59 | 60 | # Run the application 61 | shinyApp(ui = ui, server = server) 62 | -------------------------------------------------------------------------------- /inst/examples/04rmd/Example04.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: 'Collapsible Tree Example 4: Org Chart' 3 | author: "Adeel Khan" 4 | output: html_document 5 | --- 6 | 7 | ```{r setup, include=FALSE} 8 | knitr::opts_chunk$set(echo = TRUE) 9 | library(collapsibleTree) 10 | ``` 11 | 12 | ## Converting a data frame to a tree 13 | 14 | A large amount of rectangular data that people want to convert into a tree follows the following model: Every column is a hierarchy level and every row is a leaf. In the other examples, this model holds up nicely. Let's try an example where it doesn't: an org chart. 15 | 16 | ```{r org} 17 | org <- data.frame( 18 | Manager = c( 19 | NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 20 | "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 21 | ), 22 | Employee = c( 23 | "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 24 | "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 25 | ), 26 | Title = c( 27 | "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 28 | "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 29 | "Analyst", "Director", "Accountant", "Accountant" 30 | ) 31 | ) 32 | ``` 33 | 34 | If we use the regular `collapsibleTree` function here and consider every row as a leaf, what we end up is a series of manager-employee relationships. The first level contains all people who manage others, and the second contains all the people who are managed. We also do not have a way of mapping titles to any employee in particular since the rows map to manager-employee relationships rather than the employees themselves. 35 | 36 | ```{r collapsibleTree} 37 | collapsibleTree(org, c("Manager", "Employee"), collapsed = FALSE) 38 | ``` 39 | 40 | This isn't necessarily worthless, but what we want is an org chart. Let's try a different model: The first column is the parent, the second is the node itself, and all other columns are attributes describing that node. We can now map titles to employees in tooltips. 41 | 42 | ```{r basic} 43 | collapsibleTreeNetwork(org, attribute = "Title", collapsed = FALSE) 44 | ``` 45 | 46 | Note that in the original data frame, we denoted Ana as the root by giving her an `NA` as a manager. Every tree must have exactly one root. 47 | 48 | In addition to title, we can also easily map colors and sizes to our org chart. It's not always easy to get our data in this structure, but if we can, it allows us a much greater degree of customizability over our chart. 49 | 50 | ```{r color} 51 | org$Color <- org$Title 52 | levels(org$Color) <- colorspace::rainbow_hcl(11) 53 | collapsibleTreeNetwork( 54 | org, 55 | attribute = "Title", 56 | fill = "Color", 57 | nodeSize = "leafCount", 58 | collapsed = FALSE 59 | ) 60 | ``` 61 | 62 | It's also possible to assign custom html tooltips to each node since we now have so much more control over the nodes. Images used in the tooltips are from the Unsplash API. 63 | 64 | ```{r unsplash} 65 | org$tooltip <- paste0( 66 | org$Employee, 67 | "
Title: ", 68 | org$Title, 69 | "
" 70 | ) 71 | 72 | collapsibleTreeNetwork( 73 | org, 74 | attribute = "Title", 75 | fill = "Color", 76 | nodeSize = "leafCount", 77 | tooltipHtml = "tooltip", 78 | collapsed = FALSE 79 | ) 80 | ``` 81 | 82 | -------------------------------------------------------------------------------- /inst/extdata/Geography.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/inst/extdata/Geography.rda -------------------------------------------------------------------------------- /inst/extdata/Superstore_Sales.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/AdeelK93/collapsibleTree/6c40208a8082e15a7fd1da3f390a7eb69751f9a7/inst/extdata/Superstore_Sales.rda -------------------------------------------------------------------------------- /inst/extdata/species.csv: -------------------------------------------------------------------------------- 1 | SPGRPCD,NAME,REGION,CLASS,CREATED_BY,CREATED_DATE,CREATED_IN_INSTANCE,MODIFIED_BY,MODIFIED_DATE,MODIFIED_IN_INSTANCE 2 | 1,Longleaf and slash pines,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 3 | 2,Loblolly and shortleaf pines,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 4 | 3,Other yellow pines,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 5 | 4,Eastern white and red pines,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 6 | 5,Jack pine,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 7 | 6,Spruce and balsam fir,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 8 | 7,Eastern hemlock,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 9 | 8,Cypress,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 10 | 9,Other eastern softwoods,Eastern,Softwood,NA,2005-02-24,333,NA,,NA 11 | 10,Douglas-fir,Western,Softwood,NA,2005-02-24,333,NA,,NA 12 | 11,Ponderosa and Jeffrey pines,Western,Softwood,NA,2005-02-24,333,NA,,NA 13 | 12,True fir,Western,Softwood,NA,2005-02-24,333,NA,,NA 14 | 13,Western hemlock,Western,Softwood,NA,2005-02-24,333,NA,,NA 15 | 14,Sugar pine,Western,Softwood,NA,2005-02-24,333,NA,,NA 16 | 15,Western white pine,Western,Softwood,NA,2005-02-24,333,NA,,NA 17 | 16,Redwood,Western,Softwood,NA,2005-02-24,333,NA,,NA 18 | 17,Sitka spruce,Western,Softwood,NA,2005-02-24,333,NA,,NA 19 | 18,Engelmann and other spruces,Western,Softwood,NA,2005-02-24,333,NA,,NA 20 | 19,Western larch,Western,Softwood,NA,2005-02-24,333,NA,,NA 21 | 20,Incense-cedar,Western,Softwood,NA,2005-02-24,333,NA,,NA 22 | 21,Lodgepole pine,Western,Softwood,NA,2005-02-24,333,NA,,NA 23 | 22,Western redcedar,Western,Softwood,NA,2005-02-24,333,NA,,NA 24 | 23,Woodland softwoods,All,Softwood,NA,2005-02-24,333,NA,2011-08-24,10945 25 | 24,Other western softwoods,Western,Softwood,NA,2005-02-24,333,NA,,NA 26 | 25,Select white oaks,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 27 | 26,Select red oaks,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 28 | 27,Other white oaks,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 29 | 28,Other red oaks,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 30 | 29,Hickory,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 31 | 30,Yellow birch,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 32 | 31,Hard maple,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 33 | 32,Soft maple,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 34 | 33,Beech,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 35 | 34,Sweetgum,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 36 | 35,Tupelo and blackgum,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 37 | 36,Ash,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 38 | 37,Cottonwood and aspen,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 39 | 38,Basswood,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 40 | 39,Yellow-poplar,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 41 | 40,Black walnut,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 42 | 41,Other eastern soft hardwoods,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 43 | 42,Other eastern hard hardwoods,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 44 | 43,Eastern noncommercial hardwoods,Eastern,Hardwood,NA,2005-02-24,333,NA,,NA 45 | 44,Cottonwood and aspen,Western,Hardwood,NA,2005-02-24,333,NA,,NA 46 | 45,Red alder,Western,Hardwood,NA,2005-02-24,333,NA,,NA 47 | 46,Oak,Western,Hardwood,NA,2005-02-24,333,NA,,NA 48 | 47,Other western hardwoods,Western,Hardwood,NA,2005-02-24,333,NA,,NA 49 | 48,Woodland hardwoods,All,Hardwood,NA,2005-02-24,333,NA,2011-08-24,10945 50 | 51,Tropical and subtropical pines,Tropical,Softwood,NA,2010-09-17,10854,NA,2010-09-17,10854 51 | 52,Other tropical and subtropical softwoods,Tropical,Softwood,NA,2010-09-17,10854,NA,2010-09-17,10854 52 | 53,Tropical and subtropical palms,Tropical,Hardwood,NA,2010-09-17,10854,NA,2010-09-17,10854 53 | 54,Tropical and subtropical hardwoods,Tropical,Hardwood,NA,2010-09-17,10854,NA,2010-09-17,10854 54 | 55,Urban-specific hardwoods,All,Hardwood,NA,2014-05-01,440,NA,,NA 55 | 56,Urban-specific softwoods,All,Softwood,NA,2014-05-01,440,NA,,NA 56 | -------------------------------------------------------------------------------- /inst/htmlwidgets/collapsibleTree.js: -------------------------------------------------------------------------------- 1 | HTMLWidgets.widget({ 2 | 3 | name: 'collapsibleTree', 4 | type: 'output', 5 | 6 | factory: function(el, width, height) { 7 | 8 | var i = 0, 9 | duration = 750, 10 | root = {}, 11 | options = {}, 12 | treemap; 13 | 14 | // Optionally enable zooming, and limit to 1/5x or 5x of the original viewport 15 | var zoom = d3.zoom() 16 | .scaleExtent([1/5, 5]) 17 | .on('zoom', function () { 18 | svg.attr('transform', d3.event.transform) 19 | }) 20 | 21 | // create our tree object and bind it to the element 22 | // appends a 'group' element to 'svg' 23 | // moves the 'group' element to the top left margin 24 | var svg = d3.select(el).append('svg') 25 | .attr('width', width) 26 | .attr('height', height) 27 | .append('g'); 28 | 29 | // Define the div for the tooltip 30 | var tooltip = d3.select(el).append('div') 31 | .attr('class', 'tooltip') 32 | .style('opacity', 0); 33 | 34 | function update(source) { 35 | 36 | // Assigns the x and y position for the nodes 37 | var treeData = treemap(root); 38 | 39 | // Compute the new tree layout. 40 | var nodes = treeData.descendants(), 41 | links = treeData.descendants().slice(1); 42 | 43 | // Normalize for fixed-depth. 44 | nodes.forEach(function(d) {d.y = d.depth * options.linkLength}); 45 | 46 | // ****************** Nodes section *************************** 47 | 48 | // Update the nodes... 49 | var node = svg.selectAll('g.node') 50 | .data(nodes, function(d) {return d.id || (d.id = ++i); }); 51 | 52 | // Enter any new modes at the parent's previous position. 53 | var nodeEnter = node.enter().append('g') 54 | .attr('class', 'node') 55 | .attr('transform', function(d) { 56 | return 'translate(' + source.y0 + ',' + source.x0 + ')'; 57 | }) 58 | .on('click', click); 59 | 60 | // Add tooltips, if specified in options 61 | if (options.tooltip) { 62 | nodeEnter = nodeEnter 63 | .on('mouseover', mouseover) 64 | .on('mouseout', mouseout); 65 | } 66 | 67 | // Enable zooming, if specified 68 | if (options.zoomable) d3.select(el).select('svg').call(zoom) 69 | 70 | // Add Circle for the nodes 71 | nodeEnter.append('circle') 72 | .attr('class', 'node') 73 | .attr('r', 1e-6) 74 | .style('fill', function(d) { 75 | return d.data.fill || (d._children ? options.fill : '#fff'); 76 | }) 77 | .style('stroke-width', function(d) { 78 | return d._children ? 3 : 1; 79 | }); 80 | 81 | // Add labels for the nodes 82 | nodeEnter.append('text') 83 | .attr('dy', '.35em') 84 | .attr('x', function(d) { 85 | // Scale padding for label to the size of node 86 | var padding = (d.data.SizeOfNode || 10) + 3 87 | return d.children || d._children ? -1 * padding : padding; 88 | }) 89 | .attr('text-anchor', function(d) { 90 | return d.children || d._children ? 'end' : 'start'; 91 | }) 92 | .style('font-size', options.fontSize + 'px') 93 | .text(function(d) { return d.data.name; }); 94 | 95 | // UPDATE 96 | var nodeUpdate = nodeEnter.merge(node); 97 | 98 | // Transition to the proper position for the node 99 | nodeUpdate.transition() 100 | .duration(duration) 101 | .attr('transform', function(d) { 102 | return 'translate(' + d.y + ',' + d.x + ')'; 103 | }); 104 | 105 | // Update the node attributes and style 106 | nodeUpdate.select('circle.node') 107 | .attr('r', function(d) { 108 | return d.data.SizeOfNode || 10; // default radius is 10 109 | }) 110 | .style('fill', function(d) { 111 | return d.data.fill || (d._children ? options.fill : '#fff'); 112 | }) 113 | .style('stroke-width', function(d) { 114 | return d._children ? 3 : 1; 115 | }) 116 | .attr('cursor', 'pointer'); 117 | 118 | 119 | // Remove any exiting nodes 120 | var nodeExit = node.exit().transition() 121 | .duration(duration) 122 | .attr('transform', function(d) { 123 | return 'translate(' + source.y + ',' + source.x + ')'; 124 | }) 125 | .remove(); 126 | 127 | // On exit reduce the node circles size to 0 128 | nodeExit.select('circle') 129 | .attr('r', 1e-6); 130 | 131 | // On exit reduce the opacity of text labels 132 | nodeExit.select('text') 133 | .style('fill-opacity', 1e-6); 134 | 135 | // ****************** links section *************************** 136 | 137 | // Update the links... 138 | var link = svg.selectAll('path.link') 139 | .data(links, function(d) { return d.id; }); 140 | 141 | // Enter any new links at the parent's previous position. 142 | var linkEnter = link.enter().insert('path', 'g') 143 | .attr('class', 'link') 144 | // Potentially, this may one day be mappable 145 | // .style('stroke-width', function(d) { return d.data.linkWidth || 1 }) 146 | .attr('d', function(d){ 147 | var o = { x: source.x0, y: source.y0 } 148 | return diagonal(o, o) 149 | }); 150 | 151 | // UPDATE 152 | var linkUpdate = linkEnter.merge(link); 153 | 154 | // Transition back to the parent element position 155 | linkUpdate.transition() 156 | .duration(duration) 157 | .attr('d', function(d){ return diagonal(d, d.parent) }); 158 | 159 | // Remove any exiting links 160 | var linkExit = link.exit().transition() 161 | .duration(duration) 162 | .attr('d', function(d) { 163 | var o = {x: source.x, y: source.y} 164 | return diagonal(o, o) 165 | }) 166 | .remove(); 167 | 168 | // Store the old positions for transition. 169 | nodes.forEach(function(d){ 170 | d.x0 = d.x; 171 | d.y0 = d.y; 172 | }); 173 | 174 | // Creates a curved (diagonal) path from parent to the child nodes 175 | function diagonal(s, d) { 176 | 177 | path = 'M ' + s.y + ' ' + s.x + ' C ' + 178 | (s.y + d.y) / 2 + ' ' + s.x + ', ' + 179 | (s.y + d.y) / 2 + ' ' + d.x + ', ' + 180 | d.y + ' ' + d.x; 181 | 182 | return path 183 | } 184 | 185 | // Toggle children on click. 186 | function click(d) { 187 | if (d.children) { 188 | d._children = d.children; 189 | d.children = null; 190 | } else { 191 | d.children = d._children; 192 | d._children = null; 193 | } 194 | update(d); 195 | // Hide the tooltip after clicking 196 | tooltip.transition() 197 | .duration(100) 198 | .style('opacity', 0) 199 | // Update Shiny inputs, if applicable 200 | if (options.input) { 201 | var nest = {}, 202 | obj = d; 203 | // Navigate up the list and recursively find parental nodes 204 | for (var n = d.depth; n > 0; n--) { 205 | nest[options.hierarchy[n-1]] = obj.data.name 206 | obj = obj.parent 207 | } 208 | Shiny.onInputChange(options.input, nest) 209 | } 210 | } 211 | 212 | // Show tooltip on mouseover 213 | function mouseover(d) { 214 | tooltip.transition() 215 | .duration(200) 216 | .style('opacity', .9); 217 | 218 | // Show either a constructed tooltip, or override with one from the data 219 | tooltip.html( 220 | d.data.tooltip || d.data.name + '
' + 221 | options.attribute + ': ' + d.data.WeightOfNode 222 | ) 223 | // Make the tooltip font size just a little bit bigger 224 | .style('font-size', (options.fontSize + 1) + 'px') 225 | .style('left', (d3.event.layerX) + 'px') 226 | .style('top', (d3.event.layerY - 30) + 'px'); 227 | } 228 | // Hide tooltip on mouseout 229 | function mouseout(d) { 230 | tooltip.transition() 231 | .duration(500) 232 | .style('opacity', 0); 233 | } 234 | } 235 | 236 | return { 237 | renderValue: function(x) { 238 | // Assigns parent, children, height, depth 239 | root = d3.hierarchy(x.data, function(d) { return d.children; }); 240 | root.x0 = height / 2; 241 | root.y0 = 0; 242 | 243 | // Attach options as a property of the instance 244 | options = x.options; 245 | 246 | // Update the canvas with the new dimensions 247 | svg = svg.attr('transform', 'translate(' 248 | + options.margin.left + ',' + options.margin.top + ')') 249 | 250 | // width and height, corrected for margins 251 | var heightMargin = height - options.margin.top - options.margin.bottom, 252 | widthMargin = width - options.margin.left - options.margin.right; 253 | // declares a tree layout and assigns the size 254 | treemap = d3.tree().size([heightMargin, widthMargin]) 255 | .separation(separationFun); 256 | 257 | // Calculate a reasonable link length, if not otherwise specified 258 | if (!options.linkLength) { 259 | options.linkResponsive = true 260 | options.linkLength = widthMargin / options.hierarchy.length 261 | if (options.linkLength < 10) { 262 | options.linkLength = 10 // Offscreen or too short 263 | } 264 | } 265 | 266 | // Optionally collapse after the second level 267 | if (options.collapsed) root.children.forEach(collapse); 268 | update(root); 269 | 270 | // Collapse the node and all it's children 271 | function collapse(d) { 272 | // A collapsed data value was specified and is true 273 | if(d.children && options.collapsed in d.data && !d.data[options.collapsed]) { 274 | d.children.forEach(collapse) 275 | } else if(d.children) { 276 | d._children = d.children 277 | d._children.forEach(collapse) 278 | d.children = null 279 | } 280 | } 281 | }, 282 | 283 | resize: function(width, height) { 284 | // Resize the canvas 285 | d3.select(el).select('svg') 286 | .attr('width', width) 287 | .attr('height', height); 288 | 289 | // width and height, corrected for margins 290 | var heightMargin = height - options.margin.top - options.margin.bottom, 291 | widthMargin = width - options.margin.left - options.margin.right; 292 | 293 | // Calculate a reasonable link length, if not originally specified 294 | if (options.linkResponsive) { 295 | options.linkLength = widthMargin / options.hierarchy.length 296 | if (options.linkLength < 10) { 297 | options.linkLength = 10 // Offscreen or too short 298 | } 299 | } 300 | // Update the treemap to fit the new canvas size 301 | treemap = d3.tree().size([heightMargin, widthMargin]) 302 | .separation(separationFun); 303 | update(root) 304 | }, 305 | // Make the instance properties available as a property of the widget 306 | svg: svg, 307 | root: root, 308 | options: options 309 | }; 310 | } 311 | }); 312 | 313 | function separationFun(a, b) { 314 | var height = a.data.SizeOfNode + b.data.SizeOfNode, 315 | // Scale distance to SizeOfNode, if defined 316 | distance = (height || 20) / 10; 317 | return (a.parent === b.parent ? 1 : distance); 318 | }; 319 | -------------------------------------------------------------------------------- /inst/htmlwidgets/collapsibleTree.yaml: -------------------------------------------------------------------------------- 1 | dependencies: 2 | - name: d3 3 | version: 4.10.2 4 | src: "htmlwidgets/lib/d3-4.10.2" 5 | script: d3.min.js 6 | - name: collapsibleTree 7 | version: 0.1.6 8 | src: "htmlwidgets/lib" 9 | stylesheet: collapsibleTree.css 10 | -------------------------------------------------------------------------------- /inst/htmlwidgets/lib/collapsibleTree.css: -------------------------------------------------------------------------------- 1 | .collapsibleTree .node { 2 | cursor: pointer; 3 | } 4 | 5 | .collapsibleTree .node circle { 6 | fill: #fff; 7 | stroke: #000; 8 | } 9 | 10 | .collapsibleTree .node text { 11 | font: 10px sans-serif; 12 | } 13 | 14 | .collapsibleTree .link { 15 | fill: none; 16 | stroke: #ccc; 17 | stroke-width: 1.5px; 18 | } 19 | 20 | .collapsibleTree div.tooltip { 21 | position: absolute; 22 | text-align: center; 23 | padding: 3px; 24 | font: 10px sans-serif; 25 | background: #fff; 26 | border: 2px; 27 | border-radius: 8px; 28 | border-style: solid; 29 | pointer-events: none; 30 | } 31 | -------------------------------------------------------------------------------- /inst/htmlwidgets/lib/d3-4.10.2/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2010-2017 Mike Bostock 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | * Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | * Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | * Neither the name of the author nor the names of contributors may be used to 15 | endorse or promote products derived from this software without specific prior 16 | written permission. 17 | 18 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 19 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 20 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 21 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR 22 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 23 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 24 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 25 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 26 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 27 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /man/collapsibleTree-shiny.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/Shiny.R 3 | \name{collapsibleTree-shiny} 4 | \alias{collapsibleTree-shiny} 5 | \alias{collapsibleTreeOutput} 6 | \alias{renderCollapsibleTree} 7 | \title{Shiny bindings for collapsibleTree} 8 | \usage{ 9 | collapsibleTreeOutput(outputId, width = "100\%", height = "400px") 10 | 11 | renderCollapsibleTree(expr, env = parent.frame(), quoted = FALSE) 12 | } 13 | \arguments{ 14 | \item{outputId}{output variable to read from} 15 | 16 | \item{width, height}{Must be a valid CSS unit (like \code{'100\%'}, 17 | \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a 18 | string and have \code{'px'} appended.} 19 | 20 | \item{expr}{An expression that generates a collapsibleTree} 21 | 22 | \item{env}{The environment in which to evaluate \code{expr}.} 23 | 24 | \item{quoted}{Is \code{expr} a quoted expression (with \code{quote()})? This 25 | is useful if you want to save an expression in a variable.} 26 | } 27 | \description{ 28 | Output and render functions for using collapsibleTree within Shiny 29 | applications and interactive Rmd documents. 30 | } 31 | \examples{ 32 | if(interactive()) { 33 | 34 | # Shiny Interaction 35 | shiny::runApp(system.file("examples/02shiny", package = "collapsibleTree")) 36 | 37 | # Interactive Gradient Mapping 38 | shiny::runApp(system.file("examples/03shiny", package = "collapsibleTree")) 39 | 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /man/collapsibleTree.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/collapsibleTree.R, 3 | % R/collapsibleTree.data.frame.R, R/collapsibleTree.data.tree.R 4 | \name{collapsibleTree} 5 | \alias{collapsibleTree} 6 | \alias{collapsibleTree.data.frame} 7 | \alias{collapsibleTree.Node} 8 | \title{Create Interactive Collapsible Tree Diagrams} 9 | \source{ 10 | Christopher Gandrud: \url{http://christophergandrud.github.io/networkD3/}. 11 | 12 | d3noob: \url{https://bl.ocks.org/d3noob/43a860bc0024792f8803bba8ca0d5ecd}. 13 | } 14 | \usage{ 15 | collapsibleTree( 16 | df, 17 | ..., 18 | inputId = NULL, 19 | attribute = "leafCount", 20 | aggFun = sum, 21 | fill = "lightsteelblue", 22 | linkLength = NULL, 23 | fontSize = 10, 24 | tooltip = FALSE, 25 | tooltipHtml = NULL, 26 | nodeSize = NULL, 27 | collapsed = TRUE, 28 | zoomable = TRUE, 29 | width = NULL, 30 | height = NULL 31 | ) 32 | 33 | \method{collapsibleTree}{data.frame}( 34 | df, 35 | hierarchy, 36 | root = deparse(substitute(df)), 37 | inputId = NULL, 38 | attribute = "leafCount", 39 | aggFun = sum, 40 | fill = "lightsteelblue", 41 | fillByLevel = TRUE, 42 | linkLength = NULL, 43 | fontSize = 10, 44 | tooltip = FALSE, 45 | nodeSize = NULL, 46 | collapsed = TRUE, 47 | zoomable = TRUE, 48 | width = NULL, 49 | height = NULL, 50 | ... 51 | ) 52 | 53 | \method{collapsibleTree}{Node}( 54 | df, 55 | hierarchy_attribute = "level", 56 | root = df$name, 57 | inputId = NULL, 58 | attribute = "leafCount", 59 | aggFun = sum, 60 | fill = "lightsteelblue", 61 | linkLength = NULL, 62 | fontSize = 10, 63 | tooltip = FALSE, 64 | tooltipHtml = NULL, 65 | nodeSize = NULL, 66 | collapsed = TRUE, 67 | zoomable = TRUE, 68 | width = NULL, 69 | height = NULL, 70 | ... 71 | ) 72 | } 73 | \arguments{ 74 | \item{df}{a \code{data.frame} from which to construct a nested list 75 | (where every row is a leaf) or a preconstructed \code{data.tree}} 76 | 77 | \item{...}{other arguments to pass onto S3 methods that implement 78 | this generic function - \code{collapsibleTree.data.frame}, \code{collapsibleTree.Node}} 79 | 80 | \item{inputId}{the input slot that will be used to access the selected node (for Shiny). 81 | Will return a named list of the most recently clicked node, 82 | along with all of its parents.} 83 | 84 | \item{attribute}{numeric column not listed in hierarchy that will be used 85 | for tooltips, if applicable. Defaults to 'leafCount', 86 | which is the cumulative count of a node's children} 87 | 88 | \item{aggFun}{aggregation function applied to the attribute column to determine 89 | values of parent nodes. Defaults to \code{sum}, but \code{mean} also makes sense.} 90 | 91 | \item{fill}{either a single color or a mapping of colors: 92 | \itemize{ 93 | \item For \code{data.frame} input, a vector of colors the same length as the number 94 | of nodes. By default, vector should be ordered by level, such that the root color is 95 | described first, then all the children's colors, and then all the grandchildren's colors 96 | \item For \code{data.tree} input, a tree attribute containing the color for each node 97 | }} 98 | 99 | \item{linkLength}{length of the horizontal links that connect nodes in pixels. 100 | (optional, defaults to automatic sizing)} 101 | 102 | \item{fontSize}{font size of the label text in pixels} 103 | 104 | \item{tooltip}{tooltip shows the node's label and attribute value.} 105 | 106 | \item{tooltipHtml}{column name (possibly containing html) to override default tooltip 107 | contents, allowing for more advanced customization. Applicable only for \code{data.tree} input.} 108 | 109 | \item{nodeSize}{numeric column that will be used to determine relative node size. 110 | Default is to have a constant node size throughout. 'leafCount' can also 111 | be used here (cumulative count of a node's children), or 'count' 112 | (count of node's immediate children).} 113 | 114 | \item{collapsed}{the tree's children will start collapsed by default 115 | \itemize{ 116 | \item For \code{data.frame} input, can also be a vector of logical values the same length 117 | as the number of nodes. Follows the same logic as the fill vector. 118 | \item For \code{data.tree} input, can also be a tree attribute for conditionally collapsing nodes 119 | }} 120 | 121 | \item{zoomable}{pan and zoom by dragging and scrolling} 122 | 123 | \item{width}{width in pixels (optional, defaults to automatic sizing)} 124 | 125 | \item{height}{height in pixels (optional, defaults to automatic sizing)} 126 | 127 | \item{hierarchy}{a character vector of column names that define the order 128 | and hierarchy of the tree network. Applicable only for \code{data.frame} input.} 129 | 130 | \item{root}{label for the root node} 131 | 132 | \item{fillByLevel}{which order to assign fill values to nodes. 133 | \code{TRUE}: Filling by level; will assign fill values to nodes vertically. 134 | \code{FALSE}: Filling by order; will assign fill values to nodes horizontally.} 135 | 136 | \item{hierarchy_attribute}{name of the \code{data.tree} attribute that contains 137 | hierarchy information of the tree network. Applicable only for \code{data.tree} input.} 138 | } 139 | \description{ 140 | Interactive Reingold-Tilford tree diagram created using D3.js, 141 | where every node can be expanded and collapsed by clicking on it. 142 | } 143 | \examples{ 144 | collapsibleTree(warpbreaks, c("wool", "tension", "breaks")) 145 | 146 | # Data from US Forest Service DataMart 147 | species <- read.csv(system.file("extdata/species.csv", package = "collapsibleTree")) 148 | collapsibleTree(df = species, c("REGION", "CLASS", "NAME"), fill = "green") 149 | 150 | # Visualizing the order in which the node colors are filled 151 | library(RColorBrewer) 152 | collapsibleTree( 153 | warpbreaks, c("wool", "tension"), 154 | fill = brewer.pal(9, "RdBu"), 155 | fillByLevel = TRUE 156 | ) 157 | collapsibleTree( 158 | warpbreaks, c("wool", "tension"), 159 | fill = brewer.pal(9, "RdBu"), 160 | fillByLevel = FALSE 161 | ) 162 | 163 | # Tooltip can be mapped to an attribute, or default to leafCount 164 | collapsibleTree( 165 | warpbreaks, c("wool", "tension", "breaks"), 166 | tooltip = TRUE, 167 | attribute = "breaks" 168 | ) 169 | 170 | # Node size can be mapped to any numeric column, or to leafCount 171 | collapsibleTree( 172 | warpbreaks, c("wool", "tension", "breaks"), 173 | nodeSize = "breaks" 174 | ) 175 | 176 | # collapsibleTree.Node example 177 | data(acme, package="data.tree") 178 | acme$Do(function(node) node$cost <- data.tree::Aggregate(node, attribute = "cost", aggFun = sum)) 179 | acme$Do(function(node) node$lessThanMillion <- node$cost < 10^6) 180 | collapsibleTree( 181 | acme, 182 | nodeSize = "cost", 183 | attribute = "cost", 184 | tooltip = TRUE, 185 | collapsed = "lessThanMillion" 186 | ) 187 | 188 | # Emulating collapsibleTree.data.frame using collapsibleTree.Node 189 | species <- read.csv(system.file("extdata/species.csv", package = "collapsibleTree")) 190 | hierarchy <- c("REGION", "CLASS", "NAME") 191 | species$pathString <- paste( 192 | "species", 193 | apply(species[,hierarchy], 1, paste, collapse = "//"), 194 | sep = "//" 195 | ) 196 | df <- data.tree::as.Node(species, pathDelimiter = "//") 197 | collapsibleTree(df) 198 | 199 | } 200 | -------------------------------------------------------------------------------- /man/collapsibleTreeNetwork.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/collapsibleTreeNetwork.R 3 | \name{collapsibleTreeNetwork} 4 | \alias{collapsibleTreeNetwork} 5 | \title{Create Network Interactive Collapsible Tree Diagrams} 6 | \source{ 7 | Christopher Gandrud: \url{http://christophergandrud.github.io/networkD3/}. 8 | 9 | d3noob: \url{https://bl.ocks.org/d3noob/43a860bc0024792f8803bba8ca0d5ecd}. 10 | } 11 | \usage{ 12 | collapsibleTreeNetwork( 13 | df, 14 | inputId = NULL, 15 | attribute = "leafCount", 16 | aggFun = sum, 17 | fill = "lightsteelblue", 18 | linkLength = NULL, 19 | fontSize = 10, 20 | tooltip = TRUE, 21 | tooltipHtml = NULL, 22 | nodeSize = NULL, 23 | collapsed = TRUE, 24 | zoomable = TRUE, 25 | width = NULL, 26 | height = NULL 27 | ) 28 | } 29 | \arguments{ 30 | \item{df}{a network data frame (where every row is a node) 31 | from which to construct a nested list 32 | \itemize{ 33 | \item First column must be the parent (\code{NA} for root node) 34 | \item Second column must be the child 35 | \item Additional columns are passed on as attributes for other parameters 36 | \item There must be exactly 1 root node 37 | }} 38 | 39 | \item{inputId}{the input slot that will be used to access the selected node (for Shiny). 40 | Will return a named list of the most recently clicked node, 41 | along with all of its parents. 42 | (For \code{collapsibleTreeNetwork} the names of the list are tree depth)} 43 | 44 | \item{attribute}{numeric column not listed in hierarchy that will be used 45 | as weighting to define the color gradient across nodes. Defaults to 'leafCount', 46 | which colors nodes by the cumulative count of its children} 47 | 48 | \item{aggFun}{aggregation function applied to the attribute column to determine 49 | values of parent nodes. Defaults to \code{sum}, but \code{mean} also makes sense.} 50 | 51 | \item{fill}{either a single color or a column name with the color for each node} 52 | 53 | \item{linkLength}{length of the horizontal links that connect nodes in pixels. 54 | (optional, defaults to automatic sizing)} 55 | 56 | \item{fontSize}{font size of the label text in pixels} 57 | 58 | \item{tooltip}{tooltip shows the node's label and attribute value.} 59 | 60 | \item{tooltipHtml}{column name (possibly containing html) to override 61 | default tooltip contents, allowing for more advanced customization} 62 | 63 | \item{nodeSize}{numeric column that will be used to determine relative node size. 64 | Default is to have a constant node size throughout. 'leafCount' can also 65 | be used here (cumulative count of a node's children), or 'count' 66 | (count of node's immediate children).} 67 | 68 | \item{collapsed}{the tree's children will start collapsed by default. 69 | Can also be a logical value found in the data for conditionally collapsing nodes.} 70 | 71 | \item{zoomable}{pan and zoom by dragging and scrolling} 72 | 73 | \item{width}{width in pixels (optional, defaults to automatic sizing)} 74 | 75 | \item{height}{height in pixels (optional, defaults to automatic sizing)} 76 | } 77 | \description{ 78 | Interactive Reingold-Tilford tree diagram created using D3.js, 79 | where every node can be expanded and collapsed by clicking on it. 80 | This function serves as a convenience wrapper for network style data frames 81 | containing the node's parent in the first column, node parent in the second 82 | column, and additional attributes in the rest of the columns. The root node 83 | is denoted by having an \code{NA} for a parent. There must be exactly 1 root. 84 | } 85 | \examples{ 86 | # Create a simple org chart 87 | org <- data.frame( 88 | Manager = c( 89 | NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 90 | "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 91 | ), 92 | Employee = c( 93 | "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 94 | "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 95 | ), 96 | Title = c( 97 | "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 98 | "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 99 | "Analyst", "Director", "Accountant", "Accountant" 100 | ) 101 | ) 102 | collapsibleTreeNetwork(org, attribute = "Title") 103 | 104 | # Add in colors and sizes 105 | org$Color <- org$Title 106 | levels(org$Color) <- colorspace::rainbow_hcl(11) 107 | collapsibleTreeNetwork( 108 | org, 109 | attribute = "Title", 110 | fill = "Color", 111 | nodeSize = "leafCount", 112 | collapsed = FALSE 113 | ) 114 | 115 | # Use unsplash api to add in random photos to tooltip 116 | org$tooltip <- paste0( 117 | org$Employee, 118 | "
Title: ", 119 | org$Title, 120 | "
" 121 | ) 122 | 123 | collapsibleTreeNetwork( 124 | org, 125 | attribute = "Title", 126 | fill = "Color", 127 | nodeSize = "leafCount", 128 | tooltipHtml = "tooltip", 129 | collapsed = FALSE 130 | ) 131 | 132 | } 133 | \seealso{ 134 | \code{\link[data.tree]{FromDataFrameNetwork}} for underlying function 135 | that constructs trees from the network data frame 136 | } 137 | -------------------------------------------------------------------------------- /man/collapsibleTreeSummary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/collapsibleTreeSummary.R 3 | \name{collapsibleTreeSummary} 4 | \alias{collapsibleTreeSummary} 5 | \title{Create Summary Interactive Collapsible Tree Diagrams} 6 | \source{ 7 | Christopher Gandrud: \url{http://christophergandrud.github.io/networkD3/}. 8 | 9 | d3noob: \url{https://bl.ocks.org/d3noob/43a860bc0024792f8803bba8ca0d5ecd}. 10 | } 11 | \usage{ 12 | collapsibleTreeSummary( 13 | df, 14 | hierarchy, 15 | root = deparse(substitute(df)), 16 | inputId = NULL, 17 | attribute = "leafCount", 18 | fillFun = colorspace::heat_hcl, 19 | maxPercent = 25, 20 | percentOfParent = FALSE, 21 | linkLength = NULL, 22 | fontSize = 10, 23 | tooltip = TRUE, 24 | nodeSize = NULL, 25 | collapsed = TRUE, 26 | zoomable = TRUE, 27 | width = NULL, 28 | height = NULL, 29 | ... 30 | ) 31 | } 32 | \arguments{ 33 | \item{df}{a data frame (where every row is a leaf) from which to construct a nested list} 34 | 35 | \item{hierarchy}{a character vector of column names that define the order 36 | and hierarchy of the tree network} 37 | 38 | \item{root}{label for the root node} 39 | 40 | \item{inputId}{the input slot that will be used to access the selected node (for Shiny). 41 | Will return a named list of the most recently clicked node, 42 | along with all of its parents.} 43 | 44 | \item{attribute}{numeric column not listed in hierarchy that will be used 45 | as weighting to define the color gradient across nodes. Defaults to 'leafCount', 46 | which colors nodes by the cumulative count of its children} 47 | 48 | \item{fillFun}{function that takes its first argument and returns a vector 49 | of colors of that length. \link[colorspace]{rainbow_hcl} is a good example.} 50 | 51 | \item{maxPercent}{highest weighting percent to use in color scale mapping. 52 | All numbers above this value will be treated as the same maximum value for the 53 | sake of coloring in the nodes (but not the ordering of nodes). Setting this value 54 | too high will make it difficult to tell the difference between nodes with many 55 | children.} 56 | 57 | \item{percentOfParent}{toggle attribute tooltip to be percent of parent 58 | rather than the actual value of attribute} 59 | 60 | \item{linkLength}{length of the horizontal links that connect nodes in pixels. 61 | (optional, defaults to automatic sizing)} 62 | 63 | \item{fontSize}{font size of the label text in pixels} 64 | 65 | \item{tooltip}{tooltip shows the node's label and attribute value.} 66 | 67 | \item{nodeSize}{numeric column that will be used to determine relative node size. 68 | Default is to have a constant node size throughout. 'leafCount' can also 69 | be used here (cumulative count of a node's children), or 'count' 70 | (count of node's immediate children).} 71 | 72 | \item{collapsed}{the tree's children will start collapsed by default 73 | (There is no conditional collapsing in this function yet, but it could be implemented 74 | if there's sufficient demand)} 75 | 76 | \item{zoomable}{pan and zoom by dragging and scrolling} 77 | 78 | \item{width}{width in pixels (optional, defaults to automatic sizing)} 79 | 80 | \item{height}{height in pixels (optional, defaults to automatic sizing)} 81 | 82 | \item{...}{other arguments passed on to \code{fillFun}, such declaring a 83 | palette for \link[RColorBrewer]{brewer.pal}} 84 | } 85 | \description{ 86 | Interactive Reingold-Tilford tree diagram created using D3.js, 87 | where every node can be expanded and collapsed by clicking on it. 88 | This function serves as a convenience wrapper to add color gradients to nodes 89 | either by counting that node's children (default) or specifying another numeric 90 | column in the input data frame. 91 | } 92 | \examples{ 93 | # Color in by number of children 94 | collapsibleTreeSummary(warpbreaks, c("wool", "tension", "breaks"), maxPercent = 50) 95 | 96 | # Color in by the value of breaks and use the terrain_hcl gradient 97 | collapsibleTreeSummary( 98 | warpbreaks, 99 | c("wool", "tension", "breaks"), 100 | attribute = "breaks", 101 | fillFun = colorspace::terrain_hcl, 102 | maxPercent = 50 103 | ) 104 | } 105 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(collapsibleTree) 3 | 4 | test_check("collapsibleTree") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-error.R: -------------------------------------------------------------------------------- 1 | library(collapsibleTree) 2 | context("Error handling") 3 | 4 | test_that("df is a data frame", { 5 | expect_error(collapsibleTree(sunspots,c("Year","Solar.R"))) 6 | expect_error(collapsibleTreeSummary(sunspots,c("Year","Solar.R"))) 7 | expect_error(collapsibleTreeNetwork(sunspots,c("Year","Solar.R"))) 8 | }) 9 | 10 | test_that("column names are in data frame", { 11 | expect_error(collapsibleTree(warpbreaks, c("wool", "tensions"))) 12 | expect_error(collapsibleTreeSummary(warpbreaks, c("wool", "tensions"))) 13 | }) 14 | 15 | test_that("attribute name is in data frame", { 16 | expect_error(collapsibleTree(warpbreaks, c("wool", "tensions"), attribute = "break")) 17 | expect_error(collapsibleTreeSummary(warpbreaks, c("wool", "tensions"), attribute = "break")) 18 | }) 19 | 20 | test_that("column names are not too short (might be fixed in the future)", { 21 | expect_error(collapsibleTree(warpbreaks, c("wool"))) 22 | expect_error(collapsibleTreeSummary(warpbreaks, c("wool"))) 23 | }) 24 | -------------------------------------------------------------------------------- /tests/testthat/test-margin.R: -------------------------------------------------------------------------------- 1 | library(collapsibleTree) 2 | library(tibble) 3 | load(system.file("extdata/Geography.rda", package = "collapsibleTree")) 4 | context("Margin sizing") 5 | 6 | geo <- collapsibleTree( 7 | Geography, 8 | hierarchy = c("continent", "type", "country") 9 | ) 10 | geoSummary <- collapsibleTreeSummary( 11 | Geography, 12 | hierarchy = c("continent", "type", "country") 13 | ) 14 | 15 | test_that("left margins are the correct size - data frame", { 16 | expect_gt(geo$x$options$margin$left, 50) 17 | expect_gt(geoSummary$x$options$margin$left, 50) 18 | expect_lt(geo$x$options$margin$left, 100) 19 | expect_lt(geoSummary$x$options$margin$left, 100) 20 | }) 21 | 22 | test_that("right margins are the correct size - data frame", { 23 | expect_gt(geo$x$options$margin$right, 250) 24 | expect_gt(geoSummary$x$options$margin$right, 250) 25 | expect_lt(geo$x$options$margin$right, 300) 26 | expect_lt(geoSummary$x$options$margin$right, 300) 27 | }) 28 | 29 | Geography <- as_tibble(Geography) 30 | geo <- collapsibleTree( 31 | Geography, 32 | hierarchy = c("continent", "type", "country") 33 | ) 34 | geoSummary <- collapsibleTreeSummary( 35 | Geography, 36 | hierarchy = c("continent", "type", "country") 37 | ) 38 | 39 | test_that("left margins are the correct size - tibble", { 40 | expect_gt(geo$x$options$margin$left, 50) 41 | expect_gt(geoSummary$x$options$margin$left, 50) 42 | expect_lt(geo$x$options$margin$left, 100) 43 | expect_lt(geoSummary$x$options$margin$left, 100) 44 | }) 45 | 46 | test_that("right margins are the correct size - tibble", { 47 | expect_gt(geo$x$options$margin$right, 250) 48 | expect_gt(geoSummary$x$options$margin$right, 250) 49 | expect_lt(geo$x$options$margin$right, 300) 50 | expect_lt(geoSummary$x$options$margin$right, 300) 51 | }) 52 | -------------------------------------------------------------------------------- /tests/testthat/test-na.R: -------------------------------------------------------------------------------- 1 | library(collapsibleTree) 2 | context("Missing values") 3 | 4 | test_that("missing values in hierarchy", { 5 | expect_silent(collapsibleTree(airquality,c("Month","Day","Solar.R"))) 6 | expect_silent(collapsibleTreeSummary(airquality,c("Month","Day","Solar.R"))) 7 | }) 8 | 9 | test_that("there are no missing values in attribute", { 10 | expect_error(collapsibleTree(airquality,c("Month","Day","Solar.R"),attribute="Ozone")) 11 | expect_error(collapsibleTreeSummary(airquality,c("Month","Day","Solar.R"),attribute="Ozone")) 12 | }) 13 | -------------------------------------------------------------------------------- /tests/testthat/test-network.R: -------------------------------------------------------------------------------- 1 | library(collapsibleTree) 2 | context("Network") 3 | 4 | org <- data.frame( 5 | Manager = c( 6 | NA, "Ana", "Ana", "Bill", "Bill", "Bill", "Claudette", "Claudette", "Danny", 7 | "Fred", "Fred", "Grace", "Larry", "Larry", "Nicholas", "Nicholas" 8 | ), 9 | Employee = c( 10 | "Ana", "Bill", "Larry", "Claudette", "Danny", "Erika", "Fred", "Grace", 11 | "Henri", "Ida", "Joaquin", "Kate", "Mindy", "Nicholas", "Odette", "Peter" 12 | ), 13 | Title = c( 14 | "President", "VP Operations", "VP Finance", "Director", "Director", "Scientist", 15 | "Manager", "Manager", "Jr Scientist", "Operator", "Operator", "Associate", 16 | "Analyst", "Director", "Accountant", "Accountant" 17 | ), 18 | stringsAsFactors = FALSE 19 | ) 20 | 21 | test_that("root validation", { 22 | expect_error(collapsibleTreeNetwork(warpbreaks)) 23 | expect_error(collapsibleTreeNetwork(rbind(org, org))) 24 | }) 25 | 26 | test_that("network is resolvable", { 27 | expect_error(collapsibleTreeNetwork(rbind(head(org), tail(org)))) 28 | }) 29 | 30 | test_that("org chart can be built", { 31 | o <- collapsibleTreeNetwork(org) 32 | expect_is(o, "htmlwidget") 33 | expect_is(o$x$data, "list") 34 | expect_is(o$x$options$hierarchy, "integer") 35 | }) 36 | 37 | test_that("single node tree", { 38 | o <- collapsibleTreeNetwork(org[1,]) 39 | expect_is(o, "htmlwidget") 40 | expect_is(o$x$data, "list") 41 | expect_is(o$x$options$hierarchy, "integer") 42 | }) 43 | -------------------------------------------------------------------------------- /tests/testthat/test-root.R: -------------------------------------------------------------------------------- 1 | library(collapsibleTree) 2 | context("Root labelling") 3 | 4 | test_that("unlabelled root works for collapsibleTree", { 5 | wb <- collapsibleTree(warpbreaks, c("wool", "tension", "breaks")) 6 | expect_is(wb,"htmlwidget") 7 | expect_is(wb$x$data,"list") 8 | expect_is(wb$x$options$hierarchy,"character") 9 | }) 10 | 11 | test_that("unlabelled root works for collapsibleTreeSummary", { 12 | wb <- collapsibleTreeSummary(warpbreaks, c("wool", "tension", "breaks")) 13 | expect_is(wb,"htmlwidget") 14 | expect_is(wb$x$data,"list") 15 | expect_is(wb$x$options$hierarchy,"character") 16 | }) 17 | 18 | test_that("labeled root works for collapsibleTree", { 19 | wblabeled <- collapsibleTree(warpbreaks, c("wool", "tension", "breaks"), "a label") 20 | expect_is(wblabeled$x$data,"list") 21 | expect_is(wblabeled$x$options$hierarchy,"character") 22 | }) 23 | 24 | test_that("labeled root works for collapsibleTreeSummary", { 25 | wblabeled <- collapsibleTreeSummary(warpbreaks, c("wool", "tension", "breaks"), "a label") 26 | expect_is(wblabeled$x$data,"list") 27 | expect_is(wblabeled$x$options$hierarchy,"character") 28 | }) 29 | --------------------------------------------------------------------------------