Showing preview only (464K chars total). Download the full file or copy to clipboard to get everything.
Repository: gluc/data.tree
Branch: master
Commit: 849d95ef9fca
Files: 114
Total size: 435.0 KB
Directory structure:
gitextract_u1u_requ/
├── .Rbuildignore
├── .gitattributes
├── .github/
│ ├── .gitignore
│ └── workflows/
│ ├── R-CMD-check.yaml
│ └── test-coverage.yaml
├── .gitignore
├── .travis.yml
├── CRAN-SUBMISSION
├── DESCRIPTION
├── NAMESPACE
├── NEWS
├── R/
│ ├── data.tree-package.R
│ ├── data_doc.R
│ ├── node.R
│ ├── node_actives.R
│ ├── node_conversion.R
│ ├── node_conversion_ape.R
│ ├── node_conversion_dataframe.R
│ ├── node_conversion_dendrogram.R
│ ├── node_conversion_igraph.R
│ ├── node_conversion_list.R
│ ├── node_conversion_party.R
│ ├── node_conversion_rpart.R
│ ├── node_methods.R
│ ├── node_methods_sideeffect.R
│ ├── node_methods_traversal.R
│ ├── node_plot.R
│ ├── register-s3.R
│ ├── release.R
│ ├── util.R
│ └── zzz.R
├── README.md
├── appveyor.yml
├── cran-comments.md
├── data/
│ ├── acme.rda
│ └── mushroom.rda
├── data.tree.Rproj
├── data_gen/
│ ├── acme.R
│ └── mushroom.R
├── getting-started-with-development.md
├── inst/
│ └── extdata/
│ ├── flare.json
│ ├── jennylind.yaml
│ ├── portfolio.csv
│ └── useR15.csv
├── man/
│ ├── Aggregate.Rd
│ ├── AreNamesUnique.Rd
│ ├── CheckNameReservedWord.Rd
│ ├── Climb.Rd
│ ├── Clone.Rd
│ ├── CreateRandomTree.Rd
│ ├── CreateRegularTree.Rd
│ ├── Cumulate.Rd
│ ├── DefaultPlotHeight.Rd
│ ├── Distance.Rd
│ ├── Do.Rd
│ ├── FindNode.Rd
│ ├── FormatFixedDecimal.Rd
│ ├── FormatPercent.Rd
│ ├── Get.Rd
│ ├── GetAttribute.Rd
│ ├── GetPhyloNr.Rd
│ ├── NODE_RESERVED_NAMES_CONST.Rd
│ ├── Navigate.Rd
│ ├── Node.Rd
│ ├── Prune.Rd
│ ├── Revert.Rd
│ ├── Set.Rd
│ ├── SetFormat.Rd
│ ├── Sort.Rd
│ ├── ToDiagrammeRGraph.Rd
│ ├── ToNewick.Rd
│ ├── Traverse.Rd
│ ├── acme.Rd
│ ├── as.Node.BinaryTree.Rd
│ ├── as.Node.Rd
│ ├── as.Node.data.frame.Rd
│ ├── as.Node.dendrogram.Rd
│ ├── as.Node.list.Rd
│ ├── as.Node.party.Rd
│ ├── as.Node.phylo.Rd
│ ├── as.Node.rpart.Rd
│ ├── as.data.frame.Node.Rd
│ ├── as.dendrogram.Node.Rd
│ ├── as.igraph.Node.Rd
│ ├── as.list.Node.Rd
│ ├── as.phylo.Node.Rd
│ ├── averageBranchingFactor.Rd
│ ├── data.tree.Rd
│ ├── isLeaf.Rd
│ ├── isNotLeaf.Rd
│ ├── isNotRoot.Rd
│ ├── isRoot.Rd
│ ├── mushroom.Rd
│ ├── print.Node.Rd
│ └── s3_register.Rd
├── publish-cheat-sheet.md
├── tests/
│ ├── testthat/
│ │ ├── test-draw.R
│ │ ├── test-treeConstruction.R
│ │ ├── test-treeConversionApe.R
│ │ ├── test-treeConversionDataFrame.R
│ │ ├── test-treeConversionDendrogram.R
│ │ ├── test-treeConversionList.R
│ │ ├── test-treeConversionParty.R
│ │ ├── test-treeConversionRpart.R
│ │ ├── test-treeConversionigraph.R
│ │ ├── test-treeDocu.R
│ │ ├── test-treeMethods.R
│ │ ├── test-treeMethodsSideEffect.R
│ │ └── test-util.R
│ └── testthat.R
└── vignettes/
├── applications.Rmd
├── applications.banner.html
├── data.tree.Rmd
└── intro.banner.html
================================================
FILE CONTENTS
================================================
================================================
FILE: .Rbuildignore
================================================
^.*\.Rproj$
^\.Rproj\.user$
^\.travis\.yml$
data_gen
cran-comments.md
publish-cheat-sheet.md
getting-started-with-development.md
appveyor.yml
travis-tool.sh.cmd
Rprof.out
^appveyor\.yml$
revdep
README.md
^CRAN-RELEASE$
^\.github$
^CRAN-SUBMISSION$
================================================
FILE: .gitattributes
================================================
* text=auto
data/* binary
src/* text=lf
R/* text=lf
================================================
FILE: .github/.gitignore
================================================
*.html
================================================
FILE: .github/workflows/R-CMD-check.yaml
================================================
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
on:
push:
branches: [main, master]
pull_request:
branches: [main, master]
name: R-CMD-check
jobs:
R-CMD-check:
runs-on: ${{ matrix.config.os }}
name: ${{ matrix.config.os }} (${{ matrix.config.r }})
strategy:
fail-fast: false
matrix:
config:
- {os: macos-latest, r: 'release'}
- {os: windows-latest, r: 'release'}
- {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
- {os: ubuntu-latest, r: 'release'}
- {os: ubuntu-latest, r: 'oldrel-1'}
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
R_KEEP_PKG_SOURCE: yes
steps:
- uses: actions/checkout@v3
- uses: r-lib/actions/setup-pandoc@v2
- uses: r-lib/actions/setup-r@v2
with:
r-version: ${{ matrix.config.r }}
http-user-agent: ${{ matrix.config.http-user-agent }}
use-public-rspm: true
- uses: r-lib/actions/setup-r-dependencies@v2
with:
extra-packages: any::rcmdcheck
needs: check
- uses: r-lib/actions/check-r-package@v2
with:
upload-snapshots: true
================================================
FILE: .github/workflows/test-coverage.yaml
================================================
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
on:
push:
branches: [main, master]
pull_request:
branches: [main, master]
name: test-coverage
jobs:
test-coverage:
runs-on: ubuntu-latest
env:
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
steps:
- uses: actions/checkout@v3
- uses: r-lib/actions/setup-r@v2
with:
use-public-rspm: true
- uses: r-lib/actions/setup-r-dependencies@v2
with:
extra-packages: any::covr
needs: coverage
- name: Test coverage
run: |
covr::codecov(
quiet = FALSE,
clean = FALSE,
install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
)
shell: Rscript {0}
- name: Show testthat output
if: always()
run: |
## --------------------------------------------------------------------
find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
shell: bash
- name: Upload test results
if: failure()
uses: actions/upload-artifact@v3
with:
name: coverage-test-failures
path: ${{ runner.temp }}/package
================================================
FILE: .gitignore
================================================
.Rproj.user
.Rhistory
.RData
inst/doc
private
Rprof.out
revdep
================================================
FILE: .travis.yml
================================================
language: r
cache: packages
r:
- oldrel
- release
- devel
sudo: false
warnings_are_errors: true
r_packages:
- rmarkdown
- covr
r_check_args: --as-cran
after_success:
- Rscript -e 'library(covr);codecov()'
notifications:
email:
on_success: change
on_failure: change
================================================
FILE: CRAN-SUBMISSION
================================================
Version: 1.1.0
Date: 2023-11-12 11:25:34 UTC
SHA: d9ceaf8a4343f32483a5856ff530f4a31a6b40fa
================================================
FILE: DESCRIPTION
================================================
Package: data.tree
Type: Package
Title: General Purpose Hierarchical Data Structure
Version: 1.1.0
Date: 2023-11-11
Authors@R: c(
person(
"Russ", "Hyde",
role = c("ctb"),
comment = "improve dependencies"
),
person(
"Chris", "Hammill",
role = c("ctb"),
comment = "improve getting"
),
person(
"Facundo", "Munoz",
role = c("ctb"),
comment = "improve list conversion"
),
person(
"Markus", "Wamser"
, role = c("ctb")
, comment = "fixed some typos"
),
person(
"Pierre", "Formont"
, role = c("ctb")
, comment = "additional features"
),
person(
"Kent", "Russel"
, role = c("ctb")
, comment = "documentation"
),
person(
"Noam", "Ross"
, role = c("ctb")
, comment = "fixes"
),
person(
"Duncan", "Garmonsway"
, role = c("ctb")
, comment = "fixes"
),
person(
"Christoph", "Glur"
, role = c("aut", "cre")
, comment = "R interface"
, email = "christoph.glur@powerpartners.pro"
)
)
VignetteBuilder:
knitr,
rmarkdown
Imports:
R6,
stringi,
methods
Suggests:
Formula,
graphics,
testthat,
knitr,
rmarkdown,
ape,
yaml,
networkD3,
jsonlite,
treemap,
party,
partykit,
doParallel,
foreach,
htmlwidgets,
DiagrammeR (>= 1.0.0),
mockery,
rpart
Enhances:
igraph
Description: Create tree structures from hierarchical data, and traverse the
tree in various orders. Aggregate, cumulate, print, plot, convert to and from
data.frame and more. Useful for decision trees, machine learning, finance,
conversion from and to JSON, and many other applications.
License: GPL (>= 2)
URL: https://github.com/gluc/data.tree
BugReports: https://github.com/gluc/data.tree/issues
Depends:
R (>= 3.5)
RoxygenNote: 7.2.3
Encoding: UTF-8
================================================
FILE: NAMESPACE
================================================
# Generated by roxygen2: do not edit by hand
S3method(as.Node,BinaryTree)
S3method(as.Node,data.frame)
S3method(as.Node,dendrogram)
S3method(as.Node,list)
S3method(as.Node,party)
S3method(as.Node,phylo)
S3method(as.Node,rpart)
S3method(as.data.frame,Node)
S3method(as.dendrogram,Node)
S3method(as.list,Node)
S3method(plot,Node)
S3method(print,Node)
export(.parentSeparator)
export(.separator)
export(Aggregate)
export(AreNamesUnique)
export(Climb)
export(Clone)
export(CreateRandomTree)
export(CreateRegularTree)
export(Cumulate)
export(DefaultPlotHeight)
export(Distance)
export(Do)
export(FindNode)
export(FormatFixedDecimal)
export(FormatPercent)
export(FromDataFrameNetwork)
export(FromDataFrameTable)
export(FromListExplicit)
export(FromListSimple)
export(Get)
export(GetAttribute)
export(GetDefaultTooltip)
export(GetPhyloNr)
export(NODE_RESERVED_NAMES_CONST)
export(Navigate)
export(Node)
export(Prune)
export(Revert)
export(Set)
export(SetEdgeStyle)
export(SetFormat)
export(SetGraphStyle)
export(SetNodeStyle)
export(Sort)
export(ToDataFrameNetwork)
export(ToDataFrameTable)
export(ToDataFrameTree)
export(ToDataFrameTypeCol)
export(ToDiagrammeRGraph)
export(ToListExplicit)
export(ToListSimple)
export(ToNewick)
export(Traverse)
export(as.Node)
export(as.igraph.Node)
export(as.phylo.Node)
export(averageBranchingFactor)
export(isLeaf)
export(isNotLeaf)
export(isNotRoot)
export(isRoot)
import(methods)
import(stats)
import(stringi)
importFrom(R6,R6Class)
================================================
FILE: NEWS
================================================
# All changes to data.tree are documented here.
## Version 1.1.0
- IMPROVE: Node names may no longer be `NA`. It was not fully supported, and now it is an error. (#152)
- FIX: changed lock_object to lock_objects (#149 thx to Olly Beagly)
- FIX: help('data.tree') works again
- IMPROVE: FromListSimple and as.Node.list now have an additional parameter 'interpretNullAsList'. See #169 for details.
- IMPROVE: added parameter `row.names = FALSE`in `print.Node()` to hide row numbers when printing a data.tree.
## Version 1.0.0
- IMPROVE: Replaced dependency on stringr by dependency on stringi, which make data.tree even more light-weight
- CHANGE: Node serialization changed. In many cases, you might still be able to load previously saved data.tree objects, but then they do not correspond to the latest version.
- CHANGE: New reserved words for Node: attributes and attributesAll
- NOTE: Node$fields and Node$fieldsAll will be deprecated in the next version. Use Node$attributes and Node$attributesAll instead
- REMOVE: Deprecated Node$FindNode has been removed (use FindeNode(node, ...) instead)
- IMPROVE: Node is now fully documented, (thx to roxygen2 for supporting R6)
- CHANGE: data.tree now depends on R 3.5
- FIX: adjusted sample data that didn't support correct handling of active bindings
- IMPROVE: Adding reserved word check to FromDataFrameNetwork (#147 thx to wkumler)
## Version 0.7.11
- IMPROVE: diagrammeR is now only suggested, so data.tree is much more lightweight if plotting is not needed (#143 thx to Russ Hyde)
- FIX: plot now also works with quotations in names (#137 thx to thotal)
- IMPROVE: as.list and other conversions to list now contain pruneFun argument (#142)
## Version 0.7.10
- IMPROVE: various spell errors fixed in vignettes
## Version 0.7.9
- FIX: Bug in as.data.frame.Node: NA for certain lists slots (#135)
- FIX: Get prints Null as NA by default (#128)
## Version 0.7.8
- FIX: wrong export of S3
## Version 0.7.7
- IMPROVE: if an attribute of a node has n dimensions, then Get will return an array of dim n+1, with the names of the first dimension being equal to the node names (thanks to Chris Hammil)
- FIX: fieldsAll now doesn't simplify (thanks to Vaclav Slimacek)
## Version 0.7.6
- IMPROVE: plot now also works for trees with a single root node (thx to Pierre Neuvial)
- IMPROVE: ellipsis parameters are not passed to DiagrammeR for plotting (#109)
- FIX: Dependency on DiagrammeR (>= 1.0.0) explicitly stated (#111)
- IMPROVE: Allow tibble in FromDataFrameNetwork and FromDataFrameTable (#115)
## Version 0.7.5
- IMPROVE: namesNotUnique parameter in as.Node.phylo (#106)
- FIX: fixed incompatibility issue with DiagrammeR (#110)
## Version 0.7.4
- IMPROVE: print now has an explicit arg pruneFun
- FIX: partykit tests now pass
- FIX: DESCRIPTION now in line with latest changes from CRAN (rmarkdown declared)
- FIX: Skipped tests in testMethods included
## Version 0.7.3
- FIX: Various typos in documentation
## Version 0.7.2
Upgrade to R 3.4.x and newest package versions.
- FIX: plot: global graph attributes now work (#88)
- FIX: typo in vignette data.tree vignette('applications', package = "data.tree")
- FIX: warnings in as.dendrogram
- FIX: warnings in sample code for Do
- FIX: as.data.frame created warnings for values that were of length 0
## Version 0.7.0
- ADD: ToDiagrammeRGraph to convert to a DiagrammeR graph object
- REMOVE: ToGraphViz (replaced with ToDiagrammeRGraph, to support the latest features in the DiagrammeR package). You can still get the dot representation by using DiagrammeR::generate_dot(ToDiagrammeRGraph(node))
- CHANGE: plot.Node 's last parameter is now 'graph', and not 'engine' anymore.
- FIX: minor typos fixed
## Version 0.6.2
- ADD: new Distance function to measure distance from one Node to another in the same tree
## Version 0.6.1
- IMPROVE: FromListSimple now accepts subclasses of lists (#79)
- IMPROVE: FromDataFrameTable now supports tibbles (#89)
- IMPROVE: print.Node and as.data.frame.Node now also work for node fields with length > 1 (#81)
- FIX: print.Node and as.data.frame.Node now also work if some Nodes have the same name as some fileds (#82)
- REMOVE: node$FindNode, and node$Navigate are now deprecated. Use FindNode(node, ...) and Naviate(node, ...) instead
- REMOVE: node$Sort, node$Prune, and node$Revert are now deprecated. Use Sort(node, ...), Prune(node, ...) and Revert(node, ...) instead
## Version 0.5.0
- IMPROVE: Performance improvement for many functions. For example, as.Node roughly by factor 4 for large dataset (#74)
- CHANGE: by default, as.data.frame.Node (and derivatives) do not format anymore (use the format parameter if you want to format)
- IMPROVE: Allow the possibility to keep only some fields when converting to list using as.list.Node (#76)
- FromDataFrameTable (#77)
- FIX: now also works if there is only the pathString column
- IMPROVE: pathString can now also be a factor (or any other type convertible to character)
## Version 0.4.0
- IMPROVE: as.Node.data.frame and FromDataFrameTable now support paths containing reserved words (#65)
- CHANGE: Node$new now checks that names are not reserved names. As a consequence, many conversions to Node now contain a check parameter.
- IMPROVE: Climb is now much faster when climbing by name (#71)
- IMPROVE: As a result of #71, many other functions are much faster, e.g. FromDataFrameTable (#72)
## Version 0.3.7
- ADD: Traverse can now also take custom function as a traversal argument
- ADD: Navigate method
- ADD: as.Node.BinaryTree Convert SplittingNode from party package to data.tree (#6)
- ADD: as.Node.party Convert party class from partykit package to data.tree (#6)
## Version 0.3.6
- FIX: GetDefaultTooltip now also works for attributes which are functions
- FIX: GetAttribute now returns attributes with length 0 (e.g. an empty list)
- ADD: Sort, Revert and Prune are now also available in traditional format (e.g. Prune(node, pruneFun))
- FIX: FromListSimple: Empty lists now become empty nodes (#59)
- IMPROVE: FromListSimple: Unnamed list elements are now also converted (#61)
- IMPROVE: documentation of Aggregate
- IMPROVE: Check type when setting Node$parent and Node$children (#63)
## Version 0.3.5
- FIX: minor correction in documentation
## Version 0.3.4
- FIX: minor correction in documentation
## Version 0.3.3
- CHANGE: Renamed Find method to FindNode, in order to avoid masking from base
- FIX: upgrade to latest version of treemap package
- FIX: a few typos in documentation
## Version 0.3.2
- ADD: FromListExplicit now interprets character vectors as a list of nodes (#58)
## Version 0.3.1
- IMPROVE: as.list.Node
- now generates auto name if unique name is not available (#54)
- now has warn arg, warning if source data contains reserved names
- now also imports fiels with names equal to reserved names (e.g. count), they will be renamed (to e.g. count2)
- CHANGE: node$leaves now returns a list even when called on a leaf itself
- ADD: Find method to find a single Node in a (sub-)tree (#52)
## Version 0.3.0 Pine Tree
- REMOVE: Removed the cacheAttribute parameter from Aggregate and Cumulate (they were confusing, even to me. Use Do instead to manually store aggregate values in the tree)
- ADD: plot function (see ?plot.Node)
- ADD: ToDataFrameTypeCol to export e.g. the path to columns by level in columns: ToDataFrameTypeCol(acme)
- ADD: Node$AddSibling
- ADD: Node$RemoveAttribute now contains a mandatory parameter so that it can be used if the node does not have the attribute to be removed.
- ADD: Get works on methods without args
- IMPROVE: FormatFixedDecimal and FormatPercent work for NULL values
- IMPROVE: Documentation
- FIX: Aggregate will not return attribute from callee anymore, but *always* aggregate children attributes
- FIX: Removed ... parameter from ToListExplicit and ToListSimple
- FIX: Clone was adding empty children list, which caused a series of problems (#44)
- FIX: Cloning a subtree does not keep reference to un-cloned parent anymore (#49)
- FIX: print with limit parameter ignored formatter (#43)
- FIX: cannot rename to int, e.g. acme$Do(function(x) x$name <- x$position) (#53)
## Version 0.2.4
- FIX: applications vignette, changed from http://htmlwidgets.org to http://www.htmlwidgets.org, as requested by CRAN
## Version 0.2.3
- FIX #33: applications vignette doesn't build because of DiagrammeR update
- FIX #32: Cannot subclass Node
- FIX #30: strange errors when using data.tree multiple times
## Version 0.2.2
- FIX: Get can now fetch vectors and matrices too
- ADD: Node$siblings
## Version 0.2.0-rc.1 Elder
- ADD: ClimbByAttribute
- FIX: Aggregate and Cumulate now work always on attributes having a formatter
- ADD: as.igraph now has a 'directed' parameter
- ADD: print now has a pruneMethod, allowing different methods to avoid that a huge tree is printed to the console
- REMOVE: FromDataFrameTaxonomy and ToDataFrameTaxonomy (replaced by FromDataFrameNetwork and ToDataFrameNetwork, but with some differences)
- ADD: FromDataFrameNetwork and ToDataFrameNetwork
- IMPROVE: make Traversal "level" much faster
- ADD: Node$RemoveChild
- ADD: Node$RemoveAttribute
- ADD: as.igraph.Node now supports different directions (climb and descend)
## Version 0.1.9 Pine II
- Set correct version number in DESCRIPTION file
## Version 0.1.8 Pine
- Node
- CHANGE: Node$depth is now called Node$height, as the old naming was confusing for many, because in CS, the Node$level is sometimes
- Utils
- CHANGE: Renamed CreateDummyTree to CreateRegularTree
- CHANGE: Height renamed to DefaultPlotHeight, so as to avoid confusion with Node$height
- ADD: CreateRandomTree to test trees
- ADD: trees can now be climbed directly, e.g. acme$IT$`Go agile`
- ADD: print.Node with limit parameter is now much faster
- ADD: Clone is now much faster
## Version 0.1.7 Chestnut
- General
- ADD: demo portfolio
- ADD: demo decisiontree
- ADD: demo population / treemap
- Node
- CHANGE: Node$level is now 1-based (used to be: 0-based), i.e. if Node$isRoot then Node$level = 1
- CHANGE: Node$Find is now called Node$Climb to avoid confusion with base::Find
called depth
- ADD: print.Node contains a limit parameter, allowing to limit the max number of Nodes to be printed
- ADD: Clone (returning a deep copy)
- ADD: Prune (pruning the tree)
- ADD: SetFromat (support for setting formatter functions on a Node)
- ADD: Traverse, standalone traverse method that can be used for piping and whenever you need to apply multiple Get/Set/Do on the same traversal
- ADD: Node$isBinary active
- ADD: standalone versions of isLeaf, isNotLeaf, isRoot, isNotRoot for concise filtering
- ADD: AreNamesUnique to test if names of the node's are unique throughout the tree (and not only among siblings)
- FIX: node$position now returns 1 for root
- ADD: Aggregate function now supports functions
- ADD: node$averageBranchingFactor
- CHANGE: Aggregate function does not cache anymore by default. See cacheAttribute for details.
- Node$Get:
- CHANGE: Renamed filterFun parameter to pruneFun
- ADD: new parameter filterFun, as opposed to pruneFun
- CHANGE: removed the assign parameter (use Do instead)
- ADD: new traversal modes "in-order", "level"
- ADD: parameter inheritFromAncestors
- Node$Set:
- ADD: filterFun and pruneFun
- ADD: support for traversal order
- Node$Do:
- ADD: new function Do, which applies a function to Nodes
- Conversions
- ADD: conversion to and from list of lists (and thus to and from yaml, json, etc.)
- ADD: conversion from data.frame
- ADD: conversion to and from dendrogram
- ADD: conversion to and from phylo from the ape package
- ADD: conversion to Newick notation
- ADD: conversion ToDataFrameTable (returning leafs only)
- ADD: conversion ToDataFrameTree
- ADD: conversion ToDataFrameTaxonomy
- ADD: conversion to igraph
- Utils
- CHANGE: Renamed PrintFixedDecimal to FormatFixedDecimal to achieve better consistency
- ADD: CreateDummyTree to test large trees
- ADD: CreateRandomTree to test trees
================================================
FILE: R/data.tree-package.R
================================================
#' data.tree: Hierarchical Data Structures
#'
#' \code{data.tree} is to hierarchical data what \code{data.frame} is to tabular data: An extensible, general purpose structure to store, manipulate,
#' and display hierarchical data.
#'
#' @section Introduction:
#'
#' Hierarchical data is ubiquitous in statistics and programming (XML, search trees, family trees, classification, file system, etc.). However, no general-use \bold{tree data structure} is available in R.
#' Where tabular data has \code{data.frame}, hierarchical data is often modeled in lists of lists or similar makeshifts. These
#' structures are often difficult to manage.
#' This is where the \code{data.tree} package steps in. It lets you build trees of hierarchical
#' data for various uses: to print, to rapid prototype search algorithms, to test out new classification algorithms, and much more.
#'
#' @section Tree Traversal:
#'
#' \code{data.tree} allows to \code{\link{Traverse}} trees in various orders (pre-order, post-order, level, etc.), and it lets you run operations on \code{\link{Node}s} via
#' \code{\link{Do}}.
#' Similarly, you can collect and store data while traversing a tree using the \code{\link{Get}} and the \code{\link{Set}} methods.
#'
#' @section Methods:
#'
#' The package also contains utility functions to \code{\link{Sort}}, to \code{\link{Prune}}, to \code{\link{Aggregate}} and \code{\link{Cumulate}}
#' and to \code{\link{print}} in custom formats.
#'
#'
#' @section Construction and Conversion:
#'
#' The package also contains many conversions from and to data.tree structures. Check out the see also section of \code{\link{as.Node}}.
#'
#' You can construct a tree from a \code{data.frame} using \code{\link{as.Node.data.frame}}, and convert it back using \code{\link{as.data.frame.Node}}.
#' Similar options exist for list of lists.
#' For more specialized conversions, see \code{\link{as.dendrogram.Node}}, \code{\link{as.Node.dendrogram}},
#' \code{\link{as.phylo.Node}} and \code{\link{as.Node.phylo}}
#'
#' Finally, easy conversion options from and to list, dataframe, JSON, YAML, igraph, ape, rpart, party and more exist:
#'
#' \itemize{
#' \item{list: both directions}
#' \item{dataframe: both directions}
#' \item{JSON, YAML: both directions, via lists}
#' \item{igraph: from igraph to data.tree}
#' \item{ape: both directions}
#' \item{rpart: from rpart to data.tree}
#' \item{party: from party to data.tree}
#' }
#'
#' @section Node and Reference Semantics:
#'
#' The entry point to the package is \code{\link{Node}}. Each tree is composed of a number of \code{Node}s, referencing each other.
#'
#' One of most important things to note about \code{data.tree} is that it exhibits \bold{reference semantics}. In a nutshell, this means that you can modify
#' your tree along the way, without having to reassign it to a variable after each modification. By and large, this is a rather exceptional behavior
#' in R, where value-semantics is king most of the time.
#'
#' @section Applications:
#'
#' \code{data.tree} is not optimised for computational speed, but for implementation speed. Namely, its memory
#' footprint is relatively large compared to traditional R data structures. However, it can easily handle trees with
#' several thousand nodes, and once a tree is constructed, operations on it are relatively fast.
#' data.tree is always useful when
#' \itemize{
#' \item{you want to develop and test a new algorithm}
#' \item{you want to import and convert tree structures (it imports and exports to list-of-list, data.frame, yaml, json, igraph, dendrogram, phylo and more)}
#' \item{you want to play around with data, display it and get an understanding}
#' \item{you want to test another package, to compare it with your own results}
#' \item{you need to do homework}
#' }
#'
#' For a quick overview of the features, read the \code{\link{data.tree}} vignette by running \code{vignette("data.tree")}. For stylized
#' applications, see \code{vignette("applications", package='data.tree')}
#'
#' @examples
#' data(acme)
#' print(acme)
#' acme$attributesAll
#' acme$count
#' acme$totalCount
#' acme$isRoot
#' acme$height
#' print(acme, "p", "cost")
#'
#' outsource <- acme$IT$Outsource
#' class(outsource)
#' print(outsource)
#' outsource$attributes
#' outsource$isLeaf
#' outsource$level
#' outsource$path
#' outsource$p
#' outsource$parent$name
#' outsource$root$name
#' outsource$expCost <- outsource$p * outsource$cost
#' print(acme, "expCost")
#'
#' acme$Get("p")
#' acme$Do(function(x) x$expCost <- x$p * x$cost)
#' acme$Get("expCost", filterFun = isLeaf)
#'
#' ToDataFrameTable(acme, "name", "p", "cost", "level", "pathString")
#' ToDataFrameTree(acme, "name", "p", "cost", "level")
#' ToDataFrameNetwork(acme, "p", "cost")
#'
#'
#' @seealso \code{\link{Node}}
#' @seealso For more details, see the \code{data.tree} vignette by running: \code{vignette("data.tree")}
#' @name data.tree
#' @keywords internal
"_PACKAGE"
NULL
================================================
FILE: R/data_doc.R
================================================
#' Sample Data: A Simple Company with Departments
#'
#' acme's tree representation is accessed through its root, acme.
#'
#' \itemize{
#' \item cost, only available for leaf nodes. Cost of the project.
#' \item p probability that a project will be undertaken.
#' }
#'
#' @docType data
#' @keywords datasets
#' @name acme
#' @usage data(acme)
#' @format A data.tree root Node
NULL
#' Sample Data: Data Used by the ID3 Vignette
#'
#' mushroom contains attributes of mushrooms. We can use this data to predict a
#' mushroom's toxicity based on its attributes.
#' The attributes available in the data set are:
#'
#' \itemize{
#' \item color the color of a mushroom
#' \item size whether a mushroom is small or large
#' \item points whether a mushroom has points
#' \item edibility whether a mushroom is edible or toxic
#' }
#'
#' @docType data
#' @keywords datasets
#' @name mushroom
#' @usage data(mushroom)
#' @format data.frame
NULL
================================================
FILE: R/node.R
================================================
#' Names that are reserved by the Node class.
#'
#' These are reserved by the Node class, you cannot use these as
#' attribute names.
#' Note also that all attributes starting with a . are reserved.
#'
#' @export
NODE_RESERVED_NAMES_CONST <- c(
'AddChild',
'AddChildNode',
'AddSibling',
'AddSiblingNode',
'attributes',
'attributesAll',
'averageBranchingFactor',
'children',
'Climb',
'Navigate',
'FindNode',
'clone',
'count',
'Do',
'fields',
'fieldsAll',
'Get',
'GetAttribute',
'height',
'initialize',
'isBinary',
'isLeaf',
'isRoot',
'leafCount',
'leaves',
'level',
'levelName',
'name',
'parent',
'path',
'pathString',
'position',
'printFormatters',
'Prune',
'Revert',
'RemoveAttribute',
'RemoveChild',
'root',
'Set',
'siblings',
'Sort',
'totalCount',
'.*')
#' Create a \code{data.tree} Structure With \code{Nodes}
#'
#' @description \code{Node} is at the very heart of the \code{data.tree} package. All trees are constructed
#' by tying together \code{Node} objects.
#'
#' @details Assemble \code{Node} objects into a \code{data.tree}
#' structure and use the traversal methods to set, get, and perform operations on it. Typically, you construct larger tree
#' structures by converting from \code{data.frame}, \code{list}, or other formats.
#'
#' Most methods (e.g. \code{node$Sort()}) also have a functional form (e.g. \code{Sort(node)})
#'
#' @docType class
#' @importFrom R6 R6Class
#'
#'
#' @usage # n1 <- Node$new("Node 1")
#'
#' @examples
#' library(data.tree)
#' acme <- Node$new("Acme Inc.")
#' accounting <- acme$AddChild("Accounting")$
#' AddSibling("Research")$
#' AddChild("New Labs")$
#' parent$
#' AddSibling("IT")$
#' AddChild("Outsource")
#' print(acme)
#'
#'
#' @param name the name of the node to be created
#' @param check Either
#' \itemize{
#' \item{\code{"check"}: if the name conformance should be checked and warnings should be printed in case of non-conformance (the default)}
#' \item{\code{"no-warn"}: if the name conformance should be checked, but no warnings should be printed in case of non-conformance (if you expect non-conformance)}
#' \item{\code{"no-check" or FALSE}: if the name conformance should not be checked; use this if performance is critical. However, in case of non-conformance, expect cryptic follow-up errors}
#' }
#' @param ... A name-value mapping of node attributes
#' @param attribute determines what is collected. The \code{attribute} can be
#' \itemize{
#' \item a.) the name of a \bold{field} or a \bold{property/active} of each \code{Node} in the tree, e.g. \code{acme$Get("p")} or \code{acme$Get("position")}
#' \item b.) the name of a \bold{method} of each \code{Node} in the tree, e.g. \code{acme$Get("levelZeroBased")}, where e.g. \code{acme$levelZeroBased <- function() acme$level - 1}
#' \item c.) a \bold{function}, whose first argument must be a \code{Node} e.g. \code{acme$Get(function(node) node$cost * node$p)}
#' }
#'
#' @param recursive if \code{TRUE}, the method will be called recursively on the \code{Node}'s children. This allows sorting an entire tree.
#' @param traversal defines the traversal order to be used. This can be
#' \describe{
#' \item{pre-order}{Go to first child, then to its first child, etc.}
#' \item{post-order}{Go to the first branch's leaf, then to its siblings, and work your way back to the root}
#' \item{in-order}{Go to the first branch's leaf, then to its parent, and only then to the leaf's sibling}
#' \item{level}{Collect root, then level 2, then level 3, etc.}
#' \item{ancestor}{Take a node, then the node's parent, then that node's parent in turn, etc. This ignores the \code{pruneFun} }
#' \item{function}{You can also provide a function, whose sole parameter is a \code{\link{Node}} object. The function is expected to return the node's next node, a list of the node's next nodes, or NULL.}
#' }
#' Read the data.tree vignette for a detailed explanation of these traversal orders.
#'
#'
#' @param pruneFun allows providing a prune criteria, i.e. a function taking a \code{Node} as an input, and returning \code{TRUE} or \code{FALSE}.
#' If the pruneFun returns FALSE for a Node, then the Node and its entire sub-tree will not be considered.
#'
#' @param filterFun allows providing a a filter, i.e. a function taking a \code{Node} as an input, and returning \code{TRUE} or \code{FALSE}.
#' Note that if filter returns \code{FALSE}, then the node will be excluded from the result (but not the entire subtree).
#'
#'
#' @seealso For more details see the \code{\link{data.tree}} documentations, or the \code{data.tree} vignette: \code{vignette("data.tree")}
#'
#'
#' @export
#' @format An \code{\link{R6Class}} generator object
Node <- R6Class("Node",
lock_objects = FALSE,
lock_class = TRUE,
portable = TRUE,
class = TRUE,
cloneable = TRUE,
public = list(
#' @description Create a new \code{Node} object. This is often used to create the root of a tree when creating a tree programmatically.
#'
#' @examples
#' node <- Node$new("mynode", x = 2, y = "value of y")
#' node$y
#'
#' @return A new `Node` object
initialize=function(name, check = c("check", "no-warn", "no-check"), ...) {
if (!missing(name)) {
name <- as.character(name)
if (length(name) != 1) {
stop("Node name must be a scalar")
} else if (is.na(name)) {
stop("Node name must be a non-NA character scalar")
}
name <- CheckNameReservedWord(name, check)
private$p_name <- name
}
if (!missing(...)) {
args <- list(...)
mapply(FUN = function(arg, nme) self[[nme]] <- arg, args, names(args))
}
invisible (self)
},
####################
# Tree creation
#' @description Creates a \code{Node} and adds it as the last sibling as a child to the \code{Node} on which this is called.
#'
#' @examples
#' root <- Node$new("myroot", myname = "I'm the root")
#' root$AddChild("child1", myname = "I'm the favorite child")
#' child2 <- root$AddChild("child2", myname = "I'm just another child")
#' child3 <- child2$AddChild("child3", myname = "Grandson of a root!")
#' print(root, "myname")
#'
#' @return The new \code{Node} (invisibly)
AddChild = function(name, check = c("check", "no-warn", "no-check"), ...) {
child <- Node$new(as.character(name), check, ...)
invisible (self$AddChildNode(child))
},
#' @description Adds a \code{Node} as a child to this node.
#'
#' @param child The child \code{"Node"} to add.
#'
#' @examples
#' root <- Node$new("myroot")
#' child <- Node$new("mychild")
#' root$AddChildNode(child)
#'
#' @return the child node added (this lets you chain calls)
AddChildNode = function(child) {
private$p_children[[child$name]] <- child
self[[child$name]] <- child
child$parent <- self
invisible (child)
},
#' @description Creates a new \code{Node} called \code{name} and adds it after this \code{Node} as a sibling.
#'
#' @examples
#' #' root <- Node$new("myroot")
#' child <- root$AddChild("child1")
#' sibling <- child$AddSibling("sibling1")
#'
#' @return the sibling node (this lets you chain calls)
#'
AddSibling = function(name, check = c("check", "no-warn", "no-check"), ...) {
sibling <- Node$new(as.character(name), check, ...)
invisible (self$AddSiblingNode(sibling))
},
#' @description Adds a \code{Node} after this \code{Node}, as a sibling.
#'
#' @param sibling The \code{"Node"} to add as a sibling.
#'
#' @examples
#' root <- Node$new("myroot")
#' child <- Node$new("mychild")
#' sibling <- Node$new("sibling")
#' root$AddChildNode(child)$AddSiblingNode(sibling)
#'
#' @return the added sibling node (this lets you chain calls, as in the examples)
#'
AddSiblingNode = function(sibling) {
if(isRoot(self)) stop("Cannot insert sibling to root!")
private$p_parent[[sibling$name]] <- sibling
private$p_parent$children <- append(private$p_parent$children, sibling, after = self$position)
names(private$p_parent$children)[self$position + 1] <- sibling$name
sibling$parent <- private$p_parent
invisible (sibling)
},
#' @description Remove the child \code{Node} called \code{name} from a \code{Node} and returns it.
#'
#' @examples
#' node <- Node$new("myroot")$AddChild("mychild")$root
#' node$RemoveChild("mychild")
#'
#' @return the subtree spanned by the removed child.
RemoveChild = function(name) {
if (!name %in% names(private$p_children)) stop(paste0("Node ", self$name, " does not contain child ", name))
child <- private$p_children[[name]]
self$RemoveAttribute(name)
private$p_children <- private$p_children[-child$position]
child$parent <- NULL
return (child)
},
#' @description Removes attribute called \code{name} from this \code{Node}.
#'
#' @param stopIfNotAvailable Gives an error if \code{stopIfNotAvailable} and the attribute does not exist.
#'
#' @examples
#' node <- Node$new("mynode")
#' node$RemoveAttribute("age", stopIfNotAvailable = FALSE)
#' node$age <- 27
#' node$RemoveAttribute("age")
#' node
#'
RemoveAttribute = function(name, stopIfNotAvailable = TRUE) {
attAvailable <- name %in% ls(self)
if (stopIfNotAvailable && !attAvailable) stop(paste0("Node ", self$name, " does not contain field ", name))
else if (attAvailable) {
rm(list = name, envir = self)
return (TRUE)
}
return (FALSE)
},
# End Tree Creation
########################
########################
## Side Effects
#' @description Sort children of a \code{Node} or an entire \code{data.tree} structure
#'
#' @details
#' You can sort with respect to any argument of the tree. But note that sorting has
#' side-effects, meaning that you modify the underlying, original data.tree object structure.
#'
#' See also \code{\link{Sort}} for the equivalent function.
#'
#'
#' @param ... any parameters to be passed on the the attribute (in case it's a method or a
#' function)
#' @param decreasing sort order
#'
#'
#' @return Returns the node on which Sort is called, invisibly. This can be useful to chain Node methods.
#'
#' @examples
#' data(acme)
#' acme$Do(function(x) x$totalCost <- Aggregate(x, "cost", sum), traversal = "post-order")
#' Sort(acme, "totalCost", decreasing = FALSE)
#' print(acme, "totalCost")
#'
Sort = function(attribute, ..., decreasing = FALSE, recursive = TRUE) {
.Deprecated("Sort(node, ...)")
Sort(self, attribute, ..., decreasing = decreasing, recursive = recursive)
},
#' @description Reverts the sort order of a \code{Node}'s children.
#'
#' See also \code{\link{Revert}} for the equivalent function.
#'
#'
#' @return returns the Node invisibly (for chaining)
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Sort}}
#' @export
Revert = function(recursive = TRUE) {
.Deprecated("Revert(node, ...)")
Revert(self, recursive)
},
#' @description Prunes a tree.
#'
#' Pruning refers to removing entire subtrees. This function has side-effects, it modifies your data.tree structure!
#'
#' See also \code{\link{Prune}} for the equivalent function.
#'
#' @param pruneFun allows providing a a prune criteria, i.e. a function taking a \code{Node} as an input, and returning \code{TRUE} or \code{FALSE}.
#' If the pruneFun returns FALSE for a Node, then the Node and its entire sub-tree will not be considered.
#' @return the number of nodes removed
#'
#' @examples
#' data(acme)
#' acme$Do(function(x) x$cost <- Aggregate(x, "cost", sum))
#' Prune(acme, function(x) x$cost > 700000)
#' print(acme, "cost")
#'
Prune = function(pruneFun) {
.Deprecated("Prune(node, ...)")
Prune(self, pruneFun = pruneFun)
},
# End Side Effects
###########################
#' @description Climb a tree from parent to children, by provided criteria.
#'
#' @details
#' This method lets you climb the tree, from crutch to crutch. On each \code{Node}, the
#' \code{Climb} finds the first child having attribute value equal to the the provided argument.
#'
#' See also \code{\link{Climb}} and \code{\link{Navigate}}
#'
#' Climb(node, ...)
#'
#'
#' @param node The root \code{\link{Node}} of the tree or subtree to climb
#' @param ... an attribute-value pairlist to be searched. For brevity, you can also provide a character vector to search for names.
#' @return the \code{Node} having path \code{...}, or \code{NULL} if such a path does not exist
#'
#' @examples
#' data(acme)
#'
#' #the following are all equivalent
#' Climb(acme, 'IT', 'Outsource')
#' Climb(acme, name = 'IT', name = 'Outsource')
#' Climb(acme, 'IT')$Climb('Outsource')
#' Navigate(acme, path = "IT/Outsource")
#'
#' Climb(acme, name = 'IT')
#'
#' Climb(acme, position = c(2, 1))
#' #or, equivalent:
#' Climb(acme, position = 2, position = 1)
#' Climb(acme, name = "IT", cost = 250000)
#'
#' tree <- CreateRegularTree(5, 2)
#' tree$Climb(c("1", "1"), position = c(2, 2))$path
#'
#'
Climb = function(...) {
Climb(self, ...)
},
#' @description Navigate to another node by relative path.
#'
#'
#' @param node The starting \code{\link{Node}} to navigate
#' @param path A string or a character vector describing the path to navigate
#'
#' @details The \code{path} is always relative to the \code{Node}. Navigation
#' to the parent is defined by \code{..}, whereas navigation to a child
#' is defined via the child's name.
#' If path is provided as a string, then the navigation steps are separated
#' by '/'.
#'
#' See also \code{\link{Navigate}} and \code{\link{Climb}}
#'
#' @examples
#' data(acme)
#' Navigate(acme$Research, "../IT/Outsource")
#' Navigate(acme$Research, c("..", "IT", "Outsource"))
#'
Navigate = function(path) {
.Deprecated("Navigate(node, ...)")
Navigate(self, path)
},
##########################
# Traversal
#' @description Traverse a Tree and Collect Values
#'
#' @details
#' The \code{Get} method is one of the most important ones of the \code{data.tree} package. It lets you traverse a tree
#' and collect values along the way. Alternatively, you can call a method or a function on each \code{\link{Node}}.
#'
#' See also \code{\link{Get}}, \code{\link{Node}}, \code{\link{Set}}, \code{\link{Do}}, \code{\link{Traverse}}
#'
#'
#'
#'
#' @param attribute determines what is collected. The \code{attribute} can be
#' \itemize{
#' \item a.) the name of a \bold{field} or a \bold{property/active} of each \code{Node} in the tree, e.g. \code{acme$Get("p")} or \code{acme$Get("position")}
#' \item b.) the name of a \bold{method} of each \code{Node} in the tree, e.g. \code{acme$Get("levelZeroBased")}, where e.g. \code{acme$levelZeroBased <- function() acme$level - 1}
#' \item c.) a \bold{function}, whose first argument must be a \code{Node} e.g. \code{acme$Get(function(node) node$cost * node$p)}
#' }
#' @param ... in case the \code{attribute} is a function or a method, the ellipsis is passed to it as additional arguments.
#' @param format if \code{FALSE} (the default), no formatting is being used. If \code{TRUE}, then the first formatter (if any) found along the ancestor path is being used for formatting
#' (see \code{\link{SetFormat}}). If \code{format} is a function, then the collected value is passed to that function, and the result is returned.
#' @param inheritFromAncestors if \code{TRUE}, then the path above a \code{Node} is searched to get the \code{attribute} in case it is NULL.
#' @param simplify same as \code{\link{sapply}}, i.e. TRUE, FALSE or "array". Additionally, you can specify "regular" if
#' each returned value is of length > 1, and equally named. See below for an example.
#'
#' @return a vector containing the \code{atrributes} collected during traversal, in traversal order. \code{NULL} is converted
#' to NA, such that \code{length(Node$Get) == Node$totalCount}
#'
#'
#' @examples
#' data(acme)
#' acme$Get("level")
#' acme$Get("totalCount")
#'
#'
#' acme$Get(function(node) node$cost * node$p,
#' filterFun = isLeaf)
#'
#' #This is equivalent:
#' nodes <- Traverse(acme, filterFun = isLeaf)
#' Get(nodes, function(node) node$cost * node$p)
#'
#'
#' #simplify = "regular" will preserve names
#' acme$Get(function(x) c(position = x$position, level = x$level), simplify = "regular")
#'
Get = function(attribute,
...,
traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
pruneFun = NULL,
filterFun = NULL,
format = FALSE,
inheritFromAncestors = FALSE,
simplify = c(TRUE, FALSE, "array", "regular")) {
t <- Traverse(self,
traversal = traversal,
pruneFun = pruneFun,
filterFun = filterFun)
Get(t,
attribute,
...,
format = format,
inheritFromAncestors = inheritFromAncestors,
simplify = simplify)
},
#' @description Executes a function on a set of nodes
#'
#' @details
#' See also \code{\link{Node}}, \code{\link{Get}}, \code{\link{Set}}, \code{\link{Traverse}}
#'
#' @param fun the function to execute. The function is expected to be either a Method, or to take a
#' Node as its first argument
#'
#' @examples
#' data(acme)
#' acme$Do(function(node) node$expectedCost <- node$p * node$cost)
#' print(acme, "expectedCost")
#'
Do = function( fun,
...,
traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
pruneFun = NULL,
filterFun = NULL
) {
t <- Traverse(self,
traversal = traversal,
pruneFun = pruneFun,
filterFun = filterFun)
Do(t, fun, ...)
},
#' @description Traverse a Tree and Assign Values
#'
#' @details
#' The method takes one or more vectors as an argument. It traverses the tree, whereby the values are picked
#' from the vector. Also available as OO-style method on \code{\link{Node}}.
#'
#' See also \code{\link{Node}}, \code{\link{Get}}, \code{\link{Do}}, \code{\link{Traverse}}
#'
#'
#'
#' @param ... each argument can be a vector of values to be assigned. Recycled.
#'
#' @return invisibly returns the nodes (useful for chaining)
#'
#' @examples
#' data(acme)
#' acme$Set(departmentId = 1:acme$totalCount, openingHours = NULL, traversal = "post-order")
#' acme$Set(head = c("Jack Brown",
#' "Mona Moneyhead",
#' "Dr. Frank N. Stein",
#' "Eric Nerdahl"
#' ),
#' filterFun = function(x) !x$isLeaf
#' )
#' print(acme, "departmentId", "head")
#'
Set = function(...,
traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
pruneFun = NULL,
filterFun = NULL) {
t <- Traverse(self,
traversal = traversal,
pruneFun = pruneFun,
filterFun = filterFun)
Set(t, ...)
invisible (self)
}
# End Traversal
#######################
),
active = list(
#' @field name Gets or sets the name of a \code{Node}. For example \code{Node$name <- "Acme"}.
name = function(value) {
if (missing(value)) return (private$p_name)
else private$p_name <- changeName(self, private$p_name, value)
},
#' @field printFormatters gets or sets the formatters used to print a \code{Node}.
#' Set this as a list to a root node.
#' The different formatters are h (horizontal), v (vertical), l (L), j (junction), and s (separator).
#' For example, you can set the formatters to \code{list(h = "\u2500" , v = "\u2502", l = "\u2514", j = "\u251C", s = " ")}
#' to get a similar behavior as in \code{fs::dir_tree()}.
#' The defaults are: \code{list(h = "--" , v = "\u00A6", l = "\u00B0", j = "\u00A6", s = " ")}
printFormatters = function(value) {
if (missing(value)) {
# if private$p_print_formatters is not set, return default
if (is.null(private$p_print_formatters)) {
pf <- list(h = "--" ,
v = "\u00A6",
l = "\u00B0",
j = "\u00A6",
s = " "
)
} else {
pf <- private$p_print_formatters
}
return (pf)
}
private$p_print_formatters <- value
},
#' @field parent Gets or sets the parent \code{Node} of a \code{Node}. Only set this if you know what you are doing, as you might mess up the tree structure!
parent = function(value) {
if (missing(value)) return (private$p_parent)
if (!is.null(value) && !is(value, "Node")) stop("Cannot set the parent to a non-Node!")
private$p_parent <- value
},
#' @field children Gets or sets the children \code{list} of a \code{Node}. Only set this if you know what you are doing, as you might mess up the tree structure!
children = function(value) {
if (missing(value)) return (private$p_children)
if (!is.null(value) && !is.list(value)) stop("Cannot set children to non-list!")
private$p_children <- value
},
#' @field isLeaf Returns \code{TRUE} if the \code{Node} is a leaf, \code{FALSE} otherwise
isLeaf = function() {
isLeaf(self)
},
#' @field isRoot Returns \code{TRUE} if the \code{Node} is the root, \code{FALSE} otherwise
isRoot = function() {
isRoot(self)
},
#' @field count Returns the number of children of a \code{Node}
count = function() {
return (length(private$p_children))
},
#' @field totalCount Returns the total number of \code{Node}s in the tree
totalCount = function() {
return (1 + sum(as.numeric(sapply(private$p_children, function(x) x$totalCount, simplify = TRUE, USE.NAMES = FALSE))))
},
#' @field path Returns a vector of mode \code{character} containing the names of the \code{Node}s in the path from the root to this \code{Node}
path = function() {
c(private$p_parent$path, self$name)
},
#' @field pathString Returns a string representing the path to this \code{Node}, separated by backslash
pathString = function() {
paste(self$path, collapse="/")
},
#' @field position The position of a \code{Node} within its siblings
position = function() {
if (isRoot(self)) return (1)
result <- which(names(private$p_parent$children) == self$name)
# match(self$name, names(private$p_parent$children))
return (result)
},
#' @field fields Will be deprecated, use \code{attributes} instead
fields = function() {
.Deprecated("Node$attributes", old = "Node$fields")
return(self$attributes)
},
#' @field fieldsAll Will be deprecated, use \code{attributesAll} instead
fieldsAll = function() {
.Deprecated("Node$attributesAll", old = "Node$fieldsAll")
return(self$attributesAll)
},
#' @field attributes The attributes defined on this specific node
attributes = function() {
nms <- ls(self)
nms <- nms[!(nms %in% NODE_RESERVED_NAMES_CONST)]
nms <- nms[!(nms %in% names(private$p_children))]
nms <- nms[!(stri_sub(nms, 1, 1) == '.')]
return (nms)
},
#' @field attributesAll The distinct union of attributes defined on all the nodes in the tree spanned by this \code{Node}
attributesAll = function() {
as.vector(na.omit(unique(unlist(Get(Traverse(self), "attributes", simplify = FALSE)))))
},
#' @field levelName Returns the name of the \code{Node}, preceded by level times '*'. Useful for printing and not typically called by package users.
levelName = function() {
paste0(.separator(self), self$name)
},
#' @field leaves Returns a list containing all the leaf \code{Node}s
leaves = function() {
if (self$isLeaf) {
return (list(self))
} else {
unlist(sapply(private$p_children, function(x) x$leaves))
}
},
#' @field leafCount Returns the number of leaves are below a \code{Node}
leafCount = function() {
length(Traverse(self, filterFun = isLeaf))
},
#' @field level Returns an integer representing the level of a \code{Node}. For example, the root has level 1.
level = function() {
if (isRoot(self)) {
return (1)
} else {
return (1 + private$p_parent$level)
}
},
#' @field height Returns max(level) of any of the \code{Nodes} of the tree
height = function() {
if (isLeaf(self)) return (1)
max(Get(Traverse(self, filterFun = function(x) isLeaf(x) && x$position == 1), "level")) - self$level + 1
},
#' @field isBinary Returns \code{TRUE} if all \code{Node}s in the tree (except the leaves) have \code{count = 2}
isBinary = function() {
all(2 == Get(Traverse(self, filterFun = function(x) !x$isLeaf), "count"))
},
#' @field root Returns the root of a \code{Node} in a tree.
root = function() {
if (isRoot(self)) {
invisible (self)
} else {
invisible (private$p_parent$root)
}
},
#' @field siblings Returns a \code{list} containing all the siblings of this \code{Node}
siblings = function() {
if (isRoot(self)) {
return (list())
} else {
private$p_parent$children[names(private$p_parent$children) != self$name]
}
},
#' @field averageBranchingFactor Returns the average number of crotches below this \code{Node}
averageBranchingFactor = function() {
averageBranchingFactor(self)
}
),
private = list(
p_name = "",
p_children = NULL,
p_parent = NULL
)
)
================================================
FILE: R/node_actives.R
================================================
#' Check if a \code{Node} is the root
#'
#' @param node The Node to test.
#' @return TRUE if the Node is the root, FALSE otherwise
#' @export
isRoot <- function(node) {
is.null(node$parent)
}
#' Check if a \code{Node} is not a root
#'
#' @param node The Node to test.
#' @return FALSE if the Node is the root, TRUE otherwise
#' @export
isNotRoot <- function(node) {
!isRoot(node)
}
#' Check if a \code{Node} is a leaf
#'
#' @param node The Node to test.
#' @return TRUE if the Node is a leaf, FALSE otherwise
#' @export
isLeaf <- function(node) {
length(node$children) == 0
}
#' Check if a \code{Node} is not a leaf
#'
#' @param node The Node to test.
#' @return FALSE if the Node is a leaf, TRUE otherwise
#' @export
isNotLeaf <- function(node) {
!isLeaf(node)
}
changeName <- function(node, oldName, newName) {
if(!isRoot(node)) {
rm(list = oldName, envir = node$parent)
names(node$parent$children)[node$position] <- newName
node$parent[[as.character(newName)]] <- node
}
return (newName)
}
#' @export
.separator <- function(self) {
if (isRoot(self)) return("")
if (self$position == self$parent$count) mySeparator <- paste0(self$root$printFormatters$s, self$root$printFormatters$l, self$root$printFormatters$h)
else mySeparator <- paste0(self$root$printFormatters$s, self$root$printFormatters$j, self$root$printFormatters$h)
return (paste0(.parentSeparator(self$parent), mySeparator))
}
#' @export
.parentSeparator <- function(self) {
if (isRoot(self)) return("")
if (self$position == self$parent$count) mySeparator <- paste0(rep(self$root$printFormatters$s, 4), collapse = "")
else mySeparator <- paste0(self$root$printFormatters$s, self$root$printFormatters$v, self$root$printFormatters$s, self$root$printFormatters$s)
paste0(.parentSeparator(self$parent), mySeparator)
}
#' Calculate the average number of branches each non-leaf has
#'
#' @param node The node to calculate the average branching factor for
#' @export
averageBranchingFactor <- function(node) {
t <- Traverse(node, filterFun = isNotLeaf)
if (length(t) == 0) return (0)
cnt <- Get(t, "count")
if (!is.numeric(cnt)) browser()
return (mean(cnt))
}
================================================
FILE: R/node_conversion.R
================================================
#' Convert an object to a \code{data.tree} data structure
#'
#' @param x The object to be converted
#' @param ... Additional arguments
#'
#' @family as.Node
#'
#' @export
as.Node <- function(x, ...) {
UseMethod("as.Node")
}
#' Write a \code{data.tree} structure to Newick notation
#'
#' To read from Newick, you can use the \code{ape} package, and convert the resulting \code{phylo}
#' object to a \code{data.tree} structure.
#'
#' @param node The root \code{Node} of a tree or sub-tree to be converted
#' @param heightAttribute The attribute (field name, method, or function) storing or calculating the height for each \code{Node}
#' @param ... parameters that will be passed on the the heightAttributeName, in case it is a function
#'
#' @import stringi
#'
#' @examples
#' data(acme)
#' ToNewick(acme)
#' ToNewick(acme, heightAttribute = NULL)
#' ToNewick(acme, heightAttribute = function(x) DefaultPlotHeight(x, 200))
#' ToNewick(acme, rootHeight = 200)
#'
#' @family Conversions from Node
#'
#' @keywords Newick
#'
#' @export
ToNewick <- function(node, heightAttribute = DefaultPlotHeight, ...) {
deparse <- function(x) {
name <- stri_replace_all_fixed(x$name, " ", "_")
name <- stri_replace_all_fixed(name, ",", "")
if(!isRoot(x) && length(heightAttribute) > 0) {
edge <- GetAttribute(x$parent, heightAttribute, ...) - GetAttribute(x, heightAttribute, ...)
me <- paste0(name, ":", edge)
} else {
me <- name
}
return(me)
}
Newick <- function(x) {
if(x$isLeaf) {
return (deparse(x))
}
chNewick <- sapply(x$children, Newick)
chNewickStr <- paste(chNewick, collapse = ",")
res <- paste0("(", chNewickStr, ")", deparse(x))
}
res <- Newick(node)
res <- paste0(res, ";")
return (res)
}
================================================
FILE: R/node_conversion_ape.R
================================================
#' Convert a \code{Node} to a phylo object from the ape package.
#'
#' This method requires the ape package to be installed and loaded.
#'
#' @param x The root \code{Node} of the tree or sub-tree to be converted
#' @param heightAttribute The attribute (field name or function) storing the height
#' @param ... any other argument
#'
#' @examples
#' library(ape)
#' data(acme)
#' acmephylo <- as.phylo(acme)
#' #plot(acmephylo)
#'
#'
#' @family ape phylo conversions
#'
#' @export
as.phylo.Node <- function(x, heightAttribute = DefaultPlotHeight, ...) {
txt <- ToNewick(x, heightAttribute)
return (ape::read.tree(text = txt))
}
#' Convert a \code{phylo} object from the ape package to a \code{Node}
#'
#' @param x The phylo object to be converted
#' @param heightName If the phylo contains edge lengths, then they will be converted
#' to a height and stored in a field named according to this parameter (the default is "height")
#' @param replaceUnderscores if TRUE (the default), then underscores in names are replaced with spaces
#' @param namesNotUnique if TRUE, then the \code{name} of the \code{Node}s will be prefixed with a unique id.
#' This is useful if the children of a parent have non-unique names.
#' @param ... any other parameter to be passed to sub-implementations
#'
#' @examples
#' #which bird familes have the max height?
#' library(ape)
#' data(bird.families)
#' bf <- as.Node(bird.families)
#' height <- bf$height
#' t <- Traverse(bf, filterFun = function(x) x$level == 25)
#' Get(t, "name")
#'
#' @family ape phylo conversions
#' @family as.Node
#'
#' @export
as.Node.phylo <- function(x, heightName = "plotHeight", replaceUnderscores = TRUE, namesNotUnique = FALSE, ...) {
#find root node
rootNr <- unique(x$edge[,1][!x$edge[,1] %in% x$edge[,2]])
#names
nodeNrs <- c(rootNr, unique(x$edge[,2]))
leafNrs <- 1:length(x$tip.label)
nms <- x$tip.label
names(nms) <- leafNrs
if("node.label" %in% names(x)) {
nms2 <- x$node.label
} else {
nms2 <- (max(leafNrs) + 1):max(nodeNrs)
}
names(nms2) <- (max(leafNrs) + 1):max(nodeNrs)
nms <- c(nms2, nms)
root <- Node$new(rootNr)
for (i in 1:nrow(x$edge)) {
e <- x$edge[i,]
fifu <- function(x) x$name == as.character(e[1])
parent <- Traverse(root, filterFun = fifu)[[1]]
child <- parent$AddChild(as.character(e[2]))
}
if (length(x$edge.length) > 0) {
t <- Traverse(root, filterFun = isNotRoot)
Set(t, edgeLength = x$edge.length)
#try converting edge length to height
root[[heightName]] <- 0
ehf <- function(x) x[[heightName]] <- x$parent[[heightName]] - x$edgeLength
Do(t, ehf)
corr <- min(Get(t, heightName))
root$Do(function(x) x[[heightName]] <- x[[heightName]] - corr)
Do(t, function(x) rm("edgeLength", envir = x))
}
setName <- function(x) {
if (replaceUnderscores) nm <- stri_replace_all_fixed( nms[[x$name]], "_", " ")
else nm <- nms[[x$name]]
if (namesNotUnique) x$name <- paste0(x$name, ": ", nm)
else x$name <- nm
}
root$Do(setName)
return (root)
}
#' Determine the number a \code{Node} has after conversion to a phylo object
#'
#' Use this function when plotting a Node as a phylo, e.g. to set custom
#' labels to plot.
#'
#' @param x The Node
#' @param type Either "node" (the default) or "edge" (to get the number of the edge from \code{x} to its parent)
#' @return an integer representing the node
#'
#' @examples
#' library(ape)
#' library(data.tree)
#' data(acme)
#' ap <- as.phylo(acme)
#' #plot(ap)
#' #nodelabels("IT Dep.", GetPhyloNr(Climb(acme, "IT")))
#' #edgelabels("Good!", GetPhyloNr(Climb(acme, "IT", "Switch to R"), "edge"))
#'
#'
#' @family ape phylo conversions
#'
#' @export
GetPhyloNr <- function(x, type = c("node", "edge")) {
type <- type[1]
if (type == "node") {
t <- c(Traverse(x$root, filterFun = isLeaf), Traverse(x$root, filterFun = isNotLeaf))
} else if (type == "edge") {
t <- Traverse(x$root, filterFun = isNotRoot)
} else {
stop("Only node or edge allowed as type")
}
res <- which(sapply(t, function(z) identical(z, x)))
return (res)
}
================================================
FILE: R/node_conversion_dataframe.R
================================================
#' Convert a \code{data.tree} structure to a \code{data.frame}
#'
#' If a node field contains data of length > 1, then that is converted into a string in the
#' data.frame.
#'
#' @param x The root \code{Node} of the tree or sub-tree to be convert to a data.frame
#' @param ... the attributes to be added as columns of the data.frame. See \code{\link{Get}} for details.
#' If a specific Node does not contain the attribute, \code{NA} is added to the data.frame.
#' @param traversal any of 'pre-order' (the default), 'post-order', 'in-order', 'level', or 'ancestor'. See \code{\link{Traverse}} for details.
#' @param direction when converting to a network, should the edges point from root to children ("climb") or from child to parent ("descend")?
#' @param type when converting type columns, the \code{type} is the discriminator, i.e. an attribute (e.g. field name) of each node
#' @param prefix when converting type columns, the prefix used for the column names. Can be NULL to omit prefixes.
#' @param filterFun a function taking a \code{Node} as an argument. See \code{\link{Traverse}} for details.
#' @param format if \code{FALSE} (the default), then no formatting will be applied. If \code{TRUE}, then the first formatter (if any) along the ancestor
#' path is used for formatting.
#' @param inheritFromAncestors if FALSE, and if the attribute is a field or a method, then only a \code{Node} itself is
#' searched for the field/method. If TRUE, and if the \code{Node} does not contain the attribute, then ancestors are also searched.
#' @param row.names \code{NULL} or a character vector giving the row names for the data frame.
#' Missing values are not allowed.
#' @param optional logical. If \code{TRUE}, setting row names and converting column names
#' (to syntactic names: see make.names) is optional.
#'
#'
#' @examples
#' data(acme)
#' acme$attributesAll
#' as.data.frame(acme, row.names = NULL, optional = FALSE, "cost", "p")
#'
#' ToDataFrameTree(acme, "cost", "p")
#' ToDataFrameNetwork(acme, "cost", "p", direction = "climb")
#' ToDataFrameTable(acme, "cost", "p")
#' ToDataFrameTypeCol(acme)
#'
#' #use the pruneFun:
#' acme$Do(function(x) x$totalCost <- Aggregate(x, "cost", sum), traversal = "post-order")
#' ToDataFrameTree(acme, "totalCost", pruneFun = function(x) x$totalCost > 300000)
#'
#' #inherit
#' acme$Set(floor = c(1, 2, 3), filterFun = function(x) x$level == 2)
#' as.data.frame(acme, row.names = NULL, optional = FALSE, "floor", inheritFromAncestors = FALSE)
#' as.data.frame(acme, row.names = NULL, optional = FALSE, "floor", inheritFromAncestors = TRUE)
#'
#' #using a function as an attribute:
#' acme$Accounting$Head <- "Mrs. Numright"
#' acme$Research$Head <- "Mr. Stein"
#' acme$IT$Head <- "Mr. Squarehead"
#' ToDataFrameTable(acme, department = function(x) x$parent$name, "name", "Head", "cost")
#'
#' #complex TypeCol
#' acme$IT$Outsource$AddChild("India")
#' acme$IT$Outsource$AddChild("Poland")
#' acme$Set(type = c('company', 'department', 'project', 'project', 'department',
#' 'project', 'project', 'department', 'program', 'project',
#' 'project', 'project', 'project'
#' )
#' )
#' print(acme, 'type')
#' ToDataFrameTypeCol(acme, type = 'type')
#'
#' @inheritParams Prune
#'
#' @export
as.data.frame.Node <- function(x,
row.names = NULL,
optional = FALSE,
...,
traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
pruneFun = NULL,
filterFun = NULL,
format = FALSE,
inheritFromAncestors = FALSE
) {
traversal <- traversal[1]
if(!isRoot(x) || length(pruneFun) > 0) {
#clone s.t. x is root (for pretty level names)
x <- Clone(x, attributes = TRUE)
if (length(pruneFun) > 0) Prune(x, pruneFun)
x$parent <- NULL
}
t <- Traverse(x, traversal = traversal, filterFun = filterFun)
df <- data.frame( levelName = format(Get(t, 'levelName')),
row.names = row.names,
stringsAsFactors = FALSE)
cols <- list(...)
if(length(cols) == 0) return (df)
for (i in 1:length(cols)) {
col <- cols[[i]]
if (length(names(cols)) > 0 && nchar(names(cols)[i]) > 0) colName <- names(cols)[i]
else if (is.character(col)) colName <- col
else stop(paste0("Cannot infer column name for ... arg nr ", i))
if (length(col) > 1) {
it <- col
} else {
it <- Get(t,
col,
format = format,
inheritFromAncestors = inheritFromAncestors,
simplify = FALSE)
it <- lapply(it,
function(el) {
if (inherits(el, "Node")) return ("")
else if (length(unlist(el)) > 1) return (toString(unlist(el)))
else if (length(unlist(el)) == 0) return (NA)
else return (el)
}
)
}
df[colName] <- unlist(it)
}
return (df)
}
#' @rdname as.data.frame.Node
#' @return ToDataFrameTree: a \code{data.frame}, where each row represents a \code{Node} in the tree or sub-tree
#' spanned by \code{x}, possibly pruned according to \code{pruneFun}.
#'
#' @export
ToDataFrameTree <- function(x, ..., pruneFun = NULL) {
as.data.frame(x, row.names = NULL, optional = FALSE, ..., pruneFun = pruneFun)
}
#' @rdname as.data.frame.Node
#'
#'
#' @return ToDataFrameTable: a \code{data.frame}, where each row represents a leaf \code{Node} in the tree or sub-tree
#' spanned by \code{x}, possibly pruned according to \code{pruneFun}.
#'
#'
#' @export
ToDataFrameTable <- function(x, ..., pruneFun = NULL) {
df <- as.data.frame(x, row.names = NULL, optional = FALSE, ..., filterFun = isLeaf, pruneFun = pruneFun, inheritFromAncestors = TRUE)
df[,-1]
}
#' @rdname as.data.frame.Node
#'
#' @return ToDataFrameNetwork: a \code{data.frame}, where each row represents a \code{Node} in the tree or sub-tree
#' spanned by \code{x}, possibly pruned according to \code{pruneFun}. The first column is called 'from', while the
#' second is called 'to', describing the parent to child edge (for direction "climb") or the child to parent edge (for direction "descend").
#' If \code{\link{AreNamesUnique}} is TRUE, then the Network is
#' based on the \code{Node$name}, otherwise on the \code{Node$pathString}
#'
#'
#' @export
ToDataFrameNetwork <- function(x,
...,
direction = c("climb", "descend"),
pruneFun = NULL,
format = FALSE,
inheritFromAncestors = FALSE) {
direction <- direction[1]
if(!AreNamesUnique(x)) GetName <- function(x) x$pathString
else GetName <- function(x) x$name
t <- Traverse(x, traversal = "level", pruneFun = pruneFun)
children <- Get(t, function(x) GetName(x))
parents <- Get(t, function(x) GetName(x$parent))
if (direction == "descend") df <- data.frame(from = children,
to = parents,
stringsAsFactors = FALSE)
else if(direction == "climb") df <- data.frame(from = parents,
to = children,
stringsAsFactors = FALSE)
else stop(paste0("direction ", direction, " unknown. Must be either climb or descend."))
df2 <- ToDataFrameTree(x, ..., traversal = "level", pruneFun = pruneFun, format = format, inheritFromAncestors = inheritFromAncestors)[,-1, drop = FALSE]
df <- cbind(df, df2)
df <- df[-1,]
rownames(df) <- seq_len(nrow(df))
return (df)
}
#' @rdname as.data.frame.Node
#'
#' @return ToDataFrameTypeCol: a \code{data.frame} in table format (i.e. where each row represents a leaf in the tree or sub-tree
#' spanned by \code{x}), possibly pruned according to \code{pruneFun}. In addition to \code{...}, each distinct
#' \code{type} is output to a column.
#'
#'
#' @export
ToDataFrameTypeCol <- function(x,
...,
type = 'level',
prefix = type,
pruneFun = NULL) {
cols <- unique(c(x$Get(type, filterFun = isNotLeaf), x$Get(type, filterFun = isLeaf)))
pathArgs <- GetPathArgV(cols, type)
if (is.null(prefix)) names(pathArgs) <- as.character(cols)
else names(pathArgs) <- paste0(prefix, '_', cols)
do.call(ToDataFrameTable, c(x, pathArgs, ...))
}
GetPathArg <- function(n, type) {
lvl <- force(n)
f <- function(leaf) {
path <- leaf$Get(type, traversal = 'ancestor')
name <- names(path[path == lvl])
if (length(name) == 0) name <- NA
return (name)
}
return (f)
}
GetPathArgV <- Vectorize(GetPathArg, vectorize.args = 'n')
#' Convert a \code{data.frame} to a \code{data.tree} structure
#'
#' @param x The data.frame in the required format.
#' @param ... Any other argument implementations of this might need
#' @param mode Either "table" (if x is a data.frame in tree or table format) or "network"
#' @param na.rm If \code{TRUE}, then NA's are treated as NULL and values will not be set on nodes
#'
#' @return The root \code{Node} of the \code{data.tree} structure
#'
#' @examples
#' data(acme)
#'
#' #Tree
#' x <- ToDataFrameTree(acme, "pathString", "p", "cost")
#' x
#' xN <- as.Node(x)
#' print(xN, "p", "cost")
#'
#' #Table
#' x <- ToDataFrameTable(acme, "pathString", "p", "cost")
#' x
#' xN <- FromDataFrameTable(x)
#' print(xN, "p", "cost")
#'
#' #More complex Table structure, using colLevels
#' acme$Set(floor = c(1, 2, 3), filterFun = function(x) x$level == 2)
#' x <- ToDataFrameTable(acme, "pathString", "floor", "p", "cost")
#' x
#' xN <- FromDataFrameTable(x, colLevels = list(NULL, "floor", c("p", "cost")), na.rm = TRUE)
#' print(xN, "floor", "p", "cost")
#'
#' #Network
#' x <- ToDataFrameNetwork(acme, "p", "cost", direction = "climb")
#' x
#' xN <- FromDataFrameNetwork(x)
#' print(xN, "p", "cost")
#'
#' @seealso \code{\link{as.data.frame.Node}}
#' @family as.Node
#'
#' @export
as.Node.data.frame <- function(x,
...,
mode = c("table", "network"),
pathName = 'pathString',
pathDelimiter = '/',
colLevels = NULL,
na.rm = TRUE) {
mode <- mode[1]
if (mode == 'table') return (FromDataFrameTable(x, pathName, pathDelimiter, colLevels, na.rm))
else if (mode == 'network') return (FromDataFrameNetwork(x))
else stop(paste0("Mode ", mode, " unknown."))
}
#' @rdname as.Node.data.frame
#'
#' @param table a \code{data.frame} in table or tree format, i.e. having a row for each leaf (and optionally
#' for additional nodes). There should be a column called \code{pathName}, separated by \code{pathDelimiter},
#' describing the path of each row.
#' @param pathName The name of the column in x containing the path of the row
#' @param pathDelimiter The delimiter used to separate nodes in \code{pathName}
#' @param colLevels Nested list of column names, determining on what node levels the attributes are written to.
#'
#' @inheritParams CheckNameReservedWord
#'
#' @export
FromDataFrameTable <- function(table,
pathName = 'pathString',
pathDelimiter = '/',
colLevels = NULL,
na.rm = TRUE,
check = c("check", "no-warn", "no-check")
) {
if (!is(table, "data.frame")) stop("table must be a data.frame")
#make sure tibble etc. work (#115)
table <- as.data.frame(table)
table[[pathName]] <- as.character(table[[pathName]])
root <- NULL
mycols <- names(table)[ !(names(table) %in% c(NODE_RESERVED_NAMES_CONST, pathName)) ]
for (i in 1:nrow(table)) {
myrow <- table[ i, , drop = FALSE]
mypath <- myrow[[pathName]]
myvalues <- myrow[!colnames(myrow) == pathName]
#create node and ancestors if necessary (might already have been created)
paths <- strsplit(mypath, pathDelimiter, fixed = TRUE)[[1]]
paths <- paths[paths!=""]
if (is.null(root)) root <- Node$new(paths[1], check)
mynode <- root
colsToSet <- mycols
colsToSetForLeaf <- mycols
for (path in paths[-1]) {
path <- CheckNameReservedWord(path, check)
child <- Climb(mynode, path)
if( is.null(child)) {
mynode <- mynode$AddChild(path)
} else {
mynode <- child
}
if( length(colLevels) >= mynode$level ) {
colsToSet <- intersect(colLevels[[mynode$level]], mycols)
#fill values on appropriate level
for (mycol in colsToSet) {
if ( !( na.rm && is.na(myrow[[mycol]]) )) {
mynode[[mycol]] <- myrow[[mycol]]
}
}
colsToSetForLeaf <- colsToSetForLeaf[!(colsToSetForLeaf %in% colsToSet)]
}
}
#put the rest in the leaf
for (mycol in colsToSetForLeaf) {
if ( !( na.rm && is.na(myrow[[mycol]]) )) {
mynode[[mycol]] <- myrow[[mycol]]
}
#remove
}
}
return (root)
}
#' @rdname as.Node.data.frame
#'
#' @param network A \code{data.frame} in network format, i.e.
#' it must adhere to the following requirements:
#' \itemize{
#' \item{It must contain as many rows as there are nodes (excluding the root, there is no row for the root)}
#' \item{Its first and second columns contain the network relationships. This can be either climbing (from parent to children) or descending (from child to parent)}
#' \item{Its subsequent columns contain the attributes to be set on the nodes}
#' \item{It must contain a single root}
#' \item{There are no cycles in the network}
#' }
#'
#' @import methods
#'
#' @inheritParams CheckNameReservedWord
#'
#' @export
FromDataFrameNetwork <- function(network, check = c("check", "no-warn", "no-check")) {
if (!is(network, "data.frame")) stop("network must be a data.frame")
#make sure tibble etc. work (#115)
network <- as.data.frame(network)
if (dim(network)[2] < 2) stop("network must hold the relationships in the first two columns")
if (length(unique(network[ , 1])) > length(unique(network[ , 2]))) {
children <- network[ , 1]
parents <- network[ , 2]
} else {
children <- network[ , 2]
parents <- network[ , 1]
}
rootName <- unique(parents[!(parents %in% children)])
if (length(rootName) != 1) stop("Cannot find root name. network is not a tree!")
root <- Node$new(rootName, check)
AddChildren <- function(node) {
childrenIdxs <- which(parents == node$name)
for (idx in childrenIdxs) {
nodeName <- children[idx]
child <- node$AddChild(nodeName)
if (dim(network)[2] > 2) {
for (j in 3:dim(network)[2]) {
vlu <- network[idx, j]
if (!is.na(vlu)) {
nm <- names(network)[j]
nm <- CheckNameReservedWord(nm, check)
if (!nm %in% NODE_RESERVED_NAMES_CONST) child[[nm]] <- network[idx, j]
}
}
}
AddChildren(child)
}
}
AddChildren(root)
return (root)
}
================================================
FILE: R/node_conversion_dendrogram.R
================================================
#' Convert a \code{\link{dendrogram}} to a data.tree \code{Node}
#'
#' @param x The dendrogram
#' @param name The name of the root Node
#' @param heightName The name under which the dendrogram's height is stored
#' @param ... Additional parameters
#'
#' @return The root \code{Node} of a \code{data.tree}
#'
#' @examples
#' hc <- hclust(dist(USArrests), "ave")
#' dend1 <- as.dendrogram(hc)
#' tree1 <- as.Node(dend1)
#' tree1$attributesAll
#' tree1$totalCount
#' tree1$leafCount
#' tree1$height
#'
#' @family as.Node
#'
#' @inheritParams CheckNameReservedWord
#'
#' @export
as.Node.dendrogram <- function(x, name = "Root", heightName = "plotHeight", check = c("check", "no-warn", "no-check"), ...) {
#str(unclass(dend1))
if (is.leaf(x)) {
name <- attr(x, 'label')
} else if(is.null(name) && is.null(attr(x, "edgetext"))) {
name <- tempfile(pattern = '', tmpdir = '')
} else if(!is.null(attr(x, "edgetext"))) {
name <- attr(x, "edgetext")
}
n <- Node$new(name, check)
reserved <- c('label', 'class', 'comment', 'dim', 'dimnames', 'names', 'row.names', 'tsp', NODE_RESERVED_NAMES_CONST)
ats <- names(attributes(x))
for (a in ats[!(ats %in% reserved)]) {
n[[a]] <- attr(x, a)
}
n[[heightName]] <- attr(x, "height")
if (!is.leaf(x)) {
for (i in 1:length(x)) {
childNode <- as.Node.dendrogram(x[[i]], name = NULL, ...)
n$AddChildNode(childNode)
if(!is.leaf(x[[i]])) {
name <- as.character(childNode$position)
childNode$name <- name
}
}
} else {
n$value <- as.vector(x)
}
return (n)
}
#' Convert a \code{Node} to a \code{dendrogram}
#'
#' Convert a \code{data.tree} structure to a \code{\link{dendrogram}}
#'
#' @param object The Node to convert
#' @param heightAttribute The attribute (field name or function) storing the height
#' @param edgetext If TRUE, then the for non-leaf nodes the node name is stored as the dendrogram's edge text.
#' @param ... Additional parameters
#'
#' @return An object of class dendrogram
#'
#' @examples
#' data(acme)
#' acmed <- as.dendrogram(acme)
#' plot(acmed, center = TRUE)
#'
#' #you can take an attribute for the height:
#' acme$Do( function(x) x$myPlotHeight <- (10 - x$level))
#' acmed <- as.dendrogram(acme, heightAttribute = "myPlotHeight")
#' plot(acmed, center = TRUE)
#'
#' #or directly a function
#' acmed <- as.dendrogram(acme, heightAttribute = function(x) 10 - x$level)
#' plot(acmed)
#'
#' @family Conversions from Node
#'
#' @import stats
#' @export
as.dendrogram.Node <- function(object, heightAttribute = DefaultPlotHeight, edgetext = FALSE, ...) {
node <- object
#strange: the original dendrogram will
# unclass the nested dendrograms as well,
# while ours won't?
#
# hc <- hclust(dist(USArrests), "ave")
# dend1 <-d as.dendrogram(hc)
# node <- as.Node(dend1)
# dend2 <- as.dendrogram(node)
# unclass(dend1)
# unclass(dend2)
height <- as.vector(GetAttribute(node, heightAttribute))
if (node$isLeaf) {
res <- node$value
if (is.null(res)) res <- 0
res <- structure(res,
label = node$name,
members = 1,
height = height,
leaf = node$isLeaf,
class = "dendrogram")
} else {
#res <- list()
#class(res) <- "dendrogram"
res <- unname(lapply(node$children, FUN = function(x) as.dendrogram(x, heightAttribute, ...)))
res <- structure(res,
members = node$leafCount,
midpoint = node$midpoint,
height = height,
class = "dendrogram")
if (edgetext) attr(res, "edgetext") <- node$name
}
return (res)
}
================================================
FILE: R/node_conversion_igraph.R
================================================
#' Convert a \code{data.tree} structure to an igraph network
#'
#' This requires the igraph package to be installed.
#' Also, this requires the names of the \code{Nodes} to be unique within
#' the \code{data.tree} structure.
#'
#' @param x The root \code{Node} to convert
#' @param vertexAttributes A vector of strings, representing the attributes
#' in the \code{data.tree} structure to add as attributes to the vertices of the igraph
#' @param edgeAttributes A vector of strings, representing the attributes
#' in the \code{data.tree} structure to add as edge attributes of the igraph
#' @param ... Currently unused.
#'
#' @inheritParams igraph::graph_from_data_frame
#' @inheritParams ToDataFrameNetwork
#'
#' @return an \code{igraph} object
#'
#' @examples
#' data(acme)
#' library(igraph)
#' ig <- as.igraph(acme, "p", c("level", "isLeaf"))
#' plot(ig)
#'
#' @seealso AreNamesUnique
#'
#' @export
as.igraph.Node <- function(x, vertexAttributes = character(), edgeAttributes = character(), directed = FALSE, direction = c("climb", "descend"), ...) {
if (!AreNamesUnique(x)) stop("Node names must be unique within the tree")
network <- do.call("ToDataFrameNetwork", c(x, "name", vertexAttributes, edgeAttributes, direction = direction))
data <- network[,c("from", "to", edgeAttributes)]
vert <- do.call("ToDataFrameTree", c(x, "name", vertexAttributes))[,-1]
ig <- igraph::graph_from_data_frame(data,
directed = directed,
vertices = vert)
return (ig)
}
================================================
FILE: R/node_conversion_list.R
================================================
#' Convert a nested \code{list} structure to a \code{data.tree} structure
#'
#' @param x The \code{list} to be converted.
#' @param mode How the list is structured. "simple" (the default) will interpret any list to be a child. "explicit"
#' assumes that children are in a nested list called \code{childrenName}
#' @param nameName The name of the element in the list that should be used as the name, can be NULL if mode = explicit and
#' the children lists are named, or if an automatic name (running number) should be assigned
#' @param childrenName The name of the element that contains the child list (applies to mode 'explicit' only).
#' @param nodeName A name suggestion for x, if the name cannot be deferred otherwise. This is for example the case for
#' the root with mode explicit and named lists.
#' @param interpretNullAsList If \code{TRUE}, then \code{NULL}-valued lists are interpreted as child nodes. Else, they are interpreted as attributes.
#' This has only an effect if \code{mode} is "simple".
#' @param ... Any other argument to be passed to generic sub implementations
#'
#' @examples
#' kingJosephs <- list(name = "Joseph I",
#' spouse = "Mary",
#' born = "1818-02-23",
#' died = "1839-08-29",
#' children = list(
#' list(name = "Joseph II",
#' spouse = "Kathryn",
#' born = "1839-03-28",
#' died = "1865-12-19"),
#' list(name = "Helen",
#' born = "1840-17-08",
#' died = "1845-01-01")
#' )
#' )
#' FromListExplicit(kingJosephs)
#'
#' kingJosephs <- list(head = "Joseph I",
#' spouse = "Mary",
#' born = "1818-02-23",
#' died = "1839-08-29",
#' list(head = "Joseph II",
#' spouse = "Kathryn",
#' born = "1839-03-28",
#' died = "1865-12-19"),
#' list(head = "Helen",
#' born = "1840-17-08",
#' died = "1845-01-01")
#' )
#' FromListSimple(kingJosephs, nameName = "head")
#'
#' kingJosephs <- list(spouse = "Mary",
#' born = "1818-02-23",
#' died = "1839-08-29",
#' `Joseph II` = list(spouse = "Kathryn",
#' born = "1839-03-28",
#' died = "1865-12-19"),
#' Helen = list(born = "1840-17-08",
#' died = "1845-01-01")
#'
#' )
#' FromListSimple(kingJosephs, nodeName = "Joseph I")
#'
#' @inheritParams CheckNameReservedWord
#' @family as.Node
#'
#' @export
as.Node.list <- function(x, mode = c("simple", "explicit"), nameName = "name", childrenName = "children", nodeName = NULL, interpretNullAsList = FALSE, check = c("check", "no-warn", "no-check"), ...) {
mode <- mode[1]
check <- check[1]
#find my name
if (is.null(nameName) || !(nameName %in% names(x))) {
if (length(nodeName)==0) myName <- "Root"
else myName <- nodeName
} else {
myName <- x[[nameName]]
}
n <- Node$new(as.character(myName), check = check)
#set attributes
#find attributes that need importing
attributes <- names(x)
#capture attributes without names
if (is.null(attributes) && length(x) !=0) {
attributes <- rep("", length(x))
}
field_nums <- seq_along(x)
unnamed_attributes <- attributes == "" & !vapply(x, is.list, logical(1))
#exclude nameName
if(!is.null(nameName)) {
field_nums <- field_nums[attributes != nameName]
unnamed_attributes <- unnamed_attributes[attributes != nameName]
attributes <- attributes[attributes != nameName]
}
#exclude childrenName if explicit
if (mode == "explicit") {
field_nums <- field_nums[attributes != childrenName]
unnamed_attributes <- unnamed_attributes[attributes != childrenName]
attributes <- attributes[attributes != childrenName]
}
attributes[unnamed_attributes] <- seq_along(which(unnamed_attributes))
if (check != "no-check") {
fieldNameIsReserved <- (attributes %in% NODE_RESERVED_NAMES_CONST) & !(attributes %in% c(nameName, childrenName))
if (any(fieldNameIsReserved) && (check != "no-warn")) warning(paste0("The following names are data.tree reserved words and will be appended with 2: ", paste(attributes[fieldNameIsReserved], sep = ", "), "." ))
}
for (i in seq_along(field_nums)) {
v <- x[[field_nums[i]]]
if(mode == 'simple' && inherits(v, 'list')) {
#any list is interpreted as child, so don't store
} else {
fieldNm <- attributes[i]
if (fieldNm %in% NODE_RESERVED_NAMES_CONST) fieldNm <- paste0(fieldNm, "2")
n[[fieldNm]] <- v
}
}
#children
if (is.character(x)) return (n)
if (mode == 'simple') {
if (interpretNullAsList) children <- x[vapply(x, function(y) is.list(y) || is.null(y), logical(1))]
else children <- x[vapply(x, is.list, logical(1))]
}
else if (mode == 'explicit') children <- x[[childrenName]]
if (length(children) == 0) return (n)
for (i in 1:length(children)) {
if (any(duplicated(names(children)))) {
childName <- ""
} else if (is.character(children)) {
childName <- children[i]
} else if (!is.null(names(children))) {
childName <- names(children)[i]
} else {
childName <- ""
}
if (nchar(childName) == 0) childName <- i
child <- children[[i]]
childNode <- as.Node.list(child, mode, nameName, childrenName, nodeName = childName, interpretNullAsList = interpretNullAsList, check = check, ...)
n$AddChildNode(childNode)
}
return (n)
}
#' @rdname as.Node.list
#'
#' @param explicitList A \code{list} in which children are in a separate nested list called \code{childrenName}.
#'
#' @export
FromListExplicit <- function(explicitList, nameName = "name", childrenName = "children", nodeName = NULL, check = c("check", "no-warn", "no-check")) {
as.Node.list(explicitList, mode = "explicit", nameName = nameName, childrenName = childrenName, nodeName = nodeName, check = check)
}
#' @rdname as.Node.list
#'
#' @param simpleList A \code{list} in which children are stored as nested list alongside other attributes. Any list is
#' interpreted as a child \code{Node}
#'
#' @export
FromListSimple <- function(simpleList, nameName = "name", nodeName = NULL, interpretNullAsList = FALSE, check = c("check", "no-warn", "no-check")) {
as.Node.list(simpleList, mode = "simple", nameName = nameName, nodeName = nodeName, interpretNullAsList = interpretNullAsList, check = check)
}
#' Convert a \code{data.tree} structure to a list-of-list structure
#'
#' @param x The Node to convert
#' @param mode How the list is structured. "simple" (the default) will add children directly as nested lists.
#' "explicit" puts children in a separate nested list called \code{childrenName}
#' @param unname If TRUE, and if \code{mode} is "explicit", then the nested children list will not have named arguments. This
#' can be useful e.g. in the context of conversion to JSON, if you prefer the children to be
#' an array rather than named objects.
#' @param nameName The name that should be given to the name element
#' @param childrenName The name that should be given to the children nested list
#' @param rootName The name of the node. If provided, this overrides \code{Node$name}
#' @param keepOnly A character vector of attributes to include in the result. If \code{NULL} (the default), all attributes are kept.
#' @param ... Additional parameters passed to \code{as.list.Node}
#'
#' @examples
#' data(acme)
#'
#' str(ToListSimple(acme))
#' str(ToListSimple(acme, keepOnly = "cost"))
#'
#' str(ToListExplicit(acme))
#' str(ToListExplicit(acme, unname = TRUE))
#' str(ToListExplicit(acme, unname = TRUE, nameName = "id", childrenName = "descendants"))
#'
#' @inheritParams Prune
#'
#' @export
as.list.Node <- function(x,
mode = c("simple", "explicit"),
unname = FALSE,
nameName = ifelse(unname, "name", ""),
childrenName = 'children',
rootName = '',
keepOnly = NULL,
pruneFun = NULL,
...) {
mode <- mode[1]
self <- x
res <- list()
myname <- if (nchar(rootName) != 0) rootName else x$name
if (nchar(nameName) != 0 || nchar(rootName) != 0 || isRoot(x)) {
l_nameName <- nameName
if (nchar(nameName) == 0) l_nameName <- "name"
res[l_nameName] <- myname
}
attributes <- self$attributes
attributes <- attributes[!is.function(attributes) && !is.environment(attributes)]
if (!is.null(keepOnly) & !all(is.na(attributes))) attributes <- attributes[attributes %in% keepOnly]
for (attributeName in attributes) res[[attributeName]] <- self[[attributeName]]
if (!self$isLeaf) {
children <- self$children
if (length(pruneFun) > 0) {
filter <- unlist(lapply(children, pruneFun))
children <- children[filter]
}
kids <- lapply(children, FUN = function(x) as.list.Node(x, mode, unname, nameName, childrenName, keepOnly = keepOnly, pruneFun = pruneFun, ...))
if (mode == "explicit") {
res[[childrenName]] <- kids
if (unname) res[[childrenName]] <- unname(res[[childrenName]])
} else if (mode == "simple") {
res <- c(res, kids)
} else {
stop(paste0("Mode ", mode, " unknown"))
}
}
return(res)
}
#' @rdname as.list.Node
#'
#' @export
ToListSimple <- function(x, nameName = "name", pruneFun = NULL, ...) {
as.list.Node(x, mode = "simple", nameName = nameName, pruneFun = pruneFun, ...)
}
#' @rdname as.list.Node
#'
#'
#' @export
ToListExplicit <- function(x, unname = FALSE, nameName = ifelse(unname, "name", ""), childrenName = 'children', pruneFun = NULL, ...) {
as.list.Node(x, mode = "explicit", unname = unname, nameName = nameName, childrenName = childrenName, pruneFun = pruneFun, ...)
}
================================================
FILE: R/node_conversion_party.R
================================================
#' Convert a a \code{SplitNode} from the party package to a \code{data.tree} structure.
#'
#' @param x The BinaryTree
#' @param ... additional arguments (unused)
#'
#' @examples
#' library(party)
#' airq <- subset(airquality, !is.na(Ozone))
#' airct <- ctree(Ozone ~ ., data = airq,
#' controls = ctree_control(maxsurrogate = 3))
#'
#' tree <- as.Node(airct)
#' tree
#'
#' print(tree,
#' "label",
#' criterion = function(x) round(x$criterion$maxcriterion, 3),
#' statistic = function(x) round(max(x$criterion$statistic), 3)
#' )
#'
#' FindNode(tree, 6)$path
#'
#'
#' @export
#'
as.Node.BinaryTree <- function(x, ...) {
CreateNodeFromSplittingNode(x@tree)
}
CreateNodeFromSplittingNode <- function(splittingNode, left = TRUE) {
node <- Node$new(splittingNode$nodeID,
weights = splittingNode$weights,
criterion = splittingNode$criterion,
psplit = splittingNode$psplit,
ssplit = splittingNode$ssplit,
label = GetSplittingNodeLabel(splittingNode, left))
if (!splittingNode$terminal) {
node$AddChildNode( CreateNodeFromSplittingNode(splittingNode$left) )
node$AddChildNode( CreateNodeFromSplittingNode(splittingNode$right, left = FALSE) )
}
return (node)
}
GetSplittingNodeLabel <- function(splittingNode, left) {
if( splittingNode$terminal ) {
paste0("weights = ", sum(splittingNode$weights))
} else {
as.character.orderedSplit(splittingNode$psplit, left)
}
}
as.character.orderedSplit <- function(x, left = TRUE, ...)
{
if (!is.null(attr(x$splitpoint, "levels"))) {
sp <- attr(x$splitpoint, "levels")[x$splitpoint]
}
else {
sp <- x$splitpoint
}
if (!is.null(x$toleft))
left <- as.logical(x$toleft) == left
if (left) {
res <- paste0(x$variableName, " <= ", sp)
}
else {
res <- paste0(x$variableName, " > ", sp)
}
return (res)
}
#' Convert a a \code{party} from the partykit package to a \code{data.tree} structure.
#'
#' @param x The party object
#' @param ... other arguments (unused)
#'
#' @examples
#' library(partykit)
#' data("WeatherPlay", package = "partykit")
#' ### splits ###
#' # split in overcast, humidity, and windy
#' sp_o <- partysplit(1L, index = 1:3)
#' sp_h <- partysplit(3L, breaks = 75)
#' sp_w <- partysplit(4L, index = 1:2)
#'
#' ## query labels
#' character_split(sp_o)
#'
#' ### nodes ###
#' ## set up partynode structure
#' pn <- partynode(1L, split = sp_o, kids = list(
#' partynode(2L, split = sp_h, kids = list(
#' partynode(3L, info = "yes"),
#' partynode(4L, info = "no"))),
#' partynode(5L, info = "yes"),
#' partynode(6L, split = sp_w, kids = list(
#' partynode(7L, info = "yes"),
#' partynode(8L, info = "no")))))
#' pn
#' ### tree ###
#' ## party: associate recursive partynode structure with data
#' py <- party(pn, WeatherPlay)
#' tree <- as.Node(py)
#'
#' print(tree,
#' "splitname",
#' count = function(node) nrow(node$data),
#' "splitLevel")
#'
#' SetNodeStyle(tree,
#' label = function(node) paste0(node$name, ": ", node$splitname),
#' tooltip = function(node) paste0(nrow(node$data), " observations"),
#' fontname = "helvetica")
#' SetEdgeStyle(tree,
#' arrowhead = "none",
#' label = function(node) node$splitLevel,
#' fontname = "helvetica",
#' penwidth = function(node) 12 * nrow(node$data)/nrow(node$root$data),
#' color = function(node) {
#' paste0("grey",
#' 100 - as.integer( 100 * nrow(node$data)/nrow(node$root$data))
#' )
#' }
#' )
#' Do(tree$leaves,
#' function(node) {
#' SetNodeStyle(node,
#' shape = "box",
#' color = ifelse(node$splitname == "yes", "darkolivegreen4", "lightsalmon4"),
#' fillcolor = ifelse(node$splitname == "yes", "darkolivegreen1", "lightsalmon"),
#' style = "filled,rounded",
#' penwidth = 2
#' )
#' }
#' )
#'
#' plot(tree)
#'
#'
#' @export
as.Node.party <- function(x, ...) {
tree <- FromParty(x, x$node)
tree$Do(function(node) node$splitLevel <- node$parent$splitlevels[node$position], filterFun = isNotRoot)
return (tree)
}
FromParty <- function(party, partynode) {
stopifnot(inherits(party, "party"))
node <- Node$new(partynode$id)
for (childnode in partynode$kids) {
childid <- childnode$id
childparty <- party[[as.character(childid)]]
node$AddChildNode(FromParty(childparty, childnode))
}
node$data <- party$data
node$fitted <- party$fitted
node$partyinfo <- party$info
node$nodeinfo <- partynode$info
node$terms <- party$terms
node$split <- partynode$split
formatInfo <- partykit::formatinfo_node(partynode)
if (length(partynode) > 0) {
csplit <- partykit::character_split(partynode$split, party$data)
node$splitlevels <- csplit$levels
node$splitname <- csplit$name
} else if (identical(nchar(formatInfo) > 0, TRUE)) {
node$splitname <- formatInfo
}
return (node)
}
================================================
FILE: R/node_conversion_rpart.R
================================================
#' Convert an \code{\link{rpart}} object to a \code{data.tree} structure
#'
#' @param x the \code{rpart} object to be converted
#' @param digits the number of digits to be used for numeric values in labels
#' @param use.n logical. Add cases to labels, see \code{\link{text.rpart}} for further
#' information
#' @param ... any other argument to be passed to generic sub implementations
#'
#' @return a \code{data.tree} object. The tree contains a field \code{rpart.id} which
#' references back to the original node id in the row names of the \code{rpart} object.
#' @export
#'
#' @examples
#' if (require(rpart)) {
#' fit <- rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)
#' as.Node(fit)
#' }
#' @family as.Node
as.Node.rpart <- function(x,
digits = getOption("digits") - 3,
use.n = FALSE,
...) {
frame <- x$frame
ylevels <- attr(x, "ylevels")
nodes <- as.numeric(rownames(frame))
leaves <- frame$var == "<leaf>"
leaf_labels <- x$functions$text(
yval = if (is.null(frame$yval2)) frame$yval[leaves] else frame$yval2[leaves, ],
dev = frame$dev[leaves],
wt = frame$wt[leaves],
ylevel = ylevels,
digits = digits,
n = frame$n[leaves],
use.n = use.n)
node_labels <- setNames(c(labels(x)[which(!leaves) + 1L],
leaf_labels),
c(nodes[!leaves], nodes[leaves]))
network_df <- data.frame(from = node_labels[as.character(floor(nodes[-1L] / 2L))],
to = node_labels[as.character(nodes[-1L])],
rpart.id = nodes[-1L])
tree <- FromDataFrameNetwork(network_df)
tree$rpart.id <- nodes[1L]
tree
}
================================================
FILE: R/node_methods.R
================================================
#
# These are the methods that would normally sit on Node
# However, to reduce the memory footprint of the Node object,
# we only support traditional R methods.
# The first argument of all these methods is node
#' Print a \code{Node} in a human-readable fashion.
#'
#' @param x The Node
#' @param ... Node attributes to be printed. Can be either a character (i.e. the name of a Node field),
#' a Node method, or a function taking a Node as a single argument. See \code{Get} for details on
#' the meaning of \code{attribute}.
#' @param pruneMethod The method can be used to prune for printing in a simple way. If NULL, the entire tree is displayed. If
#' "simple", then only the first \code{limit} nodes are displayed. If "dist", then Nodes are removed
#' everywhere in the tree, according to their level. If pruneFun is provided, then pruneMethod is ignored.
#' @param limit The maximum number of nodes to print. Can be \code{NULL} if the
#' entire tree should be printed.
#' @param row.names If \code{TRUE} (default), then the row names are printed out. Else, they are not.
#'
#' @inheritParams ToDataFrameTree
#'
#' @examples
#' data(acme)
#' print(acme, "cost", "p")
#' print(acme, "cost", probability = "p")
#' print(acme, expectedCost = function(x) x$cost * x$p)
#' do.call(print, c(acme, acme$attributesAll))
#'
#' tree <- CreateRegularTree(4, 5)
#' # print entire tree:
#' print(tree, pruneMethod = NULL)
#' # print first 20 nodes:
#' print(tree, pruneMethod = "simple", limit = 20)
#' # print 20 nodes, removing leafs first:
#' print(tree, pruneMethod = "dist", limit = 20)
#' # provide your own pruning function:
#' print(tree, pruneFun = function(node) node$position != 2)
#'
#'
#' @export
print.Node <- function(x, ..., pruneMethod = c("simple", "dist", NULL), limit = 100, pruneFun = NULL, row.names = T) {
if (length(pruneFun) > 0) pruneMethod <- NULL
pruneMethod <- pruneMethod[1]
if (length(pruneMethod) > 0 && length(limit) > 0) {
if (pruneMethod == "simple") {
x <- PrintPruneSimple(x, limit = limit)
} else if (pruneMethod == "dist") {
x <- PrintPruneDist(x, limit = limit)
} else {
stop (paste0("Unknown pruneMethod ", pruneMethod, "!"))
}
} else if(!isRoot(x)) {
#clone s.t. x is root (for pretty level names)
x <- Clone(x, attributes = TRUE)
x$parent <- NULL
}
df <- ToDataFrameTree(x, format = TRUE, ..., pruneFun = pruneFun)
print(df, na.print = "", row.names = row.names)
}
#' Aggregate child values of a \code{Node}, recursively.
#'
#' The \code{Aggregate} method lets you fetch an attribute from a \code{Node}'s children, and then aggregate them
#' using \code{aggFun}. For example, you can aggregate cost by summing costs of child \code{Nodes}. This is especially useful in the
#' context of tree traversal, when using post-order traversal mode.
#'
#' As with \code{\link{Get}}, the attribute can be a field, a method or a function. If the attribute on a child
#' is \code{NULL}, \code{Aggregate} is called recursively on its children.
#'
#' @param node the \code{Node} on which to aggregate
#' @param aggFun the aggregation function to be applied to the children's \code{attributes}
#' @param ... any arguments to be passed on to attribute (in case it's a function)
#'
#' @inheritParams Get
#'
#' @examples
#' data(acme)
#'
#' #Aggregate on a field
#' Aggregate(acme, "cost", sum)
#'
#' #This is the same as:
#' HomeRolledAggregate <- function(node) {
#' sum(sapply(node$children, function(child) {
#' if (!is.null(child$cost)) child$cost
#' else HomeRolledAggregate(child)
#' }))
#' }
#' HomeRolledAggregate(acme)
#'
#' #Aggregate using Get
#' print(acme, "cost", minCost = acme$Get(Aggregate, "cost", min))
#'
#' #use Aggregate with a function:
#' Aggregate(acme, function(x) x$cost * x$p, sum)
#'
#' #cache values along the way
#' acme$Do(function(x) x$cost <- Aggregate(x, "cost", sum), traversal = "post-order")
#' acme$IT$cost
#'
#' @seealso \code{\link{Node}}
#'
#' @export
Aggregate = function(node,
attribute,
aggFun,
...) {
if("cacheAttribute" %in% names(list(...))) stop("cacheAttribute not supported anymore! Please use Do instead.")
if (isLeaf(node)) return ( GetAttribute(node, attribute, ...) )
values <- sapply(node$children,
function(x) {
v <- GetAttribute(x, attribute, format = identity, ...)
if (length(v) > 0 && !any(is.na(v))) return(v)
Aggregate(x, attribute, aggFun, ...)
})
result <- unname(aggFun(values))
return (result)
}
#' Cumulate values among siblings
#'
#' For example, you can sum up values of siblings before
#' this \code{Node}.
#'
#' @param node The node on which we want to cumulate
#'
#' @inheritParams Aggregate
#' @inheritParams Get
#'
#' @examples
#' data(acme)
#' acme$Do(function(x) x$cost <- Aggregate(x, "cost", sum), traversal = "post-order")
#' acme$Do(function(x) x$cumCost <- Cumulate(x, "cost", sum))
#' print(acme, "cost", "cumCost")
#'
#' @export
Cumulate = function(node, attribute, aggFun, ...) {
if ("cacheAttribute" %in% names(list(...))) stop("cacheAttribute not supported anymore! Please use Do instead.")
if (isRoot(node)) return (GetAttribute(node, attribute))
pos <- node$position
nodes <- node$parent$children[1:pos]
res <- aggFun(Get(nodes, attribute))
return (res)
}
#' Clone a tree (creates a deep copy)
#'
#' The method also clones object attributes (such as the formatters), if desired.
#' If the method is called on a non-root, then the parent relationship is not cloned,
#' and the resulting \code{\link{Node}} will be a root.
#'
#' @param node the root node of the tree or sub-tree to clone
#' @param attributes if FALSE, then R class attributes (e.g. formatters and grViz styles)
#' are not cloned. This makes the method faster.
#' @return the clone of the tree or sub-tree
#'
#' @examples
#' data(acme)
#' acmeClone <- Clone(acme)
#' acmeClone$name <- "New Acme"
#' # acmeClone does not point to the same reference object anymore:
#' acme$name
#'
#' #cloning a subtree
#' data(acme)
#' itClone <- Clone(acme$IT)
#' itClone$isRoot
#'
#'
#' @inheritParams Prune
#'
#' @seealso SetFormat
#'
#' @export
Clone <- function(node, pruneFun = NULL, attributes = FALSE) {
.Clone(node, pruneFun, attributes)
}
.Clone <- function(node, pruneFun = NULL, attributes = FALSE, firstCall = TRUE) {
myclone <- node$clone()
if (attributes) attributes(myclone) <- attributes(node)
if (!is.null(pruneFun) && length(node$children) > 0) {
keep <- sapply(node$children, pruneFun)
children <- node$children[keep]
rm(list = names(node$children)[!keep], envir = myclone)
} else children <- node$children
myclone$children <- lapply(children, function(x) .Clone(x, pruneFun, attributes, firstCall = FALSE))
for (child in myclone$children) {
myclone[[child$name]] <- child
child$parent <- myclone
}
if (length(myclone$children) == 0) myclone$children <- NULL
if (firstCall) myclone$parent <- NULL #myclone$RemoveAttribute("parent", stopIfNotAvailable = FALSE)
return (myclone)
}
#' Navigate to another node by relative path.
#'
#' @usage Navigate(node, path)
#'
#' @param node The starting \code{\link{Node}} to navigate
#' @param path A string or a character vector describing the path to navigate
#'
#' @details The \code{path} is always relative to the \code{node}. Navigation
#' to the parent is defined by \code{..}, whereas navigation to a child
#' is defined via the child's name.
#' If path is provided as a string, then the navigation steps are separated
#' by '/'.
#'
#' @examples
#' data(acme)
#' Navigate(acme$Research, "../IT/Outsource")
#' Navigate(acme$Research, c("..", "IT", "Outsource"))
#'
#' @seealso \code{\link{Climb}}
#'
#' @export
Navigate <- function(node, path) {
if (length(path) == 1) path <- strsplit(path, "/", fixed = TRUE)[[1]]
for (nxt in path) {
if (identical("..", nxt)) {
node <- node$parent
} else if (identical(".", nxt)) {
#don't do anything
} else {
node <- node[[nxt]]
}
}
return (node)
}
#' Climb a tree from parent to children, by provided criteria.
#'
#'
#' This method lets you climb the tree, from crutch to crutch. On each \code{Node}, the
#' \code{Climb} finds the first child having attribute value equal to the the provided argument.
#'
#' @usage #node$Climb(...)
#' Climb(node, ...)
#'
#'
#' @param node The root \code{\link{Node}} of the tree or subtree to climb
#' @param ... an attribute-value pairlist to be searched. For brevity, you can also provide a character vector to search for names.
#' @return the \code{Node} having path \code{...}, or \code{NULL} if such a path does not exist
#'
#' @examples
#' data(acme)
#'
#' #the following are all equivalent
#' Climb(acme, 'IT', 'Outsource')
#' Climb(acme, name = 'IT', name = 'Outsource')
#' Climb(acme, 'IT')$Climb('Outsource')
#' Navigate(acme, path = "IT/Outsource")
#'
#' Climb(acme, name = 'IT')
#'
#' Climb(acme, position = c(2, 1))
#' #or, equivalent:
#' Climb(acme, position = 2, position = 1)
#' Climb(acme, name = "IT", cost = 250000)
#'
#' tree <- CreateRegularTree(5, 2)
#' tree$Climb(c("1", "1"), position = c(2, 2))$path
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Navigate}}
#'
#' @export
Climb <- function(node, ...) {
path <- list(...)
if (length(path) == 0) {
return (node)
} else {
#convert args to standard
#e.g. id = (3, 5), name = "myname"
#to
# id = 3, id = 5, name = "mynam"
# path <- list(id = c(3, 5), "myname", c("bla", "blo"))
# path <- list(id = 3, id = 5, name = "myname")
# path <- c("IT")
mpath <- NULL
for (i in 1:length(path)) names(path[[i]]) <- rep(names(path)[i], length(path[[i]]))
for (i in 1:length(path)) mpath <- c(mpath, as.list(path[[i]]))
attribute <- names(mpath)[[1]]
if (length(attribute) == 0 || is.na(attribute) || nchar(attribute) == 0) attribute <- "name"
value <- mpath[[1]]
if (attribute == "name") child <- node[[value]]
else {
getA <- Get(node$children, attribute)
child <- node$children[getA == value][[1]]
}
if (is.null(child)) {
return (NULL)
} else if (length(mpath) == 1) {
return (child)
} else {
return (do.call(Climb, c(node = child, mpath[-1])))
}
}
}
#' Find a node by name in the (sub-)tree
#'
#' Scans the entire sub-tree spanned by \code{node} and returns the first \code{\link{Node}}
#' having the \code{name} specified. This is mainly useful for trees whose name is unique.
#' If \code{\link{AreNamesUnique}} is \code{FALSE}, i.e. if there is more than one \code{Node}
#' called \code{name} in the tree, then it is undefined which one will be returned.
#' Also note that this method is not particularly fast. See examples for a faster way to
#' index large trees, if you need to do multiple searches. See \code{\link{Traverse}} if
#' you need to find multiple \code{Nodes}.
#'
#' @param node The root \code{Node} of the tree or sub-tree to search
#' @param name The name of the \code{Node} to be returned
#'
#' @return The first \code{Node} whose name matches, or \code{NULL} if no such \code{Node} is
#' found.
#'
#' @examples
#' data(acme)
#' FindNode(acme, "Outsource")
#'
#' #re-usable hashed index for multiple searches:
#' if(!AreNamesUnique(acme)) stop("Hashed index works for unique names only!")
#' trav <- Traverse(acme, "level")
#' names(trav) <- Get(trav, "name")
#' nameIndex <- as.environment(trav)
#' #you could also use hash from package hash instead!
#' #nameIndex <- hash(trav)
#' nameIndex$Outsource
#' nameIndex$IT
#'
#'
#' @seealso AreNamesUnique, Traverse
#'
#' @export
FindNode <- function(node, name) {
trav <- Traverse(node, filterFun = function(x) x$name == name)
if (length(trav) == 0) return(NULL)
return(trav[[1]])
}
#' Find the distance between two nodes of the same tree
#'
#' The distance is measured as the number of edges that
#' need to be traversed to reach node2 when starting
#' from node1.
#'
#' @param node1 the first node in the tree
#' @param node2 the second node in the same tree
#'
#' @examples
#' data(acme)
#' Distance(FindNode(acme, "Outsource"), FindNode(acme, "Research"))
#'
#' @export
Distance <- function(node1, node2) {
if(!identical(node1$root, node2$root)) stop("node1 and node2 must be in same tree!")
path1 <- node1$path
path2 <- node2$path
i <- 1
maxi <- min(node1$level, node2$level)
while (path1[i] == path2[i] && i <= maxi) i <- i + 1
distance <- length(path1) + length(path2) - 2 * (i - 1)
return (distance)
}
#' Get an attribute from a Node.
#'
#' @param node The \code{\link{Node}} from which the \code{attribute} should be fetched.
#' @param nullAsNa If TRUE (the default), then NULL is returned as NA. Otherwise it is returned as NULL.
#'
#'
#' @inheritParams Get
#'
#' @examples
#' data(acme)
#' GetAttribute(acme$IT$Outsource, "cost")
#'
#' @export
GetAttribute <- function(node, attribute, ..., format = FALSE, inheritFromAncestors = FALSE, nullAsNa = TRUE) {
# for backwards compatibility:
if (is.null(format)) format <- TRUE
if (is.function(attribute)) {
#function
v <- attribute(node, ...)
} else if(is.character(attribute) && length(attribute) == 1) {
#property
v <- node[[attribute]]
if (is.function(v)) {
if (is.null(formals(v))) v <- v()
else if (names(formals(v))[[1]] == "self") v <- v(self = node, ...) #allow storing functions whose first arg is self
else v <- v(...)
}
} else {
stop("attribute must be a function, the name of a public property, or the name of method")
}
if (is.null(v) && inheritFromAncestors && !isRoot(node)) {
v <- GetAttribute(node$parent, attribute,
...,
format = format,
inheritFromAncestors = TRUE,
nullAsNa = FALSE)
}
if (!nullAsNa && is.null(v)) return (NULL)
if (is.null(v)) v <- NA
if(is.logical(format) && format == TRUE && !is.function(attribute)) {
#get default formatter
format <- GetObjectAttribute(node, "formatters")[[attribute]]
}
if (is.function(format)) {
v <- format(v)
}
return (v)
}
GetObjectAttribute <- function(node, name) {
a <- attr(node, name)
##try to speed up by avoiding isRoot call
prnt <- node$parent
if (length(a) > 0 || is.null(prnt)) return (a)
return ( GetObjectAttribute(prnt, name))
}
#' Set a formatter function on a specific node
#'
#' Formatter functions set on a Node act as a default formatter when printing and using
#' the \code{\link{Get}} method. The formatter is inherited, meaning that whenever
#' \code{Get} fetches an attribute from a \code{Node}, it checks on the \code{Node} or
#' on any of its ancestors whether a formatter is set.
#'
#' @param node The node on which to set the formatter
#' @param name The attribute name for which to set the formatter
#' @param formatFun The formatter, i.e. a function taking a value as an input, and formatting
#' returning the formatted value
#'
#' @examples
#' data(acme)
#' acme$Set(id = 1:(acme$totalCount))
#' SetFormat(acme, "id", function(x) FormatPercent(x, digits = 0))
#' SetFormat(Climb(acme, "IT"), "id", FormatFixedDecimal)
#' print(acme, "id")
#' # Calling Get with an explicit formatter will overwrite the default set on the Node:
#' print(acme, id = acme$Get("id", format = function(x) paste0("id:", x)))
#'
#' # Or, to avoid formatters, even though you set them on a Node:
#' print(acme, id = acme$Get("id", format = identity))
#'
#'
#' @seealso Get
#' @seealso print.Node
#'
#' @export
SetFormat <- function(node, name, formatFun) {
if (length(attr(node, "formatters")) == 0) attr(node, "formatters") <- list()
attr(node, "formatters")[[name]] <- formatFun
}
#' Test whether all node names are unique.
#'
#' This can be useful for some conversions.
#' @param node The root \code{Node} of the \code{data.tree} structure to test
#'
#' @return \code{TRUE} if all \code{Node$name == TRUE} for all nodes in the tree
#'
#' @examples
#' data(acme)
#' AreNamesUnique(acme)
#' acme$name <- "IT"
#' AreNamesUnique(acme)
#'
#' @seealso as.igraph.Node
#' @export
AreNamesUnique <- function(node) {
mynames <- node$Get("name")
all(duplicated(mynames) == FALSE)
}
================================================
FILE: R/node_methods_sideeffect.R
================================================
#
# These are methods on Node which have side effects, meaning they
# change a Node object or any of its descendants. To keep the
# memory footprint of the Node object small, and to be able to
# document them, they are implemented in traditional R style,
# and their OO part is only a wrapper around the methods here.
#
# Requirements for side effect methods
# 1. they are implement here
# 2. their OO part in Node.R is a wrapper
# 3. the Node documentation links to here
# 4. the methods here are not exported
# 5. the methods here are marked as internal, so a to have roxygen generate documentation
#
#' Sort children of a \code{Node} or an entire \code{data.tree} structure
#'
#' You can sort with respect to any argument of the tree. But note that sorting has
#' side-effects, meaning that you modify the underlying, original data.tree object structure.
#'
#' @usage Sort(node, attribute, ..., decreasing = FALSE, recursive = TRUE)
#'
#' @param node The node whose children are to be sorted
#' @param ... any parameters to be passed on the the attribute (in case it's a method or a
#' function)
#' @param decreasing sort order
#' @param recursive if \code{TRUE}, Sort will be called recursively on the \code{Node}'s children.
#' This allows sorting an entire tree.
#'
#' @inheritParams Get
#'
#' @return Returns the node on which Sort is called, invisibly. This can be useful to chain Node methods.
#'
#' @examples
#' data(acme)
#' acme$Do(function(x) x$totalCost <- Aggregate(x, "cost", sum), traversal = "post-order")
#' Sort(acme, "totalCost", decreasing = FALSE)
#' print(acme, "totalCost")
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Revert}}
#' @export
Sort <- function(node, attribute, ..., decreasing = FALSE, recursive = TRUE) {
if (node$isLeaf) return()
ChildL <- sapply(node$children, function(x) GetAttribute(x, attribute, ...))
names(ChildL) <- names(node$children)
node$children <- node$children[names(sort(ChildL, decreasing = decreasing, na.last = TRUE))]
if (recursive) for(child in node$children) Sort(child, attribute, ..., decreasing = decreasing, recursive = recursive)
invisible (node)
}
#' Reverts the sort order of a \code{Node}'s children.
#'
#' @usage Revert(node, recursive = TRUE)
#'
#' @param node the Node whose childrens' sort order is to be reverted
#' @param recursive If \code{TRUE}, then revert is called recursively on
#' all children.
#'
#' @return returns the Node invisibly (for chaining)
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Sort}}
#' @export
Revert <- function(node, recursive = TRUE) {
pf <- function(x) {
if (recursive) return (TRUE)
else return (x$level <= (node$level + 1))
}
t <- Traverse(node, pruneFun = pf)
Set(t, .tmp = 1:node$totalCount)
Sort(node, ".tmp", decreasing = TRUE, recursive = recursive)
Do(t, function(x) rm(".tmp", envir = x))
invisible (node)
}
#' Prunes a tree.
#'
#' Pruning refers to removing entire subtrees. This function has side-effects, it modifies your data.tree structure!
#'
#' @usage Prune(node, pruneFun)
#'
#' @param node The root of the sub-tree to be pruned
#' @param pruneFun allows providing a prune criteria, i.e. a function taking a \code{Node} as an input, and returning \code{TRUE} or \code{FALSE}.
#' If the pruneFun returns FALSE for a Node, then the Node and its entire sub-tree will not be considered.
#' @return the number of nodes removed
#'
#' @examples
#' data(acme)
#' acme$Do(function(x) x$cost <- Aggregate(x, "cost", sum))
#' Prune(acme, function(x) x$cost > 700000)
#' print(acme, "cost")
#'
#' @seealso \code{\link{Node}}
#'
#' @export
Prune <- function(node, pruneFun) {
return (.Prune(node, pruneFun, TRUE))
}
.Prune <- function(node, pruneFun, isFirstCall = FALSE) {
if (isFirstCall) cnt <- node$totalCount
if ( node$isLeaf) return (0)
for( i in length(node$children):1 ) {
if (length(pruneFun(node$children[[i]]))==0){
stop(paste("pruneFun evaluated on node",
node$children[[i]]$name,
"evaluated to logical(0).",
"Perhaps you should read nullAsNa in GetAttribute's help." ))
} else if ( !pruneFun(node$children[[i]]) ) {
rm(list = names(node$children)[i], envir = node)
node$children <- node$children[-i]
}
}
for( child in node$children) {
.Prune(child, pruneFun)
}
if (isFirstCall) return (cnt - node$totalCount)
}
================================================
FILE: R/node_methods_traversal.R
================================================
#' Traverse a tree or a sub-tree
#'
#' Traverse takes the root of a tree or a sub-tree, and "walks" the tree in a specific order. It returns a list of
#' \code{\link{Node}} objects, filtered and pruned by \code{filterFun} and \code{pruneFun}.
#'
#' @param node the root of a tree or a sub-tree that should be traversed
#' @param traversal any of 'pre-order' (the default), 'post-order', 'in-order', 'level', 'ancestor', or a custom function (see details)
#' @param filterFun allows providing a a filter, i.e. a function taking a \code{Node} as an input, and returning \code{TRUE} or \code{FALSE}.
#' Note that if filter returns \code{FALSE}, then the node will be excluded from the result (but not the entire subtree).
#'
#' @return a list of \code{Node}s
#'
#' @details
#' The traversal order is as follows. (Note that these descriptions are not precise and complete. They are meant
#' for quick reference only. See the data.tree vignette for a more detailed description).
#' \describe{
#' \item{pre-order}{Go to first child, then to its first child, etc.}
#' \item{post-order}{Go to the first branch's leaf, then to its siblings, and work your way back to the root}
#' \item{in-order}{Go to the first branch's leaf, then to its parent, and only then to the leaf's sibling}
#' \item{level}{Collect root, then level 2, then level 3, etc.}
#' \item{ancestor}{Take a node, then the node's parent, then that node's parent in turn, etc. This ignores the \code{pruneFun} }
#' \item{function}{You can also provide a function, whose sole parameter is a \code{\link{Node}} object. The
#' function is expected to return the node's next node, a list of the node's next nodes, or NULL.}
#' }
#'
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Get}}
#' @seealso \code{\link{Set}}
#' @seealso \code{\link{Do}}
#'
#' @inheritParams Prune
#'
#' @export
Traverse = function(node,
traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
pruneFun = NULL,
filterFun = NULL) {
#traverses in various orders. See http://en.wikipedia.org/wiki/Tree_traversal
nodes <- list()
if(length(traversal) > 1L) {
traversal <- traversal[1L]
}
if(is.function(traversal) || traversal == "pre-order" || traversal == "post-order") {
if (length(pruneFun) == 0 || pruneFun(node)) {
if (is.function(traversal)) {
children <- traversal(node)
if (is(children, "Node")) children <- list(children)
if (is.null(children)) children <- list()
} else children <- node$children
for(child in children) {
nodes <- c(nodes, Traverse(child, traversal = traversal, pruneFun = pruneFun, filterFun = filterFun))
}
if(length(filterFun) == 0 || filterFun(node)) {
if(is.function(traversal) || traversal == "pre-order") nodes <- c(node, nodes)
else nodes <- c(nodes, node)
}
}
} else if(traversal == "in-order") {
if(!node$isBinary) stop("traversal in-order valid only for binary trees")
if(length(pruneFun) == 0 || pruneFun(node)) {
if(!node$isLeaf) {
n1 <- Traverse(node$children[[1]], traversal = traversal, pruneFun = pruneFun, filterFun = filterFun)
if(length(filterFun) == 0 || filterFun(node)) n2 <- node
else n2 <- list()
n3 <- Traverse(node$children[[2]], traversal = traversal, pruneFun = pruneFun, filterFun = filterFun)
nodes <- c(n1, n2, n3)
} else {
if(length(filterFun) == 0 || filterFun(node)) n2 <- node
else n2 <- list()
nodes <- c(nodes, n2)
}
}
} else if (traversal == "ancestor") {
if (!isRoot(node)) {
nodes <- Traverse(node$parent, traversal = traversal, pruneFun = pruneFun, filterFun = filterFun)
}
if(length(filterFun) == 0 || filterFun(node)) {
nodes <- c(node, nodes)
}
} else if (traversal == "level") {
nodes <- Traverse(node, filterFun = filterFun, pruneFun = pruneFun)
if (length(nodes) > 0) nodes <- nodes[order(Get(nodes, function(x) x$level))]
} else {
stop("traversal must be pre-order, post-order, in-order, ancestor, or level")
}
return (nodes)
}
#' Traverse a Tree and Collect Values
#'
#' The \code{Get} method is one of the most important ones of the \code{data.tree} package. It lets you traverse a tree
#' and collect values along the way. Alternatively, you can call a method or a function on each \code{\link{Node}}.
#'
#' @usage
#' # OO-style:
#' #node$Get(attribute,
#' # ...,
#' # traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
#' # pruneFun = NULL,
#' # filterFun = NULL,
#' # format = FALSE,
#' # inheritFromAncestors = FALSE)
#'
#' # traditional:
#' Get(nodes,
#' attribute,
#' ...,
#' format = FALSE,
#' inheritFromAncestors = FALSE,
#' simplify = c(TRUE, FALSE, "array", "regular"))
#'
#'
#' @param nodes The nodes on which to perform the Get (typically obtained via \code{\link{Traverse}})
#' @param attribute determines what is collected. The \code{attribute} can be
#' \itemize{
#' \item a.) the name of a \bold{field} or a \bold{property/active} of each \code{Node} in the tree, e.g. \code{acme$Get("p")} or \code{acme$Get("position")}
#' \item b.) the name of a \bold{method} of each \code{Node} in the tree, e.g. \code{acme$Get("levelZeroBased")}, where e.g. \code{acme$levelZeroBased <- function() acme$level - 1}
#' \item c.) a \bold{function}, whose first argument must be a \code{Node} e.g. \code{acme$Get(function(node) node$cost * node$p)}
#' }
#' @param ... in case the \code{attribute} is a function or a method, the ellipsis is passed to it as additional arguments.
#' @param format if \code{FALSE} (the default), no formatting is being used. If \code{TRUE}, then the first formatter (if any) found along the ancestor path is being used for formatting
#' (see \code{\link{SetFormat}}). If \code{format} is a function, then the collected value is passed to that function, and the result is returned.
#' @param inheritFromAncestors if \code{TRUE}, then the path above a \code{Node} is searched to get the \code{attribute} in case it is NULL.
#' @param simplify same as \code{\link{sapply}}, i.e. TRUE, FALSE or "array". Additionally, you can specify "regular" if
#' each returned value is of length > 1, and equally named. See below for an example.
#'
#' @return a vector containing the \code{atrributes} collected during traversal, in traversal order. \code{NULL} is converted
#' to NA, such that \code{length(Node$Get) == Node$totalCount}
#'
#'
#' @examples
#' data(acme)
#' acme$Get("level")
#' acme$Get("totalCount")
#'
#'
#' acme$Get(function(node) node$cost * node$p,
#' filterFun = isLeaf)
#'
#' #This is equivalent:
#' nodes <- Traverse(acme, filterFun = isLeaf)
#' Get(nodes, function(node) node$cost * node$p)
#'
#'
#' #simplify = "regular" will preserve names
#' acme$Get(function(x) c(position = x$position, level = x$level), simplify = "regular")
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Set}}
#' @seealso \code{\link{Do}}
#' @seealso \code{\link{Traverse}}
#'
#' @import methods
#'
#' @export
Get = function(nodes,
attribute,
...,
format = FALSE,
inheritFromAncestors = FALSE,
simplify = c(TRUE, FALSE, "array", "regular")) {
if (length(nodes) == 0) return(NULL)
if (!is(nodes, "list")) stop("nodes must be a list of Node objects!")
simplify <- simplify[1]
nodes <- unname(nodes)
if (simplify == "regular") {
regular = TRUE
simplify = FALSE
} else regular = FALSE
res <- sapply(nodes,
function(x) GetAttribute(x,
attribute,
...,
format = format,
inheritFromAncestors = inheritFromAncestors),
simplify = simplify
)
if (is.character(attribute) && attribute == "name") {
names(res) <- res
} else {
if(is.null(dim(res))){
names(res) <- Get(nodes, "name")
} else {
if(is.null(dimnames(res)))
dimnames(res) <- list()
dimnames(res)[[length(dim(res))]] <- Get(nodes, "name")
}
}
if (regular) {
res <- do.call(cbind, res)
}
return (res)
}
#' Executes a function on a set of nodes
#'
#' @usage
#' # OO-style:
#' # node$Do(fun,
#' # ...,
#' # traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
#' # pruneFun = NULL,
#' # filterFun = NULL)
#'
#' # traditional:
#' Do(nodes, fun, ...)
#'
#' @param fun the function to execute. The function is expected to be either a Method, or to take a
#' Node as its first argument
#' @param ... any additional parameters to be passed on to fun
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Get}}
#' @seealso \code{\link{Set}}
#' @seealso \code{\link{Traverse}}
#'
#' @inheritParams Get
#'
#' @examples
#' data(acme)
#' traversal <- Traverse(acme)
#' Do(traversal, function(node) node$expectedCost <- node$p * node$cost)
#' print(acme, "expectedCost")
#'
#' @export
Do <- function(nodes,
fun,
...) {
if (length(nodes) == 0) invisible(nodes)
if (!is(nodes, "list")) stop("nodes must be a list of Node objects!")
for (node in nodes) fun(node, ...)
invisible (nodes)
}
#' Traverse a Tree and Assign Values
#'
#' The method takes one or more vectors as an argument. It traverses the tree, whereby the values are picked
#' from the vector. Also available as OO-style method on \code{\link{Node}}.
#'
#' @usage
#' #OO-style:
#' # node$Set(...,
#' # traversal = c("pre-order", "post-order", "in-order", "level", "ancestor"),
#' # pruneFun = NULL,
#' # filterFun = NULL)
#' #traditional:
#' Set(nodes, ...)
#'
#'
#' @param ... each argument can be a vector of values to be assigned. Recycled.
#'
#' @return invisibly returns the nodes (useful for chaining)
#'
#' @examples
#' data(acme)
#' acme$Set(departmentId = 1:acme$totalCount, openingHours = NULL, traversal = "post-order")
#' acme$Set(head = c("Jack Brown",
#' "Mona Moneyhead",
#' "Dr. Frank N. Stein",
#' "Eric Nerdahl"
#' ),
#' filterFun = function(x) !x$isLeaf
#' )
#' print(acme, "departmentId", "head")
#'
#' @seealso \code{\link{Node}}
#' @seealso \code{\link{Get}}
#' @seealso \code{\link{Do}}
#' @seealso \code{\link{Traverse}}
#'
#' @inheritParams Get
#'
#' @export
Set <- function(nodes,
...) {
if (length(nodes) == 0) return(nodes)
if (!is(nodes, "list")) stop("nodes must be a list of Node objects!")
args <- list(...)
argsnames <- sapply(substitute(list(...))[-1], deparse)
gargsnames <- names(args)
if (is.null(gargsnames)) gargsnames <- vector(mode = "character", length = length(args))
gargsnames[nchar(gargsnames) == 0] <- argsnames[nchar(gargsnames) == 0]
names(args) <- gargsnames
appFun <- function(x, arg, name) {
x[[name]] <- arg
}
for(nme in names(args)) {
arg <- args[[nme]]
if (length(arg) == 0) arg <- vector("list", 1)
mapply(appFun, nodes, arg, nme)
}
invisible (nodes)
}
================================================
FILE: R/node_plot.R
================================================
#' @rdname ToDiagrammeRGraph
#'
#' @param x The root node of the data.tree structure to plot
#' @inheritParams ToDataFrameNetwork
#' @inheritParams DiagrammeR::render_graph
#'
#' @export
plot.Node <- function(x, ..., direction = c("climb", "descend"), pruneFun = NULL, output = "graph") {
if(!requireNamespace("DiagrammeR", quietly = TRUE)) {
stop(
"Package \"DiagrammeR\" is required to plot a `data.tree::Node`",
"object. Please install it."
)}
graph <- ToDiagrammeRGraph(x, direction, pruneFun)
DiagrammeR::render_graph(graph, output = output, ...)
}
#' Plot a graph, or get a graphviz dot representation of the tree
#'
#' Use these methods to style your graph, and to plot it. The functionality is built around the
#' DiagrammeR package, so for anything that goes beyond simple plotting, it is recommended to read its
#' documentation at http://rich-iannone.github.io/DiagrammeR/docs.html. Note that DiagrammeR is only suggested
#' by data.tree, so `plot` only works if you have installed it on your system.
#'
#' Use \code{SetNodeStyle} and \code{SetEdgeStyle} to define the style of your plot. Use \code{plot} to display a
#' graphical representation of your tree.
#'
#' The most common styles that can be set on the nodes are:
#' \itemize{
#' \item{\code{color}}
#' \item{\code{fillcolor}}
#' \item{\code{fixedsize} true or false}
#' \item{\code{fontcolor}}
#' \item{\code{fontname}}
#' \item{\code{fontsize}}
#' \item{\code{height}}
#' \item{\code{penwidth}}
#' \item{\code{shape} box, ellipse, polygon, circle, box, etc.}
#' \item{\code{style}}
#' \item{\code{tooltip}}
#' \item{\code{width}}
#' }
#' The most common styles that can be set on the edges are:
#' \itemize{
#' \item{\code{arrowhead} e.g. normal, dot, vee}
#' \item{\code{arrowsize}}
#' \item{\code{arrowtail}}
#' \item{\code{color}}
#' \item{\code{dir} forward, back, both, none}
#' \item{\code{fontcolor}}
#' \item{\code{fontname}}
#' \item{\code{fontsize}}
#' \item{\code{headport}}
#' \item{\code{label}}
#' \item{\code{minlen}}
#' \item{\code{penwidth}}
#' \item{\code{tailport}}
#' \item{\code{tooltip}}
#' }
#' A good source to understand the attributes is http://graphviz.org/Documentation.php. Another good source
#' is the DiagrammeR package documentation, or more specifically: http://rich-iannone.github.io/DiagrammeR/docs.html
#'
#' In addition to the standard GraphViz functionality, the \code{data.tree} plotting infrastructure takes advantage
#' of the fact that data.tree structure are always hierarchic. Thus, style attributes are inherited from parents
#' to children on an individual basis. For example, you can set the fontcolor to red on a parent, and then all children
#' will also have red font, except if you specifically disallow inheritance. Labels and tooltips are never inherited.
#'
#' Another feature concerns functions: Instead of setting a fixed value (e.g. \code{SetNodeStyle(acme, label = "Acme. Inc"}),
#' you can set a function (e.g. \code{SetNodeStyle(acme, label = function(x) x$name)}). The function must take a \code{\link{Node}}
#' as its single argument. Together with inheritance, this becomes a very powerful tool.
#'
#' The \code{GetDefaultTooltip} method is a utility method that can be used to print all attributes of a \code{\link{Node}}.
#'
#' There are some more examples in the 'applications' vignette, see \code{vignette('applications', package = "data.tree")}
#'
#' @param root The root \code{\link{Node}} of the data.tree structure to visualize.
#' @param node The \code{\link{Node}} of the data.tree structure on which you would like to set style attributes.
#' @param ... For the SetStyle methods, this can be any stlyeName / value pair. See
#' http://graphviz.org/Documentation.php for details. For the plot.Node generic method, this is not used.
#'
#' @inheritParams Prune
#'
#' @examples
#' data(acme)
#' SetGraphStyle(acme, rankdir = "TB")
#' SetEdgeStyle(acme, arrowhead = "vee", color = "blue", penwidth = 2)
#' #per default, Node style attributes will be inherited:
#' SetNodeStyle(acme, style = "filled,rounded", shape = "box", fillcolor = "GreenYellow",
#' fontname = "helvetica", tooltip = GetDefaultTooltip)
#' SetNodeStyle(acme$IT, fillcolor = "LightBlue", penwidth = "5px")
#' #inheritance can be avoided:
#' SetNodeStyle(acme$Accounting, inherit = FALSE, fillcolor = "Thistle",
#' fontcolor = "Firebrick", tooltip = "This is the accounting department")
#' SetEdgeStyle(acme$Research$`New Labs`,
#' color = "red",
#' label = "Focus!",
#' penwidth = 3,
#' fontcolor = "red")
#' #use Do to set style on specific nodes:
#' Do(acme$leaves, function(node) SetNodeStyle(node, shape = "egg"))
#' plot(acme)
#'
#' #print p as label, where available:
#' SetNodeStyle(acme, label = function(node) node$p)
#' plot(acme)
#'
#' @export
ToDiagrammeRGraph <- function(root, direction = c("climb", "descend"), pruneFun = NULL) {
if(!requireNamespace("DiagrammeR", quietly = TRUE)) {
stop(
"Package \"DiagrammeR\" is required to convert a `data.tree::Node`",
"to a DiagrammeR graph. Please install it."
)}
#get unique node styles defined on tree
ns <- unique(unlist(sapply(root$Get(function(x) attr(x, "nodeStyle"), simplify = FALSE), names)))
# set tmp .id
tr <- Traverse(root, pruneFun = pruneFun)
Set(tr, `.id` = 1:length(tr))
#create nodes df
myargs <- list()
if(!"label" %in% ns) ns <- c(ns, "label")
for (style in ns) {
myargs[[style]] <- Get(tr, function(x) {
myns <- GetStyle(x, style, "node")
if (style == "label" && length(myns) == 0) myns <- x$name
#if (is.null(myns)) myns <- ""
myns
})
}
nodes <- do.call(DiagrammeR::create_node_df, c(n = length(tr), myargs))
## escape quotes in names to avoid problems with the gviz
nodes$label <- gsub("\"", "\\\\\"", nodes$label)
# get unique edge styles
es <- unique(unlist(sapply(root$Get(function(x) attr(x, "edgeStyle"), simplify = FALSE), names)))
myargs <- list()
#see http://stackoverflow.com/questions/19749923/function-factory-in-r
for (style in es) {
myargs[[style]] <- GetEdgeStyleFactory(style)
}
edges <- do.call("ToDataFrameNetwork", c(root, from = function(node) node$parent$`.id`, to = ".id", myargs, direction = list(direction), pruneFun = pruneFun))[,-(1:2)]
if (nrow(edges) > 0) {
edges <- do.call(DiagrammeR::create_edge_df, as.list(edges))
}
graph <- DiagrammeR::create_graph(nodes, edges, attr_theme = NULL)
# global attributes
# (we'd prefer to set the default on the root as graphAttributes, but
# due to a DiagrammeR bug/feature this is not possible). So instead
# repeating styles redundantly
graphAttributes <- attr(root, "graphStyle")
#if (is.null(graphAttributes)) graphAttributes <- ""
#nodeAttributes <- GetDefaultStyles(root, type = "node")
#edgeAttributes <- GetDefaultStyles(root, type = "edge")
nodeAttributes <- NULL
edgeAttributes <- NULL
#graph <- set_global_graph_attrs(graph, "layout", "dot", "graph")
graph <- DiagrammeR::add_global_graph_attrs(
graph,
attr = c(names(graphAttributes), names(nodeAttributes), names(edgeAttributes)),
value = c(graphAttributes, nodeAttributes, edgeAttributes),
attr_type = c(rep('graph', length(graphAttributes)), rep('node', length(nodeAttributes)), rep('edge', length(edgeAttributes)))
)
return (graph)
}
GetEdgeStyleFactory <- function(style) {
style <- force(style)
function(node = node, origNode = node) {
myes <- GetStyle(node, style, "edge")
#if (is.null(myes)) myes <- ""
myes
}
}
#' @param inherit If TRUE, then children will inherit this node's style.
#' Otherwise they inherit from this node's parent. Note that the inherit
#' always applies to the node, i.e. all style attributes of a node and not
#' to a single style attribute.
#'
#' @param keepExisting If TRUE, then style attributes are added to possibly
#' existing style attributes on the node.
#'
#' @rdname ToDiagrammeRGraph
#'
#' @export
SetNodeStyle <- function(node,
inherit = TRUE,
keepExisting = FALSE,
...) {
SetStyle(node, "node", inherit, keepExisting, ...)
}
#' @rdname ToDiagrammeRGraph
#' @export
SetEdgeStyle <- function(node,
inherit = TRUE,
keepExisting = FALSE,
...) {
SetStyle(node, "edge", inherit, keepExisting, ...)
}
SetStyle <- function(node,
type = c("node", "edge"),
inherit = TRUE,
keepExisting = FALSE,
...) {
type <- type[1]
an <- paste0(type, "Style")
ain <- paste0(type, "StyleInherit")
if (keepExisting) {
ll <- attr(node, an)
ll <- c(ll, list(...))
} else ll <- list(...)
attr(node, an) <- ll
attr(node, ain) <- inherit
}
#' @rdname ToDiagrammeRGraph
#' @export
SetGraphStyle <- function(root,
keepExisting = FALSE,
...) {
if (keepExisting) {
ll <- attr(root, "graphStyle")
ll <- c(ll, list(...))
} else ll <- list(...)
attr(root, "graphStyle") <- ll
}
GetStyle <- function(node, styleName, type = c("node", "edge"), origNode = node) {
type <- type[1]
inh <- attr(node, paste0(type, "StyleInherit"))
res <- attr(node, paste0(type, "Style"))[[styleName]]
if (!is.null(res)) {
if (!isRoot(node)) {
if (identical(node, origNode) || (inh && !styleName %in% c("label", "tooltip"))) {# either on myself or inheritable
if (is.function(res)) res <- res(origNode)
return (res)
}
} else {
#root
if (is.function(res)) res <- res(origNode)
return (res)
}
}
#recursion exit criteria
if (isRoot(node)) return (NULL)
#recursion
GetStyle(node$parent, styleName, type, origNode = origNode)
}
GetDefaultStyles <- function(node, type = c("node", "edge")) {
type <- type[1]
node <- node$root
inh <- attr(node, paste0(type, "StyleInherit"))
res <- attr(node, paste0(type, "Style"))
if (!is.null(res) && inh) {
res <- res[!names(res) %in% c("label", "tooltip")]
isFun <- sapply(res, is.function)
res <- res[!isFun]
if (length(res) == 0) return (NULL)
#res <- paste(names(res), paste0("'", res, "'"), sep = " = ", collapse = ", ")
return (res)
} else return (NULL)
}
================================================
FILE: R/register-s3.R
================================================
#' Register a method for a suggested dependency
#'
#' Code copied into data.tree from `vctrs` (authors Wickham H, Henry L,
#' Vaughan D; https://github.com/r-lib/vctrs)
#'
#' Generally, the recommend way to register an S3 method is to use the
#' `S3Method()` namespace directive (often generated automatically be the
#' `@export` roxygen2 tag). However, this technique requires that the generic
#' be in an imported package, and sometimes you want to suggest a package,
#' and only provide a method when that package is loaded. `s3_register()`
#' can be called from your package's `.onLoad()` to dynamically register
#' a method only if the generic's package is loaded. (To avoid taking a
#' dependency on vctrs for this one function, please feel free to copy
#' and paste the function source into your own package.)
#'
#' For R 3.5.0 and later, `s3_register()` is also useful when demonstrating
#' class creation in a vignette, since method lookup no longer always involves
#' the lexical scope. For R 3.6.0 and later, you can achieve a similar effect
#' by using "delayed method registration", i.e. placing the following in your
#' `NAMESPACE` file:
#'
#' ```
#' if (getRversion() >= "3.6.0") {
#' S3method(package::generic, class)
#' }
#' ```
#'
#' @param generic Name of the generic in the form `pkg::generic`.
#' @param class Name of the class
#' @param method Optionally, the implementation of the method. By default,
#' this will be found by looking for a function called `generic.class`
#' in the package environment.
#'
#' Note that providing `method` can be dangerous if you use
#' devtools. When the namespace of the method is reloaded by
#' `devtools::load_all()`, the function will keep inheriting from
#' the old namespace. This might cause crashes because of dangling
#' `.Call()` pointers.
#' @examples
#' # A typical use case is to dynamically register tibble/pillar methods
#' # for your class. That way you avoid creating a hard depedency on packages
#' # that are not essential, while still providing finer control over
#' # printing when they are used.
#'
#' .onLoad <- function(...) {
#' s3_register("pillar::pillar_shaft", "vctrs_vctr")
#' s3_register("tibble::type_sum", "vctrs_vctr")
#' }
#' @keywords internal
# nocov start
s3_register <- function(generic, class, method = NULL) {
stopifnot(is.character(generic), length(generic) == 1)
stopifnot(is.character(class), length(class) == 1)
pieces <- strsplit(generic, "::")[[1]]
stopifnot(length(pieces) == 2)
package <- pieces[[1]]
generic <- pieces[[2]]
caller <- parent.frame()
get_method_env <- function() {
top <- topenv(caller)
if (isNamespace(top)) {
asNamespace(environmentName(top))
} else {
caller
}
}
get_method <- function(method, env) {
if (is.null(method)) {
get(paste0(generic, ".", class), envir = get_method_env())
} else {
method
}
}
method_fn <- get_method(method)
stopifnot(is.function(method_fn))
# Always register hook in case package is later unloaded & reloaded
setHook(
packageEvent(package, "onLoad"),
function(...) {
ns <- asNamespace(package)
# Refresh the method, it might have been updated by `devtools::load_all()`
method_fn <- get_method(method)
registerS3method(generic, class, method_fn, envir = ns)
}
)
# Avoid registration failures during loading (pkgload or regular)
if (!isNamespaceLoaded(package)) {
return(invisible())
}
envir <- asNamespace(package)
# Only register if generic can be accessed
if (exists(generic, envir)) {
registerS3method(generic, class, method_fn, envir = envir)
}
invisible()
}
# nocov end
================================================
FILE: R/release.R
================================================
release_questions <- function() {
c(
"Have you set the date in DESCRIPTION?",
"Have you updated NEWS?",
"Have you verified that the application vignette looks ok?",
"Have you verified that the data.tree vignette looks ok?",
"Have you read the Node documentation ?Node",
"Have you checked that all the reserved words are listed in Node?"
)
}
================================================
FILE: R/util.R
================================================
#' Format a Number as a Percentage
#'
#' This utility method can be used as a format function when converting trees to a \code{data.frame}
#'
#' @param x A number
#' @param digits The number of digits to print
#' @param format The format to use
#' @param ... Any other argument passed to formatC
#' @return A string corresponding to x, suitable for printing
#'
#' @examples
#' data(acme)
#' print(acme, prob = acme$Get("p", format = FormatPercent))
#'
#' @seealso formatC
#' @export
FormatPercent <- function(x, digits = 2, format = "f", ...) {
ifelse(is.null(x) || is.na(x), "", paste(formatC(100 * x, format = format, digits = digits, ...), "%"))
}
#' Format a Number as a Decimal
#'
#' Simple function that can be used as a format function when converting trees to a \code{data.frame}
#'
#' @param x a numeric scalar or vector
#' @param digits the number of digits to print after the decimal point
#' @return A string corresponding to x, suitable for printing
#'
#' @examples
#' data(acme)
#' print(acme, prob = acme$Get("p", format = function(x) FormatFixedDecimal(x, 4)))
#'
#' @export
FormatFixedDecimal <- function(x, digits = 3) {
ifelse(is.null(x) || is.na(x), "", sprintf(paste0("%.",digits, "f"),x))
}
#' Calculates the height of a \code{Node} given the height of the root.
#'
#' This function puts leafs at the bottom (not hanging), and makes edges equally long.
#' Useful for easy plotting with third-party packages, e.g. if you have no specific height
#' attribute, e.g. with \code{\link{as.dendrogram.Node}}, \code{\link{ToNewick}},
#' and \code{\link{as.phylo.Node}}
#'
#' @param node The node
#' @param rootHeight The height of the root
#'
#' @examples
#' data(acme)
#' dacme <- as.dendrogram(acme, heightAttribute = function(x) DefaultPlotHeight(x, 200))
#' plot(dacme, center = TRUE)
#'
#' @export
DefaultPlotHeight <- function(node, rootHeight = 100) {
if (node$isRoot) return ( rootHeight )
if (node$isLeaf) return ( 0 )
h <- DefaultPlotHeight(node$parent, rootHeight) * (1 - 1 / node$height)
return (h)
}
SetHeight2 <- function(node, rootHeight = 100) {
Set(node$leaves, height2 = 1)
node$Do(function(x) x$height2 <- Aggregate(x, "height2", max) + 1, traversal = "post-order", filterFun = isNotLeaf)
node$plotHeight <- rootHeight
node$Do(function(x) x$plotHeight <- x$parent$plotHeight * (1 - 1 / x$height2), filterFun = isNotRoot)
}
#' Create a tree for demo and testing
#'
#' @param height the number of levels
#' @param branchingFactor the number of children per node
#' @param parent the parent node (for recursion)
#'
#' @export
CreateRegularTree <- function(height = 5, branchingFactor = 3, parent = Node$new("1")) {
if (height <= 1) return()
for (i in 1:branchingFactor) {
child <- parent$AddChild(paste(parent$name, i, sep = "."), check = FALSE)
CreateRegularTree(height - 1, branchingFactor, child)
}
return (parent)
}
#' Create a tree for demo and testing
#'
#' @param nodes The number of nodes to create
#' @param root the previous node (for recursion, typically use default value)
#' @param id The id (for recursion)
#'
#' @export
CreateRandomTree <- function(nodes = 100, root = Node$new("1"), id = 1) {
if (nodes == 0) return()
dpth <- root$height
lvl <- sample(1:dpth, 1, rep(1/dpth))
t <- Traverse(root, filterFun = function(x) x$level == lvl)
parent <- sample(t, 1)[[1]]
parent$AddChild(as.character(id + 1), check = FALSE)
CreateRandomTree(nodes - 1, root = root, id = id + 1)
return (root)
}
PrintPruneSimple <- function(x, limit) {
tc <- x$totalCount
toBeCropped <- tc - limit
if (toBeCropped < 1) {
if(!isRoot(x)) {
#clone s.t. x is root (for pretty level names)
x <- Clone(x, attributes = TRUE)
x$parent <- NULL
}
return (x)
}
x$Set(.id = 1:tc)
x$Do(function(x) {
x$.originalTotalCount <- ifelse(x$isLeaf,
1,
sum( sapply(x$children, function(x) x$.originalTotalCount)) + 1)
x$.originalCount <- x$count
},
traversal = "post-order"
)
xc <- Clone(x, pruneFun = function(x) x$.id < limit, attributes = TRUE)
xc$Do(function(x) {
if(x$count < x$.originalCount) {
nds <- x$.originalCount - x$count
sub <- x$.originalTotalCount - x$totalCount - nds
x$AddChild(paste0("... ", nds, " nodes w/ ", sub, " sub"))
}
})
x <- xc
}
PrintPruneDist <- function(x, limit) {
tc <- x$totalCount
toBeCropped <- tc - limit
if (toBeCropped < 1) {
if(!isRoot(x)) {
#clone s.t. x is root (for pretty level names)
x <- Clone(x, attributes = TRUE)
x$parent <- NULL
}
return (x)
}
t <- Traverse(x, traversal = "post-order")
Do(t, function(x) {
x$.height <- ifelse(x$isLeaf, 1, x$children[[1]]$.height + 1)
})
Do(t, function(x) {
x$.originalTotalCount <- ifelse(x$isLeaf, 1, sum( sapply(x$children, function(x) x$.originalTotalCount)) + 1)
})
t <- Traverse(x)
Set(t, .id = 1:tc)
x$.level <- 1
Do(t, function(x) {
x$.originalCount <- length(x$children)
x$.level <- ifelse(isRoot(x), 1, x$parent$.level + 1)
})
t <- t[order(Get(t, ".level"),
- Get(t, ".height"),
Get(t, function(x) x$position > 2))]
keep <- c(rep(TRUE, limit), rep(FALSE, toBeCropped))
Set(t, .keep = keep)
#sapply(t, function(x) paste(x$.height, x$.level, x$name, sep = "."))
xc <- Clone(x, pruneFun = function(x) x$.keep, attributes = TRUE)
t <- Traverse(xc)
Do(t, function(x) {
if(x$count < x$.originalCount) {
nds <- x$.originalCount - x$count
sub <- x$.originalTotalCount - x$totalCount - nds
x$AddChild(paste0("... ", nds, " nodes w/ ", sub, " sub"))
}
})
x <- xc
}
#' @rdname ToDiagrammeRGraph
#' @export
GetDefaultTooltip <- function(node) {
if (length(node$attributes) > 0) {
myattributes <- node$attributes
} else {
myattributes <- "name"
}
tt <- paste(sapply(myattributes, function(x) {
v <- node[[x]]
if (is.function(v)) v <- "function"
else v <- GetAttribute(node, x)
paste0("- ", x, ": ", v)
}), collapse = "\n")
return (tt)
}
#' Checks whether \code{name} is a reserved word, as defined in \code{NODE_RESERVED_NAMES_CONST}.
#'
#' @param name the name to check
#' @param check Either
#' \itemize{
#' \item{\code{"check"}: if the name conformance should be checked and warnings should be printed in case of non-conformance (the default)}
#' \item{\code{"no-warn"}: if the name conformance should be checked, but no warnings should be printed in case of non-conformance (if you expect non-conformance)}
#' \item{\code{"no-check" or FALSE}: if the name conformance should not be checked; use this if performance is critical. However, in case of non-conformance, expect cryptic follow-up errors}
#' }
CheckNameReservedWord <- function(name, check = c("check", "no-warn", "no-check")) {
check <- check[1]
if (check == FALSE) return (name)
if (check == "no-check") return (name)
if (!(check == FALSE || check == "no-check")) {
if (name %in% NODE_RESERVED_NAMES_CONST) {
name2 <- paste0(name, "2")
if (check != "no-warn") {
warning(paste0("Name '", name, "' is a reserved word as defined in NODE_RESERVED_NAMES_CONST. Using '", name2, "' instead."))
}
name <- name2
}
}
return (name)
}
================================================
FILE: R/zzz.R
================================================
# nocov start
.onLoad <- function(libname, pkgname) {
if(getRversion() >= "3.6.0") {
# register S3-methods from Suggested packages
s3_register("igraph::as.igraph", "Node")
s3_register("ape::as.phylo", "Node")
}
invisible()
}
# nocov end
================================================
FILE: README.md
================================================
CRAN: [](https://cran.r-project.org/package=data.tree/) [](https://cran.r-project.org/package=data.tree/)
<!-- badges: start -->
[](https://github.com/gluc/data.tree/actions/workflows/R-CMD-check.yaml)
<!-- badges: end -->
# data.tree
An R package to manage hierarchical data and tree structures
Hierarchical data is ubiquitous in statistics and programming (XML, search trees, family trees, classification, file system, etc.). However, no general-use *tree data structure* is available in base R.
Where tabular data has data.frame, hierarchical data is often modeled in lists of lists or similar makeshifts. These
structures are often difficult to manage.
This is where the data.tree package steps in. It lets you build trees of hierarchical
data for various uses: to print, plot and visualize, to generate breakdowns, to integrate with html widgets, to rapid prototype search algorithms, to test out new classification ideas, and much more.
Tree structures can be created programmatically, or by conversion. The package provides functionality to convert from and to various formats such as data.frames, list of lists, dendrograms, partykit, ape phylo, igraph, JSON, YAML, and more.
# Learn More
To get started, you might want to read the [introduction vignette](https://CRAN.R-project.org/package=data.tree/vignettes/data.tree.html). There is also a vignette containing some [examples and applications](https://CRAN.R-project.org/package=data.tree/vignettes/applications.html).
The manual is [here](https://CRAN.R-project.org/package=data.tree/data.tree.pdf)
Finally, you'll find more examples and background information on my [blog](http://ipub.com/data-tree).
# NOTE:
The latest from github dev branch may have some breaking changes compared to CRAN. See [NEWS](https://github.com/gluc/data.tree/blob/dev/NEWS) for details.
# Conventions:
Coding Conventions: Google Style Guide, see https://google.github.io/styleguide/Rguide.xml
Versioning Conventions: SemanticVersioning. See http://semver.org/ for details
Branching Conventions: GitFlow. See https://www.atlassian.com/git/tutorials/comparing-workflows/gitflow-workflow
Pull Requests: Very welcome! Please branch from the dev branch.
================================================
FILE: appveyor.yml
================================================
# DO NOT CHANGE the "init" and "install" sections below
# Download script file from GitHub
init:
ps: |
$ErrorActionPreference = "Stop"
Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1"
Import-Module '..\appveyor-tool.ps1'
install:
ps: Bootstrap
# Adapt as necessary starting from here
#in case of problems, you might want to comment this out to clean the cache
#See here: https://www.appveyor.com/docs/build-cache/
cache:
#- C:\RLibrary
environment:
global:
WARNINGS_ARE_ERRORS: 1
matrix:
- R_VERSION: devel
GCC_PATH: mingw_32
- R_VERSION: release
R_ARCH: x64
- R_VERSION: stable
- R_VERSION: patched
build_script:
- travis-tool.sh install_deps
test_script:
- travis-tool.sh run_tests
on_failure:
- 7z a failure.zip *.Rcheck\*
- appveyor PushArtifact failure.zip
artifacts:
- path: '*.Rcheck\**\*.log'
name: Logs
- path: '*.Rcheck\**\*.out'
name: Logs
- path: '*.Rcheck\**\*.fail'
name: Logs
- path: '*.Rcheck\**\*.Rout'
name: Logs
- path: '\*_*.tar.gz'
name: Bits
- path: '\*_*.zip'
name: Bits
================================================
FILE: cran-comments.md
================================================
## General Comments
This release was done as requested by Kurt Hornik, because of a problem with roxygen2. I now used "_PACKAGE" and it should solvel the problem.
Also I added a few features and fixed a few bugs. Finally, I deprecated two functions, as anounced earlier ($fields and $fieldsAll).
Best Regards, Christoph
## Test environments
* github -> (macos-latest release, windows-latest release, ubuntu-latest devel, ubuntu-latest release, ubuntu-latest oldrel-1) -> OK
* rhub::check_for_cran -> NOTES
## R CMD check results
There were no ERRORs or WARNINGs.
I'm getting funny NOTES on rhub::check_for_cran:
```
* checking CRAN incoming feasibility ... [11s] NOTE
Maintainer: 'Christoph Glur <christoph.glur@powerpartners.pro>'
New maintainer:
Christoph Glur <christoph.glur@powerpartners.pro>
Old maintainer(s):
Christoph Glur <christoph.glur@ipub.com>
* checking Rd files ... NOTE
checkRd: (-1) s3_register.Rd:46-48: Lost braces
46 | if (getRversion() >= "3.6.0") {
| ^
* checking for non-standard things in the check directory ... NOTE
Found the following files/directories:
''NULL''
* checking for detritus in the temp directory ... NOTE
Found the following files/directories:
'lastMiKTeXException'
```
I couldn't reproduce this anywhere else, and I'm not sure if this is an issue with my code or with the check environment.
Let me know if I was careless and there is anything for me to fix.
## revdepcheck results
We checked 53 reverse dependencies (46 from CRAN + 7 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package.
* We saw 3 new problems
* We failed to check 0 packages
Issues with CRAN packages are summarised below.
### New problems
(This reports the first line of each new failure)
* collapsibleTree
checking examples ... WARNING
* directotree
checking examples ... WARNING
* forestry
checking examples ... WARNING
✔ behaviorchange 0.5.5 ── E: 0 | W: 0 | N: 0
✖ collapsibleTree 0.1.7 ── E: 0 | W: 0 +1 | N: 2
✔ covid19dbcand 0.1.1 ── E: 0 | W: 0 | N: 0
✔ Cluster.OBeu 1.2.3 ── E: 0 | W: 0 | N: 0
✔ CondCopulas 0.1.3 ── E: 0 | W: 0 | N: 0
✖ directotree 1.0.0 ── E: 0 | W: 0 +1 | N: 1
✔ CovRegRF 1.0.4 ── E: 0 | W: 0 | N: 0
✔ echarty 1.6.2 ── E: 0 | W: 0 | N: 0
✔ changepoints 1.1.0 ── E: 0 | W: 0 | N: 0
✔ filterNHP 0.1.2 ── E: 0 | W: 0 | N: 1
✖ forestry 0.1.0 ── E: 0 | W: 0 +1 | N: 0
✔ echarts4r 0.4.5 ── E: 0 | W: 0 | N: 0
✔ GE 0.4.0 ── E: 0 | W: 0 | N: 0
✔ gimme 0.7.15 ── E: 0 | W: 0 | N: 0
✔ galah 1.5.4 ── E: 0 | W: 0 | N: 0
✔ icesTAF 4.2.0 ── E: 0 | W: 0 | N: 0
✔ htetree 0.1.17 ── E: 0 | W: 0 | N: 0
✔ justifier 0.2.6 ── E: 0 | W: 0 | N: 0
✔ LinTInd 1.6.0 ── E: 1 | W: 0 | N: 2
✔ cola 2.8.0 ── E: 1 | W: 0 | N: 1
✔ nmarank 0.3.0 ── E: 0 | W: 0 | N: 0
✔ LACE 2.6.0 ── E: 0 | W: 0 | N: 1
✔ momentuHMM 1.5.5 ── E: 1 | W: 0 | N: 0
✔ pmxTools 1.3 ── E: 0 | W: 1 | N: 0
✔ nonlinearICP 0.1.2.1 ── E: 0 | W: 0 | N: 0
✔ radiant.model 1.6.3 ── E: 0 | W: 0 | N: 0
✔ Pi 2.14.0 ── E: 0 | W: 0 | N: 1
✔ ranktreeEnsemble 0.22 ── E: 0 | W: 0 | N: 0
✔ randomForestSRC 3.2.2 ── E: 0 | W: 0 | N: 0
✔ RFpredInterval 1.0.7 ── E: 0 | W: 0 | N: 0
✔ Rgff 0.1.6 ── E: 0 | W: 0 | N: 1
✔ SACCR 3.2 ── E: 0 | W: 0 | N: 0
✔ shinyTree 0.3.1 ── E: 0 | W: 0 | N: 0
✔ ClassifyR 3.6.2 ── E: 1 | W: 0 | N: 3
✔ rock 0.6.7 ── E: 0 | W: 0 | N: 0
✔ scicomptools 1.0.0 ── E: 0 | W: 0 | N: 0
✔ SoilTaxonomy 0.2.3 ── E: 0 | W: 0 | N: 0
✔ rocTree 1.1.1 ── E: 0 | W: 0 | N: 1
✔ styler 1.10.2 ── E: 0 | W: 0 | N: 0
✔ supportR 1.2.0 ── E: 0 | W: 0 | N: 0
✔ tidygraph 1.2.3 ── E: 0 | W: 0 | N: 0
✔ starvz 0.7.1 ── E: 0 | W: 0 | N: 0
✔ triversity 1.0 ── E: 0 | W: 0 | N: 0
✔ TT 0.98 ── E: 0 | W: 0 | N: 0
✔ VERSO 1.12.0 ── E: 0 | W: 0 | N: 0
✔ voronoiTreemap 0.2.0 ── E: 0 | W: 0 | N: 0
✔ TKCat 1.0.7 ── E: 0 | W: 0 | N: 0
✔ webchem 1.3.0 ── E: 0 | W: 0 | N: 0
✔ yum 0.1.0 ── E: 0 | W: 0 | N: 0
✔ wrTopDownFrag 1.0.2 ── E: 0 | W: 0 | N: 1
✔ scAnnotatR 1.8.0 ── E: 0 | W: 0 | N: 0
✔ wrMisc 1.13.0 ── E: 0 | W: 0 | N: 0
✔ UniprotR 2.3.0 ── E: 0 | W: 0 | N: 0
### Problems Description
All three problems are a result of the deprecated functions.
I notified the maintainers of the packages.
================================================
FILE: data.tree.Rproj
================================================
Version: 1.0
RestoreWorkspace: No
SaveWorkspace: No
AlwaysSaveHistory: No
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: knitr
LaTeX: pdfLaTeX
BuildType: Package
PackageUseDevtools: Yes
PackageInstallArgs: --no-multiarch --with-keep.source
PackageBuildArgs: --resave-data
PackageBuildBinaryArgs: --resave-data
PackageCheckArgs: --as-cran
PackageRoxygenize: rd,collate,namespace
================================================
FILE: data_gen/acme.R
================================================
#Run this to generate data(acme)
#library(data.tree)ac
acme <- Node$new("Acme Inc.")
accounting <- acme$AddChild("Accounting")
software <- accounting$AddChild("New Software")
standards <- accounting$AddChild("New Accounting Standards")
research <- acme$AddChild("Research")
newProductLine <- research$AddChild("New Product Line")
newLabs <- research$AddChild("New Labs")
it <- acme$AddChild("IT")
outsource <- it$AddChild("Outsource")
agile <- it$AddChild("Go agile")
goToR <- it$AddChild("Switch to R")
software$cost <- 1000000
standards$cost <- 500000
newProductLine$cost <- 2000000
newLabs$cost <- 750000
outsource$cost <- 400000
agile$cost <- 250000
goToR$cost <- 50000
software$p <- 0.5
standards$p <- 0.75
newProductLine$p <- 0.25
newLabs$p <- 0.9
outsource$p <- 0.2
agile$p <- 0.05
goToR$p <- 1
save(acme, file = "data/acme.rda", compress = "xz")
================================================
FILE: data_gen/mushroom.R
================================================
color <- c('red', 'brown', 'brown', 'green', 'red')
size <- c('small', 'small', 'large', 'small', 'large')
points <- c('yes', 'no', 'yes', 'no', 'no')
edible <- c('toxic', 'edible', 'edible', 'edible', 'edible')
mushroom <- data.frame(color = color, size = size, points = points, edibility = edible)
save(mushroom, file = "data/mushroom.rda", compress = "xz")
================================================
FILE: getting-started-with-development.md
================================================
# Dev Guide
To develop on a new environment, you need to:
1. pull from CRAN (dev branch)
2. install R
3. install RStudio
4. install RTools (https://cran.rstudio.com/bin/windows/Rtools/)
4. install tinytex
1. install.packages('tinytex')
2. tinytex::install_tinytex()
3. tinytex:::install_yihui_pkgs()
5. re-start RStudio
6. install devtools by running `install.packages("devtools")`
================================================
FILE: inst/extdata/flare.json
================================================
{
"name": "flare",
"children": [
{
"name": "analytics",
"children": [
{
"name": "cluster",
"children": [
{"name": "AgglomerativeCluster", "size": 3938},
{"name": "CommunityStructure", "size": 3812},
{"name": "HierarchicalCluster", "size": 6714},
{"name": "MergeEdge", "size": 743}
]
},
{
"name": "graph",
"children": [
{"name": "BetweennessCentrality", "size": 3534},
{"name": "LinkDistance", "size": 5731},
{"name": "MaxFlowMinCut", "size": 7840},
{"name": "ShortestPaths", "size": 5914},
{"name": "SpanningTree", "size": 3416}
]
},
{
"name": "optimization",
"children": [
{"name": "AspectRatioBanker", "size": 7074}
]
}
]
},
{
"name": "animate",
"children": [
{"name": "Easing", "size": 17010},
{"name": "FunctionSequence", "size": 5842},
{
"name": "interpolate",
"children": [
{"name": "ArrayInterpolator", "size": 1983},
{"name": "ColorInterpolator", "size": 2047},
{"name": "DateInterpolator", "size": 1375},
{"name": "Interpolator", "size": 8746},
{"name": "MatrixInterpolator", "size": 2202},
{"name": "NumberInterpolator", "size": 1382},
{"name": "ObjectInterpolator", "size": 1629},
{"name": "PointInterpolator", "size": 1675},
{"name": "RectangleInterpolator", "size": 2042}
]
},
{"name": "ISchedulable", "size": 1041},
{"name": "Parallel", "size": 5176},
{"name": "Pause", "size": 449},
{"name": "Scheduler", "size": 5593},
{"name": "Sequence", "size": 5534},
{"name": "Transition", "size": 9201},
{"name": "Transitioner", "size": 19975},
{"name": "TransitionEvent", "size": 1116},
{"name": "Tween", "size": 6006}
]
},
{
"name": "data",
"children": [
{
"name": "converters",
"children": [
{"name": "Converters", "size": 721},
{"name": "DelimitedTextConverter", "size": 4294},
{"name": "GraphMLConverter", "size": 9800},
{"name": "IDataConverter", "size": 1314},
{"name": "JSONConverter", "size": 2220}
]
},
{"name": "DataField", "size": 1759},
{"name": "DataSchema", "size": 2165},
{"name": "DataSet", "size": 586},
{"name": "DataSource", "size": 3331},
{"name": "DataTable", "size": 772},
{"name": "DataUtil", "size": 3322}
]
},
{
"name": "display",
"children": [
{"name": "DirtySprite", "size": 8833},
{"name": "LineSprite", "size": 1732},
{"name": "RectSprite", "size": 3623},
{"name": "TextSprite", "size": 10066}
]
},
{
"name": "flex",
"children": [
{"name": "FlareVis", "size": 4116}
]
},
{
"name": "physics",
"children": [
{"name": "DragForce", "size": 1082},
{"name": "GravityForce", "size": 1336},
{"name": "IForce", "size": 319},
{"name": "NBodyForce", "size": 10498},
{"name": "Particle", "size": 2822},
{"name": "Simulation", "size": 9983},
{"name": "Spring", "size": 2213},
{"name": "SpringForce", "size": 1681}
]
},
{
"name": "query",
"children": [
{"name": "AggregateExpression", "size": 1616},
{"name": "And", "size": 1027},
{"name": "Arithmetic", "size": 3891},
{"name": "Average", "size": 891},
{"name": "BinaryExpression", "size": 2893},
{"name": "Comparison", "size": 5103},
{"name": "CompositeExpression", "size": 3677},
{"name": "Count", "size": 781},
{"name": "DateUtil", "size": 4141},
{"name": "Distinct", "size": 933},
{"name": "Expression", "size": 5130},
{"name": "ExpressionIterator", "size": 3617},
{"name": "Fn", "size": 3240},
{"name": "If", "size": 2732},
{"name": "IsA", "size": 2039},
{"name": "Literal", "size": 1214},
{"name": "Match", "size": 3748},
{"name": "Maximum", "size": 843},
{
"name": "methods",
"children": [
{"name": "add", "size": 593},
{"name": "and", "size": 330},
{"name": "average", "size": 287},
{"name": "count", "size": 277},
{"name": "distinct", "size": 292},
{"name": "div", "size": 595},
{"name": "eq", "size": 594},
{"name": "fn", "size": 460},
{"name": "gt", "size": 603},
{"name": "gte", "size": 625},
{"name": "iff", "size": 748},
{"name": "isa", "size": 461},
{"name": "lt", "size": 597},
{"name": "lte", "size": 619},
{"name": "max", "size": 283},
{"name": "min", "size": 283},
{"name": "mod", "size": 591},
{"name": "mul", "size": 603},
{"name": "neq", "size": 599},
{"name": "not", "size": 386},
{"name": "or", "size": 323},
{"name": "orderby", "size": 307},
{"name": "range", "size": 772},
{"name": "select", "size": 296},
{"name": "stddev", "size": 363},
{"name": "sub", "size": 600},
{"name": "sum", "size": 280},
{"name": "update", "size": 307},
{"name": "variance", "size": 335},
{"name": "where", "size": 299},
{"name": "xor", "size": 354},
{"name": "_", "size": 264}
]
},
{"name": "Minimum", "size": 843},
{"name": "Not", "size": 1554},
{"name": "Or", "size": 970},
{"name": "Query", "size": 13896},
{"name": "Range", "size": 1594},
{"name": "StringUtil", "size": 4130},
{"name": "Sum", "size": 791},
{"name": "Variable", "size": 1124},
{"name": "Variance", "size": 1876},
{"name": "Xor", "size": 1101}
]
},
{
"name": "scale",
"children": [
{"name": "IScaleMap", "size": 2105},
{"name": "LinearScale", "size": 1316},
{"name": "LogScale", "size": 3151},
{"name": "OrdinalScale", "size": 3770},
{"name": "QuantileScale", "size": 2435},
{"name": "QuantitativeScale", "size": 4839},
{"name": "RootScale", "size": 1756},
{"name": "Scale", "size": 4268},
{"name": "ScaleType", "size": 1821},
{"name": "TimeScale", "size": 5833}
]
},
{
"name": "util",
"children": [
{"name": "Arrays", "size": 8258},
{"name": "Colors", "size": 10001},
{"name": "Dates", "size": 8217},
{"name": "Displays", "size": 12555},
{"name": "Filter", "size": 2324},
{"name": "Geometry", "size": 10993},
{
"name": "heap",
"children": [
{"name": "FibonacciHeap", "size": 9354},
{"name": "HeapNode", "size": 1233}
]
},
{"name": "IEvaluable", "size": 335},
{"name": "IPredicate", "size": 383},
{"name": "IValueProxy", "size": 874},
{
"name": "math",
"children": [
{"name": "DenseMatrix", "size": 3165},
{"name": "IMatrix", "size": 2815},
{"name": "SparseMatrix", "size": 3366}
]
},
{"name": "Maths", "size": 17705},
{"name": "Orientation", "size": 1486},
{
"name": "palette",
"children": [
{"name": "ColorPalette", "size": 6367},
{"name": "Palette", "size": 1229},
{"name": "ShapePalette", "size": 2059},
{"name": "SizePalette", "size": 2291}
]
},
{"name": "Property", "size": 5559},
{"name": "Shapes", "size": 19118},
{"name": "Sort", "size": 6887},
{"name": "Stats", "size": 6557},
{"name": "Strings", "size": 22026}
]
},
{
"name": "vis",
"children": [
{
"name": "axis",
"children": [
{"name": "Axes", "size": 1302},
{"name": "Axis", "size": 24593},
{"name": "AxisGridLine", "size": 652},
{"name": "AxisLabel", "size": 636},
{"name": "CartesianAxes", "size": 6703}
]
},
{
"name": "controls",
"children": [
{"name": "AnchorControl", "size": 2138},
{"name": "ClickControl", "size": 3824},
{"name": "Control", "size": 1353},
{"name": "ControlList", "size": 4665},
{"name": "DragControl", "size": 2649},
{"name": "ExpandControl", "size": 2832},
{"name": "HoverControl", "size": 4896},
{"name": "IControl", "size": 763},
{"name": "PanZoomControl", "size": 5222},
{"name": "SelectionControl", "size": 7862},
{"name": "TooltipControl", "size": 8435}
]
},
{
"name": "data",
"children": [
{"name": "Data", "size": 20544},
{"name": "DataList", "size": 19788},
{"name": "DataSprite", "size": 10349},
{"name": "EdgeSprite", "size": 3301},
{"name": "NodeSprite", "size": 19382},
{
"name": "render",
"children": [
{"name": "ArrowType", "size": 698},
{"name": "EdgeRenderer", "size": 5569},
{"name": "IRenderer", "size": 353},
{"name": "ShapeRenderer", "size": 2247}
]
},
{"name": "ScaleBinding", "size": 11275},
{"name": "Tree", "size": 7147},
{"name": "TreeBuilder", "size": 9930}
]
},
{
"name": "events",
"children": [
{"name": "DataEvent", "size": 2313},
{"name": "SelectionEvent", "size": 1880},
{"name": "TooltipEvent", "size": 1701},
{"name": "VisualizationEvent", "size": 1117}
]
},
{
"name": "legend",
"children": [
{"name": "Legend", "size": 20859},
{"name": "LegendItem", "size": 4614},
{"name": "LegendRange", "size": 10530}
]
},
{
"name": "operator",
"children": [
{
"name": "distortion",
"children": [
{"name": "BifocalDistortion", "size": 4461},
{"name": "Distortion", "size": 6314},
{"name": "FisheyeDistortion", "size": 3444}
]
},
{
"name": "encoder",
"children": [
{"name": "ColorEncoder", "size": 3179},
{"name": "Encoder", "size": 4060},
{"name": "PropertyEncoder", "size": 4138},
{"name": "ShapeEncoder", "size": 1690},
{"name": "SizeEncoder", "size": 1830}
]
},
{
"name": "filter",
"children": [
{"name": "FisheyeTreeFilter", "size": 5219},
{"name": "GraphDistanceFilter", "size": 3165},
{"name": "VisibilityFilter", "size": 3509}
]
},
{"name": "IOperator", "size": 1286},
{
"name": "label",
"children": [
{"name": "Labeler", "size": 9956},
{"name": "RadialLabeler", "size": 3899},
{"name": "StackedAreaLabeler", "size": 3202}
]
},
{
"name": "layout",
"children": [
{"name": "AxisLayout", "size": 6725},
{"name": "BundledEdgeRouter", "size": 3727},
{"name": "CircleLayout", "size": 9317},
{"name": "CirclePackingLayout", "size": 12003},
{"name": "DendrogramLayout", "size": 4853},
{"name": "ForceDirectedLayout", "size": 8411},
{"name": "IcicleTreeLayout", "size": 4864},
{"name": "IndentedTreeLayout", "size": 3174},
{"name": "Layout", "size": 7881},
{"name": "NodeLinkTreeLayout", "size": 12870},
{"name": "PieLayout", "size": 2728},
{"name": "RadialTreeLayout", "size": 12348},
{"name": "RandomLayout", "size": 870},
{"name": "StackedAreaLayout", "size": 9121},
{"name": "TreeMapLayout", "size": 9191}
]
},
{"name": "Operator", "size": 2490},
{"name": "OperatorList", "size": 5248},
{"name": "OperatorSequence", "size": 4190},
{"name": "OperatorSwitch", "size": 2581},
{"name": "SortOperator", "size": 2023}
]
},
{"name": "Visualization", "size": 16540}
]
}
]
}
================================================
FILE: inst/extdata/jennylind.yaml
================================================
name: Jenny Lind
type: decision
Sign with Movie Company:
type: chance
Small Box Office:
type: terminal
p: 0.3
payoff: 200000
Medium Box Office:
type: terminal
p: 0.6
payoff: 1000000
Large Box Office:
type: terminal
p: 0.1
payoff: 3000000
Sign with TV Network:
type: chance
Small Box Office:
type: terminal
p: 0.3
payoff: 900000
Medium Box Office:
type: terminal
p: 0.6
payoff: 900000
Large Box Office:
type: terminal
p: 0.1
payoff: 900000
================================================
FILE: inst/extdata/portfolio.csv
================================================
ISIN,Name,Ccy,Type,Duration,Weight,AssetCategory,AssetClass,SubAssetClass
LI0015327682,LGT Money Market Fund (CHF) - B,CHF,Fund,,0.0300,Cash,CHF,
LI0214880598,CS (Lie) Money Market Fund EUR EB,EUR,Fund,,0.0600,Cash,EUR,
LI0214880689,CS (Lie) Money Market Fund USD EB,USD,Fund,,0.0200,Cash,USD,
LU0243957825,Invesco Euro Corporate Bond A EUR Acc,EUR,Fund,5.1,0.1200,Fixed Income,EUR,Sov. and Corp. Bonds
LU0408877412,JPM Euro Gov Sh. Duration Bd A (acc)-EUR,EUR,Fund,2.45,0.0650,Fixed Income,EUR,Sov. and Corp. Bonds
LU0376989207,Aberdeen Global Sel Emerg Mkt Bd A2 HEUR,EUR,Fund,6.8,0.0300,Fixed Income,EUR,Em. Mkts Bonds
GB00B42R2118,Threadneedle European High Yield Bond Ret Grs EUR,EUR,Fund,3.4,0.0450,Fixed Income,EUR,High Yield Bonds
LU0292585030,AXA IM FIIS US Short Dur HY F-C USD,USD,Fund,1.6,0.0250,Fixed Income,USD,High Yield Bonds
CH0011037469,Syngenta AG,CHF,Stock,,0.0100,Equities,Switzerland,
DE0008490145,DWS Zurich Invest Aktien Schweiz,EUR,Fund,,0.0500,Equities,Switzerland,
NL0000303600,ING Grope NV,EUR,Stock,,0.0100,Equities,Euroland,
IE00B60SWX25,Source EURO STOXX 50 UCITS ETF - A,EUR,ETF,,0.0800,Equities,Euroland,
FR0000120271,TOTAL,EUR,Stock,,0.0140,Equities,Euroland,
DE0008404005,Allianz SE,EUR,Stock,,0.0130,Equities,Euroland,
IT0000072618,Intesa Sanpaolo S.p.A.,EUR,Stock,,0.0100,Equities,Euroland,
BE0003793107,Anheuser-Busch INBEV,EUR,Stock,,0.0180,Equities,Euroland,
US4581401001,Intel Corp.,USD,Stock,,0.0100,Equities,US,
US0378331005,Apple Corp,USD,Stock,,0.0300,Equities,US,
US4370761029,Home Depot Inc.,USD,Stock,,0.0150,Equities,US,
US5949181045,Microsoft Corp.,USD,Stock,,0.0140,Equities,US,
US7427181091,Procter & Gamble Company,USD,Stock,,0.0120,Equities,US,
GB00BH4HKS39,Vodafone Group PLC,GBP,Stock,,0.0090,Equities,UK,
IE00B42Z5J44,iSHares MSCI Japan EUR Hedged,EUR,ETF,,0.0300,Equities,Japan,
IE00B5377D42,iSHares MSCI Australia,USD,ETF,,0.0200,Equities,Australia,
LU0040507039,Vontobel Emerging Markets Eq B,USD,Fund,,0.0550,Equities,Emerging Markets,
LU0216734045,AXA WF Frm Europe Real Estate EUR,EUR,Fund,,0.0550,Alternative Investments,Real Estate,Eurozone
LU0462954800,DB Platinum IV Systematic Alpha R1C-E,EUR,Fund,,0.1050,Alternative Investments,Hedge Funds,
LU0239752628,UBS (LUX) Str. SICAV - Rogers Int. Com Idx (CHF),CHF,Fund,,0.0450,Alternative Investments,Commodities,
================================================
FILE: inst/extdata/useR15.csv
================================================
session,start,end,sessionName,room,seats,speaker,presentation
Session 1,01.07.2015 10:30,01.07.2015 12:00,Kaleidoscope 1,Aalborghallen,790,Federico Marini,flowcatchR: A user-friendly workflow solution for the analysis of time-lapse cell flow imaging data
Session 1,01.07.2015 10:30,01.07.2015 12:00,Kaleidoscope 1,Aalborghallen,790,Jonathan Clayden,Image processing and alignment with RNiftyReg and mmand
Session 1,01.07.2015 10:30,01.07.2015 12:00,Kaleidoscope 1,Aalborghallen,790,Carel F. W. Peeters,rags2ridges: Ridge estimation and graphical modeling for high-dimensional precision matrices
Session 1,01.07.2015 10:30,01.07.2015 12:00,Kaleidoscope 1,Aalborghallen,790,Henrik Tobias Madsen,dgRaph: Discrete factor graphs in R
Session 1,01.07.2015 10:30,01.07.2015 12:00,Ecology,Gæstesalen,149,Costas Varsos,Optimized R functions for analysis of ecological community data using the R virtual laboratory (Rvlab)
Session 1,01.07.2015 10:30,01.07.2015 12:00,Ecology,Gæstesalen,149,David L Miller,Building ecological models bit-by-bit
Session 1,01.07.2015 10:30,01.07.2015 12:00,Ecology,Gæstesalen,149,Andrew Dolman,"Simulating ecological microcosms with systems of differential equations: tools for the scientific, technical and communication challenges"
Session 1,01.07.2015 10:30,01.07.2015 12:00,Ecology,Gæstesalen,149,Marcel Austenfeld,"A Graphical User Interface for R in an Integrated Development Environment for Ecological Modeling, Scientific Image Analysis and Statistical Analysis"
Session 1,01.07.2015 10:30,01.07.2015 12:00,Networks,Musiksalen,160,Gergely Daroczi,fbRads: Analyzing and managing Facebook ads from R
Session 1,01.07.2015 10:30,01.07.2015 12:00,Networks,Musiksalen,160,Peter Meißner,Web scraping with R - A fast track overview.
Session 1,01.07.2015 10:30,01.07.2015 12:00,Networks,Musiksalen,160,Antonio Rivero Ostoic,multiplex: Analysis of Multiple Social Networks with Algebra
Session 1,01.07.2015 10:30,01.07.2015 12:00,Networks,Musiksalen,160,Gabor Csardi,What's new in igraph and networks
Session 1,01.07.2015 10:30,01.07.2015 12:00,Reproducibility,Det lille Teater,224,Karthik Ram,rOpenSci: A suite of reproducible research tools in R
Session 1,01.07.2015 10:30,01.07.2015 12:00,Reproducibility,Det lille Teater,224,Michael Lawrence,Enhancing reproducibility and collaboration via management of R package cohorts
Session 1,01.07.2015 10:30,01.07.2015 12:00,Reproducibility,Det lille Teater,224,Joshua R. Polanin & Emily A. Hennessy,A Review of Meta-Analysis Packages in R
Session 1,01.0
gitextract_u1u_requ/
├── .Rbuildignore
├── .gitattributes
├── .github/
│ ├── .gitignore
│ └── workflows/
│ ├── R-CMD-check.yaml
│ └── test-coverage.yaml
├── .gitignore
├── .travis.yml
├── CRAN-SUBMISSION
├── DESCRIPTION
├── NAMESPACE
├── NEWS
├── R/
│ ├── data.tree-package.R
│ ├── data_doc.R
│ ├── node.R
│ ├── node_actives.R
│ ├── node_conversion.R
│ ├── node_conversion_ape.R
│ ├── node_conversion_dataframe.R
│ ├── node_conversion_dendrogram.R
│ ├── node_conversion_igraph.R
│ ├── node_conversion_list.R
│ ├── node_conversion_party.R
│ ├── node_conversion_rpart.R
│ ├── node_methods.R
│ ├── node_methods_sideeffect.R
│ ├── node_methods_traversal.R
│ ├── node_plot.R
│ ├── register-s3.R
│ ├── release.R
│ ├── util.R
│ └── zzz.R
├── README.md
├── appveyor.yml
├── cran-comments.md
├── data/
│ ├── acme.rda
│ └── mushroom.rda
├── data.tree.Rproj
├── data_gen/
│ ├── acme.R
│ └── mushroom.R
├── getting-started-with-development.md
├── inst/
│ └── extdata/
│ ├── flare.json
│ ├── jennylind.yaml
│ ├── portfolio.csv
│ └── useR15.csv
├── man/
│ ├── Aggregate.Rd
│ ├── AreNamesUnique.Rd
│ ├── CheckNameReservedWord.Rd
│ ├── Climb.Rd
│ ├── Clone.Rd
│ ├── CreateRandomTree.Rd
│ ├── CreateRegularTree.Rd
│ ├── Cumulate.Rd
│ ├── DefaultPlotHeight.Rd
│ ├── Distance.Rd
│ ├── Do.Rd
│ ├── FindNode.Rd
│ ├── FormatFixedDecimal.Rd
│ ├── FormatPercent.Rd
│ ├── Get.Rd
│ ├── GetAttribute.Rd
│ ├── GetPhyloNr.Rd
│ ├── NODE_RESERVED_NAMES_CONST.Rd
│ ├── Navigate.Rd
│ ├── Node.Rd
│ ├── Prune.Rd
│ ├── Revert.Rd
│ ├── Set.Rd
│ ├── SetFormat.Rd
│ ├── Sort.Rd
│ ├── ToDiagrammeRGraph.Rd
│ ├── ToNewick.Rd
│ ├── Traverse.Rd
│ ├── acme.Rd
│ ├── as.Node.BinaryTree.Rd
│ ├── as.Node.Rd
│ ├── as.Node.data.frame.Rd
│ ├── as.Node.dendrogram.Rd
│ ├── as.Node.list.Rd
│ ├── as.Node.party.Rd
│ ├── as.Node.phylo.Rd
│ ├── as.Node.rpart.Rd
│ ├── as.data.frame.Node.Rd
│ ├── as.dendrogram.Node.Rd
│ ├── as.igraph.Node.Rd
│ ├── as.list.Node.Rd
│ ├── as.phylo.Node.Rd
│ ├── averageBranchingFactor.Rd
│ ├── data.tree.Rd
│ ├── isLeaf.Rd
│ ├── isNotLeaf.Rd
│ ├── isNotRoot.Rd
│ ├── isRoot.Rd
│ ├── mushroom.Rd
│ ├── print.Node.Rd
│ └── s3_register.Rd
├── publish-cheat-sheet.md
├── tests/
│ ├── testthat/
│ │ ├── test-draw.R
│ │ ├── test-treeConstruction.R
│ │ ├── test-treeConversionApe.R
│ │ ├── test-treeConversionDataFrame.R
│ │ ├── test-treeConversionDendrogram.R
│ │ ├── test-treeConversionList.R
│ │ ├── test-treeConversionParty.R
│ │ ├── test-treeConversionRpart.R
│ │ ├── test-treeConversionigraph.R
│ │ ├── test-treeDocu.R
│ │ ├── test-treeMethods.R
│ │ ├── test-treeMethodsSideEffect.R
│ │ └── test-util.R
│ └── testthat.R
└── vignettes/
├── applications.Rmd
├── applications.banner.html
├── data.tree.Rmd
└── intro.banner.html
Condensed preview — 114 files, each showing path, character count, and a content snippet. Download the .json file or copy for the full structured content (474K chars).
[
{
"path": ".Rbuildignore",
"chars": 248,
"preview": "^.*\\.Rproj$\n^\\.Rproj\\.user$\n^\\.travis\\.yml$\ndata_gen\ncran-comments.md\npublish-cheat-sheet.md\ngetting-started-with-develo"
},
{
"path": ".gitattributes",
"chars": 51,
"preview": "* text=auto\ndata/* binary\nsrc/* text=lf\nR/* text=lf"
},
{
"path": ".github/.gitignore",
"chars": 7,
"preview": "*.html\n"
},
{
"path": ".github/workflows/R-CMD-check.yaml",
"chars": 1326,
"preview": "# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples\n# Need help debugging build failures? Start at"
},
{
"path": ".github/workflows/test-coverage.yaml",
"chars": 1374,
"preview": "# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples\n# Need help debugging build failures? Start at"
},
{
"path": ".gitignore",
"chars": 62,
"preview": ".Rproj.user\n.Rhistory\n.RData\ninst/doc\nprivate\nRprof.out\nrevdep"
},
{
"path": ".travis.yml",
"chars": 293,
"preview": "language: r\ncache: packages\nr:\n - oldrel\n - release\n - devel\n\nsudo: false\n\nwarnings_are_errors: true\n\nr_packages:\n -"
},
{
"path": "CRAN-SUBMISSION",
"chars": 91,
"preview": "Version: 1.1.0\nDate: 2023-11-12 11:25:34 UTC\nSHA: d9ceaf8a4343f32483a5856ff530f4a31a6b40fa\n"
},
{
"path": "DESCRIPTION",
"chars": 2040,
"preview": "Package: data.tree\nType: Package\nTitle: General Purpose Hierarchical Data Structure\nVersion: 1.1.0\nDate: 2023-11-11\nAuth"
},
{
"path": "NAMESPACE",
"chars": 1467,
"preview": "# Generated by roxygen2: do not edit by hand\n\nS3method(as.Node,BinaryTree)\nS3method(as.Node,data.frame)\nS3method(as.Node"
},
{
"path": "NEWS",
"chars": 12112,
"preview": "# All changes to data.tree are documented here.\n\n## Version 1.1.0\n- IMPROVE: Node names may no longer be `NA`. It was n"
},
{
"path": "R/data.tree-package.R",
"chars": 4990,
"preview": "#' data.tree: Hierarchical Data Structures\n#' \n#' \\code{data.tree} is to hierarchical data what \\code{data.frame} is to "
},
{
"path": "R/data_doc.R",
"chars": 952,
"preview": "#' Sample Data: A Simple Company with Departments\n#' \n#' acme's tree representation is accessed through its root, acme.\n"
},
{
"path": "R/node.R",
"chars": 40117,
"preview": "#' Names that are reserved by the Node class.\n#'\n#' These are reserved by the Node class, you cannot use these as \n#' at"
},
{
"path": "R/node_actives.R",
"chars": 2184,
"preview": "\n#' Check if a \\code{Node} is the root\n#'\n#' @param node The Node to test.\n#' @return TRUE if the Node is the root, FALS"
},
{
"path": "R/node_conversion.R",
"chars": 1801,
"preview": "\n\n\n#' Convert an object to a \\code{data.tree} data structure\n#' \n#' @param x The object to be converted\n#' @param ... Ad"
},
{
"path": "R/node_conversion_ape.R",
"chars": 4127,
"preview": "\n\n#' Convert a \\code{Node} to a phylo object from the ape package.\n#' \n#' This method requires the ape package to be ins"
},
{
"path": "R/node_conversion_dataframe.R",
"chars": 15451,
"preview": "#' Convert a \\code{data.tree} structure to a \\code{data.frame}\n#'\n#' If a node field contains data of length > 1, then t"
},
{
"path": "R/node_conversion_dendrogram.R",
"chars": 3748,
"preview": "\n\n#' Convert a \\code{\\link{dendrogram}} to a data.tree \\code{Node}\n#' \n#' @param x The dendrogram\n#' @param name The nam"
},
{
"path": "R/node_conversion_igraph.R",
"chars": 1554,
"preview": "\n#' Convert a \\code{data.tree} structure to an igraph network\n#' \n#' This requires the igraph package to be installed.\n#"
},
{
"path": "R/node_conversion_list.R",
"chars": 10479,
"preview": "#' Convert a nested \\code{list} structure to a \\code{data.tree} structure\n#' \n#' @param x The \\code{list} to be converte"
},
{
"path": "R/node_conversion_party.R",
"chars": 5261,
"preview": "\n#' Convert a a \\code{SplitNode} from the party package to a \\code{data.tree} structure.\n#' \n#' @param x The BinaryTree\n"
},
{
"path": "R/node_conversion_rpart.R",
"chars": 1801,
"preview": "#' Convert an \\code{\\link{rpart}} object to a \\code{data.tree} structure\n#'\n#' @param x the \\code{rpart} object to be co"
},
{
"path": "R/node_methods.R",
"chars": 16378,
"preview": "#\n# These are the methods that would normally sit on Node\n# However, to reduce the memory footprint of the Node object,\n"
},
{
"path": "R/node_methods_sideeffect.R",
"chars": 4443,
"preview": "#\n# These are methods on Node which have side effects, meaning they\n# change a Node object or any of its descendants. To"
},
{
"path": "R/node_methods_traversal.R",
"chars": 11599,
"preview": "#' Traverse a tree or a sub-tree\n#' \n#' Traverse takes the root of a tree or a sub-tree, and \"walks\" the tree in a speci"
},
{
"path": "R/node_plot.R",
"chars": 10568,
"preview": "\n#' @rdname ToDiagrammeRGraph\n#'\n#' @param x The root node of the data.tree structure to plot\n#' @inheritParams ToDataFr"
},
{
"path": "R/register-s3.R",
"chars": 3729,
"preview": "#' Register a method for a suggested dependency\n#'\n#' Code copied into data.tree from `vctrs` (authors Wickham H, Henry "
},
{
"path": "R/release.R",
"chars": 368,
"preview": "release_questions <- function() {\n c(\n \"Have you set the date in DESCRIPTION?\",\n \"Have you updated NEWS?\",\n \"H"
},
{
"path": "R/util.R",
"chars": 7455,
"preview": "\n\n#' Format a Number as a Percentage\n#'\n#' This utility method can be used as a format function when converting trees to"
},
{
"path": "R/zzz.R",
"chars": 254,
"preview": "# nocov start\n.onLoad <- function(libname, pkgname) {\n if(getRversion() >= \"3.6.0\") {\n # register S3-methods from Su"
},
{
"path": "README.md",
"chars": 2425,
"preview": "CRAN: [](https://cran.r-project.org/package=data.tree/) [!"
},
{
"path": "appveyor.yml",
"chars": 1185,
"preview": "# DO NOT CHANGE the \"init\" and \"install\" sections below\n\n# Download script file from GitHub\ninit:\n ps: |\n $Error"
},
{
"path": "cran-comments.md",
"chars": 5973,
"preview": "## General Comments\n\nThis release was done as requested by Kurt Hornik, because of a problem with roxygen2. I now used \""
},
{
"path": "data.tree.Rproj",
"chars": 425,
"preview": "Version: 1.0\n\nRestoreWorkspace: No\nSaveWorkspace: No\nAlwaysSaveHistory: No\n\nEnableCodeIndexing: Yes\nUseSpacesForTab: Yes"
},
{
"path": "data_gen/acme.R",
"chars": 858,
"preview": "#Run this to generate data(acme)\n\n#library(data.tree)ac\nacme <- Node$new(\"Acme Inc.\")\naccounting <- acme$AddChild(\"Accou"
},
{
"path": "data_gen/mushroom.R",
"chars": 361,
"preview": "color <- c('red', 'brown', 'brown', 'green', 'red')\nsize <- c('small', 'small', 'large', 'small', 'large')\npoints <- c('"
},
{
"path": "getting-started-with-development.md",
"chars": 391,
"preview": "# Dev Guide\n\nTo develop on a new environment, you need to:\n\n1. pull from CRAN (dev branch)\n2. install R\n3. install RStud"
},
{
"path": "inst/extdata/flare.json",
"chars": 11413,
"preview": "{\n \"name\": \"flare\",\n \"children\": [\n {\n \"name\": \"analytics\",\n \"children\": [\n {\n \"name\": \"cluster\",\n \"chil"
},
{
"path": "inst/extdata/jennylind.yaml",
"chars": 527,
"preview": "name: Jenny Lind\ntype: decision\nSign with Movie Company:\n type: chance\n Small Box Office:\n type: terminal\n p: 0."
},
{
"path": "inst/extdata/portfolio.csv",
"chars": 2327,
"preview": "ISIN,Name,Ccy,Type,Duration,Weight,AssetCategory,AssetClass,SubAssetClass\nLI0015327682,LGT Money Market Fund (CHF) - B,C"
},
{
"path": "inst/extdata/useR15.csv",
"chars": 19117,
"preview": "session,start,end,sessionName,room,seats,speaker,presentation\nSession 1,01.07.2015 10:30,01.07.2015 12:00,Kaleidoscope 1"
},
{
"path": "man/Aggregate.Rd",
"chars": 2169,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{Aggregate}\n\\alias{Agg"
},
{
"path": "man/AreNamesUnique.Rd",
"chars": 556,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{AreNamesUnique}\n\\alia"
},
{
"path": "man/CheckNameReservedWord.Rd",
"chars": 1007,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/util.R\n\\name{CheckNameReservedWord}\n\\alias"
},
{
"path": "man/Climb.Rd",
"chars": 1244,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{Climb}\n\\alias{Climb}\n"
},
{
"path": "man/Clone.Rd",
"chars": 1206,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{Clone}\n\\alias{Clone}\n"
},
{
"path": "man/CreateRandomTree.Rd",
"chars": 468,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/util.R\n\\name{CreateRandomTree}\n\\alias{Crea"
},
{
"path": "man/CreateRegularTree.Rd",
"chars": 470,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/util.R\n\\name{CreateRegularTree}\n\\alias{Cre"
},
{
"path": "man/Cumulate.Rd",
"chars": 1295,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{Cumulate}\n\\alias{Cumu"
},
{
"path": "man/DefaultPlotHeight.Rd",
"chars": 781,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/util.R\n\\name{DefaultPlotHeight}\n\\alias{Def"
},
{
"path": "man/Distance.Rd",
"chars": 546,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{Distance}\n\\alias{Dist"
},
{
"path": "man/Do.Rd",
"chars": 1012,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_traversal.R\n\\name{Do}\n\\alias{"
},
{
"path": "man/FindNode.Rd",
"chars": 1445,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{FindNode}\n\\alias{Find"
},
{
"path": "man/FormatFixedDecimal.Rd",
"chars": 622,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/util.R\n\\name{FormatFixedDecimal}\n\\alias{Fo"
},
{
"path": "man/FormatPercent.Rd",
"chars": 667,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/util.R\n\\name{FormatPercent}\n\\alias{FormatP"
},
{
"path": "man/Get.Rd",
"chars": 2981,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_traversal.R\n\\name{Get}\n\\alias"
},
{
"path": "man/GetAttribute.Rd",
"chars": 1760,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{GetAttribute}\n\\alias{"
},
{
"path": "man/GetPhyloNr.Rd",
"chars": 912,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_ape.R\n\\name{GetPhyloNr}\n\\a"
},
{
"path": "man/NODE_RESERVED_NAMES_CONST.Rd",
"chars": 492,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node.R\n\\docType{data}\n\\name{NODE_RESERVED_"
},
{
"path": "man/Navigate.Rd",
"chars": 828,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{Navigate}\n\\alias{Navi"
},
{
"path": "man/Node.Rd",
"chars": 34157,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node.R\n\\docType{class}\n\\name{Node}\n\\alias{"
},
{
"path": "man/Prune.Rd",
"chars": 844,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_sideeffect.R\n\\name{Prune}\n\\al"
},
{
"path": "man/Revert.Rd",
"chars": 573,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_sideeffect.R\n\\name{Revert}\n\\a"
},
{
"path": "man/Set.Rd",
"chars": 1293,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_traversal.R\n\\name{Set}\n\\alias"
},
{
"path": "man/SetFormat.Rd",
"chars": 1292,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{SetFormat}\n\\alias{Set"
},
{
"path": "man/Sort.Rd",
"chars": 1703,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_sideeffect.R\n\\name{Sort}\n\\ali"
},
{
"path": "man/ToDiagrammeRGraph.Rd",
"chars": 5847,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_plot.R, R/util.R\n\\name{plot.Node}\n\\al"
},
{
"path": "man/ToNewick.Rd",
"chars": 1035,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion.R\n\\name{ToNewick}\n\\alias{T"
},
{
"path": "man/Traverse.Rd",
"chars": 2298,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods_traversal.R\n\\name{Traverse}\n\\"
},
{
"path": "man/acme.Rd",
"chars": 483,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/data_doc.R\n\\docType{data}\n\\name{acme}\n\\ali"
},
{
"path": "man/as.Node.BinaryTree.Rd",
"chars": 888,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_party.R\n\\name{as.Node.Bina"
},
{
"path": "man/as.Node.Rd",
"chars": 581,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion.R\n\\name{as.Node}\n\\alias{as"
},
{
"path": "man/as.Node.data.frame.Rd",
"chars": 3642,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_dataframe.R\n\\name{as.Node."
},
{
"path": "man/as.Node.dendrogram.Rd",
"chars": 1585,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_dendrogram.R\n\\name{as.Node"
},
{
"path": "man/as.Node.list.Rd",
"chars": 4669,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_list.R\n\\name{as.Node.list}"
},
{
"path": "man/as.Node.party.Rd",
"chars": 2366,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_party.R\n\\name{as.Node.part"
},
{
"path": "man/as.Node.phylo.Rd",
"chars": 1549,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_ape.R\n\\name{as.Node.phylo}"
},
{
"path": "man/as.Node.rpart.Rd",
"chars": 1215,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_rpart.R\n\\name{as.Node.rpar"
},
{
"path": "man/as.data.frame.Node.Rd",
"chars": 5327,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_dataframe.R\n\\name{as.data."
},
{
"path": "man/as.dendrogram.Node.Rd",
"chars": 1209,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_dendrogram.R\n\\name{as.dend"
},
{
"path": "man/as.igraph.Node.Rd",
"chars": 1317,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_igraph.R\n\\name{as.igraph.N"
},
{
"path": "man/as.list.Node.Rd",
"chars": 2171,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_list.R\n\\name{as.list.Node}"
},
{
"path": "man/as.phylo.Node.Rd",
"chars": 779,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_conversion_ape.R\n\\name{as.phylo.Node}"
},
{
"path": "man/averageBranchingFactor.Rd",
"chars": 417,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_actives.R\n\\name{averageBranchingFacto"
},
{
"path": "man/data.tree.Rd",
"chars": 5417,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/data.tree-package.R\n\\docType{package}\n\\nam"
},
{
"path": "man/isLeaf.Rd",
"chars": 334,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_actives.R\n\\name{isLeaf}\n\\alias{isLeaf"
},
{
"path": "man/isNotLeaf.Rd",
"chars": 351,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_actives.R\n\\name{isNotLeaf}\n\\alias{isN"
},
{
"path": "man/isNotRoot.Rd",
"chars": 353,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_actives.R\n\\name{isNotRoot}\n\\alias{isN"
},
{
"path": "man/isRoot.Rd",
"chars": 340,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_actives.R\n\\name{isRoot}\n\\alias{isRoot"
},
{
"path": "man/mushroom.Rd",
"chars": 651,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/data_doc.R\n\\docType{data}\n\\name{mushroom}\n"
},
{
"path": "man/print.Node.Rd",
"chars": 1970,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/node_methods.R\n\\name{print.Node}\n\\alias{pr"
},
{
"path": "man/s3_register.Rd",
"chars": 2355,
"preview": "% Generated by roxygen2: do not edit by hand\n% Please edit documentation in R/register-s3.R\n\\name{s3_register}\n\\alias{s3"
},
{
"path": "publish-cheat-sheet.md",
"chars": 1148,
"preview": "Before a release, do the following:\n1. Set date in DESCRIPTION\n2. Make sure NEWS is up to date\n3. make sure tests pass ("
},
{
"path": "tests/testthat/test-draw.R",
"chars": 3830,
"preview": "context(\"plot\")\n\n\ntest_that(\"plot only works if DiagrammeR is installed\", {\n\n # Given\n # - an object of class \"Node\"--"
},
{
"path": "tests/testthat/test-treeConstruction.R",
"chars": 959,
"preview": "#library(data.tree)\ncontext(\"tree construction\")\n\ndata(acme)\n\ntest_that(\"isRoot\", {\n data(acme)\n \n expect_equal(acme$"
},
{
"path": "tests/testthat/test-treeConversionApe.R",
"chars": 2979,
"preview": "context(\"tree conversion ape\")\n\n\ntest_that(\"as.Node.phylo owls\", {\n skip_if_not_installed(\"ape\")\n txt <- \"owls(((Strix"
},
{
"path": "tests/testthat/test-treeConversionDataFrame.R",
"chars": 8730,
"preview": "context(\"tree conversion data.frame\")\n\ndata(acme)\n\n\n\ntest_that(\"as.Node.data.frame\", {\n data(acme)\n acmedf <- as.data."
},
{
"path": "tests/testthat/test-treeConversionDendrogram.R",
"chars": 449,
"preview": "context(\"tree conversion dendrogram\")\n\n\ntest_that(\"as.Node.dendrogram\", {\n hc <- hclust(dist(USArrests), \"ave\")\n dend1"
},
{
"path": "tests/testthat/test-treeConversionList.R",
"chars": 7370,
"preview": "context(\"tree conversion\")\n\ndata(acme)\n\ntest_that(\"as.list.Node explicit\", {\n data(acme)\n \n l <- as.list(acme, mode ="
},
{
"path": "tests/testthat/test-treeConversionParty.R",
"chars": 1625,
"preview": "context(\"tree conversion party\")\n\n\ntest_that(\"party on\", {\n skip_if_not_installed(\"party\")\n\n airq <- subset(airquality"
},
{
"path": "tests/testthat/test-treeConversionRpart.R",
"chars": 556,
"preview": "context(\"tree conversion rpart\")\n\ntest_that(\"Conversion from rpart\", {\n skip_if_not_installed(\"rpart\")\n\n fit <- rpart"
},
{
"path": "tests/testthat/test-treeConversionigraph.R",
"chars": 627,
"preview": "context(\"tree conversion igraph\")\n\n\ntest_that(\"as.Node.igraph undirected\", {\n skip_if_not_installed(\"igraph\")\n\n data(a"
},
{
"path": "tests/testthat/test-treeDocu.R",
"chars": 32,
"preview": "context(\"tree docu method\")\n\n\n\n\n"
},
{
"path": "tests/testthat/test-treeMethods.R",
"chars": 21139,
"preview": "context(\"tree methods\")\n\ntest_that(\"Node instantiation\", {\n \n expect_equal(\n Node$new()$name,\n \"\",\n info=\"Con"
},
{
"path": "tests/testthat/test-treeMethodsSideEffect.R",
"chars": 1311,
"preview": "context(\"tree methods side effects\")\n\n\n\ntest_that(\"Sort\", {\n data(acme)\n acme$Do(function(x) x$totalCost <- Aggregate("
},
{
"path": "tests/testthat/test-util.R",
"chars": 1012,
"preview": "context(\"util\")\n\n\ntest_that(\"createRegular\", {\n lvls <- 3\n children <- 4\n t <- CreateRegularTree(height = 3, branchin"
},
{
"path": "tests/testthat.R",
"chars": 60,
"preview": "library(testthat)\n\ntest_check(\"data.tree\")\n#devtools::test()"
},
{
"path": "vignettes/applications.Rmd",
"chars": 35296,
"preview": "---\ntitle: \"data.tree sample applications\"\nauthor: \"Christoph Glur\"\ndate: '`r Sys.Date()`'\noutput:\n html_document:\n "
},
{
"path": "vignettes/applications.banner.html",
"chars": 216,
"preview": "<img src=\"banner_applications.jpg\" alt=\"Banner\">\n<style type=\"text/css\">\n.rosabox { \n background-color:#FFDDDD; \n font"
},
{
"path": "vignettes/data.tree.Rmd",
"chars": 36696,
"preview": "---\ntitle: \"Introduction to data.tree\"\nauthor: \"Christoph Glur\"\ndate: '`r Sys.Date()`'\noutput:\n html_document:\n incl"
},
{
"path": "vignettes/intro.banner.html",
"chars": 582,
"preview": "<img src=\"banner_intro.jpg\" alt=\"Banner\">\n<style type=\"text/css\">\n.rosabox { \n background-color:#FFDDDD; \n font-size: "
}
]
// ... and 2 more files (download for full content)
About this extraction
This page contains the full source code of the gluc/data.tree GitHub repository, extracted and formatted as plain text for AI agents and large language models (LLMs). The extraction includes 114 files (435.0 KB), approximately 127.7k tokens. Use this with OpenClaw, Claude, ChatGPT, Cursor, Windsurf, or any other AI tool that accepts text input. You can copy the full output to your clipboard or download it as a .txt file.
Extracted by GitExtract — free GitHub repo to text converter for AI. Built by Nikandr Surkov.