#' Set up individual patient data (IPD)
#'
#' Prepare IPD from the index treatment for an unanchored indirect comparison.
#'
#' @param data Data frame containing IPD
#' @param treatment Column name for treatment variable
#' @param outcome Column name for outcome variable. For `family = "binomial"`,
#'   must be binary (0/1). For `family = "normal"`, any numeric. For
#'   `family = "poisson"`, non-negative integer counts.
#' @param covariates Character vector of covariate column names
#' @param family Outcome family: `"binomial"`, `"normal"`, or `"poisson"`
#' @param exposure Column name for exposure/time-at-risk (required when
#'   `family = "poisson"`)
#' @param study Column name for study identifier (optional)
#'
#' @return An object of class `mlumr_ipd`
#' @export
#'
#' @examples
#' \dontrun{
#' # Binary outcome
#' ipd <- set_ipd(
#'   data = trial_a,
#'   treatment = "trt",
#'   outcome = "response",
#'   covariates = c("age", "sex")
#' )
#'
#' # Continuous outcome
#' ipd <- set_ipd(
#'   data = trial_a,
#'   treatment = "trt",
#'   outcome = "score",
#'   covariates = c("age", "sex"),
#'   family = "normal"
#' )
#'
#' # Count outcome with exposure
#' ipd <- set_ipd(
#'   data = trial_a,
#'   treatment = "trt",
#'   outcome = "events",
#'   covariates = c("age", "sex"),
#'   family = "poisson",
#'   exposure = "person_years"
#' )
#' }
set_ipd <- function(data, treatment, outcome, covariates,
                    family = c("binomial", "normal", "poisson"),
                    exposure = NULL, study = NULL) {

  family <- match.arg(family)

  if (!is.data.frame(data)) {
    stop("`data` must be a data frame", call. = FALSE)
  }
  .validate_non_empty_data(data, "IPD")
  .validate_required_covariates(covariates, "covariates")

  required_cols <- .ipd_required_columns(treatment, outcome, covariates,
                                         exposure, study)

  .check_required_columns(data, required_cols)
  .validate_ipd_outcome(data, outcome, family, exposure)
  .validate_reserved_internal_names(
    covariates,
    c(".study", ".trt", ".outcome", ".exposure"),
    "Covariate name(s)"
  )
  .validate_ipd_covariates(data, covariates)
  .validate_ipd_finite_columns(data, outcome, exposure, family)

  data <- .drop_missing_rows(data, required_cols)
  .validate_complete_rows_remain(data, "IPD")
  .warn_constant_ipd_covariates(data, covariates)
  .validate_single_treatment(data, treatment, "IPD")
  ipd_data <- .standardize_ipd_data(data, treatment, outcome, covariates,
                                    family, exposure, study)

  out <- c(
    list(
      data = ipd_data,
      n = nrow(ipd_data),
      treatment = unique(ipd_data$.trt),
      covariates = covariates,
      family = family,
      type = "ipd"
    ),
    .ipd_outcome_summary(ipd_data, family)
  )

  class(out) <- c("mlumr_ipd", "list")
  out
}

#' Required source columns for IPD setup
#' @keywords internal
.ipd_required_columns <- function(treatment, outcome, covariates,
                                  exposure = NULL, study = NULL) {
  cols <- c(treatment, outcome, covariates)
  if (!is.null(exposure)) cols <- c(cols, exposure)
  if (!is.null(study)) cols <- c(cols, study)
  cols
}

#' Validate that required columns are present
#' @keywords internal
.check_required_columns <- function(data, required_cols) {
  missing_cols <- setdiff(required_cols, names(data))
  if (length(missing_cols) > 0L) {
    stop(sprintf("Missing columns in data: %s",
                 paste(missing_cols, collapse = ", ")), call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate that input data contain at least one row
#' @keywords internal
.validate_non_empty_data <- function(data, label) {
  if (nrow(data) == 0L) {
    stop(sprintf("%s data must contain at least one row", label),
         call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate covariate argument shape before column lookup
#' @keywords internal
.validate_required_covariates <- function(covariates, arg_name) {
  if (!is.character(covariates) || length(covariates) == 0L) {
    stop(sprintf("`%s` must be a non-empty character vector", arg_name),
         call. = FALSE)
  }
  if (any(is.na(covariates)) || any(covariates == "")) {
    stop(sprintf("`%s` must not contain missing or empty names", arg_name),
         call. = FALSE)
  }
  dup_covariates <- unique(covariates[duplicated(covariates)])
  if (length(dup_covariates) > 0L) {
    stop(sprintf("Duplicate covariates: %s",
                 paste(dup_covariates, collapse = ", ")), call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate IPD outcome and exposure columns
#' @keywords internal
.validate_ipd_outcome <- function(data, outcome, family, exposure = NULL) {
  if (family == "binomial") {
    outcome_vals <- data[[outcome]]
    if (!is.numeric(outcome_vals) && !is.logical(outcome_vals)) {
      stop("`outcome` must be numeric or logical 0/1 for binomial family",
           call. = FALSE)
    }
    invalid <- !is.na(outcome_vals) & !(outcome_vals %in% c(0, 1))
    if (any(invalid)) {
      stop("`outcome` must be binary (0/1) for binomial family", call. = FALSE)
    }
  } else if (family == "normal") {
    if (!is.numeric(data[[outcome]])) {
      stop("`outcome` must be numeric for normal family", call. = FALSE)
    }
  } else {
    if (is.null(exposure)) {
      stop("`exposure` is required for poisson family", call. = FALSE)
    }
    outcome_vals <- data[[outcome]]
    if (!.is_whole_number_count(outcome_vals, allow_missing = TRUE)) {
      stop("`outcome` must be non-negative integer counts for poisson family",
           call. = FALSE)
    }
    exposure_vals <- data[[exposure]]
    if (!is.numeric(exposure_vals) || any(exposure_vals <= 0, na.rm = TRUE)) {
      stop("`exposure` must be positive numeric values", call. = FALSE)
    }
  }
  invisible(TRUE)
}

#' Validate a data source contains only one treatment
#' @keywords internal
.validate_single_treatment <- function(data, treatment, label) {
  trt_vals <- unique(data[[treatment]])
  if (length(trt_vals) > 1L) {
    stop(sprintf("%s should contain a single treatment. Found: %s",
                 label, paste(trt_vals, collapse = ", ")), call. = FALSE)
  }
  invisible(TRUE)
}

#' Reject user names that would overwrite standardized internal columns
#' @keywords internal
.validate_reserved_internal_names <- function(user_names, reserved, label) {
  reserved_hit <- intersect(user_names, reserved)
  if (length(reserved_hit) > 0L) {
    msg <- sprintf(
      "%s collide with reserved internal columns: %s. Please rename and retry.",
      label,
      paste(reserved_hit, collapse = ", ")
    )
    stop(msg, call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate IPD covariates
#' @keywords internal
.validate_ipd_covariates <- function(data, covariates) {
  for (cov in covariates) {
    if (!is.numeric(data[[cov]])) {
      stop(sprintf("Covariate '%s' must be numeric", cov), call. = FALSE)
    }
    vals <- data[[cov]][!is.na(data[[cov]])]
    if (any(!is.finite(vals))) {
      stop(sprintf("Covariate '%s' contains non-finite values (Inf, -Inf, or NaN)", cov),
           call. = FALSE)
    }
  }
  invisible(TRUE)
}

#' Validate finite IPD outcome and exposure values
#' @keywords internal
.validate_ipd_finite_columns <- function(data, outcome, exposure, family) {
  outcome_nona <- data[[outcome]][!is.na(data[[outcome]])]
  if (any(!is.finite(outcome_nona))) {
    stop("`outcome` contains non-finite values", call. = FALSE)
  }
  if (family == "poisson") {
    exposure_nona <- data[[exposure]][!is.na(data[[exposure]])]
    if (any(!is.finite(exposure_nona))) {
      stop("`exposure` contains non-finite values", call. = FALSE)
    }
  }
  invisible(TRUE)
}

#' Drop rows with missing setup inputs
#' @keywords internal
.drop_missing_rows <- function(data, required_cols) {
  complete <- complete.cases(data[, required_cols])
  if (!all(complete)) {
    n_missing <- sum(!complete)
    warning(sprintf("%d rows with missing values will be excluded", n_missing),
            call. = FALSE)
    data <- data[complete, ]
  }
  data
}

#' Validate that complete-case filtering left rows to analyze
#' @keywords internal
.validate_complete_rows_remain <- function(data, label) {
  if (nrow(data) == 0L) {
    stop(sprintf("No complete %s rows remain after excluding missing values",
                 label), call. = FALSE)
  }
  invisible(TRUE)
}

#' Warn when IPD covariates have no empirical variation
#' @keywords internal
.warn_constant_ipd_covariates <- function(data, covariates) {
  constant <- vapply(covariates, function(cov) {
    length(unique(data[[cov]])) <= 1L
  }, logical(1))

  if (any(constant)) {
    warning(
      paste(
        "IPD covariate(s) have zero empirical variation after missing-row",
        "filtering:",
        paste(covariates[constant], collapse = ", "),
        "Regression coefficients for constant covariates are not identified",
        "from the IPD; consider removing them or using informative priors."
      ),
      call. = FALSE
    )
  }
  invisible(TRUE)
}

#' Standardize IPD to mlumr's internal column contract
#' @keywords internal
.standardize_ipd_data <- function(data, treatment, outcome, covariates,
                                  family, exposure = NULL, study = NULL) {
  ipd_data <- data.frame(
    .study = if (!is.null(study)) data[[study]] else "IPD_Study",
    .trt = data[[treatment]],
    stringsAsFactors = FALSE
  )

  if (family == "normal") {
    ipd_data$.outcome <- as.numeric(data[[outcome]])
  } else {
    ipd_data$.outcome <- as.integer(data[[outcome]])
  }
  if (family == "poisson") {
    ipd_data$.exposure <- as.numeric(data[[exposure]])
  }

  for (cov in covariates) {
    ipd_data[[cov]] <- data[[cov]]
  }
  ipd_data
}

#' Summarize standardized IPD outcomes
#' @keywords internal
.ipd_outcome_summary <- function(ipd_data, family) {
  switch(family,
    binomial = list(n_events = sum(ipd_data$.outcome)),
    normal = list(mean_outcome = mean(ipd_data$.outcome),
                  sd_outcome = sd(ipd_data$.outcome)),
    poisson = list(total_events = sum(ipd_data$.outcome),
                   total_exposure = sum(ipd_data$.exposure))
  )
}


#' Set up aggregate data (AgD)
#'
#' Prepare AgD from the comparator treatment for an unanchored indirect
#' comparison.
#'
#' @param data Data frame containing AgD summary statistics
#' @param treatment Column name for treatment variable
#' @param family Outcome family: `"binomial"`, `"normal"`, or `"poisson"`
#' @param outcome_n Column name for sample size (required for binomial,
#'   optional for normal)
#' @param outcome_r Column name for number of events (required for binomial
#'   and poisson)
#' @param outcome_mean Column name for mean outcome (required for normal)
#' @param outcome_se Column name for standard error of outcome (required for
#'   normal)
#' @param outcome_E Column name for total exposure (required for poisson)
#' @param cov_means Character vector of column names for covariate means/proportions
#' @param cov_sds Character vector of column names for covariate SDs
#'   (`NA` for binary covariates)
#' @param cov_types Character vector specifying `"continuous"` or `"binary"` for
#'   each covariate. If `NULL`, inferred from presence of SD.
#' @param study Column name for study identifier (optional)
#'
#' @details
#' **Scale assumptions for `family = "normal"`.** The AgD likelihood is
#' `y_agd ~ normal(E[exp(eta)], se_agd)` under `link = "log"` and
#' `y_agd ~ normal(E[eta], se_agd)` under `link = "identity"`. In both
#' cases `outcome_mean` and `outcome_se` must be on the **arithmetic
#' (original, untransformed) scale**. If a publication reports only a
#' log-scale mean / SD or a geometric mean, back-transform before
#' calling `set_agd()` and propagate uncertainty via the delta method;
#' passing log-scale or geometric summaries silently misspecifies the
#' likelihood and biases the posterior.
#'
#' **Scale assumptions for `family = "poisson"`.** `outcome_r` is the
#' total count in each AgD row and `outcome_E` is the total
#' person-time (or other exposure). The Stan likelihood uses
#' `log(E_agd)` as an offset, so rates are modeled on the log scale
#' regardless of how `outcome_r` is tabulated.
#'
#' **Scale assumptions for `family = "binomial"`.** `outcome_r` /
#' `outcome_n` are counts of events and trials. The log-odds (or
#' probit / cloglog under alternative links) are formed from
#' `outcome_r / outcome_n`, so no scale conversion is required.
#'
#' @return An object of class `mlumr_agd`
#' @export
#'
#' @examples
#' \dontrun{
#' # Binary outcome
#' agd <- set_agd(
#'   data = trial_b,
#'   treatment = "trt",
#'   outcome_n = "n_total",
#'   outcome_r = "n_events",
#'   cov_means = c("age_mean", "sex_prop"),
#'   cov_sds = c("age_sd", NA),
#'   cov_types = c("continuous", "binary")
#' )
#'
#' # Continuous outcome
#' agd <- set_agd(
#'   data = trial_b,
#'   treatment = "trt",
#'   family = "normal",
#'   outcome_mean = "mean_score",
#'   outcome_se = "se_score",
#'   outcome_n = "n_total",
#'   cov_means = c("age_mean", "sex_prop")
#' )
#'
#' # Count outcome
#' agd <- set_agd(
#'   data = trial_b,
#'   treatment = "trt",
#'   family = "poisson",
#'   outcome_r = "n_events",
#'   outcome_E = "person_years",
#'   cov_means = c("age_mean", "sex_prop")
#' )
#' }
set_agd <- function(data, treatment,
                    family = c("binomial", "normal", "poisson"),
                    outcome_n = NULL, outcome_r = NULL,
                    outcome_mean = NULL, outcome_se = NULL,
                    outcome_E = NULL,
                    cov_means, cov_sds = NULL, cov_types = NULL,
                    study = NULL) {

  family <- match.arg(family)

  if (!is.data.frame(data)) {
    stop("`data` must be a data frame", call. = FALSE)
  }
  .validate_non_empty_data(data, "AgD")
  .validate_required_covariates(cov_means, "cov_means")

  .validate_agd_outcome_args(family, outcome_n, outcome_r, outcome_mean,
                             outcome_se, outcome_E)
  spec <- .agd_covariate_spec(cov_means, cov_sds, cov_types)
  cov_sds <- spec$cov_sds
  cov_types <- spec$cov_types
  cov_names <- spec$cov_names

  required_cols <- .agd_required_columns(
    treatment = treatment,
    cov_means = cov_means,
    cov_sds = cov_sds,
    outcome_n = outcome_n,
    outcome_r = outcome_r,
    outcome_mean = outcome_mean,
    outcome_se = outcome_se,
    outcome_E = outcome_E,
    study = study
  )

  .check_required_columns(data, required_cols)
  .validate_single_treatment(data, treatment, "AgD")
  .validate_reserved_internal_names(
    c(cov_means, cov_sds[!is.na(cov_sds)]),
    c(".study", ".trt", ".n", ".r", ".y", ".se", ".E"),
    "Column name(s)"
  )
  .validate_agd_covariate_names(cov_means)
  .validate_agd_outcomes(data, family, outcome_n, outcome_r, outcome_mean,
                         outcome_se, outcome_E)
  .validate_agd_covariates(data, cov_means, cov_sds)
  .validate_agd_cov_types(cov_types)
  .validate_agd_binary_covariates(data, cov_means, cov_sds, cov_types)

  agd_data <- .standardize_agd_data(
    data = data,
    treatment = treatment,
    family = family,
    outcome_n = outcome_n,
    outcome_r = outcome_r,
    outcome_mean = outcome_mean,
    outcome_se = outcome_se,
    outcome_E = outcome_E,
    cov_means = cov_means,
    cov_sds = cov_sds,
    cov_names = cov_names,
    study = study
  )
  cov_info <- .agd_cov_info(cov_names, cov_sds, cov_types)

  out <- c(
    list(
      data = agd_data,
      treatment = unique(agd_data$.trt),
      covariates = cov_names,
      cov_info = cov_info,
      family = family,
      type = "agd"
    ),
    .agd_outcome_summary(data, family, outcome_n, outcome_r,
                         outcome_mean, outcome_se, outcome_E)
  )

  class(out) <- c("mlumr_agd", "list")
  out
}

#' Validate AgD outcome column arguments
#' @keywords internal
.validate_agd_outcome_args <- function(family, outcome_n, outcome_r,
                                       outcome_mean, outcome_se, outcome_E) {
  if (family == "binomial" && (is.null(outcome_n) || is.null(outcome_r))) {
    stop("`outcome_n` and `outcome_r` are required for binomial family",
         call. = FALSE)
  }
  if (family == "normal" && (is.null(outcome_mean) || is.null(outcome_se))) {
    stop("`outcome_mean` and `outcome_se` are required for normal family",
         call. = FALSE)
  }
  if (family == "poisson" && (is.null(outcome_r) || is.null(outcome_E))) {
    stop("`outcome_r` and `outcome_E` are required for poisson family",
         call. = FALSE)
  }
  invisible(TRUE)
}

#' Normalize AgD covariate specification
#' @keywords internal
.agd_covariate_spec <- function(cov_means, cov_sds = NULL, cov_types = NULL) {
  n_cov <- length(cov_means)

  if (is.null(cov_sds)) {
    cov_sds <- rep(NA_character_, n_cov)
  } else if (length(cov_sds) != n_cov) {
    stop("`cov_sds` must have same length as `cov_means` or be NULL",
         call. = FALSE)
  }

  if (is.null(cov_types)) {
    cov_types <- ifelse(is.na(cov_sds), "binary", "continuous")
  } else if (length(cov_types) != n_cov) {
    stop("`cov_types` must have same length as `cov_means` or be NULL",
         call. = FALSE)
  }

  list(
    cov_sds = cov_sds,
    cov_types = cov_types,
    cov_names = .strip_agd_cov_suffix(cov_means)
  )
}

#' AgD source columns required for setup
#' @keywords internal
.agd_required_columns <- function(treatment, cov_means, cov_sds,
                                  outcome_n = NULL, outcome_r = NULL,
                                  outcome_mean = NULL, outcome_se = NULL,
                                  outcome_E = NULL, study = NULL) {
  cols <- c(treatment, cov_means)
  for (col in c(outcome_n, outcome_r, outcome_mean, outcome_se, outcome_E)) {
    if (!is.null(col)) cols <- c(cols, col)
  }
  sd_cols <- cov_sds[!is.na(cov_sds)]
  if (length(sd_cols) > 0L) cols <- c(cols, sd_cols)
  if (!is.null(study)) cols <- c(cols, study)
  cols
}

#' Strip AgD covariate suffixes
#' @keywords internal
.strip_agd_cov_suffix <- function(cov_means) {
  sub("_prop$", "", sub("_mean$", "", cov_means))
}

#' Validate AgD covariate names after suffix stripping
#' @keywords internal
.validate_agd_covariate_names <- function(cov_means) {
  stripped <- .strip_agd_cov_suffix(cov_means)
  dup_stripped <- unique(stripped[duplicated(stripped)])
  if (length(dup_stripped) > 0L) {
    msg <- sprintf(
      paste0(
        "Covariate-name collision after stripping _mean/_prop suffix: %s. ",
        "Pass distinct `cov_means` entries."
      ),
      paste(dup_stripped, collapse = ", ")
    )
    stop(msg, call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate AgD outcome summaries
#' @keywords internal
.validate_agd_outcomes <- function(data, family, outcome_n, outcome_r,
                                   outcome_mean, outcome_se, outcome_E) {
  if (family == "binomial") {
    .validate_agd_binomial_outcomes(data[[outcome_r]], data[[outcome_n]])
  } else if (family == "normal") {
    .validate_agd_normal_outcomes(data[[outcome_mean]], data[[outcome_se]])
    if (!is.null(outcome_n)) {
      .validate_agd_sample_size(data[[outcome_n]])
    }
  } else {
    .validate_agd_poisson_outcomes(data[[outcome_r]], data[[outcome_E]])
  }
  invisible(TRUE)
}

#' Validate binomial AgD outcomes
#' @keywords internal
.validate_agd_binomial_outcomes <- function(r_vals, n_vals) {
  if (any(is.na(r_vals)) || any(is.na(n_vals))) {
    stop("`outcome_r` and `outcome_n` must not contain NA values", call. = FALSE)
  }
  if (!is.numeric(r_vals) || !is.numeric(n_vals)) {
    stop("`outcome_r` and `outcome_n` must be numeric", call. = FALSE)
  }
  if (any(!is.finite(r_vals)) || any(!is.finite(n_vals))) {
    stop("`outcome_r` and `outcome_n` must be finite", call. = FALSE)
  }
  if (!.is_whole_number_count(r_vals)) {
    stop("`outcome_r` must be integer counts", call. = FALSE)
  }
  if (!.is_whole_number_count(n_vals)) {
    stop("`outcome_n` must be integer sample sizes", call. = FALSE)
  }
  if (any(r_vals < 0)) {
    stop("`outcome_r` must be non-negative", call. = FALSE)
  }
  if (any(n_vals <= 0)) {
    stop("`outcome_n` must be positive", call. = FALSE)
  }
  if (any(r_vals > n_vals)) {
    stop("`outcome_r` must not exceed `outcome_n`", call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate optional AgD sample sizes
#' @keywords internal
.validate_agd_sample_size <- function(n_vals) {
  if (any(is.na(n_vals))) {
    stop("`outcome_n` must not contain NA values", call. = FALSE)
  }
  if (!is.numeric(n_vals)) {
    stop("`outcome_n` must be numeric", call. = FALSE)
  }
  if (any(!is.finite(n_vals))) {
    stop("`outcome_n` must be finite", call. = FALSE)
  }
  if (!.is_whole_number_count(n_vals)) {
    stop("`outcome_n` must be integer sample sizes", call. = FALSE)
  }
  if (any(n_vals <= 0)) {
    stop("`outcome_n` must be positive", call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate normal AgD outcomes
#' @keywords internal
.validate_agd_normal_outcomes <- function(y_vals, se_vals) {
  if (any(is.na(y_vals)) || any(is.na(se_vals))) {
    stop("`outcome_mean` and `outcome_se` must not contain NA values",
         call. = FALSE)
  }
  if (!is.numeric(y_vals) || !is.numeric(se_vals)) {
    stop("`outcome_mean` and `outcome_se` must be numeric", call. = FALSE)
  }
  if (any(!is.finite(y_vals)) || any(!is.finite(se_vals))) {
    stop("`outcome_mean` and `outcome_se` must be finite", call. = FALSE)
  }
  if (any(se_vals <= 0)) {
    stop("`outcome_se` must be positive", call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate Poisson AgD outcomes
#' @keywords internal
.validate_agd_poisson_outcomes <- function(r_vals, E_vals) {
  if (any(is.na(r_vals)) || any(is.na(E_vals))) {
    stop("`outcome_r` and `outcome_E` must not contain NA values", call. = FALSE)
  }
  if (!is.numeric(r_vals) || !is.numeric(E_vals)) {
    stop("`outcome_r` and `outcome_E` must be numeric", call. = FALSE)
  }
  if (any(!is.finite(r_vals)) || any(!is.finite(E_vals))) {
    stop("`outcome_r` and `outcome_E` must be finite", call. = FALSE)
  }
  if (!.is_whole_number_count(r_vals)) {
    stop("`outcome_r` must be integer counts", call. = FALSE)
  }
  if (any(r_vals < 0)) {
    stop("`outcome_r` must be non-negative", call. = FALSE)
  }
  if (any(E_vals <= 0)) {
    stop("`outcome_E` must be positive", call. = FALSE)
  }
  invisible(TRUE)
}

#' Check whether values are valid non-negative whole-number counts
#' @keywords internal
.is_whole_number_count <- function(x, allow_missing = FALSE) {
  if (!is.numeric(x)) {
    return(FALSE)
  }
  vals <- x
  if (allow_missing) {
    vals <- vals[!is.na(vals)]
  } else if (any(is.na(vals))) {
    return(FALSE)
  }
  if (length(vals) == 0L) {
    return(TRUE)
  }
  all(is.finite(vals) &
        vals >= 0 &
        vals <= .Machine$integer.max &
        abs(vals - round(vals)) <= sqrt(.Machine$double.eps))
}

#' Validate AgD covariate summaries
#' @keywords internal
.validate_agd_covariates <- function(data, cov_means, cov_sds) {
  for (cm in cov_means) {
    if (!is.numeric(data[[cm]])) {
      stop(sprintf("Covariate mean column '%s' must be numeric", cm),
           call. = FALSE)
    }
    if (any(!is.finite(data[[cm]]))) {
      stop(sprintf("Covariate mean column '%s' contains non-finite values", cm),
           call. = FALSE)
    }
  }

  for (cs in cov_sds[!is.na(cov_sds)]) {
    if (!is.numeric(data[[cs]])) {
      stop(sprintf("Covariate SD column '%s' must be numeric", cs),
           call. = FALSE)
    }
    if (any(!is.finite(data[[cs]]))) {
      stop(sprintf("Covariate SD column '%s' contains non-finite values", cs),
           call. = FALSE)
    }
    if (any(data[[cs]] < 0)) {
      stop(sprintf("Covariate SD column '%s' must be non-negative", cs),
           call. = FALSE)
    }
  }
  invisible(TRUE)
}

#' Validate AgD covariate type labels
#' @keywords internal
.validate_agd_cov_types <- function(cov_types) {
  valid_cov_types <- c("binary", "continuous")
  bad_types <- setdiff(unique(cov_types), valid_cov_types)
  if (length(bad_types) > 0L) {
    stop(sprintf("Invalid cov_types: %s. Must be 'binary' or 'continuous'.",
                 paste(sQuote(bad_types), collapse = ", ")), call. = FALSE)
  }
  invisible(TRUE)
}

#' Validate binary AgD covariate summaries
#' @keywords internal
.validate_agd_binary_covariates <- function(data, cov_means, cov_sds, cov_types) {
  for (i in seq_along(cov_types)) {
    if (cov_types[[i]] != "binary") next

    mean_vals <- data[[cov_means[[i]]]]
    cov_label <- .strip_agd_cov_suffix(cov_means[[i]])

    if (any(mean_vals < 0 | mean_vals > 1)) {
      msg <- sprintf(
        "Binary covariate '%s': mean/proportion must be in [0, 1], got %s",
        cov_label,
        paste(mean_vals[mean_vals < 0 | mean_vals > 1], collapse = ", ")
      )
      stop(msg, call. = FALSE)
    }

    if (!is.na(cov_sds[[i]])) {
      sd_vals <- data[[cov_sds[[i]]]]
      max_sd <- sqrt(mean_vals * (1 - mean_vals))
      impossible <- sd_vals > max_sd + 1e-10
      if (any(impossible)) {
        msg <- sprintf(
          paste0(
            "Binary covariate '%s': SD exceeds Bernoulli maximum sqrt(p*(1-p)). ",
            "Got SD=%s for p=%s (max SD=%s)"
          ),
          cov_label,
          paste(round(sd_vals[impossible], 4), collapse = ", "),
          paste(round(mean_vals[impossible], 4), collapse = ", "),
          paste(round(max_sd[impossible], 4), collapse = ", ")
        )
        stop(msg, call. = FALSE)
      }
    }
  }
  invisible(TRUE)
}

#' Standardize AgD to mlumr's internal column contract
#' @keywords internal
.standardize_agd_data <- function(data, treatment, family, outcome_n,
                                  outcome_r, outcome_mean, outcome_se,
                                  outcome_E, cov_means, cov_sds,
                                  cov_names, study = NULL) {
  agd_data <- data.frame(
    .study = if (!is.null(study)) data[[study]] else "AgD_Study",
    .trt = data[[treatment]],
    stringsAsFactors = FALSE
  )

  if (family == "binomial") {
    agd_data$.n <- data[[outcome_n]]
    agd_data$.r <- data[[outcome_r]]
  } else if (family == "normal") {
    agd_data$.y <- data[[outcome_mean]]
    agd_data$.se <- data[[outcome_se]]
    if (!is.null(outcome_n)) agd_data$.n <- data[[outcome_n]]
  } else {
    agd_data$.r <- data[[outcome_r]]
    agd_data$.E <- data[[outcome_E]]
  }

  for (i in seq_along(cov_means)) {
    cov_name <- cov_names[[i]]
    agd_data[[paste0(cov_name, "_mean")]] <- data[[cov_means[[i]]]]
    if (!is.na(cov_sds[[i]])) {
      agd_data[[paste0(cov_name, "_sd")]] <- data[[cov_sds[[i]]]]
    }
  }
  agd_data
}

#' Build AgD covariate metadata
#' @keywords internal
.agd_cov_info <- function(cov_names, cov_sds, cov_types) {
  cov_info <- list()
  for (i in seq_along(cov_names)) {
    cov_name <- cov_names[[i]]
    cov_info[[cov_name]] <- list(
      mean_col = paste0(cov_name, "_mean"),
      sd_col = if (!is.na(cov_sds[[i]])) paste0(cov_name, "_sd") else NA,
      type = cov_types[[i]]
    )
  }
  cov_info
}

#' Summarize AgD outcomes
#' @keywords internal
.agd_outcome_summary <- function(data, family, outcome_n, outcome_r,
                                 outcome_mean, outcome_se, outcome_E) {
  switch(family,
    binomial = list(n = data[[outcome_n]], n_events = data[[outcome_r]]),
    normal = list(y = data[[outcome_mean]], se = data[[outcome_se]],
                  n = if (!is.null(outcome_n)) data[[outcome_n]] else NULL),
    poisson = list(n_events = data[[outcome_r]],
                   total_exposure = data[[outcome_E]])
  )
}


#' Combine IPD and AgD for unanchored comparison
#'
#' @param ipd An `mlumr_ipd` object from [set_ipd()]
#' @param agd An `mlumr_agd` object from [set_agd()]
#'
#' @return An object of class `mlumr_data`
#' @export
#'
#' @examples
#' \dontrun{
#' dat <- combine_data(ipd, agd)
#' }
combine_data <- function(ipd, agd) {

  if (!inherits(ipd, "mlumr_ipd")) {
    stop("`ipd` must be created with set_ipd()", call. = FALSE)
  }
  if (!inherits(agd, "mlumr_agd")) {
    stop("`agd` must be created with set_agd()", call. = FALSE)
  }

  if (ipd$family != agd$family) {
    stop(sprintf("Family mismatch: IPD uses '%s' but AgD uses '%s'",
                 ipd$family, agd$family), call. = FALSE)
  }

  if (!identical(sort(ipd$covariates), sort(agd$covariates))) {
    stop("Covariates must match between IPD and AgD", call. = FALSE)
  }

  if (length(intersect(ipd$treatment, agd$treatment)) > 0) {
    warning("IPD and AgD share treatments -- this looks like an anchored comparison",
            call. = FALSE)
  }

  out <- list(
    ipd = ipd,
    agd = agd,
    family = ipd$family,
    covariates = ipd$covariates,
    n_covariates = length(ipd$covariates),
    treatments = c(ipd$treatment, agd$treatment),
    index_treatment = ipd$treatment,
    comparator_treatment = agd$treatment,
    has_integration = FALSE
  )

  class(out) <- c("mlumr_data", "list")
  out
}


#' @method print mlumr_data
#' @export
print.mlumr_data <- function(x, ...) {
  family <- x$family %||% "binomial"
  family_label <- switch(family,
    binomial = "Binary",
    normal   = "Continuous",
    poisson  = "Count"
  )

  cat(sprintf("Unanchored Comparison Data (%s)\n", family_label))
  cat("====================================\n\n")
  cat("Index treatment (IPD):", x$index_treatment, "\n")
  cat("  N =", x$ipd$n, "\n")

  if (family == "binomial") {
    cat("  Events =", x$ipd$n_events,
        sprintf("(%.1f%%)", 100 * x$ipd$n_events / x$ipd$n), "\n\n")
  } else if (family == "normal") {
    cat(sprintf("  Mean outcome = %.3f (SD = %.3f)\n\n",
                x$ipd$mean_outcome, x$ipd$sd_outcome))
  } else {
    cat(sprintf("  Total events = %d, Total exposure = %.1f\n\n",
                x$ipd$total_events, x$ipd$total_exposure))
  }

  cat("Comparator treatment (AgD):", x$comparator_treatment, "\n")
  if (family == "binomial") {
    cat("  N =", x$agd$n, "\n")
    cat("  Events =", x$agd$n_events,
        sprintf("(%.1f%%)", 100 * x$agd$n_events / x$agd$n), "\n\n")
  } else if (family == "normal") {
    if (!is.null(x$agd$n)) cat("  N =", x$agd$n, "\n")
    cat(sprintf("  Mean outcome = %s, SE = %s\n\n",
                paste(round(x$agd$y, 3), collapse = ", "),
                paste(round(x$agd$se, 3), collapse = ", ")))
  } else {
    cat(sprintf("  Total events = %d, Total exposure = %.1f\n\n",
                sum(x$agd$n_events), sum(x$agd$total_exposure)))
  }

  cat("Covariates (", x$n_covariates, "):",
      paste(x$covariates, collapse = ", "), "\n")
  if (x$has_integration) {
    cat("Integration points:", x$n_int, "(QMC with Gaussian copula)\n")
  } else {
    cat("Integration points: not yet added (use add_integration())\n")
  }
  invisible(x)
}
