Nothing
time_to_strat.phylo = function(obj, x, ...){
#'
#' @export
#' @import ape
#'
#' @title transform phylo object
#'
#' @description
#' transform phylo object from the time domain to the stratigraphic domain
#'
#'
#' @param obj the phylo object to be transformed
#' @param x age-depth model
#' @param ... other parameters, currently ignored
#'
#' @returns a phylo object, representation of the tree in the strat domain
#'
#' @seealso [get_height()] for the underlying procedure, [time_to_strat()] for the higher level function, and [strat_to_time.phylo()] for the transformation of phylo objects from strat domain to the time domain. See [time_to_strat.list()] and [time_to_strat.numeric()] for the transformation of lists and numeric vectors
tree = obj
adm = x
times = get_all_node_vals(tree)
height = get_height(adm, times, destructive = FALSE, out_dom_val_h = "strat_limits")
new_tree = update_branch_lengths(tree,height)
return(new_tree)
}
find_precursor_node=function(x, node){
#'
#' @title find precursor noode of node in phylo object
#'
#' @param x a phylo object
#' @param node the node for which the precursor is supposed to be determined
#'
#' @returns integer, id of precursor node
#'
#' @noRd
#' @keywords internal
#'
precursor_node=x$edge[,1][x$edge[,2]==node]
return(precursor_node)
}
#### find root ####
find_root_node = function(x, start_node_id=1){
#'
#' @title find index of root node in phylo object
#'
#' @param x phylo object
#' @param start_node integer, node where to start search
#'
#' @returns integer, index of root node
#'
#' @noRd
#' @keywords internal
#'
current_node = start_node_id
repeat{
precursor_node=find_precursor_node(x, current_node)
if(length(precursor_node)==0) break
current_node=precursor_node
}
return(current_node)
}
get_node_vals=function(x, node){
#'
#' @title get absolute times/pos of nodes
#'
#' @param x phylo object
#' @param node integer, index of node
#'
#' @returns numeric, absolute location in time/height of node
#'
#' @noRd
#' @keywords internal
#'
root=find_root_node(x)
if(node==root){
if ("root.time" %in% names(x)){
return(x$root.time)
} else {
return(0)
}
} else {
precursor_node=find_precursor_node(x,node)
edge_length=x$edge.length[x$edge[,2]==node]
node_val=get_node_vals(x,precursor_node)+ edge_length
return(node_val)
}
}
#### get all node ages ####
get_all_node_vals=function(x){
#'
#' @title get time/strat vals of all nodes
#'
#' @param x a phylo object
#'
#' @returns vector with one entry per node, timing/strat for nodes
#'
#' @noRd
#' @keywords internal
noofnodes=length(x$tip.label)+x$Nnode
vals=rep(0,noofnodes)
for (i in seq_len(noofnodes)){
vals[i]=get_node_vals(x,i)
}
return(vals)
}
#### update branch lengths ####
update_branch_lengths=function(x,node_vals, root_val = 0){
#'
#' @title updates branch lengths
#'
#' @param x a phylo object
#' @param node_vals values of the node
#' @param roow_val position of root
#'
#' @returns a phylo object
#'
#' @noRd
#' @keywords internal
#'
for (i in 1:length(x$edge.length)){
start=x$edge[i,1]
end=x$edge[i,2]
x$edge.length[i]=node_vals[end]-node_vals[start]
}
x[["root.time"]] = root_val
return(x)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.