#' Print Method for eiv_mlr Objects
#'
#' Displays a concise summary of an errors-in-variables linear model fit.
#'
#' @param x An object of class \code{"eiv_mlr"}.
#' @param ... Not used.
#'
#' @return
#' Invisibly returns the input object \code{x} of class \code{"eiv_mlr"}.
#' This function is called for its side effect of printing a summary of the model.
#'
#' @export
print.eiv_mlr <- function(x, ...) {
  cat("\nErrors-in-Variables Linear Model\n")
  cat("Method:", x$method, "\n\n")
  cat("Coefficients:\n")
  print(x$coef)
  invisible(x)
}

#' Summary of an Errors-in-Variables Linear Model
#'
#' Produces a coefficient table including standard errors, z-statistics,
#' p-values, and significance stars.
#'
#' @param object An object of class \code{"eiv_mlr"}.
#' @param ... Not used.
#'
#' @return An object of class \code{"summary"} containing a
#'   coefficient table and model information.
#'
#' @export
summary.eiv_mlr <- function(object, ...) {

  zval <- object$coef / object$se
  pval <- 2 * pnorm(-abs(zval))

  stars <- symnum(
    pval,
    cutpoints = c(0, 0.001, 0.01, 0.05, 0.1, 1),
    symbols   = c("***", "**", "*", ".", "")
  )

  tab <- data.frame(
    Estimate = object$coef,
    Std.Err  = object$se,
    z.value  = zval,
    Pr.z     = pval,
    ` `      = as.character(stars),
    check.names = FALSE
  )

  res <- list(
    call   = object$call,
    method = object$method,
    table  = tab,
    n      = object$n
  )

  class(res) <- "summary.eiv_mlr"
  res
}


#' Extract Coefficients from an eiv_mlr Object
#'
#' @param object An object of class \code{"eiv_mlr"}.
#' @param ... Not used.
#'
#' @return A named numeric vector of estimated regression coefficients.
#'
#' @export

coef.eiv_mlr <- function(object, ...) {
  object$coef
}


#' Variance-Covariance Matrix for eiv_mlr Objects
#'
#' @param object An object of class \code{"eiv_mlr"}.
#' @param ... Not used.
#'
#' @return A numeric variance-covariance matrix of the parameter estimates.
#'
#' @export
vcov.eiv_mlr <- function(object, ...) {
  object$vcov
}


#' Confidence Intervals for eiv_mlr Coefficients
#'
#' Computes Wald-type confidence intervals for regression coefficients.
#'
#' @param object An object of class \code{"eiv_mlr"}.
#' @param parm Not used.
#' @param level Confidence level; defaults to 0.95.
#' @param ... Not used.
#'
#' @return A matrix with columns \code{lower} and \code{upper}.
#'
#' @export
confint.eiv_mlr <- function(object, parm = NULL, level = 0.95, ...) {

  alpha <- 1 - level
  z     <- qnorm(1 - alpha / 2)

  ci <- cbind(
    lower = object$coef - z * object$se,
    upper = object$coef + z * object$se
  )

  rownames(ci) <- names(object$coef)
  ci
}


#' Residuals from an Errors-in-Variables Linear Model
#'
#' Computes plug-in residuals based on observed covariates and estimated
#' coefficients. Measurement error is not corrected in residuals.
#'
#' @param object An object of class \code{"eiv_mlr"}.
#' @param ... Not used.
#'
#' @return A numeric vector of residuals.
#'
#' @export
residuals.eiv_mlr <- function(object, ...) {
  object$y - object$fitted
}


#' Predictions from an Errors-in-Variables Linear Model
#'
#' Generates fitted values or confidence intervals for new observations
#' using plug-in estimates. Measurement error is not corrected for new data.
#'
#' @param object An object of class \code{"eiv_mlr"}.
#' @param newdata Optional data frame containing covariates. If omitted,
#'   predictions are returned for the training data.
#' @param interval Type of interval to compute: \code{"none"} or
#'   \code{"confidence"}.
#' @param level Confidence level for intervals.
#' @param ... Not used.
#'
#' @return A numeric vector of predictions, or a matrix with columns
#'   \code{fit}, \code{lwr}, and \code{upr} if intervals are requested.
#'
#' @export


predict.eiv_mlr <- function(
    object,
    newdata = NULL,
    interval = c("none", "confidence"),
    level = 0.95,
    ...
) {

  interval <- match.arg(interval)

  if (is.null(newdata)) {
    return(object$fitted)
  }

  beta <- object$coef

  ## -----------------------
  ## 1. Intercept
  ## -----------------------
  intercept <- if ("(Intercept)" %in% names(beta)) {
    beta["(Intercept)"]
  } else {
    0
  }

  ## -----------------------
  ## 2. W part
  ## -----------------------
  beta_W <- beta[object$W_names]
  W_new  <- as.matrix(newdata[, object$W_names, drop = FALSE])

  W_part <- W_new %*% beta_W

  ## -----------------------
  ## 3. Z part
  ## -----------------------
  Zmat_new <- model.matrix(
    object$terms_Z,
    newdata,
    contrasts.arg = object$contrasts_Z,
    xlev = object$xlevels
  )

  beta_Z <- beta[colnames(Zmat_new)]
  Z_part <- Zmat_new %*% beta_Z

  ## -----------------------
  ## 4. Prediction
  ## -----------------------
  fit <- as.numeric(intercept + W_part + Z_part)

  if (interval == "none") {
    return(fit)
  }

  ## -----------------------
  ## 5. Confidence interval
  ## -----------------------
  V <- object$vcov
  beta_names <- names(beta)

  X_full <- matrix(0, nrow = nrow(W_new), ncol = length(beta_names))
  colnames(X_full) <- beta_names

  # Intercept
  if ("(Intercept)" %in% beta_names) {
    X_full[, "(Intercept)"] <- 1
  }

  # W variables
  for (nm in object$W_names) {
    if (nm %in% beta_names) {
      X_full[, nm] <- W_new[, nm]
    }
  }

  # Z variables
  for (nm in colnames(Zmat_new)) {
    if (nm %in% beta_names) {
      X_full[, nm] <- Zmat_new[, nm]
    }
  }

  se_fit <- sqrt(rowSums((X_full %*% V) * X_full))

  alpha <- 1 - level
  z <- qnorm(1 - alpha / 2)

  cbind(
    fit = fit,
    lwr = fit - z * se_fit,
    upr = fit + z * se_fit
  )
}
