Validation Chat with MGA

[Zhenglei-BCS]

We can generalize my Dunnett framework into a modular validator that supports multiple test types (Williams, Welch/Student t, Wilcoxon, Kruskal–Wallis + Dunn, Fisher, Shapiro/Levene), each with its own discovery, execution, and metric mapping. Below are concise, practical code suggestions and targeted R commands I need you to run so I can tailor the handlers precisely.

What we’ll reuse

• Discovery: build_dunnett_fgs pattern, generalized to build_generic_fgs(pattern).
• Helpers: convert_dose, convert_numeric, dose_from_comparison, normalize_alternative.
• Long-format builder and display filters (Actual/Expected/Status with metadata).

Registry design (extensible)

• Register each test type with:

  • keyword/pattern(s) to discover expected rows
  • discover_fgs function (FG/Study pairs + alternatives)
  • run_actual function to compute real results for one endpoint
  • metrics list and tolerances
  • comparator type (many_to_one, two_sample, trend, per_group)

Code: extend the registry with stubs you can fill in

# Existing 'dunnett' entry stays the same
test_registry <- list(
  dunnett = list(
    keyword = "Dunnett",
    discover_fgs = function(res, data) build_dunnett_fgs(res, data),
    run_actual = function(endpoint_data, alternative) {
      out <- drcHelper::dunnett_test(
        data = endpoint_data,
        response_var = "Response",
        dose_var = "Dose_numeric",
        include_random_effect = FALSE,
        alternative = alternative
      )
      actual_df <- as.data.frame(out$results_table)
      actual_df$Dose <- dose_from_comparison(as.character(actual_df$comparison))
      names(actual_df)[names(actual_df) == "statistic"] <- "Actual_T"
      names(actual_df)[names(actual_df) == "p.value"]  <- "Actual_P"
      names(actual_df)[names(actual_df) == "estimate"] <- "Actual_Diff"
      rownames(actual_df) <- NULL

      group_means <- endpoint_data %>%
        dplyr::mutate(Dose = convert_dose(Dose)) %>%
        dplyr::filter(!is.na(Dose)) %>%
        dplyr::group_by(Dose) %>%
        dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")

      list(actual_df = actual_df, group_means = group_means)
    },
    metrics = c("Mean", "T-value", "P-value"),
    comparator = "many_to_one"
  ),

  # Williams trend test (uses tukeytrend; drcHelper has broom_williams/getwilliamRes)
  williams = list(
    keyword = "Williams",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Williams"),
    run_actual = function(endpoint_data, alternative) {
      # Placeholder: will wire once we see the output shapes
      # Likely via drcHelper::broom_williams or drcHelper::getwilliamRes
      stop("Williams handler: please provide structure of broom_williams/getwilliamRes outputs (see commands below).")
    },
    metrics = c("Mean", "T-value", "P-value", "Tcrit", "df", "significance"),
    comparator = "trend"
  ),

  # Student t-test (var.equal = TRUE) many-to-one (dose vs control)
  student_t = list(
    keyword = "Student's t-test",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Student's t-test"),
    run_actual = function(endpoint_data, alternative) {
      # Compute per-dose vs control t-tests (unadjusted)
      ed <- endpoint_data %>% dplyr::mutate(Dose = convert_dose(Dose))
      ctrl <- ed %>% dplyr::filter(Dose == min(Dose, na.rm = TRUE)) %>% dplyr::pull(Response)
      by_dose <- ed %>% dplyr::filter(Dose != min(Dose, na.rm = TRUE)) %>% split(.$Dose)

      rows <- lapply(names(by_dose), function(d) {
        trt <- by_dose[[d]]$Response
        tt <- stats::t.test(trt, ctrl, alternative = switch(tolower(alternative),
                                                           "smaller" = "less", "greater" = "greater", "two-sided" = "two.sided"),
                            var.equal = TRUE)
        data.frame(Dose = as.numeric(d), Actual_T = unname(tt$statistic), Actual_P = tt$p.value)
      })
      actual_df <- dplyr::bind_rows(rows)
      group_means <- ed %>% dplyr::group_by(Dose) %>% dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
      list(actual_df = actual_df, group_means = group_means)
    },
    metrics = c("Mean", "T-value", "P-value", "df"),
    comparator = "many_to_one"
  ),

  # Welch t-test (var.equal = FALSE)
  welch = list(
    keyword = "Welch",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Welch"),
    run_actual = function(endpoint_data, alternative) {
      ed <- endpoint_data %>% dplyr::mutate(Dose = convert_dose(Dose))
      ctrl <- ed %>% dplyr::filter(Dose == min(Dose, na.rm = TRUE)) %>% dplyr::pull(Response)
      by_dose <- ed %>% dplyr::filter(Dose != min(Dose, na.rm = TRUE)) %>% split(.$Dose)
      rows <- lapply(names(by_dose), function(d) {
        trt <- by_dose[[d]]$Response
        tt <- stats::t.test(trt, ctrl, alternative = switch(tolower(alternative),
                                                           "smaller" = "less", "greater" = "greater", "two-sided" = "two.sided"),
                            var.equal = FALSE)
        data.frame(Dose = as.numeric(d), Actual_T = unname(tt$statistic), Actual_P = tt$p.value)
      })
      actual_df <- dplyr::bind_rows(rows)
      group_means <- ed %>% dplyr::group_by(Dose) %>% dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
      list(actual_df = actual_df, group_means = group_means)
    },
    metrics = c("Mean", "T-value", "P-value", "df"),
    comparator = "many_to_one"
  ),

  # Wilcoxon (Mann–Whitney) per dose vs control
  wilcoxon = list(
    keyword = "Wilcoxon test",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Wilcoxon test"),
    run_actual = function(endpoint_data, alternative) {
      ed <- endpoint_data %>% dplyr::mutate(Dose = convert_dose(Dose))
      ctrl <- ed %>% dplyr::filter(Dose == min(Dose, na.rm = TRUE)) %>% dplyr::pull(Response)
      by_dose <- ed %>% dplyr::filter(Dose != min(Dose, na.rm = TRUE)) %>% split(.$Dose)
      rows <- lapply(names(by_dose), function(d) {
        trt <- by_dose[[d]]$Response
        wt <- stats::wilcox.test(trt, ctrl, alternative = switch(tolower(alternative),
                                                                 "smaller" = "less", "greater" = "greater", "two-sided" = "two.sided"))
        data.frame(Dose = as.numeric(d), Actual_W = unname(wt$statistic), Actual_P = wt$p.value)
      })
      actual_df <- dplyr::bind_rows(rows)  # Note: metric names differ (W-value, P-value)
      group_means <- ed %>% dplyr::group_by(Dose) %>% dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
      list(actual_df = actual_df, group_means = group_means)
    },
    metrics = c("Mean", "W-value", "P-value"),
    comparator = "many_to_one"
  ),

  # Kruskal–Wallis + Dunn’s post-hoc
  dunn = list(
    keyword = "Dunn's test",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Dunn's test"),
    run_actual = function(endpoint_data, alternative) {
      ed <- endpoint_data %>% dplyr::mutate(Dose = convert_dose(Dose))
      ed <- ed %>% dplyr::filter(!is.na(Dose))
      # KW omnibus
      kw <- stats::kruskal.test(Response ~ as.factor(Dose), data = ed)
      # Dunn post-hoc many-to-one vs control
      if (!requireNamespace("rstatix", quietly = TRUE)) stop("Please install rstatix for Dunn's test")
      dunn_res <- rstatix::dunn_test(ed, Response ~ as.factor(Dose), p.adjust.method = "bonferroni")  # adjust if needed
      # Extract many-to-one contrasts vs lowest Dose (control)
      ctrl_label <- as.character(min(ed$Dose, na.rm = TRUE))
      dunn_vs_ctrl <- dunn_res %>%
        dplyr::filter(grepl(paste0("^", ctrl_label, " - "), comparison) | grepl(paste0(" - ", ctrl_label, "$"), comparison)) %>%
        dplyr::mutate(Dose = dose_from_comparison(comparison)) %>%
        dplyr::rename(Actual_z = statistic, Actual_P = p.adj)
      actual_df <- dunn_vs_ctrl %>% dplyr::select(Dose, Actual_z, Actual_P)
      group_means <- ed %>% dplyr::group_by(Dose) %>% dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
      list(actual_df = actual_df, group_means = group_means, kw = kw)
    },
    metrics = c("Mean", "z-value", "P-value"),  # plus optionally H-statistic for KW
    comparator = "many_to_one"
  ),

  # Fisher’s exact (binary endpoints; drcHelper provides many_to_one_fisher_test)
  fisher = list(
    keyword = "Fishers' test",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Fishers' test"),
    run_actual = function(endpoint_data, alternative) {
      # Structure depends on Alive/Dead counts; we’ll wire after seeing a concrete example
      stop("Fisher handler: please provide example endpoint_data (Alive/Dead/Total) and expected rows.")
    },
    metrics = c("P-value", "significance"),
    comparator = "many_to_one"
  ),

  # Model tests (Shapiro/Levene) on residuals
  shapiro = list(
    keyword = "Shapiro-Wilk",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Shapiro-Wilk"),
    run_actual = function(endpoint_data, alternative) {
      # Are these computed on residuals from Response ~ Dose? Please confirm
      stop("Shapiro handler: confirm target vector (residuals vs raw group).")
    },
    metrics = c("W-value", "P-value"),
    comparator = "per_group"
  ),
  levene = list(
    keyword = "Levene",
    discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Levene"),
    run_actual = function(endpoint_data, alternative) {
      stop("Levene handler: confirm target (raw groups vs residuals).")
    },
    metrics = c("F-value", "P-value"),
    comparator = "per_group"
  )
)

Generic runner

• You can use the run_consolidated_validation_generic function I provided earlier (it already handles Mean/T/P joins and long-format output).
• For tests with different metric names, adjust the “metric splits” in that function based on reg$metrics and on Brief description labels:
  • Wilcoxon: “W-Value”
  • Dunn: “z-value”
  • Kruskal–Wallis: “H-statistic”
  • Significance: compute Actual_Significance as (Actual_P < alpha), if expected result value is 0/1; please confirm expected encoding.

Dose embedded in Brief description

• Some rows encode the dose inside Brief description, e.g., “Dunn's test, smaller, 0,41, z-value”.
• Add a parser that falls back to description when Dose is “n/a”:

dose_from_description <- function(desc) {
  # capture first numeric token allowing comma decimal
  m <- regmatches(desc, regexpr("[0-9]+(?:,[0-9]+)?", desc))
  ifelse(length(m) > 0, convert_dose(m), NA_real_)
}

When preparing expected tables, set Dose = coalesce(convert_dose(Dose), dose_from_description(Brief description)).

Key formulas you’ll likely need

• Percent inhibition/reduction per dose relative to control (please confirm your definition):
  $$%Inhibition = 100 * (1 - mean_treatment / mean_control)$$
  $$%Reduction = 100 * (1 - mean_treatment / mean_control)$$
  If your expected results use a different baseline or direction, tell me and I’ll adapt.

What I need you to run so I can finalize handlers and metric mapping
Please run these on one Williams FG/study and paste the outputs:

1. Show structure of Williams outputs from drcHelper:

• Pick an endpoint_data for a Williams case (FG00120 looks promising). Then:

w_ep <- test_cases_data %>% dplyr::filter(`Study ID` == "MOCK0065")  # replace with the actual Williams study
w_ep$Dose_numeric <- convert_dose(w_ep$Dose)
w_out <- try(drcHelper::williamsTest_JG(data = w_ep, response_var = "Response", dose_var = "Dose_numeric"), silent = TRUE)
str(w_out)

bw_out <- try(drcHelper::broom_williams(data = w_ep, response_var = "Response", dose_var = "Dose_numeric"), silent = TRUE)
str(bw_out)

2. Provide a small slice of expected Williams rows (10–20 rows):

test_cases_res %>%
  dplyr::filter(grepl("Williams", `Brief description`, ignore.case = TRUE)) %>%
  dplyr::select(`Function group ID`, `Study ID`, `Endpoint`, `Brief description`, Dose, `expected result value`) %>%
  dplyr::slice(1:20) %>% print(n = 20)

3. For Dunn’s test (Kruskal–Wallis post-hoc), show a slice of expected rows:

test_cases_res %>%
  dplyr::filter(grepl("Dunn's test", `Brief description`, ignore.case = TRUE)) %>%
  dplyr::select(`Function group ID`, `Study ID`, `Endpoint`, `Brief description`, Dose, `expected result value`) %>%
  dplyr::slice(1:20) %>% print(n = 20)

4. For Wilcoxon, show expected rows and a sample endpoint_data:

• Expected:

test_cases_res %>%
  dplyr::filter(grepl("Wilcoxon test", `Brief description`, ignore.case = TRUE)) %>%
  dplyr::select(`Function group ID`, `Study ID`, `Endpoint`, `Brief description`, Dose, `expected result value`) %>%
  dplyr::slice(1:20) %>% print(n = 20)

• Data groups:

test_cases_data %>%
  dplyr::filter(`Study ID` %in% unique(test_cases_res$`Study ID`[grepl("Wilcoxon test", test_cases_res$`Brief description`, ignore.case = TRUE)])) %>%
  dplyr::count(`Study ID`, `Test group`) %>% print(n = 50)

5. For Fisher’s test, show endpoint_data columns (Alive/Dead/Total?) and expected rows:

• Data:

test_cases_data %>%
  dplyr::filter(!is.na(Alive) | !is.na(Dead) | !is.na(Total)) %>%
  dplyr::slice(1:20) %>% print(n = 20)

• Expected:

test_cases_res %>%
  dplyr::filter(grepl("Fishers' test", `Brief description`, ignore.case = TRUE)) %>%
  dplyr::select(`Function group ID`, `Study ID`, `Endpoint`, `Brief description`, Dose, `expected result value`) %>%
  dplyr::slice(1:20) %>% print(n = 20)

6. For Shapiro/Levene “model test”: confirm target vector:

• Are these computed on residuals from lm(Response ~ Dose_numeric)? If yes, we’ll fit the same lm, then use stats::shapiro.test on residuals and car::leveneTest on grouped raw data, or another agreed approach. Please confirm.
• No, residuals are from lm(Response ~ Dose_factor)

Once I see these structures, I’ll wire the run_actual handlers to return the same shape as your Dunnett handler (actual_df + group_means), extend the expected metric parser for labels like “Tcrit”, “df”, “z-value”, “W-value”, “%Inhibition/%Reduction”, and finalize tolerances by metric/test.

[Zhenglei-BCS]

This is great progress. Based on what you showed, we can generalize your Dunnett validator into a pluggable framework that covers Williams, Dunn, Wilcoxon, Welch/Student t, Fisher, and the model tests (Shapiro/Levene) using a single harness and test-type-specific handlers.

Below is a practical plan with code you can drop in. It reuses your helpers (convert_dose, convert_numeric, dose_from_comparison, dose_from_description, normalize_alternative) and your long-format output builder. I also include Williams and Dunn/Wilcoxon/Fisher handlers tailored to your data and the function availability in drcHelper. For Williams I show the correct way to call broom_williams with a formula interface.

Key idea

• Registry per test type: discovery function, runner (computes actual metrics), metric label mapping, comparator type.
• One generic validator (you already have) that:
  • Subsets expected rows for the FG/study/alternative
  • Splits by endpoint
  • Calls test-type run_actual to get actual metrics for the endpoint
  • Parses expected metrics by label
  • Joins by Dose and builds long-format rows with Status and metadata

1. Extend your test registry

• Keep your existing dunnett entry.
• Add Williams, Dunn, Wilcoxon, Welch/Student t, Fisher.
• Each run_actual returns a list(actual_df, group_means, optional extras).
• Use the correct broom_williams call (formula-based) and set Dose_factor levels so control is first.

Code: plug these into your registry list

# Williams trend test (uses broom_williams with formula)
test_registry$williams <- list(
  keyword = "Williams",
  discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Williams"),
  run_actual = function(endpoint_data, alternative) {
    ed <- endpoint_data
    ed$Dose_numeric <- convert_dose(ed$Dose)
    ed <- ed[!is.na(ed$Dose_numeric), ]
    # Ensure control (lowest dose) is first level
    ed$Dose_factor <- factor(ed$Dose_numeric, levels = sort(unique(ed$Dose_numeric)))
    # Direction based on alternative
    direction <- if (tolower(alternative) %in% c("smaller", "less")) "decreasing" else "increasing"
    # broom_williams expects a formula x and data
    # Try PMCMRplus first; if it fails, fall back to JG
    bw <- try(drcHelper::broom_williams(Response ~ Dose_factor, data = ed,
                                        method = "Williams_PMCMRplus",
                                        direction = direction), silent = TRUE)
    if (inherits(bw, "try-error") || nrow(bw) == 0) {
      bw <- drcHelper::broom_williams(Response ~ Dose_factor, data = ed,
                                      method = "Williams_JG",
                                      direction = direction)
    }
    # bw columns: comparison, estimate, `t'-stat, `t'-crit, decision, method
    # Extract numeric Dose from comparison like "0.132 - 0 >= 0"
    actual_df <- as.data.frame(bw)
    actual_df$Dose <- dose_from_comparison(gsub(" >= 0| <= 0", "", as.character(actual_df$comparison)))
    # Normalize awkward column names
    cn <- names(actual_df)
    names(actual_df)[cn == "`t'-stat"] <- "Actual_Tadj"
    names(actual_df)[cn == "`t'-crit"] <- "Actual_Tcrit"
    names(actual_df)[cn == "estimate"] <- "Actual_Diff"
    names(actual_df)[cn == "decision"] <- "Actual_Significance" # "reject"/"accept"
    # No p-value returned; Williams uses adjusted critical values
    # Group means and %Inhibition
    group_means <- ed %>%
      dplyr::group_by(Dose = Dose_numeric) %>%
      dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
    # Percent inhibition (for decreasing/smaller)
    ctrl_mean <- group_means$Actual_Mean[group_means$Dose == min(group_means$Dose)]
    if (length(ctrl_mean) == 0 || is.na(ctrl_mean)) ctrl_mean <- NA_real_
    group_means$Actual_PercentInhibition <- if (!is.na(ctrl_mean) && ctrl_mean != 0) {
      100 * (1 - group_means$Actual_Mean / ctrl_mean)  # #$#%Inhibition = 100 * (1 - mean_treatment / mean_control)#$#
    } else NA_real_
    list(actual_df = actual_df, group_means = group_means)
  },
  metrics = c("Mean", "%Inhibition", "T-value (adjusted)", "Tcrit", "significance", "df"),
  comparator = "trend"
)

# Dunn post-hoc after Kruskal–Wallis (z and p)
test_registry$dunn <- list(
  keyword = "Dunn's test",
  discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Dunn's test"),
  run_actual = function(endpoint_data, alternative) {
    ed <- endpoint_data
    ed$Dose_numeric <- convert_dose(ed$Dose)
    ed <- ed[!is.na(ed$Dose_numeric), ]
    ed$Dose_factor <- factor(ed$Dose_numeric, levels = sort(unique(ed$Dose_numeric)))
    # Dunn many-to-one vs control (lowest dose). rstatix needed
    if (!requireNamespace("rstatix", quietly = TRUE)) stop("Please install rstatix for Dunn's test")
    dunn_res <- rstatix::dunn_test(ed, Response ~ Dose_factor, p.adjust.method = "bonferroni")
    ctrl_label <- as.character(levels(ed$Dose_factor)[1])
    dunn_vs_ctrl <- dunn_res %>%
      dplyr::filter(grepl(paste0("^", ctrl_label, " - "), comparison) | grepl(paste0(" - ", ctrl_label, "$"), comparison)) %>%
      dplyr::mutate(Dose = dose_from_comparison(comparison)) %>%
      dplyr::rename(Actual_z = statistic, Actual_P = p.adj)
    actual_df <- dunn_vs_ctrl %>% dplyr::select(Dose, Actual_z, Actual_P, comparison)
    group_means <- ed %>%
      dplyr::group_by(Dose = Dose_numeric) %>%
      dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
    ctrl_mean <- group_means$Actual_Mean[group_means$Dose == min(group_means$Dose)]
    group_means$Actual_PercentInhibition <- if (!is.na(ctrl_mean) && ctrl_mean != 0) {
      100 * (1 - group_means$Actual_Mean / ctrl_mean)  # #$#%Inhibition = 100 * (1 - mean_treatment / mean_control)#$#
    } else NA_real_
    list(actual_df = actual_df, group_means = group_means)
  },
  metrics = c("Mean", "%Inhibition", "z-value", "P-value"),
  comparator = "many_to_one"
)

# Wilcoxon (Mann–Whitney) per dose vs control
test_registry$wilcoxon <- list(
  keyword = "Wilcoxon test",
  discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Wilcoxon test"),
  run_actual = function(endpoint_data, alternative) {
    ed <- endpoint_data
    ed$Dose_numeric <- convert_dose(ed$Dose)
    ed <- ed[!is.na(ed$Dose_numeric), ]
    ctrl_dose <- min(ed$Dose_numeric, na.rm = TRUE)
    ctrl <- ed$Response[ed$Dose_numeric == ctrl_dose]
    by_dose <- split(ed$Response[ed$Dose_numeric != ctrl_dose], ed$Dose_numeric[ed$Dose_numeric != ctrl_dose])
    rows <- lapply(names(by_dose), function(d) {
      trt <- by_dose[[d]]
      wt <- stats::wilcox.test(trt, ctrl,
                               alternative = if (tolower(alternative) %in% c("smaller","less")) "less"
                               else if (tolower(alternative) %in% c("greater","more")) "greater" else "two.sided")
      data.frame(Dose = as.numeric(d), Actual_W = unname(wt$statistic), Actual_P = wt$p.value)
    })
    actual_df <- if (length(rows)) dplyr::bind_rows(rows) else data.frame(Dose = numeric(), Actual_W = numeric(), Actual_P = numeric())
    group_means <- ed %>%
      dplyr::group_by(Dose = Dose_numeric) %>%
      dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
    ctrl_mean <- group_means$Actual_Mean[group_means$Dose == min(group_means$Dose)]
    group_means$Actual_PercentInhibition <- if (!is.na(ctrl_mean) && ctrl_mean != 0) {
      100 * (1 - group_means$Actual_Mean / ctrl_mean)  # #$#%Inhibition = 100 * (1 - mean_treatment / mean_control)#$#
    } else NA_real_
    list(actual_df = actual_df, group_means = group_means)
  },
  metrics = c("Mean", "%Inhibition", "W-Value", "P-value"),
  comparator = "many_to_one"
)

# Welch t-test (var.equal = FALSE); Student's t can be similar with var.equal = TRUE
test_registry$welch <- list(
  keyword = "Welch",
  discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Welch"),
  run_actual = function(endpoint_data, alternative) {
    ed <- endpoint_data
    ed$Dose_numeric <- convert_dose(ed$Dose)
    ed <- ed[!is.na(ed$Dose_numeric), ]
    ctrl_dose <- min(ed$Dose_numeric, na.rm = TRUE)
    ctrl <- ed$Response[ed$Dose_numeric == ctrl_dose]
    by_dose <- split(ed$Response[ed$Dose_numeric != ctrl_dose], ed$Dose_numeric[ed$Dose_numeric != ctrl_dose])
    rows <- lapply(names(by_dose), function(d) {
      trt <- by_dose[[d]]
      tt <- stats::t.test(trt, ctrl,
                          alternative = if (tolower(alternative) %in% c("smaller","less")) "less"
                          else if (tolower(alternative) %in% c("greater","more")) "greater" else "two.sided",
                          var.equal = FALSE)
      data.frame(Dose = as.numeric(d), Actual_T = unname(tt$statistic), Actual_P = tt$p.value)
    })
    actual_df <- if (length(rows)) dplyr::bind_rows(rows) else data.frame(Dose = numeric(), Actual_T = numeric(), Actual_P = numeric())
    group_means <- ed %>%
      dplyr::group_by(Dose = Dose_numeric) %>%
      dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")
    list(actual_df = actual_df, group_means = group_means)
  },
  metrics = c("Mean", "T-value", "P-value"),
  comparator = "many_to_one"
)

# Fisher’s exact (binary outcomes) using drcHelper
test_registry$fisher <- list(
  keyword = "Fishers' test",
  discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Fishers' test"),
  run_actual = function(endpoint_data, alternative) {
    ed <- endpoint_data
    # Expect Alive/Dead/Total present; drcHelper has many_to_one_fisher_test
    # It likely needs counts per dose vs control
    # Compute mortality rates (%Uncorrected), and optionally corrected if needed
    ed$Dose_numeric <- convert_dose(ed$Dose)
    ed <- ed[!is.na(ed$Dose_numeric), ]
    # Build per-dose 2x2 tables and many-to-one Fisher p-values
    f_res <- drcHelper::many_to_one_fisher_test(ed, dose_var = "Dose_numeric",
                                                alive_var = "Alive", dead_var = "Dead",
                                                alternative = if (tolower(alternative) %in% c("smaller","less")) "less"
                                                else if (tolower(alternative) %in% c("greater","more")) "greater" else "two.sided")
    # Expect f_res to include dose, p.value; adjust as per real output
    actual_df <- f_res %>%
      dplyr::rename(Dose = dose, Actual_P = p.value)
    # Mortality % per dose (Uncorrected)
    mort <- ed %>%
      dplyr::group_by(Dose = Dose_numeric) %>%
      dplyr::summarise(
        Dead = sum(Dead, na.rm = TRUE),
        Total = sum(Total, na.rm = TRUE),
        Uncorrected = ifelse(Total > 0, 100 * Dead / Total, NA_real_),
        .groups = "drop"
      )
    # Optionally compute Abbott-corrected (if needed); skipped here without clear spec
    mort$Corrected <- NA_real_
    # Return group_means-like table for % metrics
    list(actual_df = actual_df, group_means = mort)
  },
  metrics = c("Uncorrected", "Corrected", "P-value", "significance"),
  comparator = "many_to_one"
)

2. Parse expected metrics flexibly

• Some rows have dose in Brief description; when Dose is NA or “n/a”, fall back to dose_from_description.
• Map metric labels by test type (e.g., Williams has “T-value (adjusted)”, “Tcrit”, “significance”; Wilcoxon has “W-Value”; Dunn has “z-value”; Fisher has “Uncorrected”, “Corrected”).

Add this helper:

parse_expected_metrics <- function(test_type, exp_tbl) {
  # Dose as numeric: from column or from description
  Dose_from_label <- ifelse(is.na(convert_dose(exp_tbl$Dose)),
                            dose_from_description(exp_tbl$`Brief description`),
                            convert_dose(exp_tbl$Dose))
  exp_tbl <- dplyr::mutate(exp_tbl,
                           Dose = Dose_from_label,
                           Expected_Value = convert_numeric(`expected result value`))

  pick <- function(pattern) exp_tbl[grepl(pattern, exp_tbl$`Brief description`, ignore.case = TRUE), c("Dose", "Expected_Value")]

  out <- list()
  if (test_type %in% c("dunnett", "williams", "dunn", "wilcoxon", "welch", "student_t")) {
    out$mean <- pick("\\bMean\\b"); names(out$mean)[2] <- "Expected_Mean"
  }
  if (test_type %in% c("dunnett", "welch", "student_t")) {
    out$t <- pick("T-value(?!\\s*\\(adjusted\\))|t-value(?!\\s*\\(adjusted\\))"); names(out$t)[2] <- "Expected_T"
    out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P"
  }
  if (test_type == "williams") {
    out$tadj <- pick("T-value\\s*\\(adjusted\\)"); names(out$tadj)[2] <- "Expected_Tadj"
    out$tcrit <- pick("\\bTcrit\\b"); names(out$tcrit)[2] <- "Expected_Tcrit"
    out$signif <- pick("\\bsignificance\\b|\\bpsignificance\\b"); names(out$signif)[2] <- "Expected_Significance"
    out$df <- pick("\\bdf\\b"); names(out$df)[2] <- "Expected_df"
    out$pinhib <- pick("%Inhibition"); names(out$pinhib)[2] <- "Expected_PercentInhibition"
  }
  if (test_type == "dunn") {
    out$z <- pick("\\bz-value\\b"); names(out$z)[2] <- "Expected_z"
    out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P"
    out$pinhib <- pick("%Inhibition"); names(out$pinhib)[2] <- "Expected_PercentInhibition"
  }
  if (test_type == "wilcoxon") {
    out$w <- pick("\\bW-Value\\b|\\bW-value\\b"); names(out$w)[2] <- "Expected_W"
    out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P"
    out$pinhib <- pick("%Inhibition"); names(out$pinhib)[2] <- "Expected_PercentInhibition"
  }
  if (test_type == "fisher") {
    out$uncorr <- pick("\\bUncorrected\\b"); names(out$uncorr)[2] <- "Expected_Uncorrected"
    out$corr <- pick("\\bCorrected\\b"); names(out$corr)[2] <- "Expected_Corrected"
    out$p <- pick("p-value"); names(out$p)[2] <- "Expected_P"
    out$signif <- pick("\\bsignificance\\b|\\bpsignificance\\b"); names(out$signif)[2] <- "Expected_Significance"
  }
  out
}

3. Adapt the generic runner to different metrics

• In run_consolidated_validation_generic (your generic version), replace the hard-coded Mean/T/P splits with:

exp_splits <- parse_expected_metrics(test_type, expected %>% dplyr::select(Brief description, Dose, expected result value))

• Then join only the splits present and compare to the columns available in actual_df/group_means. Use appropriate tolerances:
  • For “significance”, compare as strings or map to 0/1 expected flags (please confirm expected encoding).
  • For %Inhibition/Uncorrected/Corrected, use a % tolerance; e.g., 1e-6 or a looser tolerance like 1e-4 depending on rounding in the reference.

Example join logic for Williams inside the runner (illustrative):

# Means
if (!is.null(exp_splits$mean) && nrow(exp_splits$mean)) {
  mean_join <- exp_splits$mean %>%
    dplyr::left_join(actual$group_means[, c("Dose", "Actual_Mean")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_Mean - Expected_Mean),
      Status = dplyr::case_when(is.na(Expected_Mean) | is.na(Actual_Mean) ~ "MISSING",
                                Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "Mean", Actual = Actual_Mean, Expected = Expected_Mean, Status)
  pieces <- c(pieces, list(mean_join))
}

# T-value (adjusted)
if (!is.null(exp_splits$tadj) && nrow(exp_splits$tadj)) {
  tadj_join <- exp_splits$tadj %>%
    dplyr::left_join(actual$actual_df[, c("Dose", "Actual_Tadj")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_Tadj - Expected_Tadj),
      Status = dplyr::case_when(is.na(Expected_Tadj) | is.na(Actual_Tadj) ~ "MISSING",
                                Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "T-value (adjusted)", Actual = Actual_Tadj, Expected = Expected_Tadj, Status)
  pieces <- c(pieces, list(tadj_join))
}

# Tcrit
if (!is.null(exp_splits$tcrit) && nrow(exp_splits$tcrit)) {
  tcrit_join <- exp_splits$tcrit %>%
    dplyr::left_join(actual$actual_df[, c("Dose", "Actual_Tcrit")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_Tcrit - Expected_Tcrit),
      Status = dplyr::case_when(is.na(Expected_Tcrit) | is.na(Actual_Tcrit) ~ "MISSING",
                                Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "Tcrit", Actual = Actual_Tcrit, Expected = Expected_Tcrit, Status)
  pieces <- c(pieces, list(tcrit_join))
}

# %Inhibition
if (!is.null(exp_splits$pinhib) && nrow(exp_splits$pinhib)) {
  pinhib_join <- exp_splits$pinhib %>%
    dplyr::left_join(actual$group_means[, c("Dose", "Actual_PercentInhibition")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_PercentInhibition - Expected_PercentInhibition),
      Status = dplyr::case_when(is.na(Expected_PercentInhibition) | is.na(Actual_PercentInhibition) ~ "MISSING",
                                Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "%Inhibition", Actual = Actual_PercentInhibition, Expected = Expected_PercentInhibition, Status)
  pieces <- c(pieces, list(pinhib_join))
}

# significance (as string or indicator)
if (!is.null(exp_splits$signif) && nrow(exp_splits$signif)) {
  # Map to "reject"/"accept" if expected encodes like that, else to TRUE/FALSE
  s_join <- exp_splits$signif %>%
    dplyr::left_join(actual$actual_df[, c("Dose", "Actual_Significance")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Expected_lbl = as.character(Expected_Significance),
      Actual_lbl = as.character(Actual_Significance),
      Status = dplyr::case_when(is.na(Expected_lbl) | is.na(Actual_lbl) ~ "MISSING",
                                tolower(Expected_lbl) == tolower(Actual_lbl) ~ "PASS",
                                TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "significance", Actual = Actual_lbl, Expected = Expected_lbl, Status)
  pieces <- c(pieces, list(s_join))
}

Then bind_rows(pieces), add metadata (Study ID, Test organism, alternative), filter rows with both Actual and Expected NA, order by Dose and metric, as you are already doing.

4. Williams: correct way to call broom_williams

Your earlier attempt failed because broom_williams signature is broom_williams(x, method = ..., ...), where x must be a formula/aov/lm. Use:

• Create Dose_factor and ensure control (min dose) is first level.
• Call with formula and data, not with response_var/dose_var.

Example for your MOCK0065 endpoint:

w_ep <- test_cases_data %>% dplyr::filter(`Study ID` == "MOCK0065", Endpoint == "Growth Rate")
w_ep$Dose_numeric <- convert_dose(w_ep$Dose)
w_ep <- w_ep[!is.na(w_ep$Dose_numeric), ]
w_ep$Dose_factor <- factor(w_ep$Dose_numeric, levels = sort(unique(w_ep$Dose_numeric)))

bw_pm <- drcHelper::broom_williams(Response ~ Dose_factor, data = w_ep,
                                   method = "Williams_PMCMRplus", direction = "decreasing")
print(bw_pm)

bw_jg <- drcHelper::broom_williams(Response ~ Dose_factor, data = w_ep,
                                   method = "Williams_JG", direction = "decreasing")
print(bw_jg)

Please run the two calls above and paste their outputs or str() so I can confirm the column names and finalize the Williams handler mapping (T-value (adjusted), Tcrit, decision/significance, and whether df is available anywhere).

5. Dunn/Wilcoxon: adjustment method

Your expected Dunn “p-value” likely uses a specific p.adjust method (Bonferroni/Holm). I’ve set Bonferroni in the example. If expected uses Holm, change p.adjust.method = "holm".

6. Fisher’s test mapping

Your Fisher expected shows “Uncorrected”, “Corrected”, and “p-value” rows, where “expected result value” can be numeric or “-” or 0/1 flags. We can:

• Compute Uncorrected mortality % per dose from Dead/Total.
• If you need Corrected (Abbott’s), please confirm the formula; we can add:
  #$#Corrected = 100 * (Mortality_treatment - Mortality_control) / (100 - Mortality_control)#$#
• Use drcHelper::many_to_one_fisher_test to obtain Actual_P per dose vs control.
• For “significance”/“psignificance”: confirm whether expected is 1/0, “significant”/“not significant”, or something else, and I’ll add the mapping.

What I need you to run (Williams finalization)

• Please execute and post results:

w_ep <- test_cases_data %>% dplyr::filter(`Study ID` == "MOCK0065", Endpoint == "Growth Rate")
w_ep$Dose_numeric <- convert_dose(w_ep$Dose)
w_ep <- w_ep[!is.na(w_ep$Dose_numeric), ]
w_ep$Dose_factor <- factor(w_ep$Dose_numeric, levels = sort(unique(w_ep$Dose_numeric)))

bw_pm <- drcHelper::broom_williams(Response ~ Dose_factor, data = w_ep,
                                   method = "Williams_PMCMRplus", direction = "decreasing")
str(bw_pm); print(bw_pm)

bw_jg <- drcHelper::broom_williams(Response ~ Dose_factor, data = w_ep,
                                   method = "Williams_JG", direction = "decreasing")
str(bw_jg); print(bw_jg)

With that, I’ll lock in the Williams run_actual and the expected-vs-actual metric joins for:

• Mean
• %Inhibition
• T-value (adjusted)
• Tcrit
• significance
• df (if provided)

Once Williams is set, we can wire Shapiro/Levene similarly (fit lm(Response ~ Dose_factor), then stats::shapiro.test on residuals, and car::leveneTest Response ~ Dose_factor), mapping to the “model test” expected rows you have under FG00110.

[Zhenglei-BCS]

• Williams_PMCMRplus works well and gives comparison strings like “0.0448 - 0 <= 0”, with estimate, t’-stat, t’-crit, and decision.
• Williams_JG returns incomplete comparison strings (“ - 0 >= 0”), so extracting Dose from that is unreliable. We’ll treat PMCMRplus as the primary method and use JG only as a fallback with a careful dose assignment.

Below are concrete code suggestions to plug Williams into your generalized framework. They align with your existing helpers and long-format builder.

1. Robust Williams run_actual handler

• Uses the formula interface to broom_williams.
• Ensures the control is the first factor level.
• For PMCMRplus: parse Dose from comparison; straight mapping for T-value (adjusted) and Tcrit.
• For JG fallback: assign Dose from the sorted unique treatment doses (excluding control). If the order cannot be guaranteed, we warn and still proceed.
• Computes raw means and %Inhibition.

test_registry$williams <- list(
  keyword = "Williams",
  discover_fgs = function(res, data) build_generic_fgs(res, data, pattern = "Williams"),
  run_actual = function(endpoint_data, alternative) {
    ed <- endpoint_data
    ed$Dose_numeric <- convert_dose(ed$Dose)
    ed <- ed[!is.na(ed$Dose_numeric), ]
    # Control first (lowest dose)
    dose_levels <- sort(unique(ed$Dose_numeric))
    ed$Dose_factor <- factor(ed$Dose_numeric, levels = dose_levels)

    direction <- if (tolower(alternative) %in% c("smaller", "less")) "decreasing" else "increasing"

    # Primary: PMCMRplus
    bw <- try(drcHelper::broom_williams(Response ~ Dose_factor, data = ed,
                                        method = "Williams_PMCMRplus",
                                        direction = direction), silent = TRUE)

    used_method <- "PMCMRplus"
    if (inherits(bw, "try-error") || nrow(bw) == 0) {
      # Fallback: JG
      bw <- drcHelper::broom_williams(Response ~ Dose_factor, data = ed,
                                      method = "Williams_JG",
                                      direction = direction)
      used_method <- "JG"
    }

    actual_df <- as.data.frame(bw)

    if (used_method == "PMCMRplus") {
      # comparison like "0.0448 - 0  <= 0" or "... >= 0"
      comp_clean <- gsub("\\s*(<=|>=)\\s*0\\s*$", "", as.character(actual_df$comparison))
      actual_df$Dose <- dose_from_comparison(comp_clean)
    } else {
      # JG comparisons can miss doses; assign from treatment doses excluding control
      trt_doses <- dose_levels[-1]
      if (length(trt_doses) == nrow(actual_df)) {
        # PMCMRplus tends to list in ascending dose; JG may differ. Use ascending as default.
        actual_df$Dose <- trt_doses
      } else {
        actual_df$Dose <- NA_real_
        warning("Williams_JG: could not safely map Dose to rows; leaving Dose as NA.")
      }
    }

    # Normalize column names
    cn <- names(actual_df)
    names(actual_df)[cn == "`t'-stat"] <- "Actual_Tadj"
    names(actual_df)[cn == "`t'-crit"] <- "Actual_Tcrit"
    names(actual_df)[cn == "estimate"] <- "Actual_Diff"
    names(actual_df)[cn == "decision"] <- "Actual_Significance"  # "accept"/"reject"
    rownames(actual_df) <- NULL

    # Group means and %Inhibition
    group_means <- ed %>%
      dplyr::group_by(Dose = Dose_numeric) %>%
      dplyr::summarise(Actual_Mean = mean(Response, na.rm = TRUE), .groups = "drop")

    ctrl_mean <- group_means$Actual_Mean[group_means$Dose == min(group_means$Dose)]
    group_means$Actual_PercentInhibition <- if (!is.na(ctrl_mean) && ctrl_mean != 0) {
      100 * (1 - group_means$Actual_Mean / ctrl_mean)  # #$#%Inhibition = 100 * (1 - mean_treatment / mean_control)#$#
    } else NA_real_

    list(actual_df = actual_df, group_means = group_means)
  },
  metrics = c("Mean", "%Inhibition", "T-value (adjusted)", "Tcrit", "significance", "df", "MDD%"),
  comparator = "trend"
)

2. Expected-metric parsing for Williams

Extend your expected parsing to recognize Williams-specific labels:

• Mean
• %Inhibition
• T-value (adjusted)
• Tcrit
• significance/psignificance
• df
• MDD% (we’ll mark as MISSING unless you want me to implement MDD calculation)

In your parse_expected_metrics, add:

if (test_type == "williams") {
  out$mean   <- pick("\\bMean\\b");                             names(out$mean)[2] <- "Expected_Mean"
  out$pinhib <- pick("%Inhibition");                            names(out$pinhib)[2] <- "Expected_PercentInhibition"
  out$tadj   <- pick("T-value\\s*\\(adjusted\\)");              names(out$tadj)[2] <- "Expected_Tadj"
  out$tcrit  <- pick("\\bTcrit\\b");                            names(out$tcrit)[2] <- "Expected_Tcrit"
  out$signif <- pick("\\bsignificance\\b|\\bpsignificance\\b"); names(out$signif)[2] <- "Expected_Significance"
  out$df     <- pick("\\bdf\\b");                               names(out$df)[2] <- "Expected_df"
  out$mdd    <- pick("\\bMDD%\\b");                             names(out$mdd)[2] <- "Expected_MDDpct"
}

Also ensure Dose is recovered when the Dose column is NA by using dose_from_description on Brief description (you already added dose_from_description and tested it works).

3. Joins and comparisons for Williams in the generic runner

In your run_consolidated_validation_generic, after exp_splits <- parse_expected_metrics("williams", ...), join the splits that are present:

pieces <- list()

# Mean
if (!is.null(exp_splits$mean) && nrow(exp_splits$mean)) {
  mean_join <- exp_splits$mean %>%
    dplyr::left_join(actual$group_means[, c("Dose", "Actual_Mean")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_Mean - Expected_Mean),
      Status = dplyr::case_when(
        is.na(Expected_Mean) | is.na(Actual_Mean) ~ "MISSING",
        Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "Mean", Actual = Actual_Mean, Expected = Expected_Mean, Status)
  pieces <- c(pieces, list(mean_join))
}

# %Inhibition
if (!is.null(exp_splits$pinhib) && nrow(exp_splits$pinhib)) {
  pinhib_join <- exp_splits$pinhib %>%
    dplyr::left_join(actual$group_means[, c("Dose", "Actual_PercentInhibition")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_PercentInhibition - Expected_PercentInhibition),
      Status = dplyr::case_when(
        is.na(Expected_PercentInhibition) | is.na(Actual_PercentInhibition) ~ "MISSING",
        Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "%Inhibition", Actual = Actual_PercentInhibition, Expected = Expected_PercentInhibition, Status)
  pieces <- c(pieces, list(pinhib_join))
}

# T-value (adjusted)
if (!is.null(exp_splits$tadj) && nrow(exp_splits$tadj)) {
  tadj_join <- exp_splits$tadj %>%
    dplyr::left_join(actual$actual_df[, c("Dose", "Actual_Tadj")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_Tadj - Expected_Tadj),
      Status = dplyr::case_when(
        is.na(Expected_Tadj) | is.na(Actual_Tadj) ~ "MISSING",
        Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "T-value (adjusted)", Actual = Actual_Tadj, Expected = Expected_Tadj, Status)
  pieces <- c(pieces, list(tadj_join))
}

# Tcrit
if (!is.null(exp_splits$tcrit) && nrow(exp_splits$tcrit)) {
  tcrit_join <- exp_splits$tcrit %>%
    dplyr::left_join(actual$actual_df[, c("Dose", "Actual_Tcrit")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_Tcrit - Expected_Tcrit),
      Status = dplyr::case_when(
        is.na(Expected_Tcrit) | is.na(Actual_Tcrit) ~ "MISSING",
        Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "Tcrit", Actual = Actual_Tcrit, Expected = Expected_Tcrit, Status)
  pieces <- c(pieces, list(tcrit_join))
}


# Significance (string compare; expected may be accept/reject or 1/0 — confirm if you prefer 0/1)
if (!is.null(exp_splits$signif) && nrow(exp_splits$signif)) {
  s_join <- exp_splits$signif %>%
    dplyr::left_join(actual$actual_df[, c("Dose", "Actual_Significance")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Expected_lbl = as.character(Expected_Significance),
      Actual_lbl = as.character(Actual_Significance),
      Status = dplyr::case_when(
        is.na(Expected_lbl) | is.na(Actual_lbl) ~ "MISSING",
        tolower(Expected_lbl) == tolower(Actual_lbl) ~ "PASS",
        TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "significance", Actual = Actual_lbl, Expected = Expected_lbl, Status)
  pieces <- c(pieces, list(s_join))
}

# df and MDD% present in expected — unless you want me to compute them, mark as MISSING
if (!is.null(exp_splits$df) && nrow(exp_splits$df)) {
  df_join <- exp_splits$df %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Status = "MISSING"
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "df", Actual = NA, Expected = Expected_df, Status)
  pieces <- c(pieces, list(df_join))
}
if (!is.null(exp_splits$mdd) && nrow(exp_splits$mdd)) {
  mdd_join <- exp_splits$mdd %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Status = "MISSING"
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "MDD%", Actual = NA, Expected = Expected_MDDpct, Status)
  pieces <- c(pieces, list(mdd_join))
}

# Bind, add metadata, filter (Actual and Expected both NA), order
comparison_long <- dplyr::bind_rows(pieces)
test_org <- na.omit(unique(endpoint_data[["Test organism"]]))[1]
comparison_long <- comparison_long %>%
  dplyr::mutate(
    `Study ID` = study_id,
    `Test organism` = test_org,
    alternative = alt_norm
  ) %>%
  dplyr::filter(!(is.na(Actual) & is.na(Expected))) %>%
  dplyr::mutate(metric = factor(metric, levels = c("Mean", "%Inhibition", "T-value (adjusted)", "Tcrit", "significance", "df", "MDD%"))) %>%
  dplyr::arrange(`Test organism`, `Study ID`, Endpoint, Dose, metric)

4. Notes and next steps

• Williams_JG comparison strings missing doses: we handle this by assigning doses from the sorted treatment dose vector. If you want to match a specific order returned by JG, I can inspect the wt object inside broom_williams (but that needs changes inside drcHelper or a wrapper).
• T-value (adjusted) sign: PMCMRplus returns negative t’ for “smaller/decreasing.” If your expected uses positive t’ or absolute values, tell me whether to compare absolute values or keep signed comparisons.
• Williams “df” and “MDD%”: your expected includes them. I don’t currently compute them. If you want them validated, please provide the exact definitions, and I’ll implement:
  • MDD% formula and inputs
  • df definition per step-down contrast (if it’s not the overall residual df)

5. Quick test drive for MOCK0065

• Keep your dunnett_fgs-like discovery for Williams via build_generic_fgs or your overall registry loop.
• Run a single case to verify:

fg <- list(id = "FG00210", study = "MOCK0065", alternatives = c("smaller"))
res <- run_consolidated_validation_generic("williams", fg$study, fg$id, alternative = "smaller")
head(res$validation_results)

This should produce long-format rows for Mean, %Inhibition, T-value (adjusted), Tcrit, and significance where available.

If you’d like, I can also wire Dunn and Wilcoxon joins with the same pattern (you already printed their expected label patterns). The code in the registry stubs for dunn and wilcoxon is ready; just confirm the p.adjust method for Dunn (“bonferroni” vs “holm”) and whether to compute/sign-compare any “significance” flags present in your expected rows (psignificance).

[Zhenglei-BCS]

Integrate prelimSummary directly into the validation pipeline to compute group-level Mean, SD, % Inhibition, and CV per dose, and then use those in the expected-vs-actual comparisons for tests that include percent metrics (Williams, Dunn, Wilcoxon, Welch/Student t, and even Dunnett where %Inhibition/%Reduction appears in your expected results).

What this adds

• A single helper that calls drcHelper::prelimSummary on the current endpoint’s data.
• Unified percent metrics for all tests that need them.
• Optional SD and CV comparison if those appear in expected rows.
• A robust fallback to the simple formula if prelimSummary fails.

Drop-in helper

Place this near your other helpers. It cleans the endpoint data, excludes “Reference item”, runs prelimSummary, and returns a tidy frame with Mean, SD, %Inhibition, CV per numeric dose.

compute_prelim_summary <- function(endpoint_data) {
  # Exclude reference items
  ed <- endpoint_data[!grepl("reference", endpoint_data[["Test group"]], ignore.case = TRUE), ]
  # Numeric dose
  ed$Dose_numeric <- convert_dose(ed$Dose)
  ed <- ed[!is.na(ed$Dose_numeric), ]
  if (!nrow(ed)) {
    return(data.frame(Dose = numeric(0),
                      Actual_Mean = numeric(0),
                      Actual_SD = numeric(0),
                      Actual_PercentInhibition = numeric(0),
                      Actual_CV = numeric(0)))
  }
  # Prepare minimal frame for prelimSummary: columns Dose and Response
  df_ps <- data.frame(Dose = ed$Dose_numeric, Response = ed$Response)
  # Try prelimSummary; if it errors, fall back to manual computation
  ps <- try(drcHelper::prelimSummary(df_ps), silent = TRUE)
  if (!inherits(ps, "try-error")) {
    # Expect columns: Dose, Mean, SD, % Inhibition, CV (with exact or similar names)
    # Normalize column names
    cn <- names(ps)
    Dose_col <- cn[grepl("^Dose$", cn, ignore.case = TRUE)][1]
    Mean_col <- cn[grepl("^Mean$", cn, ignore.case = TRUE)][1]
    SD_col   <- cn[grepl("^SD$", cn, ignore.case = TRUE)][1]
    PI_col   <- cn[grepl("%\\s*Inhib", cn, ignore.case = TRUE)][1]  # matches "% Inhibition"
    CV_col   <- cn[grepl("^CV$", cn, ignore.case = TRUE)][1]

    # Build output
    out <- data.frame(
      Dose = ps[[Dose_col]],
      Actual_Mean = ps[[Mean_col]],
      Actual_SD = if (!is.null(SD_col)) ps[[SD_col]] else NA_real_,
      Actual_PercentInhibition = if (!is.null(PI_col)) ps[[PI_col]] else NA_real_,
      Actual_CV = if (!is.null(CV_col)) ps[[CV_col]] else NA_real_
    )
    return(out)
  } else {
    # Fallback: compute manually
    group_means <- aggregate(Response ~ Dose, data = df_ps, FUN = mean)
    group_sd    <- aggregate(Response ~ Dose, data = df_ps, FUN = sd)
    out <- merge(group_means, group_sd, by = "Dose", suffixes = c("_mean", "_sd"))
    names(out) <- c("Dose", "Actual_Mean", "Actual_SD")
    # Control mean
    ctrl_mean <- out$Actual_Mean[out$Dose == min(out$Dose)]
    out$Actual_PercentInhibition <- if (!is.na(ctrl_mean) && ctrl_mean != 0) {
      100 * (1 - out$Actual_Mean / ctrl_mean)
    } else NA_real_
    out$Actual_CV <- ifelse(out$Actual_Mean != 0, 100 * out$Actual_SD / out$Actual_Mean, NA_real_)
    return(out)
  }
}

How to use it

• Replace the ad-hoc per-dose mean/%Inhibition calculations inside each run_actual handler with compute_prelim_summary(endpoint_data).
• Then join Expected rows for Mean, %Inhibition/%Reduction, SD, CV to the columns returned by this function.

Example integration: Williams handler (updated section)
Inside test_registry$williams$run_actual, replace the group_means computation with:

prelim <- compute_prelim_summary(endpoint_data)

# Keep actual_df as built from broom_williams
# Return prelim as group_means
list(actual_df = actual_df, group_means = prelim)

And in your generic runner’s join stage for Williams, change joins to match these column names:

• Mean: left_join(group_means[, c("Dose", "Actual_Mean")], by = "Dose")
• %Inhibition: left_join(group_means[, c("Dose", "Actual_PercentInhibition")], by = "Dose")
• SD: left_join(group_means[, c("Dose", "Actual_SD")], by = "Dose") if expected “Standard deviation” exists
• CV: left_join(group_means[, c("Dose", "Actual_CV")], by = "Dose") if expected “Coefficient of variation” exists

Supporting %Reduction and synonyms

In your parse_expected_metrics function, expand the percent metric pattern to match both “%Inhibition” and “%Reduction”, and map to Expected_Percent:

• For Dunnett/Welch/Student/Wilcoxon/Dunn/Williams:

out$percent <- pick("%\\s*Inhibition|%\\s*Reduction|%\\s*Wasps on plant")
names(out$percent)[2] <- "Expected_Percent"

Then join against Actual_PercentInhibition:

pinhib_join <- exp_splits$percent %>%
  dplyr::left_join(actual$group_means[, c("Dose", "Actual_PercentInhibition")], by = "Dose") %>%
  dplyr::mutate(
    Endpoint = endpoint,
    Diff = abs(Actual_PercentInhibition - Expected_Percent),
    Status = dplyr::case_when(
      is.na(Expected_Percent) | is.na(Actual_PercentInhibition) ~ "MISSING",
      Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
  ) %>%
  dplyr::transmute(Endpoint, Dose, metric = "%Inhibition", Actual = Actual_PercentInhibition, Expected = Expected_Percent, Status)

Notes about direction

• prelimSummary computes % Inhibition relative to control mean as #$#100 * (1 - mean_treatment / mean_control)#$# which assumes “smaller/decreasing” effect.
• For “greater/increasing” alternatives, if your expected uses “%Reduction” with the same baseline but positive direction, you may want to either:
  • Keep the same formula and compare absolute values; or
  • Flip sign to #$#100 * (mean_treatment / mean_control - 1) * 100#$# for “greater” endpoints.
    Please confirm your intended definition for greater; until then, the above code compares the values as-is.

Optional: SD and CV validations

If your expected rows include “Standard deviation” or “Coefficient of variation”, add these blocks in the generic runner (analogous to Mean/%Inhibition):

# SD
if (!is.null(exp_splits$sd) && nrow(exp_splits$sd)) {
  sd_join <- exp_splits$sd %>%
    dplyr::left_join(actual$group_means[, c("Dose", "Actual_SD")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_SD - Expected_SD),
      Status = dplyr::case_when(
        is.na(Expected_SD) | is.na(Actual_SD) ~ "MISSING",
        Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "SD", Actual = Actual_SD, Expected = Expected_SD, Status)
  pieces <- c(pieces, list(sd_join))
}

# CV
if (!is.null(exp_splits$cv) && nrow(exp_splits$cv)) {
  cv_join <- exp_splits$cv %>%
    dplyr::left_join(actual$group_means[, c("Dose", "Actual_CV")], by = "Dose") %>%
    dplyr::mutate(
      Endpoint = endpoint,
      Diff = abs(Actual_CV - Expected_CV),
      Status = dplyr::case_when(
        is.na(Expected_CV) | is.na(Actual_CV) ~ "MISSING",
        Diff <= tolerance ~ "PASS", TRUE ~ "FAIL")
    ) %>%
    dplyr::transmute(Endpoint, Dose, metric = "CV", Actual = Actual_CV, Expected = Expected_CV, Status)
  pieces <- c(pieces, list(cv_join))
}

Update parse_expected_metrics to capture SD and CV if present:

out$sd <- pick("Standard\\s*deviation"); names(out$sd)[2] <- "Expected_SD"
out$cv <- pick("Coefficient\\s*of\\s*variation"); names(out$cv)[2] <- "Expected_CV"

Quick sanity check
Please run this on one endpoint to confirm prelimSummary output aligns:

tmp <- compute_prelim_summary(w_ep)
print(tmp)

You should see per-dose Actual_Mean, Actual_SD, Actual_PercentInhibition, Actual_CV matching the example style.

Once this is in place, your percent metrics will be consistent and reusable across all test types, and you can validate %Inhibition/%Reduction rows reliably.