##' @export
##' @export forest_tree
forest_tree <-
setRefClass("forest_tree",
fields=list(
ptr="externalptr"))
## TODO: It might be nicer to have the subtree and tree classes more
## tightly linked than the manual duplication here. Consider either a
## flag on creation that indicates if it's a tree or subtree (but then
## both have same *actual* class), inheritance (but then we rewrite
## all methods), or something else.
## NOTE: Consider active binding functions here:
## labels=function(v) {
## if (missing(v)) {
## forest_tree__tip_labels(ptr)
## } else {
## field_readonly("labels")
## }
## }
##
## field_readonly <- function(name) {
## stop(sprintf("Field %s is read-only", name))
## }
# forest_tree$lock(names(forest_tree$fields()))
forest_tree$lock("ptr")
forest_tree$methods(initialize=function(x=NULL) {
if (is.null(x)) {
ptr <<- forest_tree__ctor_empty()$ptr
} else if (inherits(x, "forest_node")) {
ptr <<- forest_tree__ctor_node(x)$ptr
} else if (inherits(x, "externalptr")) {
## Don't use this externally!
##
## TODO: Check the "type" attribute exists and is valid and that
## we're an externalptr here.
assert_inherits(ptr, "externalptr")
ptr <<- x
} else if (inherits(x, "phylo")) {
ptr <<- forest_from_ape(x)$ptr
} else {
stop("Can't construct a forest_tree from that, sorry :-/")
}
})
## These might be better not as methods but as functions bound to the
## ptr, or to .self$ptr. Check by benchmarking direct access and
## field access. We can bind with all sorts of things, so this will
## end up being fairly transparent to the user.
## This block can easily be done in cog. The issue will be whether we
## want to inject some documentation here at the same time.
##
## More unclear is which of these belong in the class (which ideally
## is fairly simple) and which belong as free functions. That is
## something that there is definitely some continued tension about.
##
## One issue there is that we'll need some mechanism of dispatch for
## tree/subtree (so that's probably going to be S3), and we run the
## risk of being very confusing with ape functions.
##
## Of the functions in here, associate_data is the one that most
## clearly seems a candidate for removal. check_names too. One
## reason is that these functions are not core to "being" a tree, and
## because they have nontrivial arguments that would benefit from
## actual documentation.
forest_tree$methods(
copy = function() forest_tree__copy(ptr),
is_empty = function() forest_tree__empty(ptr),
size = function() forest_tree__size(ptr),
arity = function() forest_tree__arity(ptr),
childless = function() forest_tree__childless(ptr),
representation = function() forest_tree__representation(ptr),
## TODO: I'm back and forth on whether these should be
## count_tips/count_nodes or tips/nodes.
count_tips = function() forest_tree__count_tips(ptr),
count_nodes = function() forest_tree__count_nodes(ptr),
tip_labels = function() forest_tree__tip_labels(ptr),
node_labels = function() forest_tree__node_labels(ptr),
heights = function() forest_tree__heights(ptr),
depths = function() forest_tree__depths(ptr),
is_binary = function() forest_tree__is_binary(ptr),
has_branch_lengths = function() forest_tree__has_branch_lengths(ptr),
update_heights = function() forest_tree__update_heights(ptr),
collapse_singles = function() forest_tree__collapse_singles(ptr),
ladderise = function() forest_tree__ladderise(ptr),
copy_structure = function() forest_tree__copy_structure(ptr),
## TODO: have a 'detatch' function, like in-place-copy
## And now we start getting into the functions that take arguments.
## Keeping these in sync is going to be annoying; could be worth
## moving to proper code generation for this stuff, but can always
## retrofit it.
##
drop_tips = function(labels)
forest_tree__drop_tips_by_label(ptr, labels),
rotate = function(label)
forest_tree__rotate(ptr, label),
is_ultrametric = function(eps=sqrt(.Machine$double.eps))
forest_tree__is_ultrametric(ptr, eps),
check_names = function(names, tip=TRUE, node=TRUE)
forest_tree__check_names(ptr, names, tip, node),
associate_data = function(data, tip, node)
forest_tree__associate_data(ptr, data, tip, node)
)
## This is used to sanitise inputs where we always want a tree. If a
## subtree is passed in, this will create a copy of the data.
tree_ptr <- function(tr) {
if (inherits(tr, "forest_subtree")) {
tr$to_tree()
} else {
tr
}
}
## Subset methods:
forest_tree$methods(
## 0. root_subtree
root_subtree = function() forest_tree__root_subtree(ptr),
set_root_subtree = function(value)
forest_tree__set_root_subtree(ptr, tree_ptr(value)),
## 1. root_node
root_node = function() forest_tree__root_node(ptr),
set_root_node = function(value)
forest_tree__set_root_node(ptr, value),
## 2. child_subtree
child_subtree = function(idx) forest_tree__child_subtree(ptr, idx),
set_child_subtree = function(idx, value)
forest_tree__set_child_subtree(ptr, idx, tree_ptr(value)),
## 3. child_node
child_node = function(idx) forest_tree__child_node(ptr, idx),
set_child_node = function(idx, value)
forest_tree__set_child_node(ptr, idx, value),
## 4. subtree
subtree = function(label) forest_tree__subtree(ptr, label),
## set_subtree = function(label, value)
## forest_tree__set_subtree(ptr, label, value),
## Convenience functions:
child = function(idx, subtree=TRUE) {
if (subtree) child_subtree(idx) else child_node(idx)
},
set_child = function(idx, value) {
if (inherits(value, "forest_subtree")) {
set_child_subtree(idx, value)
} else {
set_child_node(idx, value)
}
}
)
##' @export
##' @export forest_subtree
forest_subtree <- setRefClass("forest_subtree",
fields=list(ptr="externalptr"))
forest_subtree$lock(names(forest_subtree$fields()))
forest_subtree$methods(initialize=function(x=NULL) {
if (inherits(x, "externalptr")) {
## Don't use this externally!
##
## TODO: Check the "type" attribute exists and is valid and that
## we're an externalptr here.
assert_inherits(ptr, "externalptr")
ptr <<- x
} else {
stop("Can't construct a forest_subtree from that, sorry :-/")
}
})
forest_subtree$methods(
# copy = function() forest_subtree__copy(ptr),
to_tree = function() forest_subtree__subtree_to_tree(ptr),
is_empty = function() forest_subtree__empty(ptr),
size = function() forest_subtree__size(ptr),
arity = function() forest_subtree__arity(ptr),
childless = function() forest_subtree__childless(ptr),
representation = function() forest_subtree__representation(ptr),
## TODO: I'm back and forth on whether these should be
## count_tips/count_nodes or tips/nodes.
count_tips = function() forest_subtree__count_tips(ptr),
count_nodes = function() forest_subtree__count_nodes(ptr),
tip_labels = function() forest_subtree__tip_labels(ptr),
node_labels = function() forest_subtree__node_labels(ptr)
# heights = function() forest_subtree__heights(ptr),
# depths = function() forest_subtree__depths(ptr),
# is_binary = function() forest_subtree__is_binary(ptr),
# has_branch_lengths = function() forest_subtree__has_branch_lengths(ptr),
# update_heights = function() forest_subtree__update_heights(ptr),
# collapse_singles = function() forest_subtree__collapse_singles(ptr),
# ladderise = function() forest_subtree__ladderise(ptr),
# copy_structure = function() forest_subtree__copy_structure(ptr),
## TODO: have a 'detatch' function, like in-place-copy
)
## Subset methods:
forest_subtree$methods(
## 0. root_subtree
root_subtree = function() forest_subtree__root_subtree(ptr),
set_root_subtree = function(value)
forest_subtree__set_root_subtree(ptr, tree_ptr(value)),
## 1. root_node
root_node = function() forest_subtree__root_node(ptr),
set_root_node = function(value)
forest_subtree__set_root_node(ptr, value),
## 2. child_subtree
child_subtree = function(idx) forest_subtree__child_subtree(ptr, idx),
set_child_subtree = function(idx, value)
forest_subtree__set_child_subtree(ptr, idx, tree_ptr(value)),
## 3. child_node
child_node = function(idx) forest_subtree__child_node(ptr, idx),
set_child_node = function(idx, value)
forest_subtree__set_child_node(ptr, idx, value),
## 4. subtree
subtree = function(label) forest_subtree__subtree(ptr, label),
## set_subtree = function(label, value)
## forest_subtree__set_subtree(ptr, label, tree_ptr(value)),
## Convenience functions:
child = function(idx, subtree=TRUE) {
if (subtree) child_subtree(idx) else child_node(idx)
},
set_child = function(idx, value) {
if (inherits(value, "forest_subtree")) {
set_child_subtree(idx, value)
} else {
set_child_node(idx, value)
}
}
)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.