R/coef.maxlogL.R

In EstimationTools: Maximum Likelihood Estimation for Probability Functions from Data Sets

#' @title Extract Model Coefficients in a \code{maxlogL} Fits
#'
#' @encoding UTF-8
#' @author Jaime Mosquera Gutiérrez, \email{jmosquerag@unal.edu.co}
#' @aliases coef.maxlogL oefficients coefMany
#'
#' @description
#' `r lifecycle::badge("maturing")`
#'
#' \code{coef.maxlogL} is the specific method for the generic function \code{coef}
#' which extracts model coefficients from objects returned by \code{\link{maxlogLreg}}.
#' \code{coefficients} is an alias for \code{coef}.
#'
#' @param object an object of \code{maxlogL} class generated by \code{\link{maxlogLreg}}
#'               function.
#' @param parameter a character which specifies the parameter is required. In
#'                  \code{coefMany} this argument can be an atomic vector
#'                  with two or more names of parameters.
#' @param ... other arguments.
#'
#' @return
#' A named vector with coefficients of the specified distribution parameter.
#'
#' @examples
#' library(EstimationTools)
#'
#' #--------------------------------------------------------------------------------
#' # Example 1: coefficients from a model using a simulated normal distribution
#' n <- 1000
#' x <- runif(n = n, -5, 6)
#' y <- rnorm(n = n, mean = -2 + 3 * x, sd = exp(1 + 0.3* x))
#' norm_data <- data.frame(y = y, x = x)
#'
#' # It does not matter the order of distribution parameters
#' formulas <- list(sd.fo = ~ x, mean.fo = ~ x)
#'
#' norm_mod <- maxlogLreg(formulas, y_dist = y ~ dnorm, data = norm_data,
#'                        link = list(over = "sd", fun = "log_link"))
#' coef(norm_mod)
#' coef(norm_mod, parameter = 'sd')
#' a <- coefMany(norm_mod, parameter = c('mean', 'sd'))
#' b <- coefMany(norm_mod)
#' identical(a, b)
#'
#'
#' #--------------------------------------------------------------------------------
#' # Example 2: Parameters in estimation with one fixed parameter
#' x <- rnorm(n = 10000, mean = 160, sd = 6)
#' theta_1 <- maxlogL(x = x, dist = 'dnorm', control = list(trace = 1),
#'                  link = list(over = "sd", fun = "log_link"),
#'                  fixed = list(mean = 160))
#' coef(theta_1)
#'
#'
#' #--------------------------------------------------------------------------------
#' @importFrom stats setNames
#' @export
coef.maxlogL <- function(object, parameter = object$outputs$par_names, ...){
  if (object$outputs$type == "maxlogLreg"){
    # if ( is.null(parameter) ) parameter <- object$outputs$par_names[1]
    parameter <- tolower(parameter)
    parameter <- match.arg(parameter, choices = object$outputs$par_names)

    A <- param_index(object$outputs$b_length, object$outputs$npar)
    rownames(A) <- object$outputs$par_names
    i <- match(parameter, object$outputs$par_names)
    values <- object$fit$par[A[i,1]:A[i,2]]
  } else {
    values <- object$fit$par[parameter]
  }
  return(values)
}
#' @export
#' @rdname coef.maxlogL
coefMany <- function(object, parameter = NULL, ...){
  if (object$outputs$type == "maxlogLreg"){
    if ( is.null(parameter) ) parameter <- object$outputs$par_names
    parameter <- tolower(parameter)
    parameter <- match.arg(parameter, choices = object$outputs$par_names,
                           several.ok = TRUE)

    A <- param_index(object$outputs$b_length, object$outputs$npar)
    rownames(A) <- object$outputs$par_names
    i <- match(parameter, object$outputs$par_names)
    values <- lapply(setNames(i, parameter), function(x)
      object$fit$par[A[x,1]:A[x,2]])[parameter]
    values <- if ( length(i) == 1 ){values[[1]]} else {values}
  } else {
    values <- object$fit$par[parameter]
  }
  return(values)
}