R/Utility_PopulationModel.R

In mattjbayly/JoeModelCE: Joe Model for Cumulative Effects

#' esub utility function
#' @keywords internal
esub <- function(expr, sublist) {
  do.call("substitute", list(expr, sublist))
}



#' proc utility function
#' @keywords internal
proc <- function(e, env = parent.frame()) {
  for (nm in all.vars(e)) {
    if (exists(nm, env) && is.language(g <- get(nm, env))) {
      if (is.expression(g)) g <- g[[1]]
      g <- Recall(g, env)
      L <- list(g)
      names(L) <- nm
      e <- esub(e, L)
    }
  }
  e
}



#' Project Matrix Forward in Time
#' @keywords internal
pmx_eval <- function(mx, vars, byrow = TRUE) {
  matrix(sapply(mx, eval, vars),
    sqrt(length(mx)),
    sqrt(length(mx)),
    byrow = byrow
  )
}



#' rbeta equivelent from TruncatedDistributions package
#' @keywords internal
rbeta2 <- function(n, shape1, shape2, ncp = 0) {
  C_rbeta <- NULL
  if (missing(ncp)) {
    .Call(C_rbeta, n, shape1, shape2)
  } else {
    X <- stats::rchisq(n, 2 * shape1, ncp = ncp)
    X / (X + stats::rchisq(n, 2 * shape2))
  }
}