# Module 7: Hit ranking, annotation and reporting ----------------------------

# Directional, scale-free score contribution for one metric.
# `better` = "low" means smaller values are more active.
.metric_score <- function(v, better = c("low", "high")) {
  better <- match.arg(better)
  s <- stats::sd(v, na.rm = TRUE)
  z <- if (!is.finite(s) || s == 0) rep(0, length(v)) else
    (v - mean(v, na.rm = TRUE)) / s
  z[is.na(z)] <- 0
  if (better == "low") -z else z
}

#' Rank and stratify hit compounds
#'
#' Combines potency, efficacy and quality metrics into a single activity score
#' and assigns each compound to a Strong, Moderate or Weak tier, the final
#' prioritisation step of the pipeline. Lower AUC and IC50 and higher Emax count
#' as more active; lower replicate CV and higher fit \eqn{R^2} raise confidence.
#'
#' @param data A per-compound data frame of metrics.
#' @param auc_col,ic50_col,emax_col,cv_col,rsq_col Column names for the metrics
#'   to use; set any to `NULL` to omit it. Metrics absent from `data` are
#'   silently skipped.
#' @param weights Optional named numeric vector of per-metric weights (names
#'   matching the metric column names). Defaults to equal weights.
#' @param probs Two increasing probabilities splitting Weak/Moderate/Strong by
#'   score quantile. Default `c(1/3, 2/3)`.
#'
#' @return `data` with added `score` (numeric) and `tier` (ordered factor
#'   Weak < Moderate < Strong), sorted by descending score.
#'
#' @examples
#' drc <- calc_drc_auc(fit_4pl_curve(import_dose_response(hts_dose_response,
#'   response_col = "viability", group_cols = "cell_line"),
#'   group_cols = "cell_line"))
#' params <- merge(extract_drc_params(drc), drc$meta[, c("curve_id", "auc")])
#' ranked <- rank_hit_compound(params)
#' table(ranked$tier)
#'
#' @seealso [annotate_hit_info()], [plot_hit_stratify_bar()]
#' @export
rank_hit_compound <- function(data, auc_col = "auc", ic50_col = "ic50",
                              emax_col = "emax", cv_col = "cv",
                              rsq_col = "rsq", weights = NULL,
                              probs = c(1 / 3, 2 / 3)) {
  df <- as.data.frame(data, stringsAsFactors = FALSE)
  spec <- list(
    auc = list(col = auc_col, better = "low"),
    ic50 = list(col = ic50_col, better = "low"),
    emax = list(col = emax_col, better = "high"),
    cv = list(col = cv_col, better = "low"),
    rsq = list(col = rsq_col, better = "high")
  )
  score <- rep(0, nrow(df))
  used <- character(0)
  for (nm in names(spec)) {
    col <- spec[[nm]]$col
    if (is.null(col) || !col %in% names(df)) next
    w <- if (!is.null(weights) && col %in% names(weights)) weights[[col]] else 1
    score <- score + w * .metric_score(.as_numeric(df[[col]]),
      better = spec[[nm]]$better)
    used <- c(used, col)
  }
  if (length(used) == 0) {
    stop("None of the requested metric columns are present in `data`.",
      call. = FALSE)
  }
  df$score <- score
  qs <- stats::quantile(score, probs = probs, na.rm = TRUE)
  tier <- ifelse(score >= qs[2], "Strong",
    ifelse(score >= qs[1], "Moderate", "Weak"))
  df$tier <- factor(tier, levels = c("Weak", "Moderate", "Strong"),
    ordered = TRUE)
  df <- df[order(-df$score), , drop = FALSE]
  rownames(df) <- NULL
  attr(df, "score_metrics") <- used
  df
}

#' Annotate hits with compound metadata
#'
#' Joins external compound metadata (name, target, mechanism, library source)
#' onto a hit table.
#'
#' @param hits A hit data frame (for example from [rank_hit_compound()]).
#' @param meta A metadata data frame such as [hts_compound_meta].
#' @param by Join key present in both. Default `"compound_id"`.
#'
#' @return `hits` with the metadata columns merged in (left join), row order
#'   preserved.
#'
#' @examples
#' drc <- calc_drc_auc(fit_4pl_curve(import_dose_response(hts_dose_response,
#'   response_col = "viability", group_cols = "cell_line"),
#'   group_cols = "cell_line"))
#' params <- merge(extract_drc_params(drc), drc$meta[, c("curve_id", "auc")])
#' annotate_hit_info(rank_hit_compound(params), hts_compound_meta)
#'
#' @seealso [rank_hit_compound()], [export_hit_table()]
#' @export
annotate_hit_info <- function(hits, meta, by = "compound_id") {
  if (!by %in% names(hits) || !by %in% names(meta)) {
    stop("Join column '", by, "' must be present in both `hits` and `meta`.",
      call. = FALSE)
  }
  hits <- as.data.frame(hits, stringsAsFactors = FALSE)
  hits$.order <- seq_len(nrow(hits))
  out <- merge(hits, meta, by = by, all.x = TRUE, sort = FALSE)
  out <- out[order(out$.order), , drop = FALSE]
  out$.order <- NULL
  rownames(out) <- NULL
  out
}

#' Export a hit summary table
#'
#' Writes a complete hit table (all QC and pharmacology columns) to a CSV file.
#'
#' @param hits A hit data frame.
#' @param file Output path.
#' @param ... Passed to [utils::write.csv()].
#'
#' @return The `file` path, invisibly.
#'
#' @examples
#' drc <- calc_drc_auc(fit_4pl_curve(import_dose_response(hts_dose_response,
#'   response_col = "viability", group_cols = "cell_line"),
#'   group_cols = "cell_line"))
#' params <- merge(extract_drc_params(drc), drc$meta[, c("curve_id", "auc")])
#' export_hit_table(rank_hit_compound(params), tempfile(fileext = ".csv"))
#'
#' @seealso [rank_hit_compound()], [annotate_hit_info()]
#' @export
export_hit_table <- function(hits, file, ...) {
  utils::write.csv(as.data.frame(hits), file = file, row.names = FALSE, ...)
  invisible(file)
}

#' Generate an HTML screening report
#'
#' Renders a standard HTML analysis report from the bundled R Markdown template,
#' embedding the supplied QC, dose-response and heatmap results. Requires the
#' suggested \pkg{rmarkdown} package.
#'
#' @param params A named list of objects made available to the report template
#'   (passed as `params`), for example `list(hits = ranked, drc = drc)`.
#' @param output_file Output HTML path. Default a temporary file.
#' @param template Path to an `.Rmd` template. Defaults to the package template
#'   in `inst/rmd/report_template.Rmd`.
#' @param quiet Passed to [rmarkdown::render()]. Default `TRUE`.
#'
#' @return The path to the rendered report, invisibly.
#'
#' @examples
#' \dontrun{
#' drc <- calc_drc_auc(fit_4pl_curve(import_dose_response(hts_dose_response,
#'   response_col = "viability", group_cols = "cell_line"),
#'   group_cols = "cell_line"))
#' params <- merge(extract_drc_params(drc), drc$meta[, c("curve_id", "auc")])
#' generate_hts_report(list(hits = rank_hit_compound(params)))
#' }
#'
#' @seealso [export_hit_table()]
#' @export
generate_hts_report <- function(params = list(),
                                output_file = tempfile(fileext = ".html"),
                                template = NULL, quiet = TRUE) {
  if (!requireNamespace("rmarkdown", quietly = TRUE)) {
    stop("Generating reports requires the 'rmarkdown' package.", call. = FALSE)
  }
  if (is.null(template)) {
    template <- system.file("rmd", "report_template.Rmd", package = "diffHTS")
  }
  if (!nzchar(template) || !file.exists(template)) {
    stop("Report template not found.", call. = FALSE)
  }
  rmarkdown::render(template, output_file = output_file,
    params = params, envir = new.env(parent = globalenv()), quiet = quiet)
  invisible(output_file)
}

#' Stratified hit-count bar chart
#'
#' Bar chart of the number of Strong, Moderate and Weak hits.
#'
#' @param ranked A data frame from [rank_hit_compound()] with a `tier` column.
#'
#' @return A [ggplot2::ggplot] object.
#'
#' @examples
#' drc <- calc_drc_auc(fit_4pl_curve(import_dose_response(hts_dose_response,
#'   response_col = "viability", group_cols = "cell_line"),
#'   group_cols = "cell_line"))
#' params <- merge(extract_drc_params(drc), drc$meta[, c("curve_id", "auc")])
#' plot_hit_stratify_bar(rank_hit_compound(params))
#'
#' @seealso [rank_hit_compound()]
#' @export
plot_hit_stratify_bar <- function(ranked) {
  if (!"tier" %in% names(ranked)) {
    stop("`ranked` must contain a 'tier' column.", call. = FALSE)
  }
  df <- as.data.frame(table(tier = ranked$tier))
  ggplot2::ggplot(df, ggplot2::aes(x = .data$tier, y = .data$Freq,
    fill = .data$tier)) +
    ggplot2::geom_col(width = 0.65, color = "white", linewidth = 0.3) +
    ggplot2::geom_text(ggplot2::aes(label = .data$Freq), vjust = -0.4,
      color = "#333333", size = 3.6) +
    ggplot2::scale_fill_manual(values = c("Weak" = .hts_col("Weak"),
      "Moderate" = .hts_col("Moderate"), "Strong" = .hts_col("Strong")),
      guide = "none") +
    ggplot2::scale_y_continuous(expand = ggplot2::expansion(mult = c(0, 0.1))) +
    ggplot2::labs(x = NULL, y = "Compounds") +
    theme_hts()
}

#' Primary versus secondary activity correlation
#'
#' Scatter of primary-screen activity against secondary-screen AUC for the same
#' compounds, the standard check that primary hits reproduce in the dose-response
#' confirmation screen.
#'
#' @param primary A data frame with a compound column and a primary-activity
#'   column.
#' @param secondary A data frame with a compound column and a secondary-activity
#'   (AUC) column.
#' @param by Join key. Default `"compound_id"`.
#' @param primary_col Primary-activity column. Default `"activity"`.
#' @param secondary_col Secondary-activity column. Default `"auc"`.
#'
#' @return A [ggplot2::ggplot] object.
#'
#' @examples
#' norm <- norm_by_control(baseline_subtract(read_hts_plate(hts_primary_raw)))
#' primary <- select_primary_hit(norm)
#' drc <- calc_drc_auc(fit_4pl_curve(import_dose_response(hts_dose_response,
#'   response_col = "viability", group_cols = "cell_line"),
#'   group_cols = "cell_line"))
#' sec <- aggregate(auc ~ compound_id, drc$meta, mean)
#' plot_primary_secondary_cor(primary, sec)
#'
#' @seealso [select_primary_hit()], [calc_drc_auc()]
#' @export
plot_primary_secondary_cor <- function(primary, secondary, by = "compound_id",
                                       primary_col = "activity",
                                       secondary_col = "auc") {
  if (!by %in% names(primary) || !by %in% names(secondary)) {
    stop("Join column '", by, "' must be present in both inputs.",
      call. = FALSE)
  }
  m <- merge(primary[, c(by, primary_col)], secondary[, c(by, secondary_col)],
    by = by)
  m <- m[stats::complete.cases(m), , drop = FALSE]
  r2 <- if (nrow(m) > 2) {
    stats::cor(m[[primary_col]], m[[secondary_col]])^2
  } else {
    NA_real_
  }
  ggplot2::ggplot(m, ggplot2::aes(x = .data[[primary_col]],
    y = .data[[secondary_col]])) +
    ggplot2::geom_point(color = .hts_col("accent"), alpha = 0.8, size = 2.6,
      stroke = 0.2) +
    ggplot2::geom_smooth(method = "lm", formula = y ~ x, se = FALSE,
      color = .hts_col("fail"), linewidth = 0.8) +
    ggplot2::labs(x = "Primary activity", y = "Secondary AUC",
      subtitle = if (is.na(r2)) NULL else sprintf("R^2 = %.3f", r2)) +
    theme_hts()
}
