#' @title Quantile-on-Quantile Kernel Regularized Least Squares
#'
#' @description
#' Implements QQKRLS as in Adebayo et al. (2024): for each x-quantile
#' \eqn{\theta} subset the data where \eqn{x \le Q_x(\theta)} and fit KRLS
#' of \eqn{y} on \eqn{x}; the \eqn{\tau}-quantile of the resulting
#' pointwise marginal effects gives \eqn{\hat\beta(\theta, \tau)}.
#' Standard errors come from a paired bootstrap.
#'
#' @param y Numeric vector. Dependent variable.
#' @param x Numeric vector or matrix. Independent variable(s). When a
#'   matrix, KRLS is fit on all columns and the partial derivative w.r.t.
#'   the column indexed by \code{deriv_index} is summarised across
#'   quantiles.
#' @param y_quantiles Numeric vector of \eqn{\tau} in (0, 1). Default
#'   \code{seq(0.05, 0.95, by = 0.05)}.
#' @param x_quantiles Numeric vector of \eqn{\theta} in (0, 1). Default
#'   \code{seq(0.05, 0.95, by = 0.05)}.
#' @param subset_col Integer. Column of \code{x} used to subset by quantile
#'   when \code{x} is multivariate. Default 1.
#' @param deriv_index Integer. Column of \code{x} used to summarise the
#'   KRLS pointwise marginal effects. Default 1.
#' @param sigma Numeric. KRLS Gaussian bandwidth. If \code{NULL}, KRLS
#'   uses its default \code{ncol(X)}.
#' @param lambda Numeric. KRLS regularisation parameter. If \code{NULL},
#'   KRLS chooses via LOO CV per subset.
#' @param min_obs Integer. Minimum observations to fit a subset.
#' @param n_boot Integer. Bootstrap replicates for standard errors.
#'   Default 200.
#' @param verbose Logical. Print progress.
#' @param seed Integer or \code{NULL}. RNG seed for bootstrap.
#'
#' @return Object of class \code{"qqkrls"} containing:
#' \describe{
#'   \item{results}{Data frame with columns y_quantile, x_quantile,
#'      coefficient, std_error, t_value, p_value, significance.}
#'   \item{y_quantiles, x_quantiles}{Quantile grids used.}
#'   \item{n_obs}{Number of complete observations.}
#'   \item{call}{Matched call.}
#' }
#'
#' @references
#' Adebayo, T.S., Ozkan, O., Eweade, B.S. (2024). Do energy efficiency
#' R&D investments and ICT promote environmental sustainability in
#' Sweden? A QQKRLS investigation. \emph{Journal of Cleaner Production},
#' 440, 140832.
#'
#' Hainmueller, J., Hazlett, C. (2014). Kernel Regularized Least Squares.
#' \emph{Political Analysis}, 22(2), 143-168.
#'
#' @examples
#' \donttest{
#' set.seed(1); n <- 150
#' x <- rnorm(n); y <- 0.5 * sin(x) + rnorm(n, sd = 0.3)
#' fit <- qqkrls(y, x,
#'               y_quantiles = c(0.25, 0.5, 0.75),
#'               x_quantiles = c(0.25, 0.5, 0.75),
#'               n_boot = 20, verbose = FALSE)
#' print(fit)
#' }
#'
#' @export
#' @importFrom KRLS krls
#' @importFrom stats quantile sd pnorm complete.cases
qqkrls <- function(y, x,
                   y_quantiles = seq(0.05, 0.95, by = 0.05),
                   x_quantiles = seq(0.05, 0.95, by = 0.05),
                   subset_col = 1,
                   deriv_index = 1,
                   sigma = NULL,
                   lambda = NULL,
                   min_obs = 15,
                   n_boot = 200,
                   verbose = TRUE,
                   seed = 42) {
  y <- as.numeric(y)
  if (is.null(dim(x))) {
    X <- matrix(as.numeric(x), ncol = 1)
    colnames(X) <- "X"
  } else {
    X <- as.matrix(x)
  }
  if (length(y) != nrow(X))
    stop("y and x must have the same number of observations")

  ok <- is.finite(y) & apply(X, 1, function(r) all(is.finite(r)))
  y <- y[ok]; X <- X[ok, , drop = FALSE]
  n_obs <- length(y)
  if (n_obs < 20) stop("need at least 20 observations after NA-removal")

  if (verbose) {
    message(strrep("=", 60))
    message("  Quantile-on-Quantile KRLS  (QQKRLS)")
    message(strrep("=", 60))
    message("  n = ", n_obs,
            ",  Y quantiles = ", length(y_quantiles),
            ",  X quantiles = ", length(x_quantiles))
  }

  records <- list()
  total <- length(x_quantiles); done <- 0
  pct_marker <- max(1L, total %/% 10L)

  for (theta in x_quantiles) {
    done <- done + 1L
    x_thresh <- as.numeric(stats::quantile(X[, subset_col], theta,
                                           na.rm = TRUE))
    sel <- X[, subset_col] <= x_thresh
    X_sub <- X[sel, , drop = FALSE]; y_sub <- y[sel]

    derivs <- NULL; krls_fit <- NULL
    if (nrow(X_sub) >= min_obs) {
      krls_fit <- tryCatch(
        KRLS::krls(X = X_sub, y = y_sub,
                   sigma = sigma, lambda = lambda,
                   derivative = TRUE, vcov = TRUE, binary = FALSE,
                   print.level = 0),
        error = function(e) {
          if (verbose) message("  KRLS failed at theta = ",
                               round(theta, 2), ": ", e$message)
          NULL
        })
      if (!is.null(krls_fit)) {
        derivs <- as.numeric(krls_fit$derivatives[, deriv_index])
      }
    }

    for (tau in y_quantiles) {
      rec <- list(y_quantile = round(tau, 4),
                  x_quantile = round(theta, 4),
                  coefficient = NA_real_,
                  std_error = NA_real_,
                  t_value = NA_real_,
                  p_value = NA_real_,
                  significance = "")
      if (!is.null(derivs) && length(derivs) >= 5) {
        beta <- as.numeric(stats::quantile(derivs, tau, na.rm = TRUE))
        if (!is.null(seed)) set.seed(seed + as.integer(theta * 1000 + tau * 100))
        boot_betas <- numeric(n_boot)
        n_sub <- nrow(X_sub)
        for (b in seq_len(n_boot)) {
          idx <- sample.int(n_sub, n_sub, replace = TRUE)
          bfit <- tryCatch(
            KRLS::krls(X = X_sub[idx, , drop = FALSE], y = y_sub[idx],
                       sigma = sigma, lambda = krls_fit$lambda,
                       derivative = TRUE, vcov = FALSE, binary = FALSE,
                       print.level = 0),
            error = function(e) NULL)
          boot_betas[b] <- if (!is.null(bfit))
            as.numeric(stats::quantile(bfit$derivatives[, deriv_index],
                                       tau, na.rm = TRUE))
            else NA_real_
        }
        valid <- boot_betas[is.finite(boot_betas)]
        se <- if (length(valid) > 10) stats::sd(valid) else NA_real_
        if (!is.finite(se)) {
          if (!is.null(krls_fit$var.avgderivatives))
            se <- sqrt(krls_fit$var.avgderivatives[deriv_index,
                                                   deriv_index])
        }
        if (is.finite(se) && se > 0) {
          tval <- beta / se
          pval <- 2 * stats::pnorm(-abs(tval))
          stars <- if (pval < 0.01) "***"
            else if (pval < 0.05) "**"
            else if (pval < 0.10) "*" else ""
          rec$coefficient <- beta
          rec$std_error <- se
          rec$t_value <- tval
          rec$p_value <- pval
          rec$significance <- stars
        } else {
          rec$coefficient <- beta
        }
      }
      records[[length(records) + 1]] <- rec
    }
    if (verbose && done %% pct_marker == 0)
      message("  theta = ", sprintf("%.2f", theta),
              "  (", round(100 * done / total), "%)")
  }
  if (verbose) message("  done.")

  df <- do.call(rbind, lapply(records, as.data.frame,
                              stringsAsFactors = FALSE))
  rownames(df) <- NULL
  res <- list(results = df,
              y_quantiles = y_quantiles,
              x_quantiles = x_quantiles,
              n_obs = n_obs,
              subset_col = subset_col,
              deriv_index = deriv_index,
              call = match.call(),
              method = "Quantile-on-Quantile KRLS (QQKRLS)")
  class(res) <- "qqkrls"
  res
}


#' @title Print method for qqkrls
#' @param x A qqkrls object.
#' @param ... Ignored.
#' @return Invisibly returns \code{x}.
#' @export
print.qqkrls <- function(x, ...) {
  cat("\nQuantile-on-Quantile KRLS (QQKRLS)\n")
  cat(strrep("=", 50), "\n", sep = "")
  cat("  N = ", x$n_obs, "  Y q-grid: ", length(x$y_quantiles),
      "  X q-grid: ", length(x$x_quantiles), "\n", sep = "")
  r <- x$results
  rok <- r[is.finite(r$coefficient), ]
  if (nrow(rok) > 0) {
    cat(sprintf("\n  Coefficient stats\n"))
    cat(sprintf("    mean   = %+0.4f\n", mean(rok$coefficient)))
    cat(sprintf("    median = %+0.4f\n", stats::median(rok$coefficient)))
    cat(sprintf("    min    = %+0.4f\n", min(rok$coefficient)))
    cat(sprintf("    max    = %+0.4f\n", max(rok$coefficient)))
    p <- rok$p_value
    cat(sprintf("\n  Significance\n"))
    cat(sprintf("    p<0.10 : %d / %d  (%0.1f%%)\n",
                sum(p < 0.10, na.rm = TRUE), nrow(rok),
                100 * sum(p < 0.10, na.rm = TRUE) / nrow(rok)))
    cat(sprintf("    p<0.05 : %d / %d  (%0.1f%%)\n",
                sum(p < 0.05, na.rm = TRUE), nrow(rok),
                100 * sum(p < 0.05, na.rm = TRUE) / nrow(rok)))
    cat(sprintf("    p<0.01 : %d / %d  (%0.1f%%)\n",
                sum(p < 0.01, na.rm = TRUE), nrow(rok),
                100 * sum(p < 0.01, na.rm = TRUE) / nrow(rok)))
  }
  invisible(x)
}


#' @title Summary method for qqkrls
#' @param object A qqkrls object.
#' @param ... Ignored.
#' @return Invisibly returns \code{object}.
#' @export
summary.qqkrls <- function(object, ...) {
  print(object); invisible(object)
}


#' @title Convert QQKRLS Results to Matrix
#' @param qqkrls_result A \code{qqkrls} object.
#' @param value Column to pivot: \code{"coefficient"} (default),
#'   \code{"std_error"}, \code{"t_value"}, \code{"p_value"}.
#' @return Numeric matrix with y_quantiles as rows and x_quantiles as columns.
#' @export
qqkrls_to_matrix <- function(qqkrls_result, value = "coefficient") {
  if (!inherits(qqkrls_result, "qqkrls"))
    stop("'qqkrls_result' must be a qqkrls object")
  df <- qqkrls_result$results
  if (!value %in% names(df)) stop("value '", value, "' not in results")
  ys <- sort(unique(df$y_quantile))
  xs <- sort(unique(df$x_quantile))
  M <- matrix(NA_real_, length(ys), length(xs),
              dimnames = list(as.character(ys), as.character(xs)))
  for (i in seq_along(ys)) for (j in seq_along(xs)) {
    k <- which(df$y_quantile == ys[i] & df$x_quantile == xs[j])
    if (length(k)) M[i, j] <- df[[value]][k[1]]
  }
  M
}


#' @title Export QQKRLS results to CSV
#' @param qqkrls_result A qqkrls object.
#' @param file Output path.
#' @param digits Rounding digits.
#' @return Invisible NULL.
#' @export
#' @importFrom utils write.csv
qqkrls_export <- function(qqkrls_result, file, digits = 4) {
  df <- qqkrls_result$results
  num <- vapply(df, is.numeric, logical(1))
  df[num] <- lapply(df[num], round, digits)
  utils::write.csv(df, file, row.names = FALSE)
  invisible(NULL)
}
