## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.width = 7,
  fig.height = 4.5
)

## -----------------------------------------------------------------------------
summary_path <- system.file(
  "extdata",
  "validation",
  "quantile_benchmark_release_summary.csv",
  package = "SelectBoost.quantile"
)
raw_path <- system.file(
  "extdata",
  "validation",
  "quantile_benchmark_release_raw.csv",
  package = "SelectBoost.quantile"
)

resolve_validation_path <- function(installed_path, filename) {
  if (nzchar(installed_path) && file.exists(installed_path)) {
    return(installed_path)
  }

  candidates <- c(
    file.path("inst", "extdata", "validation", filename),
    file.path("..", "inst", "extdata", "validation", filename)
  )
  candidates <- candidates[file.exists(candidates)]
  if (!length(candidates)) {
    stop("Could not locate shipped validation artifact: ", filename, call. = FALSE)
  }
  candidates[[1]]
}

summary_path <- resolve_validation_path(summary_path, "quantile_benchmark_release_summary.csv")
raw_path <- resolve_validation_path(raw_path, "quantile_benchmark_release_raw.csv")

validation_summary <- utils::read.csv(summary_path, stringsAsFactors = FALSE)
validation_raw <- utils::read.csv(raw_path, stringsAsFactors = FALSE)

validation_summary$family <- sub("_tau_.*$", "", validation_summary$scenario)
validation_summary$is_high_dim <- grepl("^high_dim", validation_summary$scenario)
validation_summary$mean_f1 <- with(
  validation_summary,
  ifelse(
    (2 * mean_tp + mean_fp + mean_fn) > 0,
    2 * mean_tp / (2 * mean_tp + mean_fp + mean_fn),
    NA_real_
  )
)

## -----------------------------------------------------------------------------
overall <- aggregate(
  cbind(mean_tpr, mean_fdr, mean_f1, failure_rate, mean_runtime_sec) ~ method,
  data = validation_summary,
  FUN = mean
)

knitr::kable(overall, digits = 3)

## -----------------------------------------------------------------------------
stable_regimes <- subset(validation_summary, !is_high_dim)

stable_overall <- aggregate(
  cbind(mean_tpr, mean_fdr, mean_f1, failure_rate, mean_runtime_sec) ~ method,
  data = stable_regimes,
  FUN = mean
)

knitr::kable(stable_overall, digits = 3)

## -----------------------------------------------------------------------------
family_summary <- aggregate(
  cbind(mean_tpr, mean_fdr, mean_f1) ~ family + method,
  data = stable_regimes,
  FUN = mean
)

knitr::kable(family_summary, digits = 3)

## -----------------------------------------------------------------------------
plot_df <- stable_regimes
method_levels <- c("lasso", "lasso_tuned", "selectboost")
cols <- c("lasso" = "#4C78A8", "lasso_tuned" = "#F58518", "selectboost" = "#54A24B")
plot(
  plot_df$mean_fdr,
  plot_df$mean_f1,
  col = cols[plot_df$method],
  pch = 19,
  xlab = "Mean FDR",
  ylab = "Mean F1",
  main = "Validation Summary by Scenario"
)
legend(
  "bottomleft",
  legend = method_levels,
  col = cols[method_levels],
  pch = 19,
  bty = "n"
)

## -----------------------------------------------------------------------------
high_dim <- subset(validation_summary, is_high_dim)

high_dim_overall <- aggregate(
  cbind(mean_tpr, mean_fdr, mean_f1, failure_rate, mean_support_size) ~ method,
  data = high_dim,
  FUN = mean
)

knitr::kable(high_dim_overall, digits = 3)

## -----------------------------------------------------------------------------
failure_rows <- subset(validation_summary, failure_rate > 0)
if (nrow(failure_rows)) {
  knitr::kable(failure_rows[, c(
    "scenario",
    "method",
    "failure_rate",
    "mean_tpr",
    "mean_fdr",
    "mean_support_size"
  )], digits = 3)
} else {
  cat("No method failures were recorded in the shipped study.\n")
}

## ----eval = FALSE-------------------------------------------------------------
# out_dir <- file.path(tempdir(), "SelectBoost.quantile-validation")
# system2(
#   "Rscript",
#   c("inst/scripts/run_quantile_benchmark.R", out_dir, "4", "0.55")
# )