R/zzz.R

In DStree: Recursive Partitioning for Discrete-Time Survival Trees

#.onUnload <- function(libpath) library.dynam.unload("DStree", libpath)

#.noGenerics <- TRUE

tree.depth <- function (nodes)
{
  depth <- floor(log(nodes, base = 2) + 1e-7)
  depth - min(depth)
}

string.bounding.box <- function(s)
{
  s2 <- strsplit(s, "\n")
  rows <- sapply(s2, length)
  columns <- sapply(s2, function(x) max(nchar(x, "w")))
  list(columns = columns, rows = rows)
}

node.match <- function(nodes, nodelist, leaves, print.it = TRUE)
{
  node.index <- match(nodes, nodelist, 0L)
  bad <- nodes[node.index == 0L]
  ## FIXME: plurals?
  if (length(bad) > 0 && print.it)
    warning(gettextf("supplied nodes %s are not in this tree",
                     paste(bad, collapse = ",")), domain = NA)
  good <- nodes[node.index > 0L]
  if (!missing(leaves) && any(leaves <- leaves[node.index])) {
    warning(gettextf("supplied nodes %s are leaves",
                     paste(good[leaves], collapse = ",")), domain = NA)
    node.index[node.index > 0L][!leaves]
  } else node.index[node.index > 0L]
}

descendants <- function(nodes, include = TRUE)
{
  n <- length(nodes)
  if (n == 1L) return(matrix(TRUE, 1L, 1L))
  ind <- 1:n
  desc <- matrix(FALSE, n, n)
  if (include) diag(desc) <- TRUE
  parents <- match((nodes %/% 2L), nodes)
  lev <- floor(log(nodes, base = 2))
  desc[1L, 2L:n] <- TRUE
  for (i in max(lev):2L) {
    desc[cbind(ind[parents[lev == i]], ind[lev == i])] <- TRUE
    parents[lev == i] <- parents[parents[lev == i]]
    lev[lev == i] <- i - 1L
  }
  desc
}

#rpart_env <- new.env()