diff -ru R_original_backup_for_audit/HCinitial.R R/HCinitial.R
--- R_original_backup_for_audit/HCinitial.R	2025-05-29 20:36:28.000000000 +0000
+++ R/HCinitial.R	2026-05-29 21:59:00.172650016 +0000
@@ -1,85 +1,17 @@
-#' Two-Step Method for Parameter Estimation of the Heckman Model
-#'
-#' @description
-#' Estimates the parameters of the classical Heckman model using the two-step method.
-#'
-#' @details
-#' This method is especially useful for obtaining initial values for maximum likelihood estimation.
-#' The first step fits a Probit model to the selection equation.
-#' The second step fits a linear regression to the outcome equation, adjusting for selection bias using the inverse Mills ratio.
-#'
-#' @param selection A formula for the selection equation.
-#' @param outcome A formula for the outcome equation.
-#' @param data A data frame containing the variables.
-#'
-#' @return A numeric vector containing the estimated parameters of the classic Heckman model:
-#' \itemize{
-#'   \item Coefficients from the selection equation (Probit model),
-#'   \item Coefficients from the outcome equation (excluding the IMR),
-#'   \item Estimated standard deviation of the error term (\code{sigma}),
-#'   \item Estimated correlation between error terms (\code{rho}).
-#' }
-#'
-#' @examples
-#' data(MEPS2001)
-#' attach(MEPS2001)
-#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
-#' outcomeEq <- lnambx ~ age + female + educ + blhisp + totchr + ins
-#' HCinitial(selectEq, outcomeEq, data = MEPS2001)
-#'
-#' @export
-HCinitial <- function(selection, outcome, data = sys.frame(sys.parent())) {
-
-  # Step 1: Construct model frame for selection equation
-  mf <- match.call(expand.dots = FALSE)
-  m <- match(c("selection", "data", "subset"), names(mf), 0)
-  mfs <- mf[c(1, m)]
-  mfs$drop.unused.levels <- TRUE
-  mfs$na.action <- na.pass
-  mfs[[1]] <- as.name("model.frame")
-  names(mfs)[2] <- "formula"  # required argument name
-  mfs <- eval(mfs, parent.frame())
-  mts <- terms(mfs)
-  xs <- model.matrix(mts, mfs)
-  ys <- model.response(mfs)
-  yslevels <- levels(as.factor(ys))
-
-  # Step 2: Construct model frame for outcome equation
-  m <- match(c("outcome", "data", "subset", "weights", "offset"), names(mf), 0)
-  mfo <- mf[c(1, m)]
-  mfo$drop.unused.levels <- TRUE
-  mfo$na.action <- na.pass
-  mfo[[1]] <- as.name("model.frame")
-  names(mfo)[2] <- "formula"
-  mfo <- eval(mfo, parent.frame())
-  mto <- attr(mfo, "terms")
-  xo <- model.matrix(mto, mfo)
-  yo <- model.response(mfo)
-
-  # Step 3: Fit Probit model for the selection equation
-  fit1 <- glm(ys ~ xs - 1, family = binomial(link = "probit"))
-
-  # Step 4: Compute Inverse Mills Ratio (IMR)
-  imr <- dnorm(fit1$linear.predictors) / pnorm(fit1$linear.predictors)
-
-  # Step 5: Fit outcome regression using IMR as additional covariate
-  xmat <- cbind(xo, imr)
-  fit2 <- lm(yo ~ xo + imr - 1, subset = ys == 1)
-
-  # Step 6: Estimate additional quantities for sigma and rho
-  xmat <- data.frame(xmat)
-  delta <- xmat$imr * (xmat$imr + fit1$fitted.values)
-  resid_squared_sum <- sum((fit2$residuals)^2)
-  imr_coef <- coef(fit2)[length(coef(fit2))]
-  var <- (resid_squared_sum + (imr_coef^2) * sum(delta[ys == 1])) / sum(ys)
-  sigma <- sqrt(var)
-  names(sigma) <- "sigma"
-
-  # Step 7: Estimate rho
-  rho <- imr_coef / sigma
-  names(rho) <- "rho"
-
-  # Step 8: Return parameter estimates
-  result <- c(coef(fit1), coef(fit2)[-length(coef(fit2))], sigma, rho)
-  return(result)
-}
+#' Two-Step Method for Parameter Estimation of the Heckman Model
+#'
+#' @description
+#' Estimates classical Heckman starting values using Heckman's two-step method.
+#'
+#' @param selection A formula for the selection equation.
+#' @param outcome A formula for the outcome equation.
+#' @param data A data frame containing the variables.
+#'
+#' @return A numeric vector containing selection coefficients, outcome coefficients,
+#'   sigma and rho.
+#'
+#' @export
+HCinitial <- function(selection, outcome, data = sys.frame(sys.parent())) {
+  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
+  step2(components$YS, components$XS, components$YO, components$XO)
+}
diff -ru R_original_backup_for_audit/HeckmanBS.R R/HeckmanBS.R
--- R_original_backup_for_audit/HeckmanBS.R	2025-05-29 15:52:30.000000000 +0000
+++ R/HeckmanBS.R	2026-05-29 22:00:01.223812905 +0000
@@ -1,280 +1,284 @@
-#' Heckman BS Model fit Function
-#'
-#' @description
-#' Estimates the parameters of the Heckman-BS model
-#'
-#' @return
-#'
-#' Returns a list with the following components.
-#'
-#' Coefficients: Returns a numerical vector with the best estimated values
-#' of the model parameters;
-#'
-#' Value: The value of function to be minimized (or maximized) corresponding
-#' to par.
-#'
-#' loglik: Negative of value. Minimum (or maximum) of the likelihood function
-#' calculated from the estimated coefficients.
-#'
-#' counts: Component of the Optim function. A two-element integer vector
-#' giving the number of calls to fn and gr respectively. This excludes
-#' those calls needed to compute the Hessian, if requested, and any calls
-#' to fn to compute a finite-difference approximation to the gradient.
-#'
-#' hessian: Component of the Optim function, with pre-defined option
-#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
-#' at the solution found. Note that this is the Hessian of the unconstrained
-#' problem even if the box constraints are active.
-#'
-#' fisher_infoBS: Fisher information matrix
-#'
-#' prop_sigmaBS: Square root of the Fisher information matrix diagonal
-#'
-#' level: Selection variable levels
-#'
-#' nObs: Numeric value representing the size of the database
-#'
-#' nParam: Numerical value representing the number of model parameters
-#'
-#' N0: Numerical value representing the number of unobserved entries
-#'
-#' N1: Numerical value representing the number of complete entries
-#'
-#' NXS: Numerical value representing the number of parameters of the
-#' selection model
-#'
-#' NXO: Numerical value representing the number of parameters of the
-#' regression model
-#'
-#' df: Numerical value that represents the difference between the size
-#' of the response vector of the selection equation and the number of
-#' model parameters
-#'
-#' aic: Numerical value representing Akaike's information criterion.
-#'
-#' bic: Numerical value representing Schwarz's Bayesian Criterion
-#'
-#' initial.value: Numerical vector that represents the input values
-#' (Initial Values) used in the parameter estimation.
-#'
-#' @details
-#' The HeckmanBS() function fits the Sample Selection Model
-#' based on the Birnbaum Saunders bivariate distribution,
-#' it has the same number of parameters as the classical
-#' Heckman model. For more information see
-#' \insertCite{bastos;textual}{ssmodels}
-#'
-#'
-#' @param selection Selection equation.
-#' @param outcome Primary Regression Equation.
-#' @param data Database.
-#' @param start initial values.
-#' @examples
-#' data(MEPS2001)
-#' attach(MEPS2001)
-#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
-#' outcomeBS <- ambexp ~ age + female + educ + blhisp + totchr + ins
-#' HeckmanBS(selectEq, outcomeBS, data = MEPS2001)
-#' @importFrom Rdpack reprompt
-#' @importFrom stats model.frame
-#' @references {
-#' \insertAllCited{}
-#' }
-#' @export HeckmanBS
-#' @export
-HeckmanBS <- function(selection, outcome, data = sys.frame(sys.parent()), start = NULL) {
-
-  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
-  XS  <- components$XS
-  YS  <- components$YS
-  NXS <- components$NXS
-  XO  <- components$XO
-  YO  <- components$YO
-  NXO <- components$NXO
-
-  if (is.null(start)) {
-    message("Start not provided using default start values.")
-    start <- c(rep(0, NXS + NXO), 1, 0)
-  }
-
-  # Auxiliary transformation: maps rho_star ∈ ℝ to rho ∈ (-1, 1)
-  inv_logit_2 <- function(x) 2 / (1 + exp(-x)) - 1
-  loglik_BS <- function(par) {
-    # Check for invalid parameters
-    if (any(!is.finite(par))) return(NA)
-
-    # Parameter indexing
-    igamma <- 1:NXS
-    ibeta  <- seq(tail(igamma, 1) + 1, length.out = NXO)
-    iphi1  <- tail(ibeta, 1) + 1
-    irho   <- iphi1 + 1
-
-    # Parameter extraction
-    gamma <- par[igamma]
-    beta  <- par[ibeta]
-    phi1  <- par[iphi1]
-    if (!is.finite(phi1) || phi1 < 1e-3 || phi1 > 100) return(NA)
-    rho_star <- par[irho]
-    rho <- inv_logit_2(rho_star)
-    phi2 <- 1  # Fixed value for identifiability
-
-    # Prepare data subsets
-    XS0 <- XS[YS == 0, , drop = FALSE]
-    XS1 <- XS[YS == 1, , drop = FALSE]
-    YO_clean <- ifelse(is.na(YO), 0, YO)
-    YO1 <- YO_clean[YS == 1]
-    XO1 <- XO[YS == 1, , drop = FALSE]
-
-    # Linear predictors
-    XS0.g <- exp(XS0 %*% gamma)
-    XS1.g <- exp(XS1 %*% gamma)
-    XO1.b <- exp(XO1 %*% beta)
-
-    # Compute likelihood terms
-    term0 <- sqrt(YO1 * (phi1 + 1)/(phi1 * XO1.b)) - sqrt((phi1 * XO1.b)/(YO1 * (phi1 + 1)))
-    term1 <- exp((-phi1 / 4) * term0^2)
-    term2 <- sqrt((phi1 + 1)/(phi1 * XO1.b * YO1)) + sqrt((phi1 * XO1.b)/((phi1 + 1) * YO1^3))
-    term3 <- (1 / (2 * sqrt(2 * pi))) * sqrt(phi1 / 2)
-    temp_rho2 <- pmax(1 - rho^2, 1e-6)
-    term4 <- sqrt((phi2 + 1)/(2 * XS1.g * temp_rho2))
-    term5 <- (phi2 * XS1.g)/(phi2 + 1) - 1
-    term6 <- rho * sqrt(phi1 / (2 * temp_rho2))
-    integrand <- term4 * term5 + term6 * term0
-    term7 <- pnorm(integrand, log.p = TRUE)
-
-    term8 <- sqrt(phi2 / 2) * (sqrt((phi2 + 1)/(phi2 * XS0.g)) - sqrt((phi2 * XS0.g)/(phi2 + 1)))
-    FT2 <- pnorm(term8, log.p = TRUE)
-
-    # Stabilize log computations
-    term1[term1 < 1e-300] <- 1e-300
-    logterm1 <- log(term1)
-    logterm2 <- log(term2)
-    if (any(!is.finite(logterm1)) || any(!is.finite(logterm2))) return(NA)
-
-    # Final log-likelihood
-    ll <- sum(logterm1 + logterm2 + log(term3) + term7) + sum(FT2)
-    return(ll)
-  }
-
-  ################################################################################
-
-  gradlik_BS <- function(par) {
-    # Parameter indexing
-    igamma <- 1:NXS
-    ibeta  <- seq(tail(igamma, 1) + 1, length.out = NXO)
-    iphi1  <- tail(ibeta, 1) + 1
-    irho   <- iphi1 + 1
-
-    # Parameter extraction
-    gamma <- par[igamma]
-    beta  <- par[ibeta]
-    phi1  <- par[iphi1]
-    rho_star <- par[irho]
-    rho <- inv_logit_2(rho_star)
-    phi2 <- 1  # Fixed value
-
-    # Prepare data subsets
-    XS0 <- XS[YS == 0, , drop = FALSE]
-    XS1 <- XS[YS == 1, , drop = FALSE]
-    YO_clean <- ifelse(is.na(YO), 0, YO)
-    YO1 <- YO_clean[YS == 1]
-    XO1 <- XO[YS == 1, , drop = FALSE]
-
-    # Linear predictors
-    XS0.g <- exp(as.numeric(XS0 %*% gamma))
-    XS1.g <- exp(as.numeric(XS1 %*% gamma))
-    XO1.b <- exp(as.numeric(XO1 %*% beta))
-
-    # Auxiliary terms
-    temp_rho2 <- pmax(1 - rho^2, 1e-6)
-    term0 <- sqrt(YO1 * (phi1 + 1)/(phi1 * XO1.b)) - sqrt((phi1 * XO1.b)/(YO1 * (phi1 + 1)))
-    term1 <- exp((-phi1 / 4) * term0^2)
-    term2 <- sqrt((phi1 + 1)/(phi1 * XO1.b * YO1)) + sqrt((phi1 * XO1.b)/((phi1 + 1) * YO1^3))
-    term3 <- (1 / (2 * sqrt(2 * pi))) * sqrt(phi1 / 2)
-    term4 <- sqrt((phi2 + 1)/(2 * XS1.g * temp_rho2))
-    term5 <- (phi2 * XS1.g)/(phi2 + 1) - 1
-    term6 <- rho * sqrt(phi1 / (2 * temp_rho2))
-    integrand <- term4 * term5 + term6 * term0
-    term8 <- sqrt(phi2 / 2) * (sqrt((phi2 + 1)/(phi2 * XS0.g)) - sqrt((phi2 * XS0.g)/(phi2 + 1)))
-
-    # Ratios of PDF to CDF
-    lambda_I  <- exp(dnorm(integrand, log = TRUE) - pnorm(integrand, log.p = TRUE))
-    lambda_T8 <- exp(dnorm(term8, log = TRUE) - pnorm(term8, log.p = TRUE))
-
-    # Partial derivatives
-    term9  <- (-1 / 2) * (sqrt(YO1 * (phi1 + 1)/(phi1 * XO1.b)) + sqrt((phi1 * XO1.b)/(YO1 * (phi1 + 1)))) * model.matrix(~XO1 - 1)
-    term10 <- (1 / 2) * (sqrt((XO1.b * phi1)/(YO1^3 * (phi1 + 1))) - sqrt((phi1 + 1)/(YO1 * phi1 * XO1.b))) * model.matrix(~XO1 - 1)
-    term11 <- (-1 / 2) * sqrt(phi2 / 2) * (sqrt((phi2 + 1)/(phi2 * XS0.g)) + sqrt((phi2 * XS0.g)/(phi2 + 1))) * model.matrix(~XS0 - 1)
-    term12 <- (-1 / 2) * (sqrt(YO1/(phi1^3 * XO1.b * (phi1 + 1))) + sqrt(XO1.b/(YO1 * (phi1 + 1)^3 * phi1)))
-    term13 <- (1 / 2) * (sqrt(XO1.b / (phi1 * (phi1 + 1)^3 * YO1^3)) - sqrt(1 / (phi1^3 * (phi1 + 1) * XO1.b * YO1)))
-    term14 <- rho / (2 * sqrt(2 * phi1 * temp_rho2))
-
-    # Derivatives w.r.t. parameters
-    df1b     <- (-phi1 / 2) * term0 * term9
-    df2b     <- term10 / term2
-    df4b     <- lambda_I * term9 * term6
-    df4g     <- lambda_I * (1/4) * ((XS1.g + 2) / sqrt(XS1.g * temp_rho2)) * model.matrix(~XS1 - 1)
-    df5g     <- lambda_T8 * term11
-    df1phi1  <- - (term0^2) / 4 - (phi1 / 2) * term0 * term12
-    df2phi1  <- term13 / term2
-    df3phi1  <- 1 / (8 * term3 * sqrt(pi * phi1))
-    df4phi1  <- lambda_I * (term0 * term14 + term6 * term12)
-
-    # Derivative w.r.t. rho using chain rule
-    dt5_drho <- if (abs(rho) < 1e-8) sqrt(phi1 / 2) else sqrt(phi1 / (2 * temp_rho2)) + rho^2 * sqrt(phi1) / ((temp_rho2)^(3/2) * sqrt(2))
-    d_rho    <- (4 * exp(-rho_star)) / (1 + exp(-rho_star))^2
-    df4rho_raw <- 0.5 * lambda_I * (term5 * term4 * (rho / temp_rho2) + dt5_drho * term0)
-    gr_rho_star <- df4rho_raw * d_rho
-
-    # Assemble gradient matrix
-    gradient <- matrix(0, nrow = length(YS), ncol = length(par))
-    gradient[YS == 0, igamma] <- df5g
-    gradient[YS == 1, igamma] <- df4g
-    gradient[YS == 1, ibeta]  <- df1b + df2b + df4b
-    gradient[YS == 1, iphi1]  <- df1phi1 + df2phi1 + df3phi1 + df4phi1
-    gradient[YS == 1, irho]   <- gr_rho_star
-
-    return(colSums(gradient))
-  }
-
-  theta_BS <- optim(start, loglik_BS, gradlik_BS, method = "BFGS", hessian = TRUE,
-                    control = list(fnscale = -1, maxit = 1000))
-  names(theta_BS$par) <- c(colnames(XS), colnames(XO), "sigma", "rho")
-
-  irho <- length(theta_BS$par)
-  a1 <- theta_BS$par
-  a4 <- theta_BS$hessian
-  a5 <- tryCatch(solve(-a4), error = function(e) matrix(NA, nrow = length(a1), ncol = length(a1)))
-  a6 <- suppressWarnings(sqrt(diag(a5)))
-  a6[!is.finite(a6)] <- NA
-  rho_star <- a1[irho]
-  rho_hat <- 2 / (1 + exp(-rho_star)) - 1
-  g_prime <- 4 * exp(-rho_star) / (1 + exp(-rho_star))^2
-  se_rho_star <- a6[irho]
-  se_rho <- abs(g_prime) * se_rho_star
-  a1[irho] <- rho_hat
-  a6[irho] <- se_rho
-
-  result <- list(
-    coefficients     = a1,
-    value            = theta_BS$value,
-    loglik           = -theta_BS$value,
-    counts           = theta_BS$counts[2],
-    hessian          = a4,
-    fisher_infoBS    = a5,
-    prop_sigmaBS     = a6,
-    level            = levels(as.factor(YS)),
-    nObs             = length(YS),
-    nParam           = length(start),
-    N0               = sum(YS == 0),
-    N1               = sum(YS == 1),
-    NXS              = NXS,
-    NXO              = NXO,
-    df               = length(YS) - length(start),
-    aic              = -2 * theta_BS$value + 2 * length(start),
-    bic              = -2 * theta_BS$value + length(start) * log(length(YS)),
-    initial.value    = start
-  )
-  class(result) <- c("HeckmanBS")
-  return(result)
-}
+#' Heckman BS Model fit Function
+#'
+#' @description
+#' Estimates the parameters of the Heckman-BS model
+#'
+#' @return
+#'
+#' Returns a list with the following components.
+#'
+#' Coefficients: Returns a numerical vector with the best estimated values
+#' of the model parameters;
+#'
+#' Value: The value of function to be minimized (or maximized) corresponding
+#' to par.
+#'
+#' loglik: Maximized value of the log-likelihood function calculated from the estimated coefficients.
+#'
+#' counts: Component of the Optim function. A two-element integer vector
+#' giving the number of calls to fn and gr respectively. This excludes
+#' those calls needed to compute the Hessian, if requested, and any calls
+#' to fn to compute a finite-difference approximation to the gradient.
+#'
+#' hessian: Component of the Optim function, with pre-defined option
+#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
+#' at the solution found. Note that this is the Hessian of the unconstrained
+#' problem even if the box constraints are active.
+#'
+#' fisher_infoBS: Fisher information matrix
+#'
+#' prop_sigmaBS: Square root of the Fisher information matrix diagonal
+#'
+#' level: Selection variable levels
+#'
+#' nObs: Numeric value representing the size of the database
+#'
+#' nParam: Numerical value representing the number of model parameters
+#'
+#' N0: Numerical value representing the number of unobserved entries
+#'
+#' N1: Numerical value representing the number of complete entries
+#'
+#' NXS: Numerical value representing the number of parameters of the
+#' selection model
+#'
+#' NXO: Numerical value representing the number of parameters of the
+#' regression model
+#'
+#' df: Numerical value that represents the difference between the size
+#' of the response vector of the selection equation and the number of
+#' model parameters
+#'
+#' aic: Numerical value representing Akaike's information criterion.
+#'
+#' bic: Numerical value representing Schwarz's Bayesian Criterion
+#'
+#' initial.value: Numerical vector that represents the input values
+#' (Initial Values) used in the parameter estimation.
+#'
+#' @details
+#' The HeckmanBS() function fits the Sample Selection Model
+#' based on the Birnbaum Saunders bivariate distribution,
+#' it has the same number of parameters as the classical
+#' Heckman model. For more information see
+#' \insertCite{bastos;textual}{ssmodels}
+#'
+#'
+#' @param selection Selection equation.
+#' @param outcome Primary Regression Equation.
+#' @param data Database.
+#' @param start initial values.
+#' @examples
+#' data(MEPS2001)
+#' attach(MEPS2001)
+#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
+#' outcomeBS <- ambexp ~ age + female + educ + blhisp + totchr + ins
+#' HeckmanBS(selectEq, outcomeBS, data = MEPS2001)
+#' @importFrom Rdpack reprompt
+#' @importFrom stats model.frame
+#' @references {
+#' \insertAllCited{}
+#' }
+#' @export HeckmanBS
+#' @export
+HeckmanBS <- function(selection, outcome, data = sys.frame(sys.parent()), start = NULL) {
+
+  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
+  XS  <- components$XS
+  YS  <- components$YS
+  NXS <- components$NXS
+  XO  <- components$XO
+  YO  <- components$YO
+  NXO <- components$NXO
+  YSLevels <- components$YSLevels
+
+  if (any(YS == 1L & (!is.finite(YO) | YO <= 0))) {
+    stop("HeckmanBS requires strictly positive outcome values for selected observations.")
+  }
+
+  if (is.null(start)) {
+    message("Start not provided using default start values.")
+    start <- c(rep(0, NXS + NXO), 1, 0)
+  }
+
+  # Auxiliary transformation: maps rho_star ∈ ℝ to rho ∈ (-1, 1)
+  inv_logit_2 <- function(x) 2 / (1 + exp(-x)) - 1
+  loglik_BS <- function(par) {
+    # Check for invalid parameters
+    if (any(!is.finite(par))) return(NA)
+
+    # Parameter indexing
+    igamma <- 1:NXS
+    ibeta  <- seq(tail(igamma, 1) + 1, length.out = NXO)
+    iphi1  <- tail(ibeta, 1) + 1
+    irho   <- iphi1 + 1
+
+    # Parameter extraction
+    gamma <- par[igamma]
+    beta  <- par[ibeta]
+    phi1  <- par[iphi1]
+    if (!is.finite(phi1) || phi1 < 1e-3 || phi1 > 100) return(NA)
+    rho_star <- par[irho]
+    rho <- inv_logit_2(rho_star)
+    phi2 <- 1  # Fixed value for identifiability
+
+    # Prepare data subsets
+    XS0 <- XS[YS == 0, , drop = FALSE]
+    XS1 <- XS[YS == 1, , drop = FALSE]
+    YO_clean <- ifelse(is.na(YO), 0, YO)
+    YO1 <- YO_clean[YS == 1]
+    XO1 <- XO[YS == 1, , drop = FALSE]
+
+    # Linear predictors
+    XS0.g <- exp(XS0 %*% gamma)
+    XS1.g <- exp(XS1 %*% gamma)
+    XO1.b <- exp(XO1 %*% beta)
+
+    # Compute likelihood terms
+    term0 <- sqrt(YO1 * (phi1 + 1)/(phi1 * XO1.b)) - sqrt((phi1 * XO1.b)/(YO1 * (phi1 + 1)))
+    term1 <- exp((-phi1 / 4) * term0^2)
+    term2 <- sqrt((phi1 + 1)/(phi1 * XO1.b * YO1)) + sqrt((phi1 * XO1.b)/((phi1 + 1) * YO1^3))
+    term3 <- (1 / (2 * sqrt(2 * pi))) * sqrt(phi1 / 2)
+    temp_rho2 <- pmax(1 - rho^2, 1e-6)
+    term4 <- sqrt((phi2 + 1)/(2 * XS1.g * temp_rho2))
+    term5 <- (phi2 * XS1.g)/(phi2 + 1) - 1
+    term6 <- rho * sqrt(phi1 / (2 * temp_rho2))
+    integrand <- term4 * term5 + term6 * term0
+    term7 <- pnorm(integrand, log.p = TRUE)
+
+    term8 <- sqrt(phi2 / 2) * (sqrt((phi2 + 1)/(phi2 * XS0.g)) - sqrt((phi2 * XS0.g)/(phi2 + 1)))
+    FT2 <- pnorm(term8, log.p = TRUE)
+
+    # Stabilize log computations
+    term1[term1 < 1e-300] <- 1e-300
+    logterm1 <- log(term1)
+    logterm2 <- log(term2)
+    if (any(!is.finite(logterm1)) || any(!is.finite(logterm2))) return(NA)
+
+    # Final log-likelihood
+    ll <- sum(logterm1 + logterm2 + log(term3) + term7) + sum(FT2)
+    return(ll)
+  }
+
+  ################################################################################
+
+  gradlik_BS <- function(par) {
+    # Parameter indexing
+    igamma <- 1:NXS
+    ibeta  <- seq(tail(igamma, 1) + 1, length.out = NXO)
+    iphi1  <- tail(ibeta, 1) + 1
+    irho   <- iphi1 + 1
+
+    # Parameter extraction
+    gamma <- par[igamma]
+    beta  <- par[ibeta]
+    phi1  <- par[iphi1]
+    rho_star <- par[irho]
+    rho <- inv_logit_2(rho_star)
+    phi2 <- 1  # Fixed value
+
+    # Prepare data subsets
+    XS0 <- XS[YS == 0, , drop = FALSE]
+    XS1 <- XS[YS == 1, , drop = FALSE]
+    YO_clean <- ifelse(is.na(YO), 0, YO)
+    YO1 <- YO_clean[YS == 1]
+    XO1 <- XO[YS == 1, , drop = FALSE]
+
+    # Linear predictors
+    XS0.g <- exp(as.numeric(XS0 %*% gamma))
+    XS1.g <- exp(as.numeric(XS1 %*% gamma))
+    XO1.b <- exp(as.numeric(XO1 %*% beta))
+
+    # Auxiliary terms
+    temp_rho2 <- pmax(1 - rho^2, 1e-6)
+    term0 <- sqrt(YO1 * (phi1 + 1)/(phi1 * XO1.b)) - sqrt((phi1 * XO1.b)/(YO1 * (phi1 + 1)))
+    term1 <- exp((-phi1 / 4) * term0^2)
+    term2 <- sqrt((phi1 + 1)/(phi1 * XO1.b * YO1)) + sqrt((phi1 * XO1.b)/((phi1 + 1) * YO1^3))
+    term3 <- (1 / (2 * sqrt(2 * pi))) * sqrt(phi1 / 2)
+    term4 <- sqrt((phi2 + 1)/(2 * XS1.g * temp_rho2))
+    term5 <- (phi2 * XS1.g)/(phi2 + 1) - 1
+    term6 <- rho * sqrt(phi1 / (2 * temp_rho2))
+    integrand <- term4 * term5 + term6 * term0
+    term8 <- sqrt(phi2 / 2) * (sqrt((phi2 + 1)/(phi2 * XS0.g)) - sqrt((phi2 * XS0.g)/(phi2 + 1)))
+
+    # Ratios of PDF to CDF
+    lambda_I  <- exp(dnorm(integrand, log = TRUE) - pnorm(integrand, log.p = TRUE))
+    lambda_T8 <- exp(dnorm(term8, log = TRUE) - pnorm(term8, log.p = TRUE))
+
+    # Partial derivatives
+    term9  <- (-1 / 2) * (sqrt(YO1 * (phi1 + 1)/(phi1 * XO1.b)) + sqrt((phi1 * XO1.b)/(YO1 * (phi1 + 1)))) * model.matrix(~XO1 - 1)
+    term10 <- (1 / 2) * (sqrt((XO1.b * phi1)/(YO1^3 * (phi1 + 1))) - sqrt((phi1 + 1)/(YO1 * phi1 * XO1.b))) * model.matrix(~XO1 - 1)
+    term11 <- (-1 / 2) * sqrt(phi2 / 2) * (sqrt((phi2 + 1)/(phi2 * XS0.g)) + sqrt((phi2 * XS0.g)/(phi2 + 1))) * model.matrix(~XS0 - 1)
+    term12 <- (-1 / 2) * (sqrt(YO1/(phi1^3 * XO1.b * (phi1 + 1))) + sqrt(XO1.b/(YO1 * (phi1 + 1)^3 * phi1)))
+    term13 <- (1 / 2) * (sqrt(XO1.b / (phi1 * (phi1 + 1)^3 * YO1^3)) - sqrt(1 / (phi1^3 * (phi1 + 1) * XO1.b * YO1)))
+    term14 <- rho / (2 * sqrt(2 * phi1 * temp_rho2))
+
+    # Derivatives w.r.t. parameters
+    df1b     <- (-phi1 / 2) * term0 * term9
+    df2b     <- term10 / term2
+    df4b     <- lambda_I * term9 * term6
+    df4g     <- lambda_I * (1/4) * ((XS1.g + 2) / sqrt(XS1.g * temp_rho2)) * model.matrix(~XS1 - 1)
+    df5g     <- lambda_T8 * term11
+    df1phi1  <- - (term0^2) / 4 - (phi1 / 2) * term0 * term12
+    df2phi1  <- term13 / term2
+    df3phi1  <- 1 / (8 * term3 * sqrt(pi * phi1))
+    df4phi1  <- lambda_I * (term0 * term14 + term6 * term12)
+
+    # Derivative w.r.t. rho using chain rule
+    dt5_drho <- if (abs(rho) < 1e-8) sqrt(phi1 / 2) else sqrt(phi1 / (2 * temp_rho2)) + rho^2 * sqrt(phi1) / ((temp_rho2)^(3/2) * sqrt(2))
+    d_rho    <- (4 * exp(-rho_star)) / (1 + exp(-rho_star))^2
+    df4rho_raw <- 0.5 * lambda_I * (term5 * term4 * (rho / temp_rho2) + dt5_drho * term0)
+    gr_rho_star <- df4rho_raw * d_rho
+
+    # Assemble gradient matrix
+    gradient <- matrix(0, nrow = length(YS), ncol = length(par))
+    gradient[YS == 0, igamma] <- df5g
+    gradient[YS == 1, igamma] <- df4g
+    gradient[YS == 1, ibeta]  <- df1b + df2b + df4b
+    gradient[YS == 1, iphi1]  <- df1phi1 + df2phi1 + df3phi1 + df4phi1
+    gradient[YS == 1, irho]   <- gr_rho_star
+
+    return(colSums(gradient))
+  }
+
+  theta_BS <- optim(start, loglik_BS, gradlik_BS, method = "BFGS", hessian = TRUE,
+                    control = list(fnscale = -1, maxit = 1000))
+  names(theta_BS$par) <- c(colnames(XS), colnames(XO), "sigma", "rho")
+
+  irho <- length(theta_BS$par)
+  a1 <- theta_BS$par
+  a4 <- theta_BS$hessian
+  a5 <- tryCatch(solve(-a4), error = function(e) matrix(NA, nrow = length(a1), ncol = length(a1)))
+  a6 <- suppressWarnings(sqrt(diag(a5)))
+  a6[!is.finite(a6)] <- NA
+  rho_star <- a1[irho]
+  rho_hat <- 2 / (1 + exp(-rho_star)) - 1
+  g_prime <- 4 * exp(-rho_star) / (1 + exp(-rho_star))^2
+  se_rho_star <- a6[irho]
+  se_rho <- abs(g_prime) * se_rho_star
+  a1[irho] <- rho_hat
+  a6[irho] <- se_rho
+
+  result <- list(
+    coefficients     = a1,
+    value            = theta_BS$value,
+    loglik           = theta_BS$value,
+    counts           = theta_BS$counts[2],
+    hessian          = a4,
+    fisher_infoBS    = a5,
+    prop_sigmaBS     = a6,
+    level            = YSLevels,
+    nObs             = length(YS),
+    nParam           = length(start),
+    N0               = sum(YS == 0),
+    N1               = sum(YS == 1),
+    NXS              = NXS,
+    NXO              = NXO,
+    df               = length(YS) - length(start),
+    aic              = -2 * theta_BS$value + 2 * length(start),
+    bic              = -2 * theta_BS$value + length(start) * log(length(YS)),
+    initial.value    = start
+  )
+  class(result) <- c("HeckmanBS")
+  return(result)
+}
diff -ru R_original_backup_for_audit/HeckmanCL.R R/HeckmanCL.R
--- R_original_backup_for_audit/HeckmanCL.R	2025-05-29 20:28:50.000000000 +0000
+++ R/HeckmanCL.R	2026-05-29 21:59:11.010452469 +0000
@@ -1,238 +1,242 @@
-#' Classic Heckman Model fit Function
-#'
-#' @description
-#' Estimates the parameters of the classic Heckman model
-#' via Maximum Likelihood method. The initial start is obtained
-#' via the two-step method.
-#'
-#' @return
-#' Returns a list with the following components.
-#'
-#' Coefficients: Returns a numerical vector with the best estimated values
-#' of the model parameters;
-#'
-#' Value: The value of function to be minimized (or maximized) corresponding
-#' to par.
-#'
-#' loglik: Negative of value. Minimum (or maximum) of the likelihood function
-#' calculated from the estimated coefficients.
-#'
-#' counts: Component of the Optim function. A two-element integer vector
-#' giving the number of calls to fn and gr respectively. This excludes
-#' those calls needed to compute the Hessian, if requested, and any calls
-#' to fn to compute a finite-difference approximation to the gradient.
-#'
-#' hessian: Component of the Optim function, with pre-defined option
-#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
-#' at the solution found. Note that this is the Hessian of the unconstrained
-#' problem even if the box constraints are active.
-#'
-#' fisher_infoHC: Fisher information matrix
-#'
-#' prop_sigmaHC: Square root of the Fisher information matrix diagonal
-#'
-#' level: Selection variable levels
-#'
-#' nObs: Numeric value representing the size of the database
-#'
-#' nParam: Numerical value representing the number of model parameters
-#'
-#' N0: Numerical value representing the number of unobserved entries
-#'
-#' N1: Numerical value representing the number of complete entries
-#'
-#' NXS: Numerical value representing the number of parameters of the
-#' selection model
-#'
-#' NXO: Numerical value representing the number of parameters of the
-#' regression model
-#'
-#' df: Numerical value that represents the difference between the size
-#' of the response vector of the selection equation and the number of
-#' model parameters
-#'
-#' aic: Numerical value representing Akaike's information criterion.
-#'
-#' bic: Numerical value representing Schwarz's Bayesian Criterion
-#'
-#' initial.value: Numerical vector that represents the input values
-#' (Initial Values) used in the parameter estimation.
-#'
-#' @param selection Selection equation.
-#' @param outcome Primary Regression Equation.
-#' @param start initial values.
-#' @param data Database.
-#' @examples
-#' data(MEPS2001)
-#' attach(MEPS2001)
-#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
-#' outcomeEq <- lnambx ~ age + female + educ + blhisp + totchr + ins
-#' HeckmanCL(selectEq, outcomeEq, data = MEPS2001)
-#' @export HeckmanCL
-#' @export
-HeckmanCL <- function(selection, outcome, data = sys.frame(sys.parent()), start = NULL) {
-  # Extract model components from selection and outcome formulas
-  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
-  XS  <- components$XS       # Design matrix for selection equation
-  YS  <- components$YS       # Response variable for selection equation
-  NXS <- components$NXS      # Number of selection parameters
-  XO  <- components$XO       # Design matrix for outcome equation
-  YO  <- components$YO       # Response variable for outcome equation
-  NXO <- components$NXO      # Number of outcome parameters
-  YSLevels <- components$YSLevels  # Levels of the selection variable
-
-  ######################################
-  # Log-likelihood function definition
-  ######################################
-  loglik_HC <- function(start) {
-    # Parameter indices
-    istartS <- 1:NXS
-    istartO <- seq(tail(istartS, 1) + 1, length.out = NXO)
-    isigma  <- tail(istartO, 1) + 1
-    irho    <- isigma + 1
-
-    # Extract parameters
-    g     <- start[istartS]
-    b     <- start[istartO]
-    sigma <- start[isigma]
-    rho   <- start[irho]
-
-    # Check parameter validity
-    if (!is.finite(sigma) || sigma <= 0) return(NA)
-    if (!is.finite(rho) || abs(rho) >= 1) return(NA)
-
-    # Compute linear predictors
-    XS.g     <- XS %*% g
-    XO.b     <- XO %*% b
-    YO_clean <- ifelse(is.na(YO), 0, YO)
-    u2       <- YO_clean - XO.b
-    r        <- sqrt(1 - rho^2)
-    B        <- (XS.g + (rho / sigma) * u2) / r
-
-    # Log-likelihood contributions
-    ll <- ifelse(YS == 0,
-                 pnorm(-XS.g, log.p = TRUE),
-                 dnorm(u2 / sigma, log = TRUE) - log(sigma) + pnorm(B, log.p = TRUE))
-
-    return(sum(ll))
-  }
-
-  ######################################
-  # Gradient of the log-likelihood
-  ######################################
-  gradlik_HC <- function(start) {
-    nObs <- length(YS)
-
-    # Parameter indices
-    istartS <- 1:NXS
-    istartO <- seq(tail(istartS, 1) + 1, length.out = NXO)
-    isigma  <- tail(istartO, 1) + 1
-    irho    <- isigma + 1
-    nParam  <- irho
-
-    # Extract parameters
-    g     <- start[istartS]
-    b     <- start[istartO]
-    sigma <- start[isigma]
-    rho   <- start[irho]
-
-    # Check parameter validity
-    if (!is.finite(sigma) || sigma <= 0) return(rep(NA, nParam))
-    if (!is.finite(rho) || abs(rho) >= 1) return(rep(NA, nParam))
-
-    # Partition data based on selection indicator
-    XS0 <- XS[YS == 0, , drop = FALSE]
-    XS1 <- XS[YS == 1, , drop = FALSE]
-    XO1 <- XO[YS == 1, , drop = FALSE]
-    YO_clean <- ifelse(is.na(YO), 0, YO)
-    YO1 <- YO_clean[YS == 1]
-
-    # Linear predictors and residuals
-    XS0.g <- drop(XS0 %*% g)
-    XS1.g <- drop(XS1 %*% g)
-    XO1.b <- drop(XO1 %*% b)
-    u2    <- YO1 - XO1.b
-    r     <- sqrt(1 - rho^2)
-
-    # Compute correction term
-    B <- (XS1.g + (rho / sigma) * u2) / r
-    lambdaB <- exp(dnorm(B, log = TRUE) - pnorm(B, log.p = TRUE))
-
-    # Initialize gradient matrix
-    gradient <- matrix(0, nrow = nObs, ncol = nParam)
-
-    # Gradient contributions
-    gradient[YS == 0, istartS] <- -XS0 * exp(dnorm(-XS0.g, log = TRUE) - pnorm(-XS0.g, log.p = TRUE))
-    gradient[YS == 1, istartS] <-  XS1 * lambdaB / r
-    gradient[YS == 1, istartO] <-  XO1 * (u2 / sigma^2 - lambdaB * rho / (sigma * r))
-    gradient[YS == 1, isigma]  <- (u2^2 / sigma^3 - lambdaB * rho * u2 / (sigma^2 * r)) - 1 / sigma
-    gradient[YS == 1, irho]    <- lambdaB * (u2 / sigma + rho * XS1.g) / r^3
-
-    return(colSums(gradient))
-  }
-
-  ######################################
-  # Starting values (if not provided)
-  ######################################
-  if (is.null(start)) {
-    message("Start not provided using default start values.")
-    start <- c(rep(0, NXS + NXO), 1, 0)
-  }
-
-  ######################################
-  # Maximum Likelihood Estimation
-  ######################################
-  theta_HC <- optim(start,
-                    loglik_HC,
-                    gradlik_HC,
-                    method  = "BFGS",
-                    hessian = TRUE,
-                    control = list(fnscale = -1))
-
-  # Assign names to estimated parameters
-  names(theta_HC$par) <- c(colnames(XS), colnames(XO), "sigma", "rho")
-
-  ######################################
-  # Organize results
-  ######################################
-  a   <- start
-  a1  <- theta_HC$par
-  a2  <- theta_HC$value
-  a3  <- theta_HC$counts[2]
-  a4  <- theta_HC$hessian
-  a5  <- solve(-a4)
-  a6  <- sqrt(diag(a5))
-  a7  <- YSLevels
-  a8  <- length(YS)
-  a9  <- length(start)
-  a10 <- sum(YS == 0)
-  a11 <- sum(YS == 1)
-  a12 <- NXS
-  a13 <- NXO
-  a14 <- a8 - a9
-  a15 <- -2 * a2 + 2 * a9
-  a16 <- -2 * a2 + a9 * log(a8)
-
-  # Create result object
-  result <- list(coefficients   = a1,
-                 value          = a2,
-                 loglik         = -a2,
-                 counts         = a3,
-                 hessian        = a4,
-                 fisher_infoHC  = a5,
-                 prop_sigmaHC   = a6,
-                 level          = a7,
-                 nObs           = a8,
-                 nParam         = a9,
-                 N0             = a10,
-                 N1             = a11,
-                 NXS            = a12,
-                 NXO            = a13,
-                 df             = a14,
-                 aic            = a15,
-                 bic            = a16,
-                 initial.value  = a)
-
-  class(result) <- c("HeckmanCL", class(theta_HC))
-  return(result)
-}
+#' Classic Heckman Model fit Function
+#'
+#' @description
+#' Estimates the parameters of the classic Heckman model
+#' via Maximum Likelihood method. The initial start is obtained
+#' via the two-step method.
+#'
+#' @return
+#' Returns a list with the following components.
+#'
+#' Coefficients: Returns a numerical vector with the best estimated values
+#' of the model parameters;
+#'
+#' Value: The value of function to be minimized (or maximized) corresponding
+#' to par.
+#'
+#' loglik: Maximized value of the log-likelihood function calculated from the estimated coefficients.
+#'
+#' counts: Component of the Optim function. A two-element integer vector
+#' giving the number of calls to fn and gr respectively. This excludes
+#' those calls needed to compute the Hessian, if requested, and any calls
+#' to fn to compute a finite-difference approximation to the gradient.
+#'
+#' hessian: Component of the Optim function, with pre-defined option
+#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
+#' at the solution found. Note that this is the Hessian of the unconstrained
+#' problem even if the box constraints are active.
+#'
+#' fisher_infoHC: Fisher information matrix
+#'
+#' prop_sigmaHC: Square root of the Fisher information matrix diagonal
+#'
+#' level: Selection variable levels
+#'
+#' nObs: Numeric value representing the size of the database
+#'
+#' nParam: Numerical value representing the number of model parameters
+#'
+#' N0: Numerical value representing the number of unobserved entries
+#'
+#' N1: Numerical value representing the number of complete entries
+#'
+#' NXS: Numerical value representing the number of parameters of the
+#' selection model
+#'
+#' NXO: Numerical value representing the number of parameters of the
+#' regression model
+#'
+#' df: Numerical value that represents the difference between the size
+#' of the response vector of the selection equation and the number of
+#' model parameters
+#'
+#' aic: Numerical value representing Akaike's information criterion.
+#'
+#' bic: Numerical value representing Schwarz's Bayesian Criterion
+#'
+#' initial.value: Numerical vector that represents the input values
+#' (Initial Values) used in the parameter estimation.
+#'
+#' @param selection Selection equation.
+#' @param outcome Primary Regression Equation.
+#' @param start initial values.
+#' @param data Database.
+#' @examples
+#' data(MEPS2001)
+#' attach(MEPS2001)
+#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
+#' outcomeEq <- lnambx ~ age + female + educ + blhisp + totchr + ins
+#' HeckmanCL(selectEq, outcomeEq, data = MEPS2001)
+#' @export HeckmanCL
+#' @export
+HeckmanCL <- function(selection, outcome, data = sys.frame(sys.parent()), start = NULL) {
+  # Extract model components from selection and outcome formulas
+  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
+  XS  <- components$XS       # Design matrix for selection equation
+  YS  <- components$YS       # Response variable for selection equation
+  NXS <- components$NXS      # Number of selection parameters
+  XO  <- components$XO       # Design matrix for outcome equation
+  YO  <- components$YO       # Response variable for outcome equation
+  NXO <- components$NXO      # Number of outcome parameters
+  YSLevels <- components$YSLevels  # Levels of the selection variable
+
+  ######################################
+  # Log-likelihood function definition
+  ######################################
+  loglik_HC <- function(start) {
+    # Parameter indices
+    istartS <- 1:NXS
+    istartO <- seq(tail(istartS, 1) + 1, length.out = NXO)
+    isigma  <- tail(istartO, 1) + 1
+    irho    <- isigma + 1
+
+    # Extract parameters
+    g     <- start[istartS]
+    b     <- start[istartO]
+    sigma <- start[isigma]
+    rho   <- start[irho]
+
+    # Check parameter validity
+    if (!is.finite(sigma) || sigma <= 0) return(NA)
+    if (!is.finite(rho) || abs(rho) >= 1) return(NA)
+
+    # Compute linear predictors
+    XS.g     <- XS %*% g
+    XO.b     <- XO %*% b
+    YO_clean <- ifelse(is.na(YO), 0, YO)
+    u2       <- YO_clean - XO.b
+    r        <- sqrt(1 - rho^2)
+    B        <- (XS.g + (rho / sigma) * u2) / r
+
+    # Log-likelihood contributions
+    ll <- ifelse(YS == 0,
+                 pnorm(-XS.g, log.p = TRUE),
+                 dnorm(u2 / sigma, log = TRUE) - log(sigma) + pnorm(B, log.p = TRUE))
+
+    return(sum(ll))
+  }
+
+  ######################################
+  # Gradient of the log-likelihood
+  ######################################
+  gradlik_HC <- function(start) {
+    nObs <- length(YS)
+
+    # Parameter indices
+    istartS <- 1:NXS
+    istartO <- seq(tail(istartS, 1) + 1, length.out = NXO)
+    isigma  <- tail(istartO, 1) + 1
+    irho    <- isigma + 1
+    nParam  <- irho
+
+    # Extract parameters
+    g     <- start[istartS]
+    b     <- start[istartO]
+    sigma <- start[isigma]
+    rho   <- start[irho]
+
+    # Check parameter validity
+    if (!is.finite(sigma) || sigma <= 0) return(rep(NA, nParam))
+    if (!is.finite(rho) || abs(rho) >= 1) return(rep(NA, nParam))
+
+    # Partition data based on selection indicator
+    XS0 <- XS[YS == 0, , drop = FALSE]
+    XS1 <- XS[YS == 1, , drop = FALSE]
+    XO1 <- XO[YS == 1, , drop = FALSE]
+    YO_clean <- ifelse(is.na(YO), 0, YO)
+    YO1 <- YO_clean[YS == 1]
+
+    # Linear predictors and residuals
+    XS0.g <- drop(XS0 %*% g)
+    XS1.g <- drop(XS1 %*% g)
+    XO1.b <- drop(XO1 %*% b)
+    u2    <- YO1 - XO1.b
+    r     <- sqrt(1 - rho^2)
+
+    # Compute correction term
+    B <- (XS1.g + (rho / sigma) * u2) / r
+    lambdaB <- exp(dnorm(B, log = TRUE) - pnorm(B, log.p = TRUE))
+
+    # Initialize gradient matrix
+    gradient <- matrix(0, nrow = nObs, ncol = nParam)
+
+    # Gradient contributions
+    gradient[YS == 0, istartS] <- -XS0 * exp(dnorm(-XS0.g, log = TRUE) - pnorm(-XS0.g, log.p = TRUE))
+    gradient[YS == 1, istartS] <-  XS1 * lambdaB / r
+    gradient[YS == 1, istartO] <-  XO1 * (u2 / sigma^2 - lambdaB * rho / (sigma * r))
+    gradient[YS == 1, isigma]  <- (u2^2 / sigma^3 - lambdaB * rho * u2 / (sigma^2 * r)) - 1 / sigma
+    gradient[YS == 1, irho]    <- lambdaB * (u2 / sigma + rho * XS1.g) / r^3
+
+    return(colSums(gradient))
+  }
+
+  ######################################
+  # Starting values (if not provided)
+  ######################################
+  if (is.null(start)) {
+    start <- tryCatch(step2(YS, XS, YO, XO), error = function(e) NULL)
+    if (is.null(start) || any(!is.finite(start))) {
+      message("Two-step starting values failed; using neutral default start values.")
+      start <- c(rep(0, NXS + NXO), 1, 0)
+    }
+    start[NXS + NXO + 1L] <- max(start[NXS + NXO + 1L], .Machine$double.eps)
+    start[NXS + NXO + 2L] <- .ssmodels_clip_rho(start[NXS + NXO + 2L])
+  }
+
+  ######################################
+  # Maximum Likelihood Estimation
+  ######################################
+  theta_HC <- optim(start,
+                    loglik_HC,
+                    gradlik_HC,
+                    method  = "BFGS",
+                    hessian = TRUE,
+                    control = list(fnscale = -1))
+
+  # Assign names to estimated parameters
+  names(theta_HC$par) <- c(colnames(XS), colnames(XO), "sigma", "rho")
+
+  ######################################
+  # Organize results
+  ######################################
+  a   <- start
+  a1  <- theta_HC$par
+  a2  <- theta_HC$value
+  a3  <- theta_HC$counts[2]
+  a4  <- theta_HC$hessian
+  a5  <- .ssmodels_safe_vcov(a4)
+  a6  <- .ssmodels_safe_se(a5)
+  a7  <- YSLevels
+  a8  <- length(YS)
+  a9  <- length(start)
+  a10 <- sum(YS == 0)
+  a11 <- sum(YS == 1)
+  a12 <- NXS
+  a13 <- NXO
+  a14 <- a8 - a9
+  a15 <- -2 * a2 + 2 * a9
+  a16 <- -2 * a2 + a9 * log(a8)
+
+  # Create result object
+  result <- list(coefficients   = a1,
+                 value          = a2,
+                 loglik         = a2,
+                 counts         = a3,
+                 hessian        = a4,
+                 fisher_infoHC  = a5,
+                 prop_sigmaHC   = a6,
+                 level          = a7,
+                 nObs           = a8,
+                 nParam         = a9,
+                 N0             = a10,
+                 N1             = a11,
+                 NXS            = a12,
+                 NXO            = a13,
+                 df             = a14,
+                 aic            = a15,
+                 bic            = a16,
+                 initial.value  = a)
+
+  class(result) <- c("HeckmanCL", class(theta_HC))
+  return(result)
+}
diff -ru R_original_backup_for_audit/HeckmanGe.R R/HeckmanGe.R
--- R_original_backup_for_audit/HeckmanGe.R	2025-05-29 21:13:39.000000000 +0000
+++ R/HeckmanGe.R	2026-05-29 21:59:32.080436911 +0000
@@ -1,258 +1,194 @@
-#' Generalized Heckman Model Estimation
-#'
-#' @description
-#' Estimates the parameters of a generalized Heckman selection model,
-#' allowing for heteroskedasticity and correlation covariates.
-#'
-#' @param selection Formula for the selection equation.
-#' @param outcome Formula for the outcome equation.
-#' @param outcomeS Covariates for the scale model (optional).
-#' @param outcomeC Covariates for the correlation model (optional).
-#' @param data Data frame containing all variables.
-#' @param start Optional starting values for the optimization.
-#'
-#' @return A list with the fitted model parameters and diagnostics.
-#' @export
-HeckmanGe <- function(selection, outcome, outcomeS, outcomeC, data = sys.frame(sys.parent()), start = NULL) {
-  ##############################################################################
-  # Extract model matrix and response vectors from the selection and outcome equations
-  ##############################################################################
-  components <- extract_model_components(selection = selection,
-                                         outcome = outcome,
-                                         outcomeS = outcomeS,
-                                         outcomeC = outcomeC,
-                                         data = data)
-  XS  <- components$XS       # Model matrix for the selection equation
-  YS  <- components$YS       # Binary response for the selection equation
-  NXS <- components$NXS      # Number of selection covariates
-  XO  <- components$XO       # Model matrix for the outcome equation
-  YO  <- components$YO       # Response for the outcome equation
-  NXO <- components$NXO      # Number of outcome covariates
-  Msigma <- components$Msigma  # Covariates for the scale model
-  NE <- components$NE          # Number of dispersion parameters
-  Mrho <- components$Mrho      # Covariates for the correlation model
-  NV <- components$NV          # Number of correlation parameters
-  YSLevels <- components$YSLevels  # Levels of the selection variable
-
-  ##############################################################################
-  # Log-likelihood function for the generalized Heckman model
-  ##############################################################################
-  loglik_gen <- function(start) {
-    NXS <- ncol(model.matrix(~XS)) - 1
-    NXO <- ncol(model.matrix(~XO)) - 1
-
-    NE <- if (length(outcomeS) == 1) 1 else ncol(model.matrix(~outcomeS))
-    NV <- if (length(outcomeC) == 1) 1 else ncol(model.matrix(~outcomeC))
-
-    Msigma <- if (NE == 1) matrix(1, nrow(XO), 1) else outcomeS
-    Mrho   <- if (NV == 1) matrix(1, nrow(XO), 1) else outcomeC
-
-    ## parameter indices
-    istartS <- 1:NXS
-    istartO <- (max(istartS) + 1):(max(istartS) + NXO)
-    ilambda <- (max(istartO) + 1):(max(istartO) + NE)
-    ikappa  <- (max(ilambda) + 1):(max(ilambda) + NV)
-
-    g <- start[istartS]
-    b <- start[istartO]
-    lambda <- start[ilambda]
-    kappa <- start[ikappa]
-
-    mu2 <- XS %*% g
-    mu1 <- XO %*% b
-
-    if (NE == 1) {
-      sigma <- exp(model.matrix(~1, data = data.frame(rep(1, nrow(XO)))) %*%
-                     lambda)
-    } else {
-      sigma <- exp(model.matrix(~Msigma) %*% lambda)
-    }
-
-    if (NV == 1) {
-      rho <- tanh(model.matrix(~1, data = data.frame(rep(1, nrow(XO)))) %*%
-                    kappa)
-    } else {
-      rho <- tanh(model.matrix(~Mrho) %*% kappa)
-    }
-
-
-
-    z1 <- YO - mu1
-    z <- z1 * (1/sigma)
-    r <- sqrt(1 - rho^2)
-    A_rho <- 1/r
-    A_rrho <- rho/r
-    zeta <- mu2 * A_rho + z * A_rrho
-    ll <- ifelse(YS == 0, (pnorm(-mu2, log.p = TRUE)), dnorm(z, log = TRUE) -
-                   log(sigma) + (pnorm(zeta, log.p = TRUE)))
-    sum(ll)
-  }
-
-  ##############################################################################
-  # Analytical gradient of the log-likelihood
-  ##############################################################################
-    gradlik_gen <- function(start) {
-      NXS <- ncol(model.matrix(~XS)) - 1
-      NXO <- ncol(model.matrix(~XO)) - 1
-
-      NE <- if (length(outcomeS) == 1) 1 else ncol(model.matrix(~outcomeS))
-      NV <- if (length(outcomeC) == 1) 1 else ncol(model.matrix(~outcomeC))
-
-      Msigma <- if (NE == 1) matrix(1, nrow(XO), 1) else outcomeS
-      Mrho   <- if (NV == 1) matrix(1, nrow(XO), 1) else outcomeC
-
-      nObs <- length(YS)
-      nParam <- NXS + NXO + NE + NV
-
-        XS0 <- XS[YS == 0, , drop = FALSE]
-        XS1 <- XS[YS == 1, , drop = FALSE]
-        YO[is.na(YO)] <- 0
-        YO1 <- YO[YS == 1]
-        XO1 <- XO[YS == 1, , drop = FALSE]
-        ES0 <- Msigma[YS == 0, , drop = FALSE]
-        ES1 <- Msigma[YS == 1, , drop = FALSE]
-        VS0 <- Mrho[YS == 0, , drop = FALSE]
-        VS1 <- Mrho[YS == 1, , drop = FALSE]
-        N0 <- sum(YS == 0)
-        N1 <- sum(YS == 1)
-
-        M1 <- rep(1, N0 + N1)
-        u1 <- rep(1, N1)  #YS=1
-        u2 <- rep(1, N0)  #YS=0
-
-        ## parameter indices
-        istartS <- 1:NXS
-        istartO <- (max(istartS) + 1):(max(istartS) + NXO)
-        ilambda <- (max(istartO) + 1):(max(istartO) + NE)
-        ikappa  <- (max(ilambda) + 1):(max(ilambda) + NV)
-
-
-        g <- start[istartS]
-        b <- start[istartO]
-        lambda <- start[ilambda]
-        kappa <- start[ikappa]
-
-        mu20 <- as.numeric(XS0 %*% g)
-        mu21 <- as.numeric(XS1 %*% g)
-        mu11 <- as.numeric(XO1 %*% b)
-
-        sigma1 <- as.numeric(exp(model.matrix(if (NE == 1) ~ES1 - 1 else ~ES1) %*% lambda))
-        rho1   <- as.numeric(tanh(model.matrix(if (NV == 1) ~VS1 - 1 else ~VS1) %*% kappa))
-
-        z <- (YO1 - mu11) / sigma1
-        r <- sqrt(1 - rho1^2)
-        A_rho <- 1 / r
-        A_rrho <- rho1 / r
-
-        zeta <- drop(mu21) * A_rho + z * A_rrho
-        MZeta <- exp(dnorm(zeta, log = TRUE) - pnorm(zeta, log.p = TRUE))
-        Mmu2 <- exp(dnorm(-mu20, log = TRUE) - pnorm(-mu20, log.p = TRUE))
-        gradient <- matrix(0, nObs, nParam)
-        gradient[YS == 0, istartS] <- -u2 * XS0 * Mmu2
-        gradient[YS == 1, istartS] <- u1 * XS1 * MZeta * A_rho
-        gradient[YS == 1, istartO] <- u1 * XO1 * (z - MZeta * A_rrho) / sigma1
-
-        form_sigma <- model.matrix(if (NE == 1) ~ES1 - 1 else ~ES1)
-        form_rho   <- model.matrix(if (NV == 1) ~VS1 - 1 else ~VS1)
-        sech_sq <- pracma::sech(form_rho %*% kappa)^2
-
-        gradient[YS == 1, ilambda] <- u1 * form_sigma * (z^2 - 1 - MZeta * z * A_rrho)
-        gradient[YS == 1, ikappa]  <- u1 * form_rho * MZeta * A_rho * sech_sq *
-          (drop(mu21) * rho1 * A_rho^2 + z * (1 + A_rrho^2))
-        colSums(gradient)
-    }
-
-  ##############################################################################
-  # Starting values
-  ##############################################################################
-  if (is.null(start)) {
-    start <- step2(YS, XS, YO, XO)  # Initial values from standard Heckman model
-  }
-
-  # Auxiliary vectors for lambda and kappa parameters
-  lambda_start <- rep(1, NE)
-  kappa_start  <- rep(0, NV)
-
-  # Starting values for selection (g), outcome (b), scale (sigma) and correlation (rho)
-  g_start     <- start[1:NXS]
-  b_start     <- start[(NXS + 1):(NXS + NXO)]
-  sigma_start <- start[NXS + NXO + 1]  # log(sigma) or intercept
-  rho_start   <- start[NXS + NXO + 2]  # atanh(rho) or intercept
-
-  # Combine all initial values
-  start <- c(
-    g_start,
-    b_start,
-    if (NE == 1) sigma_start else c(sigma_start, lambda_start),
-    if (NV == 1) rho_start   else c(rho_start, kappa_start)
-  )
-
-  # Assign names to parameter vector
-  start_names <- c(
-    colnames(XS),
-    colnames(XO),
-    if (NE == 1) "sigma" else c("interceptS", colnames(outcomeS)),
-    if (NV == 1) "correlation" else c("interceptC", colnames(outcomeC))
-  )
-  names(start) <- start_names
-
-  ##############################################################################
-  # Optimization using BFGS method
-  ##############################################################################
-  theta_HG <- optim(start, loglik_gen, gradlik_gen, method = "BFGS", hessian = TRUE,
-                    control = list(fnscale = -1))
-
-  # Post-process estimated parameters: apply transformations and assign names
-  theta_HG$par <- postprocess_theta(theta_HG$par, NXS, NXO, NE, NV, XS, XO, outcomeS, outcomeC)
-
-  ##############################################################################
-  # Model diagnostics and information criteria
-  ##############################################################################
-  nObs    <- length(YS)               # Number of observations
-  nParam  <- length(start)            # Total number of parameters
-  N0      <- sum(YS == 0)             # Number of censored observations
-  N1      <- sum(YS == 1)             # Number of observed (selected) observations
-  df      <- nObs - nParam            # Degrees of freedom
-  aic     <- -2 * theta_HG$value + 2 * nParam
-  bic     <- -2 * theta_HG$value + nParam * log(nObs)
-
-  # Recalculate NE and NV in case of transformation
-  NE <- if (length(outcomeS) == 1) 1 else ncol(model.matrix(~outcomeS))
-  NV <- if (length(outcomeC) == 1) 1 else ncol(model.matrix(~outcomeC))
-
-  ##############################################################################
-  # Fisher information and standard errors
-  ##############################################################################
-  fisher_infoHG <- tryCatch(solve(-theta_HG$hessian), error = function(e) matrix(NA, nParam, nParam))
-  prop_sigmaHG  <- sqrt(diag(fisher_infoHG))
-
-  ##############################################################################
-  # Output object
-  ##############################################################################
-  result <- list(
-    coefficients   = theta_HG$par,
-    value          = theta_HG$value,
-    loglik         = -theta_HG$value,
-    counts         = theta_HG$counts[2],
-    hessian        = theta_HG$hessian,
-    fisher_infoHG  = fisher_infoHG,
-    prop_sigmaHG   = prop_sigmaHG,
-    level          = YSLevels,
-    nObs           = nObs,
-    nParam         = nParam,
-    N0             = N0,
-    N1             = N1,
-    NXS            = ncol(XS),
-    NXO            = ncol(XO),
-    df             = df,
-    aic            = aic,
-    bic            = bic,
-    initial.value  = start,
-    NE             = NE,
-    NV             = NV
-  )
-
-  # Assign class to the result object
-  class(result) <- c("HeckmanGe", class(theta_HG))
-  return(result)
-}
+#' Generalized Heckman Model Estimation
+#'
+#' @description
+#' Estimates the parameters of a generalized Heckman selection model,
+#' allowing covariates in the scale and correlation components.
+#'
+#' @param selection Formula for the selection equation.
+#' @param outcome Formula for the outcome equation.
+#' @param outcomeS Covariates for the log-scale model. It may be a matrix,
+#'   vector, one-sided formula, or 1 for an intercept-only scale model.
+#' @param outcomeC Covariates for the correlation model. It may be a matrix,
+#'   vector, one-sided formula, or 1 for an intercept-only correlation model.
+#' @param data Data frame containing all variables.
+#' @param start Optional starting values. If supplied on the natural classical
+#'   scale, sigma and rho are internally mapped to log(sigma) and atanh(rho).
+#'
+#' @return A list with the fitted model parameters and diagnostics.
+#' @export
+HeckmanGe <- function(selection, outcome, outcomeS = 1, outcomeC = 1,
+                      data = sys.frame(sys.parent()), start = NULL) {
+
+  components <- extract_model_components(selection = selection,
+                                         outcome = outcome,
+                                         outcomeS = outcomeS,
+                                         outcomeC = outcomeC,
+                                         data = data)
+  XS <- components$XS
+  YS <- components$YS
+  NXS <- components$NXS
+  XO <- components$XO
+  YO <- components$YO
+  NXO <- components$NXO
+  Msigma <- components$Msigma
+  NE <- components$NE
+  Mrho <- components$Mrho
+  NV <- components$NV
+  YSLevels <- components$YSLevels
+
+  YO_clean <- ifelse(is.na(YO), 0, YO)
+
+  loglik_gen <- function(par) {
+    if (any(!is.finite(par))) return(NA_real_)
+
+    istartS <- seq_len(NXS)
+    istartO <- seq.int(NXS + 1L, NXS + NXO)
+    ilambda <- seq.int(NXS + NXO + 1L, NXS + NXO + NE)
+    ikappa  <- seq.int(NXS + NXO + NE + 1L, NXS + NXO + NE + NV)
+
+    gamma <- par[istartS]
+    beta <- par[istartO]
+    lambda <- par[ilambda]
+    kappa <- par[ikappa]
+
+    mu2 <- drop(XS %*% gamma)
+    mu1 <- drop(XO %*% beta)
+    sigma <- as.numeric(exp(Msigma %*% lambda))
+    rho <- as.numeric(tanh(Mrho %*% kappa))
+
+    r <- sqrt(pmax(1 - rho^2, .Machine$double.eps))
+    z <- (YO_clean - mu1) / sigma
+    zeta <- (mu2 + rho * z) / r
+
+    ll0 <- stats::pnorm(-mu2, log.p = TRUE)
+    ll1 <- stats::dnorm(z, log = TRUE) - log(sigma) +
+      stats::pnorm(zeta, log.p = TRUE)
+
+    sum(ifelse(YS == 0L, ll0, ll1))
+  }
+
+  gradlik_gen <- function(par) {
+    istartS <- seq_len(NXS)
+    istartO <- seq.int(NXS + 1L, NXS + NXO)
+    ilambda <- seq.int(NXS + NXO + 1L, NXS + NXO + NE)
+    ikappa  <- seq.int(NXS + NXO + NE + 1L, NXS + NXO + NE + NV)
+    nParam <- NXS + NXO + NE + NV
+
+    if (any(!is.finite(par))) return(rep(NA_real_, nParam))
+
+    gamma <- par[istartS]
+    beta <- par[istartO]
+    lambda <- par[ilambda]
+    kappa <- par[ikappa]
+
+    XS0 <- XS[YS == 0L, , drop = FALSE]
+    XS1 <- XS[YS == 1L, , drop = FALSE]
+    XO1 <- XO[YS == 1L, , drop = FALSE]
+    YO1 <- YO_clean[YS == 1L]
+    MS1 <- Msigma[YS == 1L, , drop = FALSE]
+    MR1 <- Mrho[YS == 1L, , drop = FALSE]
+
+    mu20 <- drop(XS0 %*% gamma)
+    mu21 <- drop(XS1 %*% gamma)
+    mu11 <- drop(XO1 %*% beta)
+
+    sigma1 <- as.numeric(exp(MS1 %*% lambda))
+    rho1 <- as.numeric(tanh(MR1 %*% kappa))
+    r1 <- sqrt(pmax(1 - rho1^2, .Machine$double.eps))
+    z1 <- (YO1 - mu11) / sigma1
+    zeta1 <- (mu21 + rho1 * z1) / r1
+
+    lambda0 <- exp(stats::dnorm(-mu20, log = TRUE) -
+                     stats::pnorm(-mu20, log.p = TRUE))
+    lambda1 <- exp(stats::dnorm(zeta1, log = TRUE) -
+                     stats::pnorm(zeta1, log.p = TRUE))
+
+    gradient <- matrix(0, nrow = length(YS), ncol = nParam)
+    gradient[YS == 0L, istartS] <- -XS0 * lambda0
+    gradient[YS == 1L, istartS] <- XS1 * (lambda1 / r1)
+    gradient[YS == 1L, istartO] <- XO1 *
+      (z1 / sigma1 - lambda1 * rho1 / (sigma1 * r1))
+    gradient[YS == 1L, ilambda] <- MS1 *
+      (z1^2 - 1 - lambda1 * rho1 * z1 / r1)
+    gradient[YS == 1L, ikappa] <- MR1 *
+      (lambda1 * (z1 + rho1 * mu21) / r1)
+
+    colSums(gradient)
+  }
+
+  if (is.null(start)) {
+    start_classic <- tryCatch(step2(YS, XS, YO, XO), error = function(e) NULL)
+    if (is.null(start_classic) || any(!is.finite(start_classic))) {
+      message("Two-step starting values failed; using neutral default start values.")
+      start_classic <- c(rep(0, NXS + NXO), sigma = 1, rho = 0)
+    }
+  } else {
+    start_classic <- start
+  }
+
+  sigma0 <- max(start_classic[NXS + NXO + 1L], .Machine$double.eps)
+  rho0 <- .ssmodels_clip_rho(start_classic[NXS + NXO + 2L])
+
+  lambda_start <- c(log(sigma0), rep(0, max(NE - 1L, 0L)))
+  kappa_start <- c(atanh(rho0), rep(0, max(NV - 1L, 0L)))
+
+  start_opt <- c(start_classic[seq_len(NXS + NXO)], lambda_start, kappa_start)
+
+  sigma_names <- if (NE == 1L) "sigma" else paste0("log.sigma.", colnames(Msigma))
+  rho_names <- if (NV == 1L) "rho" else paste0("atanh.rho.", colnames(Mrho))
+  names(start_opt) <- c(colnames(XS), colnames(XO), sigma_names, rho_names)
+
+  theta_HG <- stats::optim(start_opt, loglik_gen, gradlik_gen,
+                           method = "BFGS", hessian = TRUE,
+                           control = list(fnscale = -1, maxit = 1000))
+
+  vcov_link <- .ssmodels_safe_vcov(theta_HG$hessian)
+  se_link <- .ssmodels_safe_se(vcov_link)
+  coef_out <- theta_HG$par
+  se_out <- se_link
+
+  ilambda <- seq.int(NXS + NXO + 1L, NXS + NXO + NE)
+  ikappa  <- seq.int(NXS + NXO + NE + 1L, NXS + NXO + NE + NV)
+
+  if (NE == 1L) {
+    coef_out[ilambda] <- exp(theta_HG$par[ilambda])
+    se_out[ilambda] <- abs(coef_out[ilambda]) * se_link[ilambda]
+  }
+  if (NV == 1L) {
+    coef_out[ikappa] <- tanh(theta_HG$par[ikappa])
+    se_out[ikappa] <- (1 - coef_out[ikappa]^2) * se_link[ikappa]
+  }
+  names(coef_out) <- names(start_opt)
+  names(se_out) <- names(start_opt)
+
+  nObs <- length(YS)
+  nParam <- length(start_opt)
+  result <- list(
+    coefficients   = coef_out,
+    coefficients_link = theta_HG$par,
+    value          = theta_HG$value,
+    loglik         = theta_HG$value,
+    counts         = theta_HG$counts[2],
+    hessian        = theta_HG$hessian,
+    fisher_infoHG  = vcov_link,
+    prop_sigmaHG   = se_out,
+    level          = YSLevels,
+    nObs           = nObs,
+    nParam         = nParam,
+    N0             = sum(YS == 0L),
+    N1             = sum(YS == 1L),
+    NXS            = NXS,
+    NXO            = NXO,
+    df             = nObs - nParam,
+    aic            = -2 * theta_HG$value + 2 * nParam,
+    bic            = -2 * theta_HG$value + nParam * log(nObs),
+    initial.value  = start_opt,
+    NE             = NE,
+    NV             = NV,
+    Msigma         = Msigma,
+    Mrho           = Mrho
+  )
+
+  class(result) <- c("HeckmanGe", class(theta_HG))
+  result
+}
diff -ru R_original_backup_for_audit/HeckmanSK.R R/HeckmanSK.R
--- R_original_backup_for_audit/HeckmanSK.R	2025-05-29 20:28:13.000000000 +0000
+++ R/HeckmanSK.R	2026-05-29 22:00:01.224967411 +0000
@@ -1,264 +1,264 @@
-#' Normal Skew Model fit Function
-#'
-#' @description
-#' Estimates the parameters of the Sample Selection Model with Skew-Normal
-#' Distribution
-#'
-#' @return
-#'
-#' Returns a list with the following components.
-#'
-#' Coefficients: Returns a numerical vector with the best estimated values
-#' of the model parameters;
-#'
-#' Value: The value of function to be minimized (or maximized) corresponding
-#' to par.
-#'
-#' loglik: Negative of value. Minimum (or maximum) of the likelihood function
-#' calculated from the estimated coefficients.
-#'
-#' counts: Component of the Optim function. A two-element integer vector
-#' giving the number of calls to fn and gr respectively. This excludes
-#' those calls needed to compute the Hessian, if requested, and any calls
-#' to fn to compute a finite-difference approximation to the gradient.
-#'
-#' hessian: Component of the Optim function, with pre-defined option
-#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
-#' at the solution found. Note that this is the Hessian of the unconstrained
-#' problem even if the box constraints are active.
-#'
-#' fisher_infoSK: Fisher information matrix
-#'
-#' prop_sigmaSK: Square root of the Fisher information matrix diagonal
-#'
-#' level: Selection variable levels
-#'
-#' nObs: Numeric value representing the size of the database
-#'
-#' nParam: Numerical value representing the number of model parameters
-#'
-#' N0: Numerical value representing the number of unobserved entries
-#'
-#' N1: Numerical value representing the number of complete entries
-#'
-#' NXS: Numerical value representing the number of parameters of the
-#' selection model
-#'
-#' NXO: Numerical value representing the number of parameters of the
-#' regression model
-#'
-#' df: Numerical value that represents the difference between the size
-#' of the response vector of the selection equation and the number of
-#' model parameters
-#'
-#' aic: Numerical value representing Akaike's information criterion.
-#'
-#' bic: Numerical value representing Schwarz's Bayesian Criterion
-#'
-#' initial.value: Numerical vector that represents the input values
-#' (Initial Values) used in the parameter estimation.
-#'
-#' @details
-#' The HeckmanSK() function fits the Sample Selection Model
-#' based on the Skew-normal distribution. For more information see
-#' \insertCite{ogundimu2016sample;textual}{ssmodels}
-#'
-#'
-#' @param selection Selection equation.
-#' @param outcome Primary Regression Equation.
-#' @param lambda Initial start for asymmetry parameter.
-#' @param start initial values.
-#' @param data Database.
-#' @examples
-#' data("Mroz87")
-#' attach(Mroz87)
-#' selectEq <- lfp ~ huswage + kids5 + mtr + fatheduc + educ + city
-#' outcomeEq <- log(wage) ~ educ+city
-#' HeckmanSK(selectEq, outcomeEq, data = Mroz87, lambda = -1.5)
-#' @importFrom Rdpack reprompt
-#' @references {
-#' \insertAllCited{}
-#' }
-#' @export HeckmanSK
-#' @export
-HeckmanSK <- function(selection, outcome, data = sys.frame(sys.parent()), lambda, start = NULL) {
-
-  # Extract design matrices and outcomes from the selection and outcome models
-  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
-  XS  <- components$XS       # Design matrix for selection equation
-  YS  <- components$YS       # Response variable for selection equation
-  NXS <- components$NXS      # Number of selection parameters
-  XO  <- components$XO       # Design matrix for outcome equation
-  YO  <- components$YO       # Response variable for outcome equation
-  NXO <- components$NXO      # Number of outcome parameters
-  YSLevels <- components$YSLevels  # Levels of the selection variable
-
-  # Replace missing values in the outcome with zeros
-  YO[is.na(YO)] <- 0
-
-  #############################
-  # Log-likelihood function
-  #############################
-  loglik_SK <- function(start) {
-    # Define parameter indices
-    NXS <- dim(model.matrix(~XS))[2] - 1
-    NXO <- dim(model.matrix(~XO))[2] - 1
-    istartS <- 1:NXS
-    istartO <- seq(tail(istartS, 1) + 1, length = NXO)
-    isigma  <- tail(istartO, 1) + 1
-    irho    <- tail(isigma, 1) + 1
-    ilamb1  <- tail(irho, 1) + 1
-
-    # Extract parameters
-    g      <- start[istartS]
-    b      <- start[istartO]
-    sigma  <- start[isigma]
-    if (sigma < 0) return(NA)
-    rho    <- start[irho]
-    if ((rho < -1) || (rho > 1)) return(NA)
-    lamb1  <- start[ilamb1]
-
-    # Linear predictors
-    XS.g <- XS %*% g
-    XO.b <- XO %*% b
-    u2   <- YO - XO.b
-    z    <- u2 / sigma
-    r    <- sqrt(1 - rho^2)
-    u    <- 1 + lamb1^2 - (lamb1 * rho)^2
-    lstar <- -lamb1 * rho / sqrt(u)
-
-    # Compute selection log-likelihood
-    h <- sn::psn(-XS.g, 0, 1, -lstar)
-
-    # Log-likelihood vector
-    ll <- ifelse(YS == 0,
-                 log(h),
-                 log(2 / sigma) + log(dnorm(z)) + log(pnorm(lamb1 * z)) +
-                   log(pnorm((XS.g + rho * z) / r)))
-
-    return(sum(ll))
-  }
-
-  #############################
-  # Gradient of the log-likelihood
-  #############################
-  gradlik_SK <- function(start) {
-    # Redefine dimensions and parameter counts
-    NXS <- dim(model.matrix(~XS))[2] - 1
-    NXO <- dim(model.matrix(~XO))[2] - 1
-    nObs <- length(YS)
-    nParam <- NXS + NXO + 3
-
-    # Subset by selection
-    XS0 <- XS[YS == 0, , drop = FALSE]
-    XS1 <- XS[YS == 1, , drop = FALSE]
-    XO1 <- XO[YS == 1, , drop = FALSE]
-    YO[is.na(YO)] <- 0
-    YO1 <- YO[YS == 1]
-
-    N0 <- sum(YS == 0)
-    N1 <- sum(YS == 1)
-    w0 <- rep(1, N0)
-    w1 <- rep(1, N1)
-
-    # Assign parameter indices
-    istartS <- 1:NXS
-    istartO <- seq(tail(istartS, 1) + 1, length = NXO)
-    isigma  <- tail(istartO, 1) + 1
-    irho    <- tail(isigma, 1) + 1
-    ilamb1  <- tail(irho, 1) + 1
-
-    # Extract parameters
-    g      <- start[istartS]
-    b      <- start[istartO]
-    sigma  <- start[isigma]
-    if (sigma < 0) return(matrix(NA, nObs, nParam))
-    rho    <- start[irho]
-    if ((rho < -1) || (rho > 1)) return(matrix(NA, nObs, nParam))
-    lamb1  <- start[ilamb1]
-
-    # Linear predictors
-    XS0.g <- as.numeric(XS0 %*% g)
-    XS1.g <- as.numeric(XS1 %*% g)
-    XO1.b <- as.numeric(XO1 %*% b)
-    u2    <- YO1 - XO1.b
-    z     <- u2 / sigma
-    r     <- 1 - rho^2
-    u     <- 1 + lamb1^2 - (lamb1 * rho)^2
-    lstar <- -lamb1 * rho / sqrt(u)
-
-    # Derivatives of lstar w.r.t rho and lambda
-    dlrho <- (-rho * u + lamb1 * rho * (lamb1 - lamb1 * rho^2)) / u^(3/2)
-    dllam <- (-rho / sqrt(u)) + lamb1 * rho * (lamb1 - lamb1 * rho^2) / (sqrt(u) * u)
-
-    # Intermediate quantities
-    omeg <- (XS1.g + rho * z) / sqrt(r)
-    K1   <- dnorm(omeg) / pnorm(omeg)
-    h    <- function(t) sn::psn(-t, 0, 1, -lstar)
-    h2   <- function(t) sn::psn(-t, 0, 1, lamb1 * rho / sqrt(u))
-    K2   <- dnorm(-XS0.g) * pnorm(lstar * XS0.g) / h(XS0.g)
-    eta  <- lamb1 * z
-    K3   <- dnorm(eta) / pnorm(eta)
-    K4   <- dnorm(XS0.g * sqrt(1 + lamb1^2) / sqrt(u)) / h(XS0.g)
-
-    # Initialize gradient matrix
-    gradient <- matrix(0, nObs, nParam)
-
-    # Compute gradients
-    gradient[YS == 0, istartS] <- w0 * XS0 * (-2 * K2)
-    gradient[YS == 1, istartS] <- w1 * XS1 * (K1 / sqrt(r))
-    gradient[YS == 1, istartO] <- w1 * XO1 * ((z / sigma) - (lamb1 / sigma) * K3 - (rho / (sigma * sqrt(r))) * K1)
-    gradient[YS == 1, isigma]  <- w1 * (-1 / sigma + (z^2) / sigma - (lamb1 * K3 * z) / sigma - (rho * K1 * z) / (sigma * sqrt(r)))
-    gradient[YS == 0, irho]    <- w0 * (-(2 / sqrt(2 * pi)) * (lamb1 * (1 + lamb1^2) / (sqrt(u) * (u + (lamb1 * rho)^2))) *
-                                          dnorm(sqrt(1 + (lamb1 * rho / sqrt(u))^2) * XS0.g) / h2(XS0.g))
-    gradient[YS == 1, irho]    <- w1 * (K1 * (rho * XS1.g + z)) / (sqrt(r)^3)
-    gradient[YS == 0, ilamb1]  <- w0 * dllam * sqrt(2 / pi) * (1 / (1 + lstar^2)) *
-      dnorm(sqrt(1 + lstar^2) * XS0.g) / h(XS0.g)
-    gradient[YS == 1, ilamb1]  <- w1 * (K3 * z)
-
-    return(colSums(gradient))
-  }
-
-  #############################
-  # Initial values
-  #############################
-  if (is.null(start)) {
-    message("Start not provided using default start values.")
-    start <- c(step2(YS, XS, YO, XO), lambda)
-  }
-
-  #############################
-  # Optimization via BFGS
-  #############################
-  theta_SK <- optim(start, loglik_SK, gradlik_SK, method = "BFGS", hessian = TRUE,
-                    control = list(fnscale = -1))
-
-  #############################
-  # Organize and return results
-  #############################
-  names(theta_SK$par) <- c(colnames(XS), colnames(XO), "sigma", "rho", "lambda")
-
-  result <- list(
-    coefficients   = theta_SK$par,
-    value          = theta_SK$value,
-    loglik         = -theta_SK$value,
-    counts         = theta_SK$counts[2],
-    hessian        = theta_SK$hessian,
-    fisher_infoSK  = solve(-theta_SK$hessian),
-    prop_sigmaSK   = sqrt(diag(solve(-theta_SK$hessian))),
-    level          = YSLevels,
-    nObs           = length(YS),
-    nParam         = length(start),
-    N0             = sum(YS == 0),
-    N1             = sum(YS == 1),
-    NXS            = ncol(XS),
-    NXO            = ncol(XO),
-    df             = length(YS) - length(start),
-    aic            = -2 * theta_SK$value + 2 * length(start),
-    bic            = -2 * theta_SK$value + length(start) * log(length(YS)),
-    initial.value  = start
-  )
-
-  class(result) <- c("HeckmanSK", class(theta_SK))
-  return(result)
-}
+#' Normal Skew Model fit Function
+#'
+#' @description
+#' Estimates the parameters of the Sample Selection Model with Skew-Normal
+#' Distribution
+#'
+#' @return
+#'
+#' Returns a list with the following components.
+#'
+#' Coefficients: Returns a numerical vector with the best estimated values
+#' of the model parameters;
+#'
+#' Value: The value of function to be minimized (or maximized) corresponding
+#' to par.
+#'
+#' loglik: Maximized value of the log-likelihood function calculated from the estimated coefficients.
+#'
+#' counts: Component of the Optim function. A two-element integer vector
+#' giving the number of calls to fn and gr respectively. This excludes
+#' those calls needed to compute the Hessian, if requested, and any calls
+#' to fn to compute a finite-difference approximation to the gradient.
+#'
+#' hessian: Component of the Optim function, with pre-defined option
+#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
+#' at the solution found. Note that this is the Hessian of the unconstrained
+#' problem even if the box constraints are active.
+#'
+#' fisher_infoSK: Fisher information matrix
+#'
+#' prop_sigmaSK: Square root of the Fisher information matrix diagonal
+#'
+#' level: Selection variable levels
+#'
+#' nObs: Numeric value representing the size of the database
+#'
+#' nParam: Numerical value representing the number of model parameters
+#'
+#' N0: Numerical value representing the number of unobserved entries
+#'
+#' N1: Numerical value representing the number of complete entries
+#'
+#' NXS: Numerical value representing the number of parameters of the
+#' selection model
+#'
+#' NXO: Numerical value representing the number of parameters of the
+#' regression model
+#'
+#' df: Numerical value that represents the difference between the size
+#' of the response vector of the selection equation and the number of
+#' model parameters
+#'
+#' aic: Numerical value representing Akaike's information criterion.
+#'
+#' bic: Numerical value representing Schwarz's Bayesian Criterion
+#'
+#' initial.value: Numerical vector that represents the input values
+#' (Initial Values) used in the parameter estimation.
+#'
+#' @details
+#' The HeckmanSK() function fits the Sample Selection Model
+#' based on the Skew-normal distribution. For more information see
+#' \insertCite{ogundimu2016sample;textual}{ssmodels}
+#'
+#'
+#' @param selection Selection equation.
+#' @param outcome Primary Regression Equation.
+#' @param lambda Initial start for asymmetry parameter.
+#' @param start initial values.
+#' @param data Database.
+#' @examples
+#' data("Mroz87")
+#' attach(Mroz87)
+#' selectEq <- lfp ~ huswage + kids5 + mtr + fatheduc + educ + city
+#' outcomeEq <- log(wage) ~ educ+city
+#' HeckmanSK(selectEq, outcomeEq, data = Mroz87, lambda = -1.5)
+#' @importFrom Rdpack reprompt
+#' @references {
+#' \insertAllCited{}
+#' }
+#' @export HeckmanSK
+#' @export
+HeckmanSK <- function(selection, outcome, data = sys.frame(sys.parent()), lambda, start = NULL) {
+
+  # Extract design matrices and outcomes from the selection and outcome models
+  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
+  XS  <- components$XS       # Design matrix for selection equation
+  YS  <- components$YS       # Response variable for selection equation
+  NXS <- components$NXS      # Number of selection parameters
+  XO  <- components$XO       # Design matrix for outcome equation
+  YO  <- components$YO       # Response variable for outcome equation
+  NXO <- components$NXO      # Number of outcome parameters
+  YSLevels <- components$YSLevels  # Levels of the selection variable
+
+  # Replace missing values in the outcome with zeros
+  YO[is.na(YO)] <- 0
+
+  #############################
+  # Log-likelihood function
+  #############################
+  loglik_SK <- function(start) {
+    # Define parameter indices
+    NXS <- dim(model.matrix(~XS))[2] - 1
+    NXO <- dim(model.matrix(~XO))[2] - 1
+    istartS <- 1:NXS
+    istartO <- seq(tail(istartS, 1) + 1, length = NXO)
+    isigma  <- tail(istartO, 1) + 1
+    irho    <- tail(isigma, 1) + 1
+    ilamb1  <- tail(irho, 1) + 1
+
+    # Extract parameters
+    g      <- start[istartS]
+    b      <- start[istartO]
+    sigma  <- start[isigma]
+    if (!is.finite(sigma) || sigma <= 0) return(NA_real_)
+    rho    <- start[irho]
+    if (!is.finite(rho) || abs(rho) >= 1) return(NA_real_)
+    lamb1  <- start[ilamb1]
+
+    # Linear predictors
+    XS.g <- XS %*% g
+    XO.b <- XO %*% b
+    u2   <- YO - XO.b
+    z    <- u2 / sigma
+    r    <- sqrt(1 - rho^2)
+    u    <- 1 + lamb1^2 - (lamb1 * rho)^2
+    lstar <- -lamb1 * rho / sqrt(u)
+
+    # Compute selection log-likelihood
+    h <- pmax(sn::psn(-XS.g, 0, 1, -lstar), .Machine$double.xmin)
+
+    # Log-likelihood vector
+    ll <- ifelse(YS == 0,
+                 log(h),
+                 log(2) - log(sigma) + stats::dnorm(z, log = TRUE) +
+                   stats::pnorm(lamb1 * z, log.p = TRUE) +
+                   stats::pnorm((XS.g + rho * z) / r, log.p = TRUE))
+
+    return(sum(ll))
+  }
+
+  #############################
+  # Gradient of the log-likelihood
+  #############################
+  gradlik_SK <- function(start) {
+    # Redefine dimensions and parameter counts
+    NXS <- dim(model.matrix(~XS))[2] - 1
+    NXO <- dim(model.matrix(~XO))[2] - 1
+    nObs <- length(YS)
+    nParam <- NXS + NXO + 3
+
+    # Subset by selection
+    XS0 <- XS[YS == 0, , drop = FALSE]
+    XS1 <- XS[YS == 1, , drop = FALSE]
+    XO1 <- XO[YS == 1, , drop = FALSE]
+    YO[is.na(YO)] <- 0
+    YO1 <- YO[YS == 1]
+
+    N0 <- sum(YS == 0)
+    N1 <- sum(YS == 1)
+    w0 <- rep(1, N0)
+    w1 <- rep(1, N1)
+
+    # Assign parameter indices
+    istartS <- 1:NXS
+    istartO <- seq(tail(istartS, 1) + 1, length = NXO)
+    isigma  <- tail(istartO, 1) + 1
+    irho    <- tail(isigma, 1) + 1
+    ilamb1  <- tail(irho, 1) + 1
+
+    # Extract parameters
+    g      <- start[istartS]
+    b      <- start[istartO]
+    sigma  <- start[isigma]
+    if (!is.finite(sigma) || sigma <= 0) return(rep(NA_real_, nParam))
+    rho    <- start[irho]
+    if (!is.finite(rho) || abs(rho) >= 1) return(rep(NA_real_, nParam))
+    lamb1  <- start[ilamb1]
+
+    # Linear predictors
+    XS0.g <- as.numeric(XS0 %*% g)
+    XS1.g <- as.numeric(XS1 %*% g)
+    XO1.b <- as.numeric(XO1 %*% b)
+    u2    <- YO1 - XO1.b
+    z     <- u2 / sigma
+    r     <- 1 - rho^2
+    u     <- 1 + lamb1^2 - (lamb1 * rho)^2
+    lstar <- -lamb1 * rho / sqrt(u)
+
+    # Derivatives of lstar w.r.t rho and lambda
+    dlrho <- (-rho * u + lamb1 * rho * (lamb1 - lamb1 * rho^2)) / u^(3/2)
+    dllam <- (-rho / sqrt(u)) + lamb1 * rho * (lamb1 - lamb1 * rho^2) / (sqrt(u) * u)
+
+    # Intermediate quantities
+    omeg <- (XS1.g + rho * z) / sqrt(r)
+    K1   <- dnorm(omeg) / pnorm(omeg)
+    h    <- function(t) sn::psn(-t, 0, 1, -lstar)
+    h2   <- function(t) sn::psn(-t, 0, 1, lamb1 * rho / sqrt(u))
+    K2   <- dnorm(-XS0.g) * pnorm(lstar * XS0.g) / h(XS0.g)
+    eta  <- lamb1 * z
+    K3   <- dnorm(eta) / pnorm(eta)
+    K4   <- dnorm(XS0.g * sqrt(1 + lamb1^2) / sqrt(u)) / h(XS0.g)
+
+    # Initialize gradient matrix
+    gradient <- matrix(0, nObs, nParam)
+
+    # Compute gradients
+    gradient[YS == 0, istartS] <- w0 * XS0 * (-2 * K2)
+    gradient[YS == 1, istartS] <- w1 * XS1 * (K1 / sqrt(r))
+    gradient[YS == 1, istartO] <- w1 * XO1 * ((z / sigma) - (lamb1 / sigma) * K3 - (rho / (sigma * sqrt(r))) * K1)
+    gradient[YS == 1, isigma]  <- w1 * (-1 / sigma + (z^2) / sigma - (lamb1 * K3 * z) / sigma - (rho * K1 * z) / (sigma * sqrt(r)))
+    gradient[YS == 0, irho]    <- w0 * (-(2 / sqrt(2 * pi)) * (lamb1 * (1 + lamb1^2) / (sqrt(u) * (u + (lamb1 * rho)^2))) *
+                                          dnorm(sqrt(1 + (lamb1 * rho / sqrt(u))^2) * XS0.g) / h2(XS0.g))
+    gradient[YS == 1, irho]    <- w1 * (K1 * (rho * XS1.g + z)) / (sqrt(r)^3)
+    gradient[YS == 0, ilamb1]  <- w0 * dllam * sqrt(2 / pi) * (1 / (1 + lstar^2)) *
+      dnorm(sqrt(1 + lstar^2) * XS0.g) / h(XS0.g)
+    gradient[YS == 1, ilamb1]  <- w1 * (K3 * z)
+
+    return(colSums(gradient))
+  }
+
+  #############################
+  # Initial values
+  #############################
+  if (is.null(start)) {
+    message("Start not provided using default start values.")
+    start <- c(step2(YS, XS, YO, XO), lambda)
+  }
+
+  #############################
+  # Optimization via BFGS
+  #############################
+  theta_SK <- optim(start, loglik_SK, gradlik_SK, method = "BFGS", hessian = TRUE,
+                    control = list(fnscale = -1))
+
+  #############################
+  # Organize and return results
+  #############################
+  names(theta_SK$par) <- c(colnames(XS), colnames(XO), "sigma", "rho", "lambda")
+
+  result <- list(
+    coefficients   = theta_SK$par,
+    value          = theta_SK$value,
+    loglik         = theta_SK$value,
+    counts         = theta_SK$counts[2],
+    hessian        = theta_SK$hessian,
+    fisher_infoSK  = .ssmodels_safe_vcov(theta_SK$hessian),
+    prop_sigmaSK   = .ssmodels_safe_se(.ssmodels_safe_vcov(theta_SK$hessian)),
+    level          = YSLevels,
+    nObs           = length(YS),
+    nParam         = length(start),
+    N0             = sum(YS == 0),
+    N1             = sum(YS == 1),
+    NXS            = ncol(XS),
+    NXO            = ncol(XO),
+    df             = length(YS) - length(start),
+    aic            = -2 * theta_SK$value + 2 * length(start),
+    bic            = -2 * theta_SK$value + length(start) * log(length(YS)),
+    initial.value  = start
+  )
+
+  class(result) <- c("HeckmanSK", class(theta_SK))
+  return(result)
+}
diff -ru R_original_backup_for_audit/HeckmantS.R R/HeckmantS.R
--- R_original_backup_for_audit/HeckmantS.R	2025-05-29 20:57:55.000000000 +0000
+++ R/HeckmantS.R	2026-05-29 21:59:47.984717108 +0000
@@ -1,290 +1,141 @@
-#' Heckman-t Model fit Function
-#'
-#' @description
-#' Estimates the parameters of the Heckman-t model
-#'
-#' @return
-#'
-#' Returns a list with the following components.
-#'
-#' Coefficients: Returns a numerical vector with the best estimated values
-#' of the model parameters;
-#'
-#' Value: The value of function to be minimized (or maximized) corresponding
-#' to par.
-#'
-#' loglik: Negative of value. Minimum (or maximum) of the likelihood function
-#' calculated from the estimated coefficients.
-#'
-#' counts: Component of the Optim function. A two-element integer vector
-#' giving the number of calls to fn and gr respectively. This excludes
-#' those calls needed to compute the Hessian, if requested, and any calls
-#' to fn to compute a finite-difference approximation to the gradient.
-#'
-#' hessian: Component of the Optim function, with pre-defined option
-#' hessian=TRUE. A symmetric matrix giving an estimate of the Hessian
-#' at the solution found. Note that this is the Hessian of the unconstrained
-#' problem even if the box constraints are active.
-#'
-#' fisher_infotS: Fisher information matrix
-#'
-#' prop_sigmatS: Square root of the Fisher information matrix diagonal
-#'
-#' level: Selection variable levels
-#'
-#' nObs: Numeric value representing the size of the database
-#'
-#' nParam: Numerical value representing the number of model parameters
-#'
-#' N0: Numerical value representing the number of unobserved entries
-#'
-#' N1: Numerical value representing the number of complete entries
-#'
-#' NXS: Numerical value representing the number of parameters of the
-#' selection model
-#'
-#' NXO: Numerical value representing the number of parameters of the
-#' regression model
-#'
-#' df: Numerical value that represents the difference between the size
-#' of the response vector of the selection equation and the number of
-#' model parameters
-#'
-#' aic: Numerical value representing Akaike's information criterion.
-#'
-#' bic: Numerical value representing Schwarz's Bayesian Criterion
-#'
-#' initial.value: Numerical vector that represents the input values
-#' (Initial Values) used in the parameter estimation.
-#'
-#' @details
-#' The HeckmantS() function fits the Sample Selection Model
-#' based on the Student's t distribution. For more information see
-#' \insertCite{marchenko2012heckman;textual}{ssmodels}
-#'
-#' @param selection Selection equation.
-#' @param outcome Primary Regression Equation.
-#' @param df Initial start to the degree of freedom.
-#' @param start initial values.
-#' @param data Database.
-#' @examples
-#' data(MEPS2001)
-#' attach(MEPS2001)
-#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
-#' outcomeEq <- lnambx ~ age + female + educ + blhisp + totchr + ins
-#' HeckmantS(selectEq, outcomeEq, data = MEPS2001, df=12)
-#' @importFrom Rdpack reprompt
-#' @references {
-#' \insertAllCited{}
-#' }
-#' @export HeckmantS
-#' @export
-HeckmantS <- function(selection, outcome, data = sys.frame(sys.parent()), df, start = NULL) {
-  # Step 1: Extract components from selection and outcome formulas
-  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
-  XS  <- components$XS
-  YS  <- components$YS
-  NXS <- components$NXS
-  XO  <- components$XO
-  YO  <- components$YO
-  NXO <- components$NXO
-  YSLevels <- components$YSLevels
-
-  # Step 2: Define the log-likelihood function for the Heckman-t model
-  loglik_tS <- function(start) {
-    # Compute the log-likelihood based on the Student's t-distribution
-    # using the current parameter estimates.
-
-    NXS <- dim(model.matrix(~XS))[2] - 1  # Number of columns in XS minus intercept
-    NXO <- dim(model.matrix(~XO))[2] - 1  # Number of columns in XO minus intercept
-
-    # Define parameter indices
-    istartS <- 1:NXS
-    istartO <- seq(tail(istartS, 1) + 1, length = NXO)
-    isigma  <- tail(istartO, 1) + 1
-    irho    <- tail(isigma, 1) + 1
-    iv      <- tail(irho, 1) + 1
-
-    # Extract parameter values
-    g     <- start[istartS]
-    b     <- start[istartO]
-    sigma <- start[isigma]
-
-    # Validate sigma
-    if (sigma < 0) return(NA)
-
-    rho <- start[irho]
-    if ((rho < -1) || (rho > 1)) return(NA)
-
-    v <- start[iv]
-
-    # Compute linear predictors
-    XS.g <- XS %*% g
-    XO.b <- XO %*% b
-    u2   <- YO - XO.b
-    z    <- u2 / sigma
-    r    <- sqrt(1 - rho^2)
-    Q    <- sqrt((v + 1) / (v + z^2))
-    eta  <- Q * ((rho * z + XS.g) / r)
-
-    # Compute log-density constant
-    gam <- log(gamma((v + 1) / 2)) - log(gamma(v / 2)) - 0.5 * log(pi) -
-      0.5 * log(v) - log(sigma)
-
-    # Compute log-likelihood contributions
-    ll <- ifelse(YS == 0,
-                 pt(-XS.g, v, log.p = TRUE),
-                 gam - ((v + 1)/2) * log(1 + (z^2 / v)) + pt(eta, v + 1, log.p = TRUE))
-
-    # Return total log-likelihood
-    return(sum(ll))
-  }
-    ############## Gradient #
-  # Step 3: Define the gradient of the log-likelihood function
-  gradlik_tS <- function(start) {
-    # Compute the analytical gradient of the log-likelihood
-    # with respect to all model parameters.
-
-    NXS <- dim(model.matrix(~XS))[2] - 1  # Number of columns in XS (excluding intercept)
-    NXO <- dim(model.matrix(~XO))[2] - 1  # Number of columns in XO (excluding intercept)
-    nObs <- length(YS)                   # Total number of observations
-    NO <- length(YS[YS > 0])             # Number of non-zero observations
-    nParam <- NXS + NXO + 3              # Total number of parameters
-    N0 <- sum(YS == 0)                   # Number of censored observations
-    N1 <- sum(YS == 1)                   # Number of uncensored observations
-
-    w <- rep(1, N0 + N1)                 # Weight vector for all observations
-    w0 <- rep(1, N0)                     # Weight vector for censored observations
-    w1 <- rep(1, N1)                     # Weight vector for uncensored observations
-
-    # Indices for parameter vector
-    istartS <- 1:NXS
-    istartO <- seq(tail(istartS, 1) + 1, length = NXO)
-    isigma <- tail(istartO, 1) + 1
-    irho <- tail(isigma, 1) + 1
-    iv <- tail(irho, 1) + 1
-
-    # Extract selection and outcome coefficients
-    g <- start[istartS]
-    b <- start[istartO]
-
-    # Extract and transform scale (sigma), correlation (rho), and degrees of freedom (v)
-    chuteS = start[isigma]
-    lns = log(chuteS)
-    sigma = exp(lns)
-
-    chuteR <- start[irho]
-    tau = log((1 + chuteR)/(1 - chuteR))/2
-    rho = (exp(2 * tau) - 1)/(exp(2 * tau) + 1)
-
-    chuteV = start[iv]
-    lndf = log(chuteV)
-    v = exp(lndf)
-
-    # Subsets for censored (YS == 0) and uncensored (YS == 1) cases
-    XS0 <- XS[YS == 0, , drop = FALSE]
-    XS1 <- XS[YS == 1, , drop = FALSE]
-    YO[is.na(YO)] <- 0
-    YO1 <- YO[YS == 1]
-    XO1 <- XO[YS == 1, , drop = FALSE]
-
-    # Linear predictors
-    XS0.g <- as.numeric((XS0) %*% g)
-    XS1.g <- as.numeric((XS1) %*% g)
-    XO1.b <- as.numeric((XO1) %*% b)
-
-    # Residuals and transformations
-    u2O <- YO1 - XO1.b
-    z0 <- u2O / sigma
-    r <- sqrt(1 - rho^2)
-    Qv <- ((v + 1) / (v + z0^2))^(1/2)
-    Ar <- 1 / sqrt(1 - rho^2)
-    Arr <- rho * Ar
-    QSI <- (Arr * z0) + Ar * XS1.g
-    eta <- Qv * QSI
-    dr = 4 * exp(2 * tau) / ((exp(2 * tau) + 1)^2)
-
-    # Gradient with respect to v for censored cases
-    f1 <- function(x) {
-      ff <- pt(-XS0.g, x, log.p = TRUE)
-      return(ff)
-    }
-    gv2 <- numDeriv::grad(f1, rep(1, length(XS0.g)) * v)
-
-    # Gradient with respect to v for uncensored cases
-    f2 <- function(x) {
-      teste = (((x + 1) / (x + z0^2))^(1/2)) * QSI
-      ff <- pt(teste, x + 1, log.p = TRUE)
-      return(ff)
-    }
-    gv <- numDeriv::grad(f2, rep(1, length(z0)) * v)
-
-    # Initialize gradient matrix
-    gradient <- matrix(0, nObs, nParam)
-
-    # Gradient for selection equation parameters (g)
-    gradient[YS == 0, istartS] <- -w0 * (XS0) * (dt(-XS0.g, v) / pt(-XS0.g, v))
-    gradient[YS == 1, istartS] <- w1 * (XS1) * Ar * Qv * (dt(eta, v + 1) / pt(eta, v + 1))
-
-    # Gradient for outcome equation parameters (b)
-    gradient[YS == 1, istartO] <- w1 * (XO1) * (Qv / sigma) *
-      ((Qv * z0) + ((QSI * ((v + z0^2)^(-1)) * z0 - Arr) * (dt(eta, v + 1) / pt(eta, v + 1))))
-
-    # Gradient for sigma
-    gradient[YS == 1, isigma] <- w1 * (-1 + (Qv * z0)^2 +
-                                         (dt(eta, v + 1) / pt(eta, v + 1)) * ((Qv * z0) * (QSI * ((v + z0^2)^(-1)) * z0 - Arr)))
-
-    # Gradient for rho
-    gradient[YS == 1, irho] <- w1 * (dt(eta, v + 1) / pt(eta, v + 1)) *
-      Qv * (Ar^3) * (z0 + rho * XS1.g) * dr
-
-    # Gradient for v (degrees of freedom)
-    gradient[YS == 1, iv] <- w1 * ((((1/2) * digamma((v + 1)/2) - (1/2) * digamma(v/2)) -
-                                      (1 / (2 * v))) - ((1/2) * log(1 + ((z0^2) / v))) +
-                                     ((Qv * z0)^2) / (2 * v) + gv)
-
-    gradient[YS == 0, iv] <- w0 * gv2
-
-    # Return sum of gradients for each parameter
-    return(colSums(gradient))
-  }
-
-
-  # Step 4: Define initial values if not provided
-  if (is.null(start)) {
-    message("Start not provided using default start values.")
-    start <- c(rep(0, NXS + NXO), 1, 0, log(df))
-  }
-
-  # Step 5: Maximize the log-likelihood using BFGS optimization
-  theta_tS <- optim(start, loglik_tS, gradlik_tS, method = "BFGS", hessian = T,
-                    control = list(fnscale = -1))
-
-  # Step 6: Assign names to estimated parameters
-  names(theta_tS$par) <- c(colnames(XS), colnames(XO), "sigma", "rho", "df")
-
-  # Step 7: Construct output list with all relevant model components
-  result <- list(
-    coefficients    = theta_tS$par,              # Estimated coefficients
-    value           = theta_tS$value,            # Optim objective function value
-    loglik          = -theta_tS$value,           # Log-likelihood
-    counts          = theta_tS$counts[2],        # Number of iterations
-    hessian         = theta_tS$hessian,          # Hessian matrix
-    fisher_infotS   = solve(-theta_tS$hessian),  # Fisher Information Matrix
-    prop_sigmatS    = sqrt(diag(solve(-theta_tS$hessian))), # Standard errors
-    level           = YSLevels,                  # Selection levels
-    nObs            = length(YS),                # Number of observations
-    nParam          = length(start),             # Number of parameters
-    N0              = sum(YS == 0),              # Number of censored obs
-    N1              = sum(YS == 1),              # Number of uncensored obs
-    NXS             = NXS,                       # Number of selection regressors
-    NXO             = NXO,                       # Number of outcome regressors
-    df              = length(YS) - length(start),# Degrees of freedom
-    aic             = -2 * theta_tS$value + 2 * length(start), # AIC
-    bic             = -2 * theta_tS$value + length(start) * log(length(YS)), # BIC
-    initial.value   = start                      # Initial values used
-  )
-  class(result) <- c("HeckmantS", class(theta_tS))
-  return(result)
-}
-
+#' Heckman-t Model fit Function
+#'
+#' @description
+#' Estimates the parameters of the Heckman-t model. The scale, correlation and
+#' degrees of freedom are optimized on unconstrained scales to improve numerical
+#' stability: sigma = exp(eta_sigma), rho = tanh(eta_rho), and df = 2 + exp(eta_df).
+#'
+#' @param selection Selection equation.
+#' @param outcome Primary regression equation.
+#' @param data Database.
+#' @param df Initial value for the degrees of freedom. Values greater than 2 are
+#'   recommended because the model uses a finite-variance Student-t error.
+#' @param start Optional starting values on the natural scale
+#'   (selection, outcome, sigma, rho, df).
+#'
+#' @return A list with estimated coefficients, log-likelihood and diagnostics.
+#'
+#' @importFrom Rdpack reprompt
+#' @references {
+#' \insertAllCited{}
+#' }
+#' @export HeckmantS
+#' @export
+HeckmantS <- function(selection, outcome, data = sys.frame(sys.parent()),
+                      df, start = NULL) {
+
+  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
+  XS <- components$XS
+  YS <- components$YS
+  NXS <- components$NXS
+  XO <- components$XO
+  YO <- components$YO
+  NXO <- components$NXO
+  YSLevels <- components$YSLevels
+  YO_clean <- ifelse(is.na(YO), 0, YO)
+
+  loglik_tS <- function(par) {
+    if (any(!is.finite(par))) return(NA_real_)
+
+    istartS <- seq_len(NXS)
+    istartO <- seq.int(NXS + 1L, NXS + NXO)
+    isigma <- NXS + NXO + 1L
+    irho <- isigma + 1L
+    iv <- irho + 1L
+
+    gamma <- par[istartS]
+    beta <- par[istartO]
+    sigma <- exp(par[isigma])
+    rho <- tanh(par[irho])
+    nu <- 2 + exp(par[iv])
+
+    mu2 <- drop(XS %*% gamma)
+    mu1 <- drop(XO %*% beta)
+    z <- (YO_clean - mu1) / sigma
+    r <- sqrt(pmax(1 - rho^2, .Machine$double.eps))
+    q <- sqrt((nu + 1) / (nu + z^2))
+    eta <- q * ((rho * z + mu2) / r)
+
+    ll0 <- stats::pt(-mu2, df = nu, log.p = TRUE)
+    ll1 <- stats::dt(z, df = nu, log = TRUE) - log(sigma) +
+      stats::pt(eta, df = nu + 1, log.p = TRUE)
+
+    sum(ifelse(YS == 0L, ll0, ll1))
+  }
+
+  if (missing(df) || is.null(df) || !is.finite(df) || df <= 2) {
+    df <- 12
+  }
+
+  if (is.null(start)) {
+    start_classic <- tryCatch(step2(YS, XS, YO, XO), error = function(e) NULL)
+    if (is.null(start_classic) || any(!is.finite(start_classic))) {
+      message("Two-step starting values failed; using neutral default start values.")
+      start_classic <- c(rep(0, NXS + NXO), sigma = 1, rho = 0)
+    }
+    start <- c(start_classic[seq_len(NXS + NXO)],
+               sigma = start_classic[NXS + NXO + 1L],
+               rho = start_classic[NXS + NXO + 2L],
+               df = df)
+  }
+
+  if (length(start) != NXS + NXO + 3L) {
+    stop("start must have length NXS + NXO + 3: selection, outcome, sigma, rho and df.")
+  }
+
+  start_opt <- start
+  start_opt[NXS + NXO + 1L] <- log(max(start[NXS + NXO + 1L], .Machine$double.eps))
+  start_opt[NXS + NXO + 2L] <- atanh(.ssmodels_clip_rho(start[NXS + NXO + 2L]))
+  start_opt[NXS + NXO + 3L] <- log(max(start[NXS + NXO + 3L] - 2, .Machine$double.eps))
+  names(start_opt) <- c(colnames(XS), colnames(XO), "log.sigma", "atanh.rho", "log.df.minus.2")
+
+  theta_tS <- stats::optim(start_opt, loglik_tS, method = "BFGS",
+                           hessian = TRUE,
+                           control = list(fnscale = -1, maxit = 1000))
+
+  vcov_link <- .ssmodels_safe_vcov(theta_tS$hessian)
+  se_link <- .ssmodels_safe_se(vcov_link)
+
+  coef_out <- theta_tS$par
+  isigma <- NXS + NXO + 1L
+  irho <- isigma + 1L
+  iv <- irho + 1L
+  coef_out[isigma] <- exp(theta_tS$par[isigma])
+  coef_out[irho] <- tanh(theta_tS$par[irho])
+  coef_out[iv] <- 2 + exp(theta_tS$par[iv])
+  names(coef_out) <- c(colnames(XS), colnames(XO), "sigma", "rho", "df")
+
+  jac <- rep(1, length(theta_tS$par))
+  jac[isigma] <- coef_out[isigma]
+  jac[irho] <- 1 - coef_out[irho]^2
+  jac[iv] <- coef_out[iv] - 2
+  vcov_nat <- diag(jac, nrow = length(jac)) %*% vcov_link %*% diag(jac, nrow = length(jac))
+  se_nat <- .ssmodels_safe_se(vcov_nat)
+  names(se_nat) <- names(coef_out)
+
+  nObs <- length(YS)
+  nParam <- length(start_opt)
+  result <- list(
+    coefficients    = coef_out,
+    coefficients_link = theta_tS$par,
+    value           = theta_tS$value,
+    loglik          = theta_tS$value,
+    counts          = theta_tS$counts[1],
+    hessian         = theta_tS$hessian,
+    fisher_infotS   = vcov_nat,
+    prop_sigmatS    = se_nat,
+    level           = YSLevels,
+    nObs            = nObs,
+    nParam          = nParam,
+    N0              = sum(YS == 0L),
+    N1              = sum(YS == 1L),
+    NXS             = NXS,
+    NXO             = NXO,
+    df              = nObs - nParam,
+    aic             = -2 * theta_tS$value + 2 * nParam,
+    bic             = -2 * theta_tS$value + nParam * log(nObs),
+    initial.value   = start_opt
+  )
+  class(result) <- c("HeckmantS", class(theta_tS))
+  result
+}
diff -ru R_original_backup_for_audit/extract_model_components.R R/extract_model_components.R
--- R_original_backup_for_audit/extract_model_components.R	2025-05-29 20:35:57.000000000 +0000
+++ R/extract_model_components.R	2026-05-29 21:59:00.171045098 +0000
@@ -1,105 +1,138 @@
-#' Extract model components from formulas
-#'
-#' @description
-#' This function extracts the model frame, model matrix, and model response from formulas and a dataset.
-#' It is used in models such as HeckmanCL, HeckmanGe, HeckmanSK, HeckmanBS, and HeckmantS.
-#' Optionally, it handles covariate matrices for modeling dispersion and correlation parameters.
-#'
-#' @param selection A formula representing the selection equation.
-#' @param outcome A formula representing the outcome equation.
-#' @param data A data frame containing all variables used in the formulas.
-#' @param outcomeS Optional matrix or formula of covariates for the dispersion (sigma) parameter.
-#' @param outcomeC Optional matrix or formula of covariates for the correlation (rho) parameter.
-#' @param drop.levels Logical; if TRUE, unused factor levels are dropped.
-#'
-#' @return A list containing:
-#' \itemize{
-#'   \item \code{XS}: model matrix for selection equation.
-#'   \item \code{YS}: response vector for selection equation.
-#'   \item \code{NXS}: number of covariates in the selection model.
-#'   \item \code{XO}: model matrix for outcome equation.
-#'   \item \code{YO}: response vector for outcome equation.
-#'   \item \code{NXO}: number of covariates in the outcome model.
-#'   \item \code{Msigma}: matrix for modeling dispersion (NULL if not specified).
-#'   \item \code{NE}: number of covariates for the dispersion model.
-#'   \item \code{Mrho}: matrix for modeling correlation (NULL if not specified).
-#'   \item \code{NV}: number of covariates for the correlation model.
-#'   \item \code{YSLevels}: factor levels of the selection response variable.
-#' }
-#'
-#' @importFrom stats model.frame model.matrix model.response terms
-#' @export
-extract_model_components <- function(selection, outcome, data, outcomeS = NULL, outcomeC = NULL, drop.levels = TRUE) {
-
-  # Build model frame for the selection equation
-  mfS <- model.frame(
-    formula = selection,
-    data = data,
-    drop.unused.levels = drop.levels,
-    na.action = na.pass
-  )
-  mtS <- terms(mfS)
-  XS <- model.matrix(mtS, mfS)
-  YS <- model.response(mfS)
-  NXS <- ncol(XS)
-
-  # Ensure selection outcome has exactly two levels (binary response)
-  if (length(levels(as.factor(YS))) != 2) {
-    stop("The selection equation must have exactly two levels (e.g., 0 and 1).")
-  }
-
-  YSLevels <- levels(as.factor(YS))
-
-  # Build model frame for the outcome equation
-  mfO <- model.frame(
-    formula = outcome,
-    data = data,
-    drop.unused.levels = drop.levels,
-    na.action = na.pass
-  )
-  mtO <- terms(mfO)
-  XO <- model.matrix(mtO, mfO)
-  YO <- model.response(mfO)
-  NXO <- ncol(XO)
-
-  # Construct dispersion matrix (Msigma) if provided
-  if (!is.null(outcomeS)) {
-    if (length(outcomeS) == 1) {
-      # Only one covariate: intercept-only model for sigma
-      NE <- 1
-      Msigma <- cbind(rep(1, nrow(XO)))
-    } else {
-      # Multiple covariates: use model matrix excluding intercept
-      Msigma <- outcomeS
-      NE <- dim(model.matrix(~outcomeS))[2] - 1
-    }
-  } else {
-    Msigma <- NULL
-    NE <- 0
-  }
-
-  # Construct correlation matrix (Mrho) if provided
-  if (!is.null(outcomeC)) {
-    if (length(outcomeC) == 1) {
-      # Only one covariate: intercept-only model for rho
-      NV <- 1
-      Mrho <- cbind(rep(1, nrow(XO)))
-    } else {
-      # Multiple covariates: use model matrix excluding intercept
-      Mrho <- outcomeC
-      NV <- dim(model.matrix(~outcomeC))[2] - 1
-    }
-  } else {
-    Mrho <- NULL
-    NV <- 0
-  }
-
-  # Return all extracted and constructed components
-  return(list(
-    XS = XS, YS = YS, NXS = NXS,
-    XO = XO, YO = YO, NXO = NXO,
-    Msigma = Msigma, NE = NE,
-    Mrho = Mrho, NV = NV,
-    YSLevels = YSLevels
-  ))
-}
+#' Extract model components from formulas
+#'
+#' @description
+#' This function extracts model matrices and response vectors used by the
+#' sample-selection model fitting functions. It standardizes the selection
+#' response to a numeric indicator, where 1 denotes selected/observed and
+#' 0 denotes not selected/not observed.
+#'
+#' @param selection A formula representing the selection equation.
+#' @param outcome A formula representing the outcome equation.
+#' @param data A data frame containing all variables used in the formulas.
+#' @param outcomeS Optional matrix, vector, one-sided formula, or 1 for the
+#'   log-scale model in the generalized Heckman model.
+#' @param outcomeC Optional matrix, vector, one-sided formula, or 1 for the
+#'   correlation model in the generalized Heckman model.
+#' @param drop.levels Logical; if TRUE, unused factor levels are dropped.
+#'
+#' @return A list with selection, outcome, dispersion and correlation matrices.
+#'
+#' @importFrom stats model.frame model.matrix model.response terms na.pass
+#' @export
+extract_model_components <- function(selection, outcome, data,
+                                     outcomeS = NULL, outcomeC = NULL,
+                                     drop.levels = TRUE) {
+
+  make_aux_matrix <- function(aux, data, n, prefix) {
+    if (is.null(aux)) {
+      mat <- matrix(1, nrow = n, ncol = 1)
+      colnames(mat) <- "(Intercept)"
+      return(mat)
+    }
+
+    if (length(aux) == 1L && is.numeric(aux)) {
+      mat <- matrix(as.numeric(aux), nrow = n, ncol = 1)
+      colnames(mat) <- "(Intercept)"
+      return(mat)
+    }
+
+    if (inherits(aux, "formula")) {
+      mf <- model.frame(formula = aux, data = data,
+                        drop.unused.levels = drop.levels,
+                        na.action = na.pass)
+      mat <- model.matrix(terms(mf), mf)
+      return(mat)
+    }
+
+    if (is.data.frame(aux) || is.matrix(aux)) {
+      mat <- as.matrix(aux)
+    } else {
+      mat <- matrix(aux, ncol = 1)
+      colnames(mat) <- deparse(substitute(aux))
+    }
+
+    if (nrow(mat) != n) {
+      stop(prefix, " must have the same number of rows as data.")
+    }
+
+    if (is.null(colnames(mat))) {
+      colnames(mat) <- paste0(prefix, seq_len(ncol(mat)))
+    }
+
+    first_is_intercept <- ncol(mat) >= 1L &&
+      all(is.finite(mat[, 1])) && all(abs(mat[, 1] - 1) < 1e-12)
+
+    if (!first_is_intercept) {
+      mat <- cbind("(Intercept)" = 1, mat)
+    }
+
+    mat
+  }
+
+  mfS <- model.frame(
+    formula = selection,
+    data = data,
+    drop.unused.levels = drop.levels,
+    na.action = na.pass
+  )
+  mtS <- terms(mfS)
+  XS <- model.matrix(mtS, mfS)
+  YS_raw <- model.response(mfS)
+
+  YS_factor <- as.factor(YS_raw)
+  YSLevels <- levels(YS_factor)
+  if (length(YSLevels) != 2L) {
+    stop("The selection equation must have exactly two observed levels.")
+  }
+
+  if (is.numeric(YS_raw) && all(stats::na.omit(unique(YS_raw)) %in% c(0, 1))) {
+    YS <- as.integer(YS_raw)
+  } else {
+    YS <- as.integer(YS_factor == YSLevels[2L])
+  }
+
+  mfO <- model.frame(
+    formula = outcome,
+    data = data,
+    drop.unused.levels = drop.levels,
+    na.action = na.pass
+  )
+  mtO <- terms(mfO)
+  XO <- model.matrix(mtO, mfO)
+  YO <- model.response(mfO)
+
+  Msigma <- make_aux_matrix(outcomeS, data, nrow(XS), "outcomeS")
+  Mrho   <- make_aux_matrix(outcomeC, data, nrow(XS), "outcomeC")
+
+  if (nrow(XO) != nrow(XS) || length(YO) != length(YS)) {
+    stop("Selection and outcome equations must refer to the same number of rows.")
+  }
+
+  keep <- !is.na(YS) & complete.cases(XS)
+  keep <- keep & (YS == 0 | (!is.na(YO) & complete.cases(XO)))
+  keep <- keep & (YS == 0 | (complete.cases(Msigma) & complete.cases(Mrho)))
+
+  XS <- XS[keep, , drop = FALSE]
+  YS <- YS[keep]
+  XO <- XO[keep, , drop = FALSE]
+  YO <- YO[keep]
+  Msigma <- Msigma[keep, , drop = FALSE]
+  Mrho <- Mrho[keep, , drop = FALSE]
+
+  storage.mode(YS) <- "integer"
+
+  list(
+    XS = XS,
+    YS = YS,
+    NXS = ncol(XS),
+    XO = XO,
+    YO = YO,
+    NXO = ncol(XO),
+    Msigma = Msigma,
+    NE = ncol(Msigma),
+    Mrho = Mrho,
+    NV = ncol(Mrho),
+    YSLevels = YSLevels,
+    kept = keep
+  )
+}
diff -ru R_original_backup_for_audit/postprocess_theta.R R/postprocess_theta.R
--- R_original_backup_for_audit/postprocess_theta.R	2025-05-29 20:37:19.000000000 +0000
+++ R/postprocess_theta.R	2026-05-29 22:00:26.013820796 +0000
@@ -1,84 +1,34 @@
-#' Post-process Parameter Vector for Generalized Heckman Models
-#'
-#' @description
-#' This internal helper function assigns meaningful names to a vector of estimated
-#' parameters and applies transformations (exponential or hyperbolic tangent)
-#' to the dispersion-related parameters to obtain interpretable values of \code{sigma} and \code{rho}.
-#'
-#' @details
-#' The parameter vector \code{theta_par} is assumed to follow the structure:
-#' \itemize{
-#'   \item First \code{NXS} elements: coefficients for the selection equation.
-#'   \item Next \code{NXO} elements: coefficients for the outcome equation.
-#'   \item Next \code{NE} elements: coefficients (or log-sigma if \code{NE == 1}) for the scale model.
-#'   \item Next \code{NV} elements: coefficients (or atanh(rho) if \code{NV == 1}) for the correlation model.
-#' }
-#' This function labels each element and performs:
-#' \itemize{
-#'   \item \code{exp()} transformation for \code{sigma} when \code{NE == 1}.
-#'   \item \code{tanh()} transformation for \code{rho} when \code{NV == 1}.
-#' }
-#'
-#' @param theta_par Numeric vector of estimated parameters.
-#' @param NXS Integer. Number of covariates in the selection equation.
-#' @param NXO Integer. Number of covariates in the outcome equation.
-#' @param NE Integer. Number of covariates (or 1 if intercept only) in the log-sigma model.
-#' @param NV Integer. Number of covariates (or 1 if intercept only) in the correlation model.
-#' @param XS Design matrix for the selection equation (used for labeling).
-#' @param XO Design matrix for the outcome equation (used for labeling).
-#' @param outcomeS Design matrix or variable for the scale model.
-#' @param outcomeC Design matrix or variable for the correlation model.
-#'
-#' @return
-#' A named numeric vector with transformed values of \code{sigma} and \code{rho}
-#' when appropriate, and meaningful names for all parameters.
-#'
-#' @keywords internal
-#' @export
-postprocess_theta <- function(theta_par, NXS, NXO, NE, NV, XS, XO, outcomeS, outcomeC) {
-
-  # Step 1: Construct parameter names using column names from input matrices
-  param_names <- c(colnames(XS), colnames(XO))
-
-  # Append names for scale parameters (sigma)
-  if (NE == 1) {
-    param_names <- c(param_names, "sigma")
-  } else {
-    param_names <- c(param_names, "interceptS", colnames(outcomeS))
-  }
-
-  # Append names for correlation parameters (rho)
-  if (NV == 1) {
-    param_names <- c(param_names, "correlation")
-  } else {
-    param_names <- c(param_names, "interceptC", colnames(outcomeC))
-  }
-
-  # Assign names to the full parameter vector
-  names(theta_par) <- param_names
-
-  # Step 2: Define indices for sigma and rho blocks
-  idx_sigma_start <- NXS + NXO + 1
-  idx_rho_start <- idx_sigma_start + ifelse(NE == 1, 1, NE + 1)
-
-  # Step 3: Reconstruct the transformed parameter vector
-  theta_final <- c(
-    theta_par[1:(NXS + NXO)],
-
-    # Apply transformation to sigma if needed
-    if (NE == 1) {
-      exp(theta_par[idx_sigma_start])
-    } else {
-      theta_par[idx_sigma_start:(idx_sigma_start + NE)]
-    },
-
-    # Apply transformation to rho if needed
-    if (NV == 1) {
-      tanh(theta_par[idx_rho_start])
-    } else {
-      theta_par[idx_rho_start:(idx_rho_start + NV)]
-    }
-  )
-
-  return(theta_final)
-}
+#' Post-process Parameter Vector for Generalized Heckman Models
+#'
+#' @description
+#' This helper assigns names to a generalized Heckman parameter vector and,
+#' for intercept-only scale/correlation models, maps log(sigma) and atanh(rho)
+#' to sigma and rho.
+#'
+#' @param theta_par Numeric vector of estimated parameters on the optimization scale.
+#' @param NXS Integer. Number of covariates in the selection equation.
+#' @param NXO Integer. Number of covariates in the outcome equation.
+#' @param NE Integer. Number of scale parameters.
+#' @param NV Integer. Number of correlation parameters.
+#' @param XS Design matrix for the selection equation.
+#' @param XO Design matrix for the outcome equation.
+#' @param outcomeS Design matrix or variable for the scale model.
+#' @param outcomeC Design matrix or variable for the correlation model.
+#'
+#' @return A named numeric vector.
+#' @keywords internal
+#' @export
+postprocess_theta <- function(theta_par, NXS, NXO, NE, NV, XS, XO, outcomeS, outcomeC) {
+  sigma_names <- if (NE == 1L) "sigma" else paste0("log.sigma.", seq_len(NE))
+  rho_names <- if (NV == 1L) "rho" else paste0("atanh.rho.", seq_len(NV))
+  param_names <- c(colnames(XS), colnames(XO), sigma_names, rho_names)
+  names(theta_par) <- param_names
+
+  idx_sigma <- seq.int(NXS + NXO + 1L, NXS + NXO + NE)
+  idx_rho <- seq.int(NXS + NXO + NE + 1L, NXS + NXO + NE + NV)
+
+  if (NE == 1L) theta_par[idx_sigma] <- exp(theta_par[idx_sigma])
+  if (NV == 1L) theta_par[idx_rho] <- tanh(theta_par[idx_rho])
+
+  theta_par
+}
diff -ru R_original_backup_for_audit/step2.R R/step2.R
--- R_original_backup_for_audit/step2.R	2025-05-29 20:37:42.000000000 +0000
+++ R/step2.R	2026-05-29 21:59:00.171637240 +0000
@@ -1,63 +1,56 @@
-#' Heckman's two-step method
-#'
-#' @description
-#' Estimate model parameters via two-step method.
-#'
-#' @return
-#' Returns a numerical vector with the parameter estimates of the Classical
-#' Heckman model via a two-step method. For more information see
-#' \insertCite{heckman1979sample;textual}{ssmodels}
-#'
-#' @param YS Selection vector.
-#' @param XS Selection matrix.
-#' @param YO Outcome vector.
-#' @param XO Covariate matrix for the outcome equation.
-#'
-#' @examples
-#' data(MEPS2001)
-#' attach(MEPS2001)
-#' YS <- dambexp
-#' XS <- cbind(age, female, educ, blhisp, totchr, ins)
-#' YO <- lnambx
-#' XO <- cbind(age, female, educ, blhisp, totchr, ins, income)
-#' step2(YS, XS, YO, XO)
-#'
-#' @importFrom Rdpack reprompt
-#' @references {
-#' \insertAllCited{}
-#' }
-#' @export
-step2 <- function(YS, XS, YO, XO) {
-  # Step 1: Estimate selection equation using probit model
-  fit1 <- glm(YS ~ XS - 1, family = binomial(link = "probit"))
-
-  # Step 2: Compute Inverse Mills Ratio (IMR)
-  IMR <- dnorm(fit1$linear.predictors) / pnorm(fit1$linear.predictors)
-
-  # Step 3: Estimate outcome equation with IMR as additional covariate
-  xMat <- cbind(XO, IMR)
-  fit2 <- lm(YO ~ XO + IMR - 1, subset = YS == 1)
-
-  # Step 4: Create a data frame for convenience
-  xMat <- data.frame(xMat)
-
-  # Step 5: Compute delta values (used for variance correction)
-  delta <- xMat$IMR * (xMat$IMR + fit1$fitted.values)
-
-  # Step 6: Estimate corrected variance of the outcome
-  Var <- (sum((fit2$residuals)^2) +
-            (coef(fit2)[length(coef(fit2))]^2) * sum(delta[YS == 1])) / sum(YS)
-
-  # Step 7: Estimate correlation coefficient (rho) between selection and outcome equations
-  cor <- coef(fit2)[length(coef(fit2))] / sqrt(Var)
-  names(cor) <- "rho"
-
-  # Step 8: Compute standard deviation (sigma) of the outcome equation
-  sigma <- sqrt(Var)
-  names(sigma) <- "sigma"
-
-  # Step 9: Combine all estimated parameters into a single vector
-  beta <- c(coef(fit1), coef(fit2)[-length(coef(fit2))], sigma, cor)
-
-  return(beta)
-}
+#' Heckman's two-step method
+#'
+#' @description
+#' Estimate classical Heckman model starting values by Heckman's two-step method.
+#'
+#' @param YS Selection vector coded as 0/1.
+#' @param XS Selection matrix.
+#' @param YO Outcome vector.
+#' @param XO Covariate matrix for the outcome equation.
+#'
+#' @return A numeric vector with selection coefficients, outcome coefficients,
+#'   sigma and rho.
+#'
+#' @importFrom stats binomial glm lm.fit dnorm pnorm na.omit
+#' @export
+step2 <- function(YS, XS, YO, XO) {
+  YS <- as.integer(YS)
+  if (!all(stats::na.omit(unique(YS)) %in% c(0L, 1L))) {
+    stop("YS must be coded as 0/1.")
+  }
+
+  XS <- as.matrix(XS)
+  XO <- as.matrix(XO)
+  selected <- YS == 1L
+
+  if (sum(selected) <= ncol(XO)) {
+    stop("There are not enough selected observations to estimate the outcome equation.")
+  }
+
+  fit1 <- stats::glm.fit(x = XS, y = YS, family = stats::binomial(link = "probit"))
+  eta <- drop(XS %*% stats::coef(fit1))
+  imr <- exp(stats::dnorm(eta, log = TRUE) - stats::pnorm(eta, log.p = TRUE))
+
+  XO1 <- XO[selected, , drop = FALSE]
+  YO1 <- YO[selected]
+  imr1 <- imr[selected]
+  eta1 <- eta[selected]
+
+  fit2 <- stats::lm.fit(x = cbind(XO1, IMR = imr1), y = YO1)
+  coef2 <- stats::coef(fit2)
+  beta <- coef2[seq_len(ncol(XO))]
+  imr_coef <- coef2[ncol(XO) + 1L]
+
+  delta <- imr1 * (imr1 + eta1)
+  variance <- (sum(fit2$residuals^2) + imr_coef^2 * sum(delta)) / sum(selected)
+  if (!is.finite(variance) || variance <= 0) {
+    variance <- stats::var(YO1, na.rm = TRUE)
+  }
+  sigma <- sqrt(variance)
+  rho <- imr_coef / sigma
+  rho <- .ssmodels_clip_rho(rho)
+
+  out <- c(stats::coef(fit1), beta, sigma = sigma, rho = rho)
+  names(out) <- c(colnames(XS), colnames(XO), "sigma", "rho")
+  out
+}
diff -ru R_original_backup_for_audit/summary.HeckmanBS.R R/summary.HeckmanBS.R
--- R_original_backup_for_audit/summary.HeckmanBS.R	2025-05-29 20:38:08.000000000 +0000
+++ R/summary.HeckmanBS.R	2026-05-29 21:59:11.012518181 +0000
@@ -1,82 +1,82 @@
-#' Summary of Birnbaum-Saunders Heckman Model
-#'
-#' @description
-#' Print estimates of the parameters of the Heckman-BS model using Maximum Likelihood Estimation.
-#'
-#' @param object An object of class \code{HeckmanBS}.
-#' @param ... Additional arguments (currently unused).
-#'
-#' @return
-#' Prints the summary output including coefficient tables and model fit statistics.
-#'
-#' @export summary.HeckmanBS
-#' @export
-summary.HeckmanBS <- function(object, ...) {
-
-  # Extract components from the HeckmanBS object
-  fisher_infoBS <- object$fisher_infoBS       # Fisher information matrix (not used here)
-  prop_sigmaBS  <- object$prop_sigmaBS        # Standard errors of the estimates
-  coeffsBS      <- object$coefficients        # Estimated coefficients
-  counts        <- object$counts              # Number of iterations in optimization
-  value         <- object$value               # Log-likelihood at convergence
-  loglik        <- object$loglik              # Log-likelihood function
-  NObs          <- object$NObs                # Total number of observations
-  nParam        <- object$nParam              # Number of free parameters
-  df            <- object$df                  # Degrees of freedom
-  NXS           <- object$NXS                 # Number of selection equation covariates
-  NXO           <- object$NXO                 # Number of outcome equation covariates
-  N0            <- object$N0                  # Number of censored observations
-  N1            <- object$N1                  # Number of uncensored observations
-  aic           <- object$aic                 # Akaike Information Criterion
-  bic           <- object$bic                 # Bayesian Information Criterion
-
-  # Build coefficient tables for each block of the model
-  tb  <- miscTools::coefTable(coeffsBS, prop_sigmaBS, df = df)
-
-  tb1 <- miscTools::coefTable(
-    coeffsBS[1:NXS],
-    prop_sigmaBS[1:NXS],
-    df = df
-  )
-
-  tb2 <- miscTools::coefTable(
-    coeffsBS[(NXS + 1):(NXS + NXO)],
-    prop_sigmaBS[(NXS + 1):(NXS + NXO)],
-    df = df
-  )
-
-  tb3 <- miscTools::coefTable(
-    coeffsBS[(NXS + NXO + 1):(NXS + NXO + 2)],
-    prop_sigmaBS[(NXS + NXO + 1):(NXS + NXO + 2)],
-    df = df
-  )
-
-  # Print model summary
-  cat("\n")
-  cat("--------------------------------------------------------------\n")
-  cat("   Birnbaum-Saunders Heckman Model (Package: ssmodels)        \n")
-  cat("--------------------------------------------------------------\n")
-  cat("--------------------------------------------------------------\n")
-  cat("Maximum Likelihood estimation \n")
-  cat("optim function with method BFGS - iterations number:", counts, "\n")
-  cat("Log-Likelihood:", value, "\n")
-  cat("AIC:", aic, "BIC:", bic, "\n")
-  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed", ")", "\n")
-  cat(nParam, "free parameters", "( df =", df, ")", "\n")
-  cat("--------------------------------------------------------------\n")
-
-  # Print selection equation coefficients
-  cat("Probit selection equation:\n")
-  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  # Print outcome equation coefficients
-  cat("Outcome equation:\n")
-  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  # Print error term estimates (sigma and rho)
-  cat("Error terms:\n")
-  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-}
+#' Summary of Birnbaum-Saunders Heckman Model
+#'
+#' @description
+#' Print estimates of the parameters of the Heckman-BS model using Maximum Likelihood Estimation.
+#'
+#' @param object An object of class \code{HeckmanBS}.
+#' @param ... Additional arguments (currently unused).
+#'
+#' @return
+#' Prints the summary output including coefficient tables and model fit statistics.
+#'
+#' @export summary.HeckmanBS
+#' @export
+summary.HeckmanBS <- function(object, ...) {
+
+  # Extract components from the HeckmanBS object
+  fisher_infoBS <- object$fisher_infoBS       # Fisher information matrix (not used here)
+  prop_sigmaBS  <- object$prop_sigmaBS        # Standard errors of the estimates
+  coeffsBS      <- object$coefficients        # Estimated coefficients
+  counts        <- object$counts              # Number of iterations in optimization
+  value         <- object$value               # Log-likelihood at convergence
+  loglik        <- object$loglik              # Log-likelihood function
+  NObs          <- object$nObs                # Total number of observations
+  nParam        <- object$nParam              # Number of free parameters
+  df            <- object$df                  # Degrees of freedom
+  NXS           <- object$NXS                 # Number of selection equation covariates
+  NXO           <- object$NXO                 # Number of outcome equation covariates
+  N0            <- object$N0                  # Number of censored observations
+  N1            <- object$N1                  # Number of uncensored observations
+  aic           <- object$aic                 # Akaike Information Criterion
+  bic           <- object$bic                 # Bayesian Information Criterion
+
+  # Build coefficient tables for each block of the model
+  tb  <- miscTools::coefTable(coeffsBS, prop_sigmaBS, df = df)
+
+  tb1 <- miscTools::coefTable(
+    coeffsBS[1:NXS],
+    prop_sigmaBS[1:NXS],
+    df = df
+  )
+
+  tb2 <- miscTools::coefTable(
+    coeffsBS[(NXS + 1):(NXS + NXO)],
+    prop_sigmaBS[(NXS + 1):(NXS + NXO)],
+    df = df
+  )
+
+  tb3 <- miscTools::coefTable(
+    coeffsBS[(NXS + NXO + 1):(NXS + NXO + 2)],
+    prop_sigmaBS[(NXS + NXO + 1):(NXS + NXO + 2)],
+    df = df
+  )
+
+  # Print model summary
+  cat("\n")
+  cat("--------------------------------------------------------------\n")
+  cat("   Birnbaum-Saunders Heckman Model (Package: ssmodels)        \n")
+  cat("--------------------------------------------------------------\n")
+  cat("--------------------------------------------------------------\n")
+  cat("Maximum Likelihood estimation \n")
+  cat("optim function with method BFGS - iterations number:", counts, "\n")
+  cat("Log-Likelihood:", loglik, "\n")
+  cat("AIC:", aic, "BIC:", bic, "\n")
+  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed", ")", "\n")
+  cat(nParam, "free parameters", "( df =", df, ")", "\n")
+  cat("--------------------------------------------------------------\n")
+
+  # Print selection equation coefficients
+  cat("Probit selection equation:\n")
+  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  # Print outcome equation coefficients
+  cat("Outcome equation:\n")
+  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  # Print error term estimates (sigma and rho)
+  cat("Error terms:\n")
+  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+}
diff -ru R_original_backup_for_audit/summary.HeckmanCL.R R/summary.HeckmanCL.R
--- R_original_backup_for_audit/summary.HeckmanCL.R	2025-05-29 20:38:52.000000000 +0000
+++ R/summary.HeckmanCL.R	2026-05-29 21:59:11.011844156 +0000
@@ -1,82 +1,82 @@
-#' Summary of Classic Heckman Model
-#'
-#' @description
-#' Print estimates of the parameters of the Classic Heckman model using Maximum Likelihood Estimation.
-#'
-#' @param object An object of class \code{HeckmanCL}.
-#' @param ... Additional arguments (currently unused).
-#'
-#' @return
-#' Prints the summary output including coefficient tables and model fit statistics.
-#'
-#' @export summary.HeckmanCL
-#' @export
-summary.HeckmanCL <- function(object, ...) {
-
-  # Extract components from the HeckmanCL object
-  fisher_infoHC <- object$fisher_infoHC       # Fisher information matrix (not used here)
-  prop_sigmaHC  <- object$prop_sigmaHC        # Standard errors of the estimates
-  coeffsHC      <- object$coefficients        # Estimated coefficients
-  counts        <- object$counts              # Number of iterations in optimization
-  value         <- object$value               # Log-likelihood at convergence
-  loglik        <- object$loglik              # Log-likelihood function
-  NObs          <- object$NObs                # Total number of observations
-  nParam        <- object$nParam              # Number of free parameters
-  df            <- object$df                  # Degrees of freedom
-  NXS           <- object$NXS                 # Number of selection equation covariates
-  NXO           <- object$NXO                 # Number of outcome equation covariates
-  N0            <- object$N0                  # Number of censored observations
-  N1            <- object$N1                  # Number of uncensored observations
-  aic           <- object$aic                 # Akaike Information Criterion
-  bic           <- object$bic                 # Bayesian Information Criterion
-
-  # Build coefficient tables for each block of the model
-  tb  <- miscTools::coefTable(coeffsHC, prop_sigmaHC, df = df)
-
-  tb1 <- miscTools::coefTable(
-    coeffsHC[1:NXS],
-    prop_sigmaHC[1:NXS],
-    df = df
-  )
-
-  tb2 <- miscTools::coefTable(
-    coeffsHC[(NXS + 1):(NXS + NXO)],
-    prop_sigmaHC[(NXS + 1):(NXS + NXO)],
-    df = df
-  )
-
-  tb3 <- miscTools::coefTable(
-    coeffsHC[(NXS + NXO + 1):(NXS + NXO + 2)],
-    prop_sigmaHC[(NXS + NXO + 1):(NXS + NXO + 2)],
-    df = df
-  )
-
-  # Print model summary
-  cat("\n")
-  cat("--------------------------------------------------------------\n")
-  cat("          Classic Heckman Model (Package: ssmodels)           \n")
-  cat("--------------------------------------------------------------\n")
-  cat("--------------------------------------------------------------\n")
-  cat("Maximum Likelihood estimation \n")
-  cat("optim function with method BFGS - iterations number:", counts, "\n")
-  cat("Log-Likelihood:", value, "\n")
-  cat("AIC:", aic, "BIC:", bic, "\n")
-  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed", ")", "\n")
-  cat(nParam, "free parameters", "( df =", df, ")", "\n")
-  cat("--------------------------------------------------------------\n")
-
-  # Print selection equation coefficients
-  cat("Probit selection equation:\n")
-  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  # Print outcome equation coefficients
-  cat("Outcome equation:\n")
-  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  # Print error term estimates (sigma and rho)
-  cat("Error terms:\n")
-  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-}
+#' Summary of Classic Heckman Model
+#'
+#' @description
+#' Print estimates of the parameters of the Classic Heckman model using Maximum Likelihood Estimation.
+#'
+#' @param object An object of class \code{HeckmanCL}.
+#' @param ... Additional arguments (currently unused).
+#'
+#' @return
+#' Prints the summary output including coefficient tables and model fit statistics.
+#'
+#' @export summary.HeckmanCL
+#' @export
+summary.HeckmanCL <- function(object, ...) {
+
+  # Extract components from the HeckmanCL object
+  fisher_infoHC <- object$fisher_infoHC       # Fisher information matrix (not used here)
+  prop_sigmaHC  <- object$prop_sigmaHC        # Standard errors of the estimates
+  coeffsHC      <- object$coefficients        # Estimated coefficients
+  counts        <- object$counts              # Number of iterations in optimization
+  value         <- object$value               # Log-likelihood at convergence
+  loglik        <- object$loglik              # Log-likelihood function
+  NObs          <- object$nObs                # Total number of observations
+  nParam        <- object$nParam              # Number of free parameters
+  df            <- object$df                  # Degrees of freedom
+  NXS           <- object$NXS                 # Number of selection equation covariates
+  NXO           <- object$NXO                 # Number of outcome equation covariates
+  N0            <- object$N0                  # Number of censored observations
+  N1            <- object$N1                  # Number of uncensored observations
+  aic           <- object$aic                 # Akaike Information Criterion
+  bic           <- object$bic                 # Bayesian Information Criterion
+
+  # Build coefficient tables for each block of the model
+  tb  <- miscTools::coefTable(coeffsHC, prop_sigmaHC, df = df)
+
+  tb1 <- miscTools::coefTable(
+    coeffsHC[1:NXS],
+    prop_sigmaHC[1:NXS],
+    df = df
+  )
+
+  tb2 <- miscTools::coefTable(
+    coeffsHC[(NXS + 1):(NXS + NXO)],
+    prop_sigmaHC[(NXS + 1):(NXS + NXO)],
+    df = df
+  )
+
+  tb3 <- miscTools::coefTable(
+    coeffsHC[(NXS + NXO + 1):(NXS + NXO + 2)],
+    prop_sigmaHC[(NXS + NXO + 1):(NXS + NXO + 2)],
+    df = df
+  )
+
+  # Print model summary
+  cat("\n")
+  cat("--------------------------------------------------------------\n")
+  cat("          Classic Heckman Model (Package: ssmodels)           \n")
+  cat("--------------------------------------------------------------\n")
+  cat("--------------------------------------------------------------\n")
+  cat("Maximum Likelihood estimation \n")
+  cat("optim function with method BFGS - iterations number:", counts, "\n")
+  cat("Log-Likelihood:", loglik, "\n")
+  cat("AIC:", aic, "BIC:", bic, "\n")
+  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed", ")", "\n")
+  cat(nParam, "free parameters", "( df =", df, ")", "\n")
+  cat("--------------------------------------------------------------\n")
+
+  # Print selection equation coefficients
+  cat("Probit selection equation:\n")
+  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  # Print outcome equation coefficients
+  cat("Outcome equation:\n")
+  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  # Print error term estimates (sigma and rho)
+  cat("Error terms:\n")
+  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+}
diff -ru R_original_backup_for_audit/summary.HeckmanGe.R R/summary.HeckmanGe.R
--- R_original_backup_for_audit/summary.HeckmanGe.R	2025-05-29 20:39:21.000000000 +0000
+++ R/summary.HeckmanGe.R	2026-05-29 22:00:10.751868306 +0000
@@ -1,89 +1,68 @@
-#' Summary of Generalized Heckman Model
-#'
-#' @description
-#' Print estimates of the parameters of the Generalized Heckman model using Maximum Likelihood Estimation.
-#'
-#' @param object An object of class \code{HeckmanGe}.
-#' @param ... Additional arguments (currently unused).
-#'
-#' @return
-#' Prints the summary output including coefficient tables and model fit statistics.
-#'
-#' @export summary.HeckmanGe
-#' @export
-summary.HeckmanGe <- function(object, ...) {
-  # Extract components from the HeckmanGe object
-  fisher_infoHG <- object$fisher_infoHG       # Fisher information matrix (not printed)
-  prop_sigmaHG  <- object$prop_sigmaHG        # Standard errors of the estimates
-  coeffsHG      <- object$coefficients        # Estimated coefficients
-  counts        <- object$counts              # Number of iterations in optimization
-  value         <- object$value               # Log-likelihood at convergence
-  loglik        <- object$loglik              # Log-likelihood function
-  NObs          <- object$NObs                # Total number of observations
-  nParam        <- object$nParam              # Number of free parameters
-  df            <- object$df                  # Degrees of freedom
-  NXS           <- object$NXS                 # Number of covariates in selection equation
-  NXO           <- object$NXO                 # Number of covariates in outcome equation
-  N0            <- object$N0                  # Number of censored observations
-  N1            <- object$N1                  # Number of observed (uncensored) observations
-  aic           <- object$aic                 # Akaike Information Criterion
-  bic           <- object$bic                 # Bayesian Information Criterion
-  NE            <- object$NE                  # Number of covariates in scale model
-  NV            <- object$NV                  # Number of covariates in correlation model
-
-  # Compute coefficient tables depending on the structure of the model
-  if (NE == 1 & NV == 1) {
-    tb1 <- miscTools::coefTable(coeffsHG[1:NXS], prop_sigmaHG[1:NXS], df = df)
-    tb2 <- miscTools::coefTable(coeffsHG[(NXS + 1):(NXS + NXO)], prop_sigmaHG[(NXS + 1):(NXS + NXO)], df = df)
-    tb3 <- miscTools::coefTable(exp(coeffsHG[NXS + NXO + NE]), prop_sigmaHG[NXS + NXO + NE], df = df)
-    tb4 <- miscTools::coefTable(tanh(coeffsHG[NXS + NXO + NE + NV]), prop_sigmaHG[NXS + NXO + NE + NV], df = df)
-
-  } else if (NE != 1 & NV == 1) {
-    tb1 <- miscTools::coefTable(coeffsHG[1:NXS], prop_sigmaHG[1:NXS], df = df)
-    tb2 <- miscTools::coefTable(coeffsHG[(NXS + 1):(NXS + NXO)], prop_sigmaHG[(NXS + 1):(NXS + NXO)], df = df)
-    tb3 <- miscTools::coefTable(coeffsHG[(NXS + NXO + 1):(NXS + NXO + NE)], prop_sigmaHG[(NXS + NXO + 1):(NXS + NXO + NE)], df = df)
-    tb4 <- miscTools::coefTable(tanh(coeffsHG[NXS + NXO + NE + NV]), prop_sigmaHG[NXS + NXO + NE + NV], df = df)
-
-  } else if (NE == 1 & NV != 1) {
-    tb1 <- miscTools::coefTable(coeffsHG[1:NXS], prop_sigmaHG[1:NXS], df = df)
-    tb2 <- miscTools::coefTable(coeffsHG[(NXS + 1):(NXS + NXO)], prop_sigmaHG[(NXS + 1):(NXS + NXO)], df = df)
-    tb3 <- miscTools::coefTable(exp(coeffsHG[NXS + NXO + NE]), prop_sigmaHG[NXS + NXO + NE], df = df)
-    tb4 <- miscTools::coefTable(coeffsHG[(NXS + NXO + NE + 1):(NXS + NXO + NE + NV)], prop_sigmaHG[(NXS + NXO + NE + 1):(NXS + NXO + NE + NV)], df = df)
-
-  } else {
-    tb1 <- miscTools::coefTable(coeffsHG[1:NXS], prop_sigmaHG[1:NXS], df = df)
-    tb2 <- miscTools::coefTable(coeffsHG[(NXS + 1):(NXS + NXO)], prop_sigmaHG[(NXS + 1):(NXS + NXO)], df = df)
-    tb3 <- miscTools::coefTable(coeffsHG[(NXS + NXO + 1):(NXS + NXO + NE)], prop_sigmaHG[(NXS + NXO + 1):(NXS + NXO + NE)], df = df)
-    tb4 <- miscTools::coefTable(coeffsHG[(NXS + NXO + NE + 1):(NXS + NXO + NE + NV)], prop_sigmaHG[(NXS + NXO + NE + 1):(NXS + NXO + NE + NV)], df = df)
-  }
-
-  # Print summary output
-  cat("\n")
-  cat("--------------------------------------------------------------\n")
-  cat("       Generalized Heckman Model (Package: ssmodels)          \n")
-  cat("--------------------------------------------------------------\n")
-  cat("--------------------------------------------------------------\n")
-  cat("Maximum Likelihood estimation \n")
-  cat("optim function with method BFGS - iterations number:", counts, "\n")
-  cat("Log-Likelihood:", value, "\n")
-  cat("AIC:", aic, "BIC:", bic, "\n")
-  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed )\n")
-  cat(nParam, "free parameters ( df =", df, ")\n")
-  cat("--------------------------------------------------------------\n")
-
-  cat("Probit selection equation:\n")
-  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Outcome equation:\n")
-  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Dispersion terms:\n")
-  printCoefmat(tb3, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Correlation terms:\n")
-  printCoefmat(tb4, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-}
+#' Summary of Generalized Heckman Model
+#'
+#' @description
+#' Print estimates of the parameters of the Generalized Heckman model using Maximum Likelihood Estimation.
+#'
+#' @param object An object of class \code{HeckmanGe}.
+#' @param ... Additional arguments (currently unused).
+#'
+#' @return
+#' Prints the summary output including coefficient tables and model fit statistics.
+#'
+#' @export summary.HeckmanGe
+#' @export
+summary.HeckmanGe <- function(object, ...) {
+  prop_sigmaHG <- object$prop_sigmaHG
+  coeffsHG <- object$coefficients
+  counts <- object$counts
+  loglik <- object$loglik
+  NObs <- object$nObs
+  nParam <- object$nParam
+  df <- object$df
+  NXS <- object$NXS
+  NXO <- object$NXO
+  N0 <- object$N0
+  N1 <- object$N1
+  aic <- object$aic
+  bic <- object$bic
+  NE <- object$NE
+  NV <- object$NV
+
+  idxS <- seq_len(NXS)
+  idxO <- seq.int(NXS + 1L, NXS + NXO)
+  idxE <- seq.int(NXS + NXO + 1L, NXS + NXO + NE)
+  idxV <- seq.int(NXS + NXO + NE + 1L, NXS + NXO + NE + NV)
+
+  tb1 <- miscTools::coefTable(coeffsHG[idxS], prop_sigmaHG[idxS], df = df)
+  tb2 <- miscTools::coefTable(coeffsHG[idxO], prop_sigmaHG[idxO], df = df)
+  tb3 <- miscTools::coefTable(coeffsHG[idxE], prop_sigmaHG[idxE], df = df)
+  tb4 <- miscTools::coefTable(coeffsHG[idxV], prop_sigmaHG[idxV], df = df)
+
+  cat("\n")
+  cat("--------------------------------------------------------------\n")
+  cat("       Generalized Heckman Model (Package: ssmodels)          \n")
+  cat("--------------------------------------------------------------\n")
+  cat("Maximum Likelihood estimation \n")
+  cat("optim function with method BFGS - iterations number:", counts, "\n")
+  cat("Log-Likelihood:", loglik, "\n")
+  cat("AIC:", aic, "BIC:", bic, "\n")
+  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed )\n")
+  cat(nParam, "free parameters ( df =", df, ")\n")
+  cat("--------------------------------------------------------------\n")
+
+  cat("Probit selection equation:\n")
+  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Outcome equation:\n")
+  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Dispersion terms:\n")
+  printCoefmat(tb3, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Correlation terms:\n")
+  printCoefmat(tb4, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+}
diff -ru R_original_backup_for_audit/summary.HeckmanSK.R R/summary.HeckmanSK.R
--- R_original_backup_for_audit/summary.HeckmanSK.R	2025-05-29 20:39:44.000000000 +0000
+++ R/summary.HeckmanSK.R	2026-05-29 21:59:11.013286883 +0000
@@ -1,63 +1,63 @@
-#' Summary of Skew-Normal Heckman Model
-#'
-#' @description
-#' Print estimates of the parameters of the Heckman-SK model using Maximum Likelihood Estimation.
-#'
-#' @param object An object of class \code{HeckmanSK}.
-#' @param ... Additional arguments (currently unused).
-#'
-#' @return
-#' Prints the summary output including coefficient tables and model fit statistics.
-#'
-#' @export summary.HeckmanSK
-#' @export
-summary.HeckmanSK <- function(object, ...) {
-  # Extract components from the HeckmanSK object
-  fisher_infoSK <- object$fisher_infoSK       # Fisher information matrix (not printed)
-  prop_sigmaSK  <- object$prop_sigmaSK        # Standard errors of the estimates
-  coeffsSK      <- object$coefficients        # Estimated coefficients
-  counts        <- object$counts              # Number of iterations in optimization
-  value         <- object$value               # Log-likelihood at convergence
-  loglik        <- object$loglik              # Log-likelihood function
-  NObs          <- object$NObs                # Total number of observations
-  nParam        <- object$nParam              # Number of free parameters
-  df            <- object$df                  # Degrees of freedom
-  NXS           <- object$NXS                 # Number of covariates in selection equation
-  NXO           <- object$NXO                 # Number of covariates in outcome equation
-  N0            <- object$N0                  # Number of censored observations
-  N1            <- object$N1                  # Number of observed (uncensored) observations
-  aic           <- object$aic                 # Akaike Information Criterion
-  bic           <- object$bic                 # Bayesian Information Criterion
-
-  # Generate coefficient tables
-  tb1 <- miscTools::coefTable(coeffsSK[1:NXS], prop_sigmaSK[1:NXS], df = df)                        # Selection equation
-  tb2 <- miscTools::coefTable(coeffsSK[(NXS + 1):(NXS + NXO)], prop_sigmaSK[(NXS + 1):(NXS + NXO)], df = df)  # Outcome equation
-  tb3 <- miscTools::coefTable(coeffsSK[(NXS + NXO + 1):(NXS + NXO + 3)], prop_sigmaSK[(NXS + NXO + 1):(NXS + NXO + 3)], df = df)  # Error components
-  tb  <- miscTools::coefTable(coeffsSK, prop_sigmaSK, df = df)  # Full model (unused in print but preserved)
-
-  # Print summary output
-  cat("\n")
-  cat("--------------------------------------------------------------\n")
-  cat("      Skew Normal Heckman Model (Package: ssmodels)           \n")
-  cat("--------------------------------------------------------------\n")
-  cat("--------------------------------------------------------------\n")
-  cat("Maximum Likelihood estimation \n")
-  cat("optim function with method BFGS - iterations number:", counts, "\n")
-  cat("Log-Likelihood:", value, "\n")
-  cat("AIC:", aic, "BIC:", bic, "\n")
-  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed )\n")
-  cat(nParam, "free parameters ( df =", df, ")\n")
-  cat("--------------------------------------------------------------\n")
-
-  cat("Probit selection equation:\n")
-  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Outcome equation:\n")
-  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Error terms:\n")
-  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-}
+#' Summary of Skew-Normal Heckman Model
+#'
+#' @description
+#' Print estimates of the parameters of the Heckman-SK model using Maximum Likelihood Estimation.
+#'
+#' @param object An object of class \code{HeckmanSK}.
+#' @param ... Additional arguments (currently unused).
+#'
+#' @return
+#' Prints the summary output including coefficient tables and model fit statistics.
+#'
+#' @export summary.HeckmanSK
+#' @export
+summary.HeckmanSK <- function(object, ...) {
+  # Extract components from the HeckmanSK object
+  fisher_infoSK <- object$fisher_infoSK       # Fisher information matrix (not printed)
+  prop_sigmaSK  <- object$prop_sigmaSK        # Standard errors of the estimates
+  coeffsSK      <- object$coefficients        # Estimated coefficients
+  counts        <- object$counts              # Number of iterations in optimization
+  value         <- object$value               # Log-likelihood at convergence
+  loglik        <- object$loglik              # Log-likelihood function
+  NObs          <- object$nObs                # Total number of observations
+  nParam        <- object$nParam              # Number of free parameters
+  df            <- object$df                  # Degrees of freedom
+  NXS           <- object$NXS                 # Number of covariates in selection equation
+  NXO           <- object$NXO                 # Number of covariates in outcome equation
+  N0            <- object$N0                  # Number of censored observations
+  N1            <- object$N1                  # Number of observed (uncensored) observations
+  aic           <- object$aic                 # Akaike Information Criterion
+  bic           <- object$bic                 # Bayesian Information Criterion
+
+  # Generate coefficient tables
+  tb1 <- miscTools::coefTable(coeffsSK[1:NXS], prop_sigmaSK[1:NXS], df = df)                        # Selection equation
+  tb2 <- miscTools::coefTable(coeffsSK[(NXS + 1):(NXS + NXO)], prop_sigmaSK[(NXS + 1):(NXS + NXO)], df = df)  # Outcome equation
+  tb3 <- miscTools::coefTable(coeffsSK[(NXS + NXO + 1):(NXS + NXO + 3)], prop_sigmaSK[(NXS + NXO + 1):(NXS + NXO + 3)], df = df)  # Error components
+  tb  <- miscTools::coefTable(coeffsSK, prop_sigmaSK, df = df)  # Full model (unused in print but preserved)
+
+  # Print summary output
+  cat("\n")
+  cat("--------------------------------------------------------------\n")
+  cat("      Skew Normal Heckman Model (Package: ssmodels)           \n")
+  cat("--------------------------------------------------------------\n")
+  cat("--------------------------------------------------------------\n")
+  cat("Maximum Likelihood estimation \n")
+  cat("optim function with method BFGS - iterations number:", counts, "\n")
+  cat("Log-Likelihood:", loglik, "\n")
+  cat("AIC:", aic, "BIC:", bic, "\n")
+  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed )\n")
+  cat(nParam, "free parameters ( df =", df, ")\n")
+  cat("--------------------------------------------------------------\n")
+
+  cat("Probit selection equation:\n")
+  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Outcome equation:\n")
+  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Error terms:\n")
+  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+}
diff -ru R_original_backup_for_audit/summary.HeckmantS.R R/summary.HeckmantS.R
--- R_original_backup_for_audit/summary.HeckmantS.R	2025-05-29 20:40:10.000000000 +0000
+++ R/summary.HeckmantS.R	2026-05-29 21:59:11.014431227 +0000
@@ -1,63 +1,63 @@
-#' Summary of Heckman-t Model
-#'
-#' @description
-#' Print estimates of the parameters of the Heckman-t model using Maximum Likelihood Estimation.
-#'
-#' @param object An object of class \code{HeckmantS}.
-#' @param ... Additional arguments (currently unused).
-#'
-#' @return
-#' Prints the summary output including coefficient tables and model fit statistics.
-#'
-#' @export summary.HeckmantS
-#' @export
-summary.HeckmantS <- function(object, ...) {
-  # Extract components from the HeckmantS object
-  fisher_infotS <- object$fisher_infotS       # Fisher information matrix (not printed)
-  prop_sigmatS  <- object$prop_sigmatS        # Standard errors of the estimates
-  coeffstS      <- object$coefficients        # Estimated coefficients
-  counts        <- object$counts              # Number of iterations in optimization
-  value         <- object$value               # Log-likelihood at convergence
-  loglik        <- object$loglik              # Log-likelihood function
-  NObs          <- object$NObs                # Total number of observations
-  nParam        <- object$nParam              # Number of free parameters
-  df            <- object$df                  # Degrees of freedom
-  NXS           <- object$NXS                 # Number of covariates in selection equation
-  NXO           <- object$NXO                 # Number of covariates in outcome equation
-  N0            <- object$N0                  # Number of censored observations
-  N1            <- object$N1                  # Number of observed (uncensored) observations
-  aic           <- object$aic                 # Akaike Information Criterion
-  bic           <- object$bic                 # Bayesian Information Criterion
-
-  # Generate coefficient tables
-  tb1 <- miscTools::coefTable(coeffstS[1:NXS], prop_sigmatS[1:NXS], df = df)                         # Selection equation
-  tb2 <- miscTools::coefTable(coeffstS[(NXS + 1):(NXS + NXO)], prop_sigmatS[(NXS + 1):(NXS + NXO)], df = df)  # Outcome equation
-  tb3 <- miscTools::coefTable(coeffstS[(NXS + NXO + 1):(NXS + NXO + 3)], prop_sigmatS[(NXS + NXO + 1):(NXS + NXO + 3)], df = df)  # Error and df terms
-  tb  <- miscTools::coefTable(coeffstS, prop_sigmatS, df = df)  # Full model (not printed but kept)
-
-  # Print summary output
-  cat("\n")
-  cat("--------------------------------------------------------------\n")
-  cat("      t-Student Heckman Model (Package: ssmodels)             \n")
-  cat("--------------------------------------------------------------\n")
-  cat("--------------------------------------------------------------\n")
-  cat("Maximum Likelihood estimation \n")
-  cat("optim function with method BFGS - iterations number:", counts, "\n")
-  cat("Log-Likelihood:", value, "\n")
-  cat("AIC:", aic, "BIC:", bic, "\n")
-  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed )\n")
-  cat(nParam, "free parameters ( df =", df, ")\n")
-  cat("--------------------------------------------------------------\n")
-
-  cat("Probit selection equation:\n")
-  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Outcome equation:\n")
-  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-
-  cat("Error terms:\n")
-  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
-  cat("--------------------------------------------------------------\n")
-}
+#' Summary of Heckman-t Model
+#'
+#' @description
+#' Print estimates of the parameters of the Heckman-t model using Maximum Likelihood Estimation.
+#'
+#' @param object An object of class \code{HeckmantS}.
+#' @param ... Additional arguments (currently unused).
+#'
+#' @return
+#' Prints the summary output including coefficient tables and model fit statistics.
+#'
+#' @export summary.HeckmantS
+#' @export
+summary.HeckmantS <- function(object, ...) {
+  # Extract components from the HeckmantS object
+  fisher_infotS <- object$fisher_infotS       # Fisher information matrix (not printed)
+  prop_sigmatS  <- object$prop_sigmatS        # Standard errors of the estimates
+  coeffstS      <- object$coefficients        # Estimated coefficients
+  counts        <- object$counts              # Number of iterations in optimization
+  value         <- object$value               # Log-likelihood at convergence
+  loglik        <- object$loglik              # Log-likelihood function
+  NObs          <- object$nObs                # Total number of observations
+  nParam        <- object$nParam              # Number of free parameters
+  df            <- object$df                  # Degrees of freedom
+  NXS           <- object$NXS                 # Number of covariates in selection equation
+  NXO           <- object$NXO                 # Number of covariates in outcome equation
+  N0            <- object$N0                  # Number of censored observations
+  N1            <- object$N1                  # Number of observed (uncensored) observations
+  aic           <- object$aic                 # Akaike Information Criterion
+  bic           <- object$bic                 # Bayesian Information Criterion
+
+  # Generate coefficient tables
+  tb1 <- miscTools::coefTable(coeffstS[1:NXS], prop_sigmatS[1:NXS], df = df)                         # Selection equation
+  tb2 <- miscTools::coefTable(coeffstS[(NXS + 1):(NXS + NXO)], prop_sigmatS[(NXS + 1):(NXS + NXO)], df = df)  # Outcome equation
+  tb3 <- miscTools::coefTable(coeffstS[(NXS + NXO + 1):(NXS + NXO + 3)], prop_sigmatS[(NXS + NXO + 1):(NXS + NXO + 3)], df = df)  # Error and df terms
+  tb  <- miscTools::coefTable(coeffstS, prop_sigmatS, df = df)  # Full model (not printed but kept)
+
+  # Print summary output
+  cat("\n")
+  cat("--------------------------------------------------------------\n")
+  cat("      t-Student Heckman Model (Package: ssmodels)             \n")
+  cat("--------------------------------------------------------------\n")
+  cat("--------------------------------------------------------------\n")
+  cat("Maximum Likelihood estimation \n")
+  cat("optim function with method BFGS - iterations number:", counts, "\n")
+  cat("Log-Likelihood:", loglik, "\n")
+  cat("AIC:", aic, "BIC:", bic, "\n")
+  cat("Number of observations:", NObs, "(", N0, "censored and", N1, "observed )\n")
+  cat(nParam, "free parameters ( df =", df, ")\n")
+  cat("--------------------------------------------------------------\n")
+
+  cat("Probit selection equation:\n")
+  printCoefmat(tb1, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Outcome equation:\n")
+  printCoefmat(tb2, signif.stars = TRUE, signif.legend = FALSE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+
+  cat("Error terms:\n")
+  printCoefmat(tb3, signif.stars = TRUE, signif.legend = TRUE, digits = 4)
+  cat("--------------------------------------------------------------\n")
+}
diff -ru R_original_backup_for_audit/twostep.R R/twostep.R
--- R_original_backup_for_audit/twostep.R	2025-05-29 20:42:08.000000000 +0000
+++ R/twostep.R	2026-05-29 21:59:00.173197985 +0000
@@ -1,63 +1,20 @@
-#' Heckman's two-step method
-#'
-#' @description
-#' Estimate model parameters via two-step method.
-#'
-#' @param selection A formula for the selection equation.
-#' @param outcome A formula for the outcome equation.
-#' @param data A data frame containing the variables used in the model.
-#'
-#' @return
-#' Returns a numeric vector with the parameter estimates of the Classical Heckman model using the two-step method.
-#' For more information, see \insertCite{heckman1979sample;textual}{ssmodels}
-#'
-#' @examples
-#' data(MEPS2001)
-#' attach(MEPS2001)
-#' selectEq <- dambexp ~ age + female + educ + blhisp + totchr + ins + income
-#' outcomeEq <- lnambx ~ age + female + educ + blhisp + totchr + ins
-#' twostep(selectEq, outcomeEq)
-#'
-#' @importFrom Rdpack reprompt
-#' @references {
-#' \insertAllCited{}
-#' }
-#' @export
-twostep <- function(selection, outcome, data = sys.frame(sys.parent())) {
-  # Extract selection components
-  sel <- extract_model_components(selection, data)
-  YS <- sel$y                     # Selection response
-  XS <- sel$X                     # Selection design matrix
-  NXS <- ncol(XS)                 # Number of selection covariates
-
-  # Extract outcome components
-  out <- extract_model_components(outcome, data)
-  YO <- out$y                     # Outcome response
-  XO <- out$X                     # Outcome design matrix
-  NXO <- ncol(XO)                 # Number of outcome covariates
-
-  # Step 1: First-stage estimation (Probit model)
-  fit1 <- glm(YS ~ XS - 1, family = binomial(link = "probit"))
-
-  # Compute Inverse Mills Ratio
-  IMR <- dnorm(fit1$linear.predictors) / pnorm(fit1$linear.predictors)
-
-  # Step 2: Second-stage regression (OLS with IMR)
-  xMat <- cbind(XO, IMR)
-  fit2 <- lm(YO ~ XO + IMR - 1, subset = YS == 1)
-  xMat <- data.frame(xMat)
-
-  # Compute delta for variance correction
-  delta <- xMat$IMR * (xMat$IMR + fit1$fitted.values)
-
-  # Estimate residual variance
-  Var <- (sum((fit2$residuals)^2) +
-            (coef(fit2)[length(coef(fit2))]^2 * sum(delta[YS == 1]))) / sum(YS)
-
-  # Estimate correlation between error terms
-  cor <- coef(fit2)[length(coef(fit2))] / sqrt(Var)
-
-  # Return vector of parameters
-  beta <- c(coef(fit1), coef(fit2)[-length(coef(fit2))], phi = sqrt(Var), cor)
-  return(beta)
-}
+#' Heckman's two-step method
+#'
+#' @description
+#' Estimate the classical Heckman model parameters by the two-step method.
+#'
+#' @param selection A formula for the selection equation.
+#' @param outcome A formula for the outcome equation.
+#' @param data A data frame containing the variables used in the model.
+#'
+#' @return A numeric vector with the two-step estimates.
+#'
+#' @importFrom Rdpack reprompt
+#' @references {
+#' \insertAllCited{}
+#' }
+#' @export
+twostep <- function(selection, outcome, data = sys.frame(sys.parent())) {
+  components <- extract_model_components(selection = selection, outcome = outcome, data = data)
+  step2(components$YS, components$XS, components$YO, components$XO)
+}
Only in R: utils-internal.R
