#' Hybrid regression wrapper for xreg2
#'
#' @title Hybrid Regression (xreg2 version)
#' @description High-level wrapper around \code{\link{xreg2_fit}} replicating
#'   the interface of the STATA \code{hyreg} command and
#'   \code{xreg::hyreg()}. Simultaneously fits a censored continuous model
#'   (normal or logistic) and a dichotomous model (logistic or normal) to a
#'   single data frame that contains both observation types.
#'
#' @param formula A formula or list of formulas for the continuous component.
#'   The dependent variable (left-hand side) must match a column in \code{df},
#'   or use interval columns named \code{varname.lb} and \code{varname.ub}.
#' @param df A \code{data.frame} containing both continuous and dichotomous
#'   observations. Must include the column specified by \code{datatype}.
#' @param datatype Character; name of the column that distinguishes continuous
#'   (\code{TRUE}) from dichotomous (\code{FALSE}) observations. Default
#'   \code{"method"}.
#' @param init Optional named numeric vector (or \code{xreg2} object) of
#'   starting values.
#' @param contdist Character; distribution for the continuous component.
#'   \code{"normal"} (default) or \code{"logistic"}.
#' @param dichdist Character; distribution for the dichotomous component.
#'   \code{"logistic"} (default) or \code{"normal"}.
#' @param hetcont Optional formula for heteroscedastic standard deviations in
#'   the continuous component. If \code{NULL} (default), uses
#'   \code{sigma_est ~ SIGMA} (or \code{sigma_est ~ exp(SIGMA)} when
#'   \code{lnsigma = TRUE}).
#' @param hetdich Optional formula for heteroscedastic standard deviations in
#'   the dichotomous component. If \code{NULL} (default), uses
#'   \code{theta_est ~ THETA} (or \code{theta_est ~ exp(THETA)} when
#'   \code{lntheta = TRUE}).
#' @param ul Numeric; upper censoring bound. Default \code{Inf}.
#' @param ll Numeric; lower censoring bound. Default \code{-Inf}.
#' @param lntheta Logical; exponentiate theta prior to fitting (matches STATA
#'   default). Default \code{TRUE}.
#' @param lnsigma Logical; exponentiate sigma prior to fitting (matches STATA
#'   default). Default \code{TRUE}.
#' @param dichformula Optional formula for the dichotomous component. Defaults
#'   to \code{formula}.
#' @param ... Additional arguments forwarded to \code{\link{xreg2_fit}}.
#'
#' @return An object of class \code{"xreg2"}.
#'
#' @seealso \code{\link{xreg2_fit}}, \code{\link{xreg2_control}}
#'
#' @examples
#' \donttest{
#' set.seed(1)
#' n   <- 300
#' df  <- data.frame(
#'   value  = c(rnorm(200, 0.6, 0.3), rep(NA, 100)),
#'   age    = rnorm(n),
#'   method = c(rep(TRUE, 200), rep(FALSE, 100))
#' )
#' df$value[df$method == FALSE] <- as.integer(df$age[df$method == FALSE] > 0)
#'
#' fit <- xreg2_hyreg(
#'   formula  = value ~ INTERCEPT + age * AGE,
#'   df       = df,
#'   datatype = "method"
#' )
#' print(fit)
#' }
#'
#' @export
xreg2_hyreg <- function(formula,
                          df,
                          datatype     = "method",
                          init         = numeric(),
                          contdist     = "normal",
                          dichdist     = "logistic",
                          hetcont      = NULL,
                          hetdich      = NULL,
                          ul           = Inf,
                          ll           = -Inf,
                          lntheta      = TRUE,
                          lnsigma      = TRUE,
                          dichformula  = NULL,
                          ...) {

  if (!"data.frame" %in% class(df))
    stop(paste0(class(df)[1], " provided to the df argument. Should be data.frame."))
  if (!datatype %in% colnames(df))
    stop(paste0("No column named \"", datatype, "\" in provided dataframe."))
  if (!all(as.logical(unique(df[, datatype])) %in% c(TRUE, FALSE)))
    stop("Datatype column in provided data.frame must be interpretable as boolean.")
  if (!contdist %in% c("normal", "logistic"))
    stop('contdist-argument has to be either "normal" or "logistic".')
  if (!dichdist %in% c("normal", "logistic"))
    stop('dichdist-argument has to be either "normal" or "logistic".')

  if (is.null(dichformula)) dichformula <- formula
  if (inherits(formula,     "formula")) formula     <- list(formula)
  if (inherits(dichformula, "formula")) dichformula <- list(dichformula)

  dataList <- list(
    Continuous  = df[as.logical(df[, datatype] == TRUE),  ],
    Dichotomous = df[as.logical(df[, datatype] == FALSE), ]
  )

  dot_args <- list(...)
  dot_args[c("p_fun", "p_aggrgation_fun")] <- NULL

  if (!is.null(hetcont)) {
    if (is.character(hetcont)) {
      tmp     <- try0(as.formula(hetcont))
      if (is.null(tmp)) tmp <- try0(as.formula(paste0("~ ", hetcont)))
      if (is.null(tmp)) stop("Could not generate useful formula from provided hetcont-argument.")
      hetcont <- tmp
    }
    hetcont <- change_target(hetcont, "sigma_est")
  } else {
    hetcont <- as.formula("sigma_est ~ SIGMA")
  }

  if (!is.null(hetdich)) {
    if (is.character(hetdich)) {
      tmp     <- try0(as.formula(hetdich))
      if (is.null(tmp)) tmp <- try0(as.formula(paste0("~ ", hetdich)))
      if (is.null(tmp)) stop("Could not generate useful formula from provided hetdich-argument.")
      hetdich <- tmp
    }
    hetdich <- change_target(hetdich, "theta_est")
  } else {
    hetdich <- as.formula("theta_est ~ THETA")
  }

  if (lnsigma)  hetcont <- appendmodel(hetcont, " exp(", ")")
  if (lntheta)  hetdich <- appendmodel(hetdich, " exp(", ")")

  cont_formula <- c(formula, list(hetcont))
  dich_formula <- c(dichformula, list(hetdich))

  cont_p_fun <- xreg2_cont_normal
  dich_p_fun <- xreg2_dich_logistic
  if (contdist == "logistic") cont_p_fun <- xreg2_dich_logistic
  if (dichdist == "normal")   dich_p_fun <- xreg2_cont_normal

  cont_control <- xreg2_control(formulas = cont_formula, p_fun = cont_p_fun,
                                 name = "Continuous",   censor_bounds = c(ll, ul))
  dich_control <- xreg2_control(formulas = dich_formula, p_fun = dich_p_fun,
                                 name = "Dichotomous")
  control <- c(cont_control, dich_control)

  ret <- do.call("xreg2_fit", c(
    list(controlList  = control,
         dataList     = dataList,
         start_values = init,
         run_from     = "hyreg"),
    dot_args
  ))

  return(ret)
}
