#' Define a univariate distribution for simulation
#'
#' Creates a reusable distribution specification passed to all
#' \pkg{UniCensor} sampling functions.  At least one of \code{q},
#' \code{surv}, \code{p}, or \code{d} must be supplied for random
#' number generation via inverse transform sampling.
#'
#' @param d function; PDF \eqn{f(x, \theta)}.
#' @param p function; CDF \eqn{F(x, \theta)}.
#' @param q function; quantile function \eqn{F^{-1}(u, \theta)}.
#' @param surv function; survival function \eqn{S(x, \theta)}.
#' @param lower numeric; lower support bound (default \code{0}).
#' @param upper numeric; upper support bound (default \code{Inf}).
#' @param param named list of distribution parameters (default empty).
#' @param name character label for plots (default \code{"custom"}).
#'
#' @return An object of class \code{"dist_spec"}, which is a list with
#'   elements \code{d}, \code{p}, \code{q}, \code{surv} (user-supplied
#'   functions or \code{NULL}), \code{lower} and \code{upper} (support
#'   bounds), \code{param} (named list of parameters), and \code{name}
#'   (character label).
#' @export
#'
#' @examples
#' # Exponential(rate = 1)
#' exp_dist <- dist_spec(
#'   d    = function(x, p) p$rate * exp(-p$rate * x),
#'   p    = function(x, p) 1 - exp(-p$rate * x),
#'   q    = function(u, p) -log(1 - u) / p$rate,
#'   surv = function(x, p) exp(-p$rate * x),
#'   lower = 0, upper = Inf,
#'   param = list(rate = 1),
#'   name  = "Exp(1)"
#' )
dist_spec <- function(d = NULL, p = NULL, q = NULL, surv = NULL,
                      lower = 0, upper = Inf, param = list(),
                      name = "custom") {
  if (is.null(q) && is.null(surv) && is.null(p) && is.null(d)) {
    stop("Provide at least one of q, surv, p, or d.", call. = FALSE)
  }
  structure(
    list(
      d     = d,
      p     = p,
      q     = q,
      surv  = surv,
      lower = lower,
      upper = upper,
      param = param,
      name  = name
    ),
    class = "dist_spec"
  )
}

#' @title Print method for dist_spec
#' @param x a \code{dist_spec} object.
#' @param ... ignored.
#' @return Invisibly, the input \code{dist_spec} object \code{x}.  Called
#'   for its side effect of printing a human-readable summary of the
#'   distribution name, support, parameters, and available functions.
#' @export
print.dist_spec <- function(x, ...) {
  cat("Distribution:", x$name, "\n")
  cat("Support: [", x$lower, ", ", x$upper, "]\n", sep = "")
  cat("Parameters:", paste(names(x$param), x$param, sep = " = ",
                           collapse = ", "), "\n")
  fn <- c(d = !is.null(x$d), p = !is.null(x$p),
          q = !is.null(x$q), surv = !is.null(x$surv))
  cat("Functions:", paste(names(fn)[fn], collapse = ", "), "\n")
  invisible(x)
}

#' @title Print method for censored_sample
#' @param x a \code{censored_sample} object.
#' @param ... ignored.
#' @return Invisibly, the input \code{censored_sample} object \code{x}.
#'   Called for its side effect of printing the censoring scheme, distribution
#'   name, sample size, seed, and a frequency table of status codes.
#' @export
print.censored_sample <- function(x, ...) {
  cat("Censoring scheme:", x$scheme, "\n")
  cat("Distribution:", x$dist$name, "  n =", x$n)
  if (!is.null(x$seed)) cat("  seed =", x$seed)
  cat("\n")
  cat("Status counts:\n")
  print(table(x$status, useNA = "ifany"))
  invisible(x)
}

#' @title Extract observed values from a censored sample
#' @param x a \code{censored_sample} object.
#' @param ... ignored.
#' @return Numeric vector of observed values (failures and censoring times).
#' @export
as.vector.censored_sample <- function(x, ...) x$x

#' @title Coerce censored sample to data frame
#' @param x a \code{censored_sample} object.
#' @param row.names ignored.
#' @param optional ignored.
#' @param ... ignored.
#' @return A data frame with columns \code{x} (observed values),
#'   \code{status} (integer status code: 0 = right-censored, 1 = event,
#'   2 = left-censored, 3 = interval-censored, 4 = middle-censored),
#'   \code{t_true} (latent true failure times), and \code{time2} (upper
#'   interval bound for interval- or middle-censored observations,
#'   \code{NA} otherwise).
#' @export
as.data.frame.censored_sample <- function(x, row.names = NULL,
                                          optional = FALSE, ...) {
  data.frame(
    x      = x$x,
    status = x$status,
    t_true = x$t_true,
    time2  = x$time2,
    stringsAsFactors = FALSE
  )
}
