R/ter.R

In BayerSe/trexreg: Truncated Expectation Regression

#' Truncated Expectation Regression
#'
#' TBA
#'
#' @export
ter <- function(...) UseMethod('ter')

ter.default <- function(...) {
  stop('This method should not be called directly.
       Use the formula interface instead.')
}

ter.formula <- function(formula, truncation_interval = c(0, 1),
                        early_stopping = 10, data = parent.frame()) {
  truncation_type <- find_type_of_truncation(truncation_interval)

  if (truncation_type == 'no_truncation') {
    fit <- nter.formula(formula = formula, data = data)
  } else if (truncation_type == 'lower_truncation') {
    fit <- lter.formula(formula = formula, data = data,
                        early_stopping = early_stopping,
                        lq = truncation_interval[1])
  } else if (truncation_type == 'upper_truncation') {
    fit <- uter.formula(formula = formula, data = data,
                        early_stopping = early_stopping,
                        uq = truncation_interval[2])
  } else if (truncation_type == 'double_truncation') {
    fit <- dter.formula(formula = formula, data = data,
                        early_stopping = early_stopping,
                        lq = truncation_interval[1], uq = truncation_interval[2])
  }

  fit
}

print.ter <- function(x, ...) {
  chkDots(...)
  cat(paste0('Lower Quantile: ', x$lq))
  cat(paste0('\nUpper Quantile: ', x$uq))
  cat('\nModel: ')
  print(x$formula)
  cat('\n')
  print(x$coefficients)
  invisible(x)
}

summary.ter <- function(object, ...) {
  chkDots(...)
  se <- sqrt(diag(object$vcov))
  t.value <- stats::coef(object) / se

  coefficients <- cbind(Estimate = stats::coef(object),
                        StdErr   = se,
                        t.value  = t.value,
                        p.value  = 2 * stats::pt(-abs(t.value), df = object$df))

  retval <- list(call         = object$call,
                 coefficients = coefficients)

  class(retval) <- 'summary.ter'

  retval
}

print.summary.ter <- function(x, ...) {
  chkDots(...)
  stats::printCoefmat(x$coefficients, signif.stars = FALSE,
               P.value = TRUE, has.Pvalue = TRUE)
  invisible(x)
}