---
title: "diagFDR: Verifiable FDR diagnostics report"
output:
  html_document:
    toc: true
    toc_depth: 3
    theme: readable
    css: custom.css
params:
  diag: NULL
  out_dir: NULL
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)

diag <- params$diag
out_dir <- params$out_dir

`%||%` <- function(a, b) if (!is.null(a)) a else b

md_kable <- function(x, digits = 4, escape = FALSE) {
  if (!is.data.frame(x) || nrow(x) == 0) return(knitr::kable(data.frame(note = "(empty)")))
  knitr::kable(x, digits = digits, escape = escape)
}

# -------------------------
# Icon rendering (HTML only)
# -------------------------
icon_ok      <- "&#x2713;"          # ✓
icon_caution <- "&#x26A0;"          # ⚠
icon_problem <- "&#x26A0;&#xFE0F;"  # ⚠️

flag_to_html <- function(s) {
  if (is.null(s) || length(s) == 0 || all(is.na(s))) return("n/a")
  s <- as.character(s)

  if (s %in% c("NA", "n/a")) return("n/a")
  if (identical(s, "OK")) return(icon_ok)
  if (grepl("^PROBLEM", s)) return(paste0(icon_problem, " ", sub("^PROBLEM_?", "", s)))
  if (grepl("^CAUTION", s)) return(paste0(icon_caution, " ", sub("^CAUTION_?", "", s)))
  s
}

status_to_html <- function(s) {
  s <- as.character(s)
  if (is.na(s) || s == "" || s %in% c("NA", "n/a")) return("n/a")
  if (s == "VALID") return(paste0(icon_ok, " Valid"))
  if (s == "CAUTION") return(paste0(icon_caution, " Caution"))
  if (s == "REVIEW_NEEDED") return(paste0(icon_problem, " Review needed"))
  s
}

headline_display <- function(tbl) {
  if (!is.data.frame(tbl) || nrow(tbl) == 0) return(tbl)
  out <- tbl

  flag_cols <- names(out)[grepl("^flag_", names(out))]
  for (cc in flag_cols) {
    out[[cc]] <- vapply(out[[cc]], flag_to_html, character(1))
  }
  if ("status" %in% names(out)) {
    out[["status"]] <- vapply(out[["status"]], status_to_html, character(1))
  }
  out
}

# -------------------------
# Pull tables/plots/metadata
# -------------------------
# Prefer package helper if present
if (exists("dfdr_summary_headline", mode = "function")) {
  summary_tbl <- dfdr_summary_headline(diag)
} else {
  summary_tbl <- diag$tables$headline
}

summary_tbl_disp <- headline_display(summary_tbl)

alpha_main <- (diag$params %||% list())$alpha_main %||% NA_real_
pnames <- names(diag$plots %||% list())

# Extract metadata
meta_tbl <- purrr::imap_dfr(diag$objects %||% list(), function(x, nm) {
  meta <- attr(x, "meta") %||% list()
  tibble::tibble(
    list = nm,
    unit = meta$unit %||% NA_character_,
    scope = meta$scope %||% NA_character_,
    q_source = meta$q_source %||% NA_character_,
    q_max_export = meta$q_max_export %||% NA_real_,
    p_source = meta$p_source %||% NA_character_
  )
})

# helper: choose box class from ASCII flag code
flag_class <- function(flag_value) {
  flag_value <- as.character(flag_value)
  if (is.na(flag_value) || flag_value %in% c("NA", "n/a")) return("metric-caution")
  if (flag_value == "OK") return("metric-ok")
  if (grepl("^PROBLEM", flag_value)) return("metric-problem")
  if (grepl("^CAUTION", flag_value)) return("metric-caution")
  "metric-caution"
}
```

```{css, echo=FALSE}
.alert-success {
  background-color: #d4edda;
  border-left: 4px solid #28a745;
  color: #000000;
  padding: 15px;
  margin: 20px 0;
  border-radius: 4px;
}
.alert-warning {
  background-color: #fff3cd;
  border-left: 4px solid #ffc107;
  color: #000000;
  padding: 15px;
  margin: 20px 0;
  border-radius: 4px;
}
.alert-danger {
  background-color: #f8d7da;
  border-left: 4px solid #dc3545;
  color: #000000;
  padding: 15px;
  margin: 20px 0;
  border-radius: 4px;
}
.alert-info {
  background-color: #d1ecf1;
  border-left: 4px solid #0c5460;
  color: #000000;
  padding: 15px;
  margin: 20px 0;
  border-radius: 4px;
}
.metric-box {
  display: inline-block;
  padding: 8px 12px;
  margin: 5px;
  border-radius: 4px;
  font-weight: bold;
}
.metric-ok { background-color: #d4edda; color: #155724; }
.metric-caution { background-color: #fff3cd; color: #856404; }
.metric-problem { background-color: #f8d7da; color: #721c24; }
details {
  margin: 20px 0;
  padding: 10px;
  border: 1px solid #ddd;
  border-radius: 4px;
}
summary {
  cursor: pointer;
  font-weight: bold;
  padding: 10px;
  background-color: #f8f9fa;
  border-radius: 4px;
}
summary:hover {
  background-color: #e9ecef;
}
```

## Overview

This report was generated from the output of the `dfdr_run_all()` function of the `diagFDR` R package.

- **diagFDR version:** `r as.character(utils::packageVersion("diagFDR"))`
- **Created:** `r as.character(Sys.time())`
- **Headline threshold (alpha_main):** `r alpha_main`
- **Number of lists analyzed:** `r length(diag$objects)`

---

## Executive Summary

```{r executive, results='asis'}
has_flags <- all(c("status", "interpretation") %in% names(summary_tbl))

if (!has_flags) {
  cat('<div class="alert-info">\n')
  cat('<p><em>Automated flagging not available in this version. Please review metrics manually.</em></p>\n')
  cat('</div>\n\n')
} else {

  problems <- summary_tbl |>
    dplyr::filter(status == "REVIEW_NEEDED") |>
    dplyr::pull(list)

  cautions <- summary_tbl |>
    dplyr::filter(status == "CAUTION") |>
    dplyr::pull(list)

  valid <- summary_tbl |>
    dplyr::filter(status == "VALID") |>
    dplyr::pull(list)

  if (length(problems) > 0) {
    cat('<div class="alert-danger">\n')
    cat('<h3>CRITICAL ISSUES DETECTED</h3>\n')
    for (lst in problems) {
      row <- summary_tbl |> dplyr::filter(list == lst)
      row_disp <- summary_tbl_disp |> dplyr::filter(list == lst)

      cat(sprintf('<p><strong>List "%s":</strong> %s</p>\n', lst, row$interpretation))
      cat('<ul>\n')

      if ("flag_FDR" %in% names(row) && !is.na(row$flag_FDR) && row$flag_FDR != "OK") {
        cat(sprintf('<li>FDR: %s (empirical FDR = %.2f%%)</li>\n', row_disp$flag_FDR, row$FDR_hat * 100))
      }
      if ("flag_IPE" %in% names(row) && !is.na(row$flag_IPE) && row$flag_IPE != "OK" && row$flag_IPE != "NA") {
        if ("IPE" %in% names(row) && is.finite(row$IPE)) {
          cat(sprintf('<li>PEP calibration: %s (IPE = %.3f)</li>\n', row_disp$flag_IPE, row$IPE))
        } else {
          cat(sprintf('<li>PEP calibration: %s</li>\n', row_disp$flag_IPE))
        }
      }
      if ("flag_equalchance" %in% names(row) && !is.na(row$flag_equalchance) && row$flag_equalchance != "OK" && row$flag_equalchance != "NA") {
        if ("effect_abs" %in% names(row) && is.finite(row$effect_abs)) {
          cat(sprintf('<li>Equal-chance: %s (|effect| = %.3f)</li>\n', row_disp$flag_equalchance, row$effect_abs))
        } else {
          cat(sprintf('<li>Equal-chance: %s</li>\n', row_disp$flag_equalchance))
        }
      }
      if ("flag_Dalpha" %in% names(row) && !is.na(row$flag_Dalpha) && row$flag_Dalpha != "OK" && row$flag_Dalpha != "NA") {
        cat(sprintf('<li>Decoy support: %s (D_alpha = %d)</li>\n', row_disp$flag_Dalpha, row$D_alpha))
      }
      if ("flag_CV" %in% names(row) && !is.na(row$flag_CV) && row$flag_CV != "OK" && row$flag_CV != "NA") {
        cat(sprintf('<li>Stability: %s (CV = %.3f)</li>\n', row_disp$flag_CV, row$CV_hat))
      }
      cat('</ul>\n')
    }
    cat('</div>\n\n')
  }

  if (length(valid) > 0) {
    cat('<div class="alert-success">\n')
    cat('<h3>VALID LISTS</h3>\n')
    cat('<ul>\n')
    for (lst in valid) {
      row <- summary_tbl |> dplyr::filter(list == lst)
      meta <- meta_tbl |> dplyr::filter(list == lst)
      cat(sprintf(
        '<li><strong>%s</strong> (%s scope, %s unit): FDR=%.2f%%, D_alpha=%d, CV=%.3f</li>\n',
        lst, meta$scope, meta$unit, row$FDR_hat * 100, row$D_alpha, row$CV_hat
      ))
    }
    cat('</ul>\n')
    cat('</div>\n\n')
  }

  if (length(cautions) > 0) {
    cat('<div class="alert-warning">\n')
    cat('<h3>LISTS WITH WARNINGS</h3>\n')
    for (lst in cautions) {
      row <- summary_tbl |> dplyr::filter(list == lst)
      cat(sprintf('<p><strong>List "%s":</strong> %s</p>\n', lst, row$interpretation))
    }
    cat('</div>\n\n')
  }
}
```

### Quick Metrics Dashboard

```{r dashboard, results='asis'}
if (!has_flags) {
  cat('<p><em>Dashboard not available without flagged headline table.</em></p>\n')
} else {
  for (i in seq_len(nrow(summary_tbl))) {
    row <- summary_tbl[i, ]
    row_disp <- summary_tbl_disp[i, ]

    cat('<div style="margin: 15px 0; padding: 10px; border: 1px solid #ddd; border-radius: 5px;">\n')
    cat(sprintf('<h4>%s <span style="float:right;">%s</span></h4>\n', row$list, row_disp$status))

    cat('<div>\n')

    if ("flag_FDR" %in% names(row)) {
      fdr_class <- flag_class(row$flag_FDR)
      cat(sprintf('<span class="metric-box %s">FDR: %.2f%%</span>\n', fdr_class, row$FDR_hat * 100))
    }

    if ("flag_Dalpha" %in% names(row)) {
      d_class <- flag_class(row$flag_Dalpha)
      cat(sprintf('<span class="metric-box %s">D_alpha: %d</span>\n', d_class, row$D_alpha))
    }

    if ("flag_CV" %in% names(row)) {
      cv_class <- flag_class(row$flag_CV)
      cat(sprintf('<span class="metric-box %s">CV: %.3f</span>\n', cv_class, row$CV_hat))
    }

    if ("flag_IPE" %in% names(row) && "IPE" %in% names(row) && is.finite(row$IPE)) {
      ipe_class <- flag_class(row$flag_IPE)
      cat(sprintf('<span class="metric-box %s">IPE: %.3f</span>\n', ipe_class, row$IPE))
    }

    cat('</div>\n')
    cat('</div>\n\n')
  }
}
```

---

## Headline Summary (Table)

```{r headline-simple}
key_cols <- c("list", "T_alpha", "D_alpha", "FDR_hat", "CV_hat")

if ("IPE" %in% names(summary_tbl)) key_cols <- c(key_cols, "IPE")

if (has_flags) {
  flag_cols <- names(summary_tbl)[grepl("^flag_", names(summary_tbl))]
  key_cols <- c(key_cols, flag_cols, "status")
}

display_cols <- key_cols[key_cols %in% names(summary_tbl_disp)]

summary_tbl_disp |>
  dplyr::select(dplyr::all_of(display_cols)) |>
  md_kable()
```

<details>
<summary>Click to show full headline table (all columns)</summary>

```{r headline-full}
md_kable(summary_tbl_disp, digits = 3)
```

</details>

---

## List Metadata (scope / unit / provenance)

```{r metadata}
md_kable(meta_tbl)
```

---

## Score Distributions (Target vs Decoy)

<div class="alert-info">
**Interpretation guide:**

- **Score distributions**: Good separation means target distribution shifted right, minimal overlap with decoys
- **q-value distributions (fallback if no scores)**: Target q-values should be concentrated near 0; decoys more uniform. Large overlap suggests poor discrimination.
- **Very few decoys at high scores / low q-values**: Leads to sparse tail support (check D_alpha)

</div>

```{r score-distributions, results='asis'}
score_plots <- pnames[grepl("^score_dist__", pnames)]

if (length(score_plots) == 0) {
  cat("\n(No score distribution plots found; score column may not be available.)\n\n")
} else {
  for (nm in score_plots) {
    list_name <- sub("^score_dist__", "", nm)
    cat(sprintf('\n### %s\n\n', list_name))
    print(diag$plots[[nm]])
    cat('\n\n')
  }
}
```

---

## Stability Diagnostics

<div class="alert-info">
**What to look for:**

- **D_alpha curve**: Should remain high at operating thresholds (e.g., >50). U-shape indicates granularity at extreme cutoffs.
- **CV curve**: Should be low (e.g., <0.15) at headline threshold. High CV = unstable estimate.
- **D_alpha_win**: Local decoy support near cutoff. If it is low (e.g., <20) indicates sparse boundary support.
- **Elasticity**: High Jaccard index (>0.9) indicates stability.
</div>

### Decoy tail support and instability proxy

```{r stability-plots}
if (!is.null(diag$plots$dalpha)) print(diag$plots$dalpha)
if (!is.null(diag$plots$cv)) print(diag$plots$cv)
```

### Local boundary support (decoys near the cutoff)

```{r dwin-plot}
if (!is.null(diag$plots$dwin)) print(diag$plots$dwin)

lt <- diag$tables$local_tail
if (is.data.frame(lt) && nrow(lt) > 0) {
  cat("\n#### local_tail table (includes `truncated` flags)\n\n")
  md_kable(lt)
}
```

### Threshold elasticity (list sensitivity to cutoff perturbation)

```{r elasticity-plot}
if (!is.null(diag$plots$elasticity)) print(diag$plots$elasticity)
```

---

## Calibration Diagnostics (target-decoy)

<div class="alert-info">
**What to look for:**

- **Equal-chance**: Decoy fraction in each q-band should be ~50%. Large deviations suggest scoring bias.
- **PEP reliability**: Observed error rate should match predicted PEP. IPE > 0.05 indicates miscalibration.
</div>

### Equal-chance plausibility (q-band decoy fractions)

```{r equal-chance-table}
ecp <- diag$tables$equal_chance_pooled
if (is.data.frame(ecp) && nrow(ecp) > 0) md_kable(ecp)
```

```{r equal-chance-plots, results='asis'}
eq_plots <- pnames[grepl("^equal_chance__", pnames)]
if (length(eq_plots) == 0) {
  cat("\n(No equal-chance plots found.)\n")
} else {
  for (nm in eq_plots) {
    list_name <- sub("^equal_chance__", "", nm)
    cat("\n#### ", list_name, "\n\n", sep = "")
    print(diag$plots[[nm]])
    cat("\n\n")
  }
}
```

### PEP reliability (bins + plots)

```{r pep-ipe-table}
ipe <- diag$tables$pep_IPE
if (is.data.frame(ipe) && nrow(ipe) > 0) md_kable(ipe)
```

```{r pep-plots, results='asis'}
pep_plots <- pnames[grepl("^pep_reliability__", pnames)]
if (length(pep_plots) == 0) {
  cat("\n(No PEP reliability plots found; PEP may be unavailable.)\n")
} else {
  for (nm in pep_plots) {
    list_name <- sub("^pep_reliability__", "", nm)
    cat("\n#### ", list_name, "\n\n", sep = "")
    print(diag$plots[[nm]])
    cat("\n\n")
  }
}
```

### PEP sanity: decoy PEP rates + target/decoy PEP densities

```{r pep-sanity-table, results='asis'}
ps <- diag$tables$pep_decoy_sanity
if (is.data.frame(ps) && nrow(ps) > 0) {
  md_kable(ps, digits = 4)
} else {
  cat("\n(No PEP sanity table found.)\n")
}

pep_den_plots <- pnames[grepl("^pep_density__", pnames)]
if (length(pep_den_plots) == 0) {
  cat("\n(No PEP density sanity plots found.)\n")
} else {
  for (nm in pep_den_plots) {
    list_name <- sub("^pep_density__", "", nm)
    cat("\n#### ", list_name, "\n\n", sep = "")
    print(diag$plots[[nm]])
    cat("\n\n")
  }
}
```

### PEP reliability (TDC-style; targets only)

```{r pep-tdc-style, results='asis'}
pt <- diag$tables$pep_reliability_tdc
if (is.data.frame(pt) && nrow(pt) > 0) {
  md_kable(pt, digits = 4)
} else {
  cat("\n(No TDC-style PEP reliability table found.)\n")
}

pep_tdc_plots <- pnames[grepl("^pep_reliability_tdc__", pnames)]
if (length(pep_tdc_plots) == 0) {
  cat("\n(No TDC-style PEP reliability plots found.)\n")
} else {
  for (nm in pep_tdc_plots) {
    list_name <- sub("^pep_reliability_tdc__", "", nm)
    cat("\n#### ", list_name, "\n\n", sep = "")
    print(diag$plots[[nm]])
    cat("\n\n")
  }
}
```

---

## Calibration Diagnostics (p-values)

<div class="alert-info">
This section is shown only when a \texttt{p} column is available (true p-values or pseudo-p-values derived from scores).

**What to look for:**

- **p-value density**: Density of p-values associated to decoy should be uniform between 0 and 1. The density associated to targets should be peaky near 0 and decrease between 0 and 1.
- **Calibration plots**: Straight lines have slopes equal to different estimators of "pi0", i.e. the proportion of true null hypotheses (proportion of false identifications). 
For decoys, the slope should be close to 1 (100% of false identifications). For targets, the closer the estimators are to 0, the lower the proportion of false identifications among the targets.
- **Estimated FDR**: This is a proxy of the FDR based on an estimator of "pi0". It should be 100% for decoys. It should increase with the p-value threshold for targets until the value of the "pi0" estimator when the threshold is 1. 
- **pi0 Storey**: Storey's estimator of the proportion of true null hypotheses (incorrect identifications). Should be stable across lambda (flat line).
- **BH elasticity**: High Jaccard (>0.95) indicates stable BH lists. Low Jaccard at operating thresholds suggests sensitivity to cutoff choice.

</div>

### (Pseudo-)p-value density (targets vs decoys)

```{r p-density-plots, results='asis'}
p_den_plots <- pnames[grepl("^p_density__", pnames)]
if (length(p_den_plots) == 0) {
  cat("\n(No p-density plots found; no `p` column was provided.)\n")
} else {
  for (nm in p_den_plots) {
    list_name <- sub("^p_density__", "", nm)
    cat("\n#### ", list_name, "\n\n", sep = "")
    print(diag$plots[[nm]])
    cat("\n\n")
  }
}
```

```{r p-diagnostics, results='asis'}
p_plots <- pnames[grepl("^Calibration_pvalues__|^Calibration_pvalues_decoys__|^Calibration_pvalues_targets__|^Estimated_fdr__|^Estimated_fdr_decoys__|^Estimated_fdr_targets__|^pi0_Storey__|^BH_elasticity__", pnames)]
if (length(p_plots) == 0) {
  cat("\n(No p-value diagnostics were found; no `p` column was provided.)\n")
} else {
  for (nm in p_plots) {
    cat("\n### ", nm, "\n\n", sep = "")
    print(diag$plots[[nm]])
    cat("\n\n")
  }
}
```

---

## Scope Comparison (if multiple lists)

```{r scope-comparison, results='asis'}
if (length(diag$objects) > 1) {
  cat('<div class="alert-info">\n')
  cat('<strong>Interpretation:</strong>\n')
  cat('<ul>\n')
  cat('<li>J > 0.9: Scopes largely agree</li>\n')
  cat('<li>0.7 < J < 0.9: Moderate disagreement - scope choice matters</li>\n')
  cat('<li>J < 0.7: Strong disagreement - scope is critical</li>\n')
  cat('</ul>\n')
  cat('</div>\n\n')

  if (!is.null(diag$plots$scope_disagreement)) {
    print(diag$plots$scope_disagreement)
  } else {
    cat("\n(Scope disagreement matrix not computed.)\n\n")
  }
} else {
  cat("\n(Only one list provided; scope comparison not applicable.)\n\n")
}
```

---

## Exported Artifacts

- **Tables directory:** `r normalizePath(out_dir, winslash = "/", mustWork = FALSE)`
- **Plots directory:** `r normalizePath(file.path(out_dir, "plots"), winslash = "/", mustWork = FALSE)`

---

## Appendix: Diagnostic Thresholds

The automated flags use these heuristic thresholds:

| Metric | OK | CAUTION | PROBLEM |
|--------|----|---------|---------|
| **D_alpha** | >= 50 | 10--50 | < 10 |
| **CV** | < 0.15 | 0.15--0.30 | > 0.30 |
| **D_alpha_win** | >= 20 | 5--20 | < 5 |
| **IPE** | <= 0.05 | 0.05--0.10 | > 0.10 |
| **FDR_hat** | <= alpha*1.2 | alpha*1.2--alpha*1.5 | > alpha*1.5 |
| **Equal-chance** | |effect| <= 0.10 | 0.10--0.15 | > 0.15 |

These are guidelines, not absolute rules.

---

<div style="text-align: center; margin-top: 40px; padding: 20px; background-color: #f8f9fa; border-top: 2px solid #dee2e6;">
<strong>End of Report</strong><br/>
Generated by diagFDR v`r utils::packageVersion("diagFDR")`
</div>

