#' codez training controls
#'
#' @param batch_size Positive integer. Mini-batch size for torch training.
#' @param validation_split Numeric value in [0, 1). Validation share for the autoencoder.
#' @param n_sim Positive integer. Number of simulated paths generated from validation residuals.
#' @param backend String. Neural backend. Only "torch" is supported.
#' @param epochs Optional positive integer overriding `codez()` epochs.
#' @param patience Optional positive integer overriding early-stopping patience.
#' @param holdout Optional numeric value between 0 and 1 overriding validation holdout.
#'
#' @return A list of controls for `fit_codez()`.
#' @export
codez_control <- function(batch_size = 32, validation_split = 0.1, n_sim = 1000,
                          backend = "torch", epochs = NULL, patience = NULL,
                          holdout = NULL)
{
  control <- list(batch_size = batch_size, validation_split = validation_split,
                  n_sim = n_sim, backend = backend, epochs = epochs,
                  patience = patience, holdout = holdout)
  control <- control[!vapply(control, is.null, logical(1))]
  class(control) <- c("codez_control", "list")
  control
}

#' Fit a codez 2.0 model
#'
#' `fit_codez()` is the codez 2.0 workflow wrapper. It keeps `codez()` as the
#' forecasting engine, then attaches tidy forecasts, rolling baseline
#' comparisons, the training call, and S3 methods.
#'
#' @param df A data frame with time features on columns.
#' @param ... Arguments passed to `codez()`.
#' @param dates Optional Date vector with one value per row of `df`.
#' @param control A `codez_control()` object.
#'
#' @return A `codez_model` object.
#' @export
fit_codez <- function(df, ..., dates = NULL, control = codez_control())
{
  if(!inherits(control, "codez_control")){stop("control must be created by codez_control()")}

  user_args <- list(...)
  if(!is.null(dates) && is.null(user_args$dates)){user_args$dates <- dates}
  call_args <- c(list(df = df), utils::modifyList(unclass(control), user_args))

  result <- do.call(codez, call_args)
  forecast <- codez_forecast_tidy(result)
  seq_len <- codez_result_seq_len(result)
  n_windows <- call_args$n_windows %||% 10
  error_scale <- call_args$error_scale %||% "naive"
  error_benchmark <- call_args$error_benchmark %||% "naive"
  benchmarks <- codez_backtest_baselines(df = df, seq_len = seq_len,
                                         n_windows = n_windows,
                                         error_scale = error_scale,
                                         error_benchmark = error_benchmark)

  structure(list(result = result,
                 forecast = forecast,
                 benchmarks = benchmarks,
                 control = control,
                 call = match.call(),
                 backend = attr(result, "backend")),
            class = "codez_model")
}

#' @export
predict.codez_model <- function(object, type = c("forecast", "raw", "plots", "benchmarks"), ...)
{
  type <- match.arg(type)
  switch(type,
         forecast = object$forecast,
         raw = object$result$best_model$predictions,
         plots = object$result$best_model$plot,
         benchmarks = object$benchmarks)
}

#' @export
summary.codez_model <- function(object, ...)
{
  errors <- object$result$best_model$errors
  history <- object$result$history
  if(!is.null(history)){history <- head(history, 5)}
  structure(list(backend = object$backend,
                 time_log = object$result$time_log,
                 best_history = history,
                 errors = errors,
                 benchmarks = object$benchmarks),
            class = "summary.codez_model")
}

#' @export
print.summary.codez_model <- function(x, ...)
{
  cat("codez model\n")
  cat("Backend:", x$backend %||% "unknown", "\n")
  cat("Elapsed:", as.character(x$time_log), "\n\n")
  if(!is.null(x$best_history))
  {
    cat("Best sampled configurations:\n")
    print(x$best_history)
    cat("\n")
  }
  cat("Testing errors:\n")
  print(x$errors)
  if(!is.null(x$benchmarks) && nrow(x$benchmarks) > 0)
  {
    cat("\nBaseline backtests:\n")
    print(head(x$benchmarks, 12))
  }
  invisible(x)
}

#' @export
autoplot <- function(object, ...)
{
  UseMethod("autoplot")
}

#' @export
autoplot.codez_model <- function(object, feature = NULL, ...)
{
  forecast <- object$forecast
  if(!is.null(feature)){forecast <- forecast[forecast$feature %in% feature,, drop = FALSE]}
  if(nrow(forecast) == 0){stop("no forecast rows available for plotting")}

  interval <- codez_interval_columns(forecast)
  forecast$.x <- if(all(!is.na(forecast$date))) forecast$date else forecast$horizon
  forecast$.mid <- forecast[[interval$mid]]
  forecast$.lower <- if(!is.null(interval$lower)) forecast[[interval$lower]] else NA_real_
  forecast$.upper <- if(!is.null(interval$upper)) forecast[[interval$upper]] else NA_real_

  codez_plot(data = forecast, type = "model_forecast",
             labels = list(x = "Horizon", y = "Forecast"))
}

#' @export
plot.codez_model <- function(x, ...)
{
  plot(autoplot.codez_model(x, ...))
  invisible(x)
}

#' @export
as.data.frame.codez_model <- function(x, row.names = NULL, optional = FALSE, ...)
{
  as.data.frame(x$forecast, row.names = row.names, optional = optional, ...)
}

#' Extract tidy forecasts from a codez result
#'
#' @param result A result returned by `codez()` or a `codez_model`.
#'
#' @return A data frame with one row per feature and forecast horizon.
#' @export
codez_forecast_tidy <- function(result)
{
  if(inherits(result, "codez_model")){result <- result$result}
  predictions <- result$best_model$predictions
  if(is.null(predictions)){return(data.frame())}

  rows <- lapply(names(predictions), function(feature)
  {
    pred <- as.data.frame(predictions[[feature]], check.names = FALSE)
    index <- rownames(pred)
    parsed_dates <- rep(as.Date(NA), length(index))
    date_attempt <- suppressWarnings(try(as.Date(index), silent = TRUE))
    if(!inherits(date_attempt, "try-error")){parsed_dates <- date_attempt}
    data.frame(feature = feature,
               horizon = seq_len(nrow(pred)),
               index = index,
               date = parsed_dates,
               pred,
               row.names = NULL,
               check.names = FALSE)
  })

  do.call(rbind, rows)
}

codez_result_seq_len <- function(result)
{
  if(!is.null(result$history) && "seq_len" %in% names(result$history)){return(result$history$seq_len[1])}
  if(!is.null(result$best_model$predictions)){return(nrow(result$best_model$predictions[[1]]))}
  if(!is.null(result$best_model$quant_pred)){return(nrow(result$best_model$quant_pred[[1]]))}
  NULL
}

codez_interval_columns <- function(forecast)
{
  numeric_names <- names(forecast)[vapply(forecast, is.numeric, logical(1))]
  percent_cols <- grep("%$", numeric_names, value = TRUE)
  mid <- if("50%" %in% names(forecast)) "50%" else if("mean" %in% names(forecast)) "mean" else numeric_names[1]
  if(!length(percent_cols)){return(list(mid = mid, lower = NULL, upper = NULL))}
  percent_values <- suppressWarnings(as.numeric(sub("%", "", percent_cols)))
  lower <- percent_cols[which.min(abs(percent_values - min(percent_values, na.rm = TRUE)))]
  upper <- percent_cols[which.max(percent_values)]
  list(mid = mid,
       lower = if(length(lower) && is.finite(percent_values[match(lower, percent_cols)])) lower else NULL,
       upper = if(length(upper) && is.finite(percent_values[match(upper, percent_cols)])) upper else NULL)
}

codez_backtest_baselines <- function(df, seq_len, n_windows = 10,
                                     error_scale = "naive", error_benchmark = "naive")
{
  numeric_index <- vapply(df, function(x) is.integer(x) || is.numeric(x), logical(1))
  if(!all(numeric_index)){return(data.frame())}
  if(is.null(seq_len) || !is.finite(seq_len) || seq_len < 1){return(data.frame())}

  n_length <- nrow(df)
  idx <- c(base::rep(1, n_length%%(n_windows + 1)), base::rep(1:(n_windows + 1), each = n_length/(n_windows + 1)))
  rows <- list()

  for(window in base::seq_len(n_windows))
  {
    train <- df[idx <= window,, drop = FALSE]
    holdout <- head(df[idx > window,, drop = FALSE], seq_len)
    if(nrow(train) < 2 || nrow(holdout) < seq_len){next}

    for(feature in names(df))
    {
      actuals <- train[[feature]]
      truth <- holdout[[feature]]
      forecasts <- list(naive = rep(tail(actuals, 1), length(truth)),
                        average = rep(mean(actuals, na.rm = TRUE), length(truth)))
      for(model in names(forecasts))
      {
        metrics <- custom_metrics(truth, forecasts[[model]], actuals,
                                  error_scale = error_scale,
                                  error_benchmark = error_benchmark,
                                  binary_class = FALSE)
        rows[[length(rows) + 1]] <- data.frame(window = window,
                                               model = model,
                                               feature = feature,
                                               metric = names(metrics),
                                               value = as.numeric(metrics),
                                               row.names = NULL)
      }
    }
  }

  if(!length(rows)){return(data.frame())}
  do.call(rbind, rows)
}
