diff --git a/DESCRIPTION b/DESCRIPTION index 34f69e952..135af4056 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: aNCA Title: (Pre-)Clinical NCA in a Dynamic Shiny App -Version: 0.1.0.9177 +Version: 0.1.0.9179 Authors@R: c( person("Ercan", "Suekuer", email = "ercan.suekuer@roche.com", role = "aut", comment = c(ORCID = "0009-0001-1626-1526")), diff --git a/NAMESPACE b/NAMESPACE index 5f1c3bffb..ae8bf6777 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -42,10 +42,13 @@ export(format_pkncadose_data) export(g_lineplot) export(g_pkcg01_lin) export(g_pkcg01_log) +export(g_pkcg01_sbs) export(g_pkcg02_lin) export(g_pkcg02_log) +export(g_pkcg02_sbs) export(g_pkcg03_lin) export(g_pkcg03_log) +export(g_pkcg03_sbs) export(generate_pre_specs) export(generate_tooltip_text) export(get_conversion_factor) @@ -55,7 +58,21 @@ export(get_settings_code) export(interval_add_impute) export(interval_remove_impute) export(l_pkcl01) +export(l_pkcl01_tad) +export(l_pkcl02_uri) +export(l_pkpl01) +export(l_pkpl01_mp) +export(l_pkpl04_mp) export(multiple_matrix_ratios) +export(p_pkcg03_lin_dose) +export(p_pkcg03_log_dose) +export(p_pkcg03_sbs_dose) +export(p_pkpg01_cum) +export(p_pkpg01_per) +export(p_pkpg02_doseprop) +export(p_pkpg03_boxp) +export(p_pkpg04_boxp) +export(p_pkpg06_mp) export(parse_annotation) export(pivot_wider_pknca_results) export(pk.calc.ermax) @@ -73,6 +90,15 @@ export(remove_pp_not_requested) export(run_app) export(settings_version_summary) export(simplify_unit) +export(t_pkct01) +export(t_pkct01_dose) +export(t_pkct01_dose_tad) +export(t_pkct01_tad) +export(t_pkpt03_MP_col) +export(t_pkpt03_col) +export(t_pkpt07_norm) +export(t_pkpt08_uri) +export(t_pkpt11_gmr) export(translate_terms) export(update_main_intervals) export(write_versioned_settings) @@ -124,10 +150,15 @@ importFrom(dplyr,where) importFrom(formatters,`var_labels<-`) importFrom(formatters,var_labels) importFrom(ggplot2,aes) +importFrom(ggplot2,element_blank) +importFrom(ggplot2,element_text) importFrom(ggplot2,facet_wrap) +importFrom(ggplot2,geom_boxplot) importFrom(ggplot2,geom_errorbar) +importFrom(ggplot2,geom_jitter) importFrom(ggplot2,geom_line) importFrom(ggplot2,geom_point) +importFrom(ggplot2,geom_text) importFrom(ggplot2,ggplot) importFrom(ggplot2,ggplot_build) importFrom(ggplot2,ggplot_gtable) @@ -137,6 +168,10 @@ importFrom(ggplot2,scale_color_viridis_d) importFrom(ggplot2,scale_colour_manual) importFrom(ggplot2,scale_shape_manual) importFrom(ggplot2,scale_x_continuous) +importFrom(ggplot2,scale_x_log10) +importFrom(ggplot2,scale_y_log10) +importFrom(ggplot2,stat_summary) +importFrom(ggplot2,theme) importFrom(ggplot2,theme_bw) importFrom(glue,glue) importFrom(grid,convertUnit) @@ -160,6 +195,7 @@ importFrom(purrr,pmap_chr) importFrom(purrr,reduce) importFrom(reactable,reactable) importFrom(reactable.extras,reactable_extras_dependency) +importFrom(rlang,.data) importFrom(rlang,expr) importFrom(rlang,sym) importFrom(rlang,syms) @@ -169,11 +205,14 @@ importFrom(shinycssloaders,withSpinner) importFrom(shinyjqui,orderInput) importFrom(shinyjs,useShinyjs) importFrom(stats,as.formula) +importFrom(stats,coef) +importFrom(stats,confint) importFrom(stats,lm) importFrom(stats,median) importFrom(stats,na.omit) importFrom(stats,predict) importFrom(stats,qt) +importFrom(stats,quantile) importFrom(stats,sd) importFrom(stats,setNames) importFrom(tidyr,crossing) diff --git a/NEWS.md b/NEWS.md index da055c698..18d073108 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,23 @@ ## Features +### TLG Catalog +* Implement new TLG functions to complete the pkct01, pkpt03/07/08/11, pkpg01/02/03/04/06, pkpl01/04, and pkcl02 catalog entries (#1343): + - `t_pkct01` / `t_pkct01_dose` / `t_pkct01_tad` / `t_pkct01_dose_tad` — summary concentration tables (by TRT or dose, from first dose or TAD) + - `t_pkpt03_col` / `t_pkpt03_MP_col` — PK parameter summary tables with stats in columns (full dataset and metabolite/parent filtered) + - `t_pkpt07_norm` — dose-normalized PK parameter summary table + - `t_pkpt08_uri` — urine cumulative amount and % dose recovered summary table (n, Mean, SD, CV%, Median, Min, Max) + - `t_pkpt11_gmr` — geometric mean ratio table with 90% CIs + - `p_pkpg03_boxp` / `p_pkpg04_boxp` — boxplots of primary PK parameters (with and without individual data points) + - `p_pkpg06_mp` — boxplot of metabolite/parent PK parameter ratios + - `p_pkpg01_cum` / `p_pkpg01_per` — mean cumulative urine amount and % dose recovered line plots + - `p_pkpg02_doseprop` — dose-proportionality scatter plot with power-model regression on log-log scale + - `l_pkpl01` / `l_pkpl01_mp` — individual PK parameter listings (all parameters and metabolite-filtered) + - `l_pkpl04_mp` — individual PK parameter listing organised for treatment comparison + - `l_pkcl02_uri` — urine concentration and volume listing +* ADPP-based TLG outputs now correctly exclude rows flagged via `PPSUMFL = "Y"`, consistent with ADNCA exclusion via `PKSUM1F` (#1343) +* Summary tables are easier to read: split tables (e.g. by analyte/specimen) now show the group as a header, `t_pkct01` rows are grouped by treatment arm with timepoints in numeric order, statistic columns use readable headers (e.g. "Geometric Mean", "CV%"), and urine specimen filtering matches `PCSPEC`/`PPSPEC` case-insensitively (#1343) + ### Settings & Configuration * Settings upload auto-restores the full session: mapping, filters, data processing, tab navigation, and auto-runs NCA if previously run. Incompatible settings degrade gracefully with notifications (#1225) * Settings version control: YAML file stores multiple versions with metadata. Save button in header, version selection on upload, version delete support (#1103) diff --git a/R/export_cdisc.R b/R/export_cdisc.R index 34b6e91c7..6324fbfa4 100644 --- a/R/export_cdisc.R +++ b/R/export_cdisc.R @@ -72,6 +72,8 @@ export_cdisc <- function(res_nca, grouping_vars = character(0), flag_rules = NUL to_match_res_cols, dose_time_col, route_col, duration_col, conc_timeu_col, # Raw variables that can be directly used in PP or ADPP if present CDISC_COLS$PP$Variable, CDISC_COLS$ADPP$Variable, + # Dose amount/unit — not in ADPP CDISC metadata but needed for dose-proportionality TLGs + "DOSEA", "DOSEU", # Variables that can be used to guess other missing variables "PCRFTDTM", "PCRFTDTC", "PCTPTREF", "VISIT", "ATPTREF", "EXFAST", "PCFAST", "FEDSTATE", "EPOCH" @@ -228,7 +230,8 @@ export_cdisc <- function(res_nca, grouping_vars = character(0), flag_rules = NUL adpp <- cdisc_info %>% select(any_of(c( CDISC_COLS$ADPP$Variable, "exclude", grouping_vars, - ".pp_excl", ".pp_excl_reason" + ".pp_excl", ".pp_excl_reason", + "DOSEA", "DOSEU" ))) %>% # Deselect permitted columns with only NAs select( diff --git a/R/g_pkcg.R b/R/g_pkcg.R index 4d94198e7..7851ea6c2 100644 --- a/R/g_pkcg.R +++ b/R/g_pkcg.R @@ -16,6 +16,15 @@ g_pkcg01_log <- function(data, ...) { pkcg01(adnca = data, scale = "LOG", ...) } +#' Wrapper around aNCA::pkcg01() function. Calls the function with `SBS` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg01. +#' @export +g_pkcg01_sbs <- function(data, ...) { + pkcg01(adnca = data, scale = "SBS", ...) +} + #' Generate PK Concentration-Time Profile Plots #' #' This function generates a list of ggplots for PK concentration-time profiles. @@ -359,6 +368,15 @@ g_pkcg02_log <- function(data, ...) { pkcg02(adnca = data, scale = "LOG", ...) } +#' Wrapper around aNCA::pkcg02() function. Calls the function with `SBS` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg02. +#' @export +g_pkcg02_sbs <- function(data, ...) { + pkcg02(adnca = data, scale = "SBS", ...) +} + #' Generate Combined PK Concentration-Time Profile Plot by Cohort #' #' This function generates a list of plotly objects PK concentration-time profiles by group @@ -669,6 +687,42 @@ g_pkcg03_log <- function(data, ...) { pkcg03(adnca = data, scale = "LOG", ...) } +#' Wrapper around aNCA::pkcg03() function. Calls the function with `SBS` scale argument. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg03. +#' @export +g_pkcg03_sbs <- function(data, ...) { + pkcg03(adnca = data, scale = "SBS", ...) +} + +#' Wrapper around aNCA::pkcg03() function. Mean linear plot grouped by dose. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg03. +#' @export +p_pkcg03_lin_dose <- function(data, ...) { + pkcg03(adnca = data, scale = "LIN", mean_group_var = "DOSEA", ...) +} + +#' Wrapper around aNCA::pkcg03() function. Mean log plot grouped by dose. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg03. +#' @export +p_pkcg03_log_dose <- function(data, ...) { + pkcg03(adnca = data, scale = "LOG", mean_group_var = "DOSEA", ...) +} + +#' Wrapper around aNCA::pkcg03() function. Mean side-by-side plot grouped by dose. +#' @param data Data to be passed into the plotting function. +#' @param ... Any other parameters to be passed into the plotting function. +#' @returns ggplot2 object for pkcg03. +#' @export +p_pkcg03_sbs_dose <- function(data, ...) { + pkcg03(adnca = data, scale = "SBS", mean_group_var = "DOSEA", ...) +} + #' Generate PK Concentration-Time Profile Plots #' #' This function generates a list of ggplots for Mean PK concentration-time profiles. diff --git a/R/g_pkpg.R b/R/g_pkpg.R new file mode 100644 index 000000000..9fb4e1bd3 --- /dev/null +++ b/R/g_pkpg.R @@ -0,0 +1,625 @@ +#' Boxplot of Primary PK Parameters (pkpg03) +#' +#' Produces one boxplot per PK parameter with treatment arms on the x-axis. +#' Returns a named list of ggplot objects, one per `PPCAT` x `PPSPEC` +#' combination in the ADPP data. +#' +#' @param data A CDISC ADPP data frame (from `export_cdisc()$adpp`). +#' @param strat_var Column used for x-axis grouping (treatment arms). +#' Default: `"TRT01A"`. +#' @param param_var Column whose unique values each become a separate plot. +#' Default: `"PARAM"`. +#' @param value_var Column containing the numeric analysis value. Default: `"AVAL"`. +#' @param list_vars Columns used to split output into separate plot pages. +#' Default: `c("PPCAT", "PPSPEC")`. +#' @param all_points Logical. When `TRUE`, individual data points are overlaid +#' on the boxes (pkpg04 style). Default: `FALSE`. +#' @param title Optional plot title string. +#' @param subtitle Optional plot subtitle string. +#' @param footnote Optional footnote string. +#' @param ylab Y-axis label. Defaults to the label attribute of `value_var`. +#' +#' @return A named list of ggplot objects. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' plots <- p_pkpg03_boxp(adpp) +#' plots[[1]] +#' } +#' +#' @import dplyr +#' @importFrom ggplot2 ggplot aes geom_boxplot geom_jitter geom_text stat_summary +#' labs theme_bw theme element_text element_blank facet_wrap +#' @importFrom rlang .data +#' @importFrom stats quantile +#' @export +p_pkpg03_boxp <- function( + data, + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL", + list_vars = c("PPCAT", "PPSPEC"), + all_points = FALSE, + title = NULL, + subtitle = NULL, + footnote = NULL, + ylab = NULL +) { + required_cols <- c(value_var, strat_var, param_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("p_pkpg03_boxp: missing required columns: ", paste(missing_cols, collapse = ", ")) + } + + data <- data[!is.na(data[[value_var]]), , drop = FALSE] + if (nrow(data) == 0) return(list()) + + data[[strat_var]] <- as.factor(data[[strat_var]]) + + y_label <- if (!is.null(ylab)) ylab else .get_var_label(data, value_var) + + .make_plot <- function(df) { + # Deduplicate to one row per subject × parameter × stratum. ADPP multi-interval + # data has identical rows per dose event; duplicates inflate jitter point counts + # and distort summary statistics in stat_summary. Done inside .make_plot (after + # split_and_apply) so that list_vars columns don't interfere with the dedup key. + # AVISIT is included when present so multi-visit rows are preserved. + if ("USUBJID" %in% names(df)) { + dedup_cols <- intersect(c("USUBJID", strat_var, param_var, "AVISIT"), names(df)) + df <- df[!duplicated(df[dedup_cols]), , drop = FALSE] + } + p <- ggplot2::ggplot( + df, + ggplot2::aes( + x = .data[[strat_var]], + y = .data[[value_var]], + fill = .data[[strat_var]] + ) + ) + + ggplot2::geom_boxplot(outlier.shape = if (all_points) NA else 19, + alpha = 0.7, width = 0.5) + + ggplot2::stat_summary( + fun = "mean", + shape = 8, + size = 0.8, + color = "black", + show.legend = FALSE + ) + + ggplot2::facet_wrap(stats::as.formula(paste("~", param_var)), + scales = "free_y") + + ggplot2::labs( + title = title, + subtitle = subtitle, + caption = footnote, + x = NULL, + y = y_label, + fill = NULL + ) + + ggplot2::theme_bw() + + ggplot2::theme( + plot.title = ggplot2::element_text(family = "sans", size = 14, color = "black"), + plot.subtitle = ggplot2::element_text(family = "sans", size = 11, color = "black"), + axis.text.x = ggplot2::element_text(angle = 30, hjust = 1), + legend.position = "none" + ) + + if (all_points) { + p <- p + ggplot2::geom_jitter(width = 0.15, size = 1.5, alpha = 0.6) + } + + # Outlier labels: only shown when all_points = FALSE (pkpg03 style). + # When all_points = TRUE (pkpg04), every dot is drawn by geom_jitter with + # a random x-offset, so a geom_text anchored at the un-jittered factor + # centre would visually float away from the jitter point. In pkpg04, all + # data points are already visible as individual dots, so outlier labelling + # is redundant and would be misleading. + if (!all_points && "USUBJID" %in% names(df)) { + outlier_df <- df %>% + dplyr::group_by(.data[[param_var]], .data[[strat_var]]) %>% + dplyr::mutate( + .q1 = quantile(.data[[value_var]], 0.25, na.rm = TRUE), + .q3 = quantile(.data[[value_var]], 0.75, na.rm = TRUE), + .iqr = .q3 - .q1, + .is_out = !is.na(.data[[value_var]]) & + (.data[[value_var]] < .q1 - 1.5 * .iqr | + .data[[value_var]] > .q3 + 1.5 * .iqr) + ) %>% + dplyr::ungroup() %>% + dplyr::filter(.data[[".is_out"]]) + + if (nrow(outlier_df) > 0) { + p <- p + ggplot2::geom_text( + data = outlier_df, + ggplot2::aes(label = .data[["USUBJID"]]), + size = 2.5, + hjust = -0.2, + color = "black", + show.legend = FALSE, + inherit.aes = TRUE + ) + } + } + + p + } + + split_and_apply(data, list_vars, .make_plot) +} + +#' @describeIn p_pkpg03_boxp Boxplot with all individual data points overlaid (pkpg04). +#' @param ... Additional arguments forwarded to [p_pkpg03_boxp()]. +#' @export +p_pkpg04_boxp <- function(data, ...) { + p_pkpg03_boxp(data, all_points = TRUE, ...) +} + +#' Boxplot of Metabolite/Parent PK Parameter Ratios (pkpg06) +#' +#' Filters ADPP to metabolite rows using the same fallback logic as +#' [t_pkpt03_MP_col()] (METABFL preferred, then PPCAT/PARAM grep for "metab"), +#' then delegates to [p_pkpg03_boxp()]. +#' +#' @inheritParams p_pkpg03_boxp +#' @param ... Additional arguments forwarded to [p_pkpg03_boxp()]. +#' +#' @return A named list of ggplot objects (same format as [p_pkpg03_boxp()]). +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' plots <- p_pkpg06_mp(adpp) +#' plots[[1]] +#' } +#' +#' @export +p_pkpg06_mp <- function(data, ...) { + p_pkpg03_boxp(filter_metabolite_rows(data, "p_pkpg06_mp"), ...) +} + +#' Mean Urine PK Parameter Profile Plot (pkpg01) +#' +#' Computes mean (+/- SD) of a urine PK parameter per treatment arm across +#' collection intervals and draws a connected line plot. Designed for ADPP +#' data filtered to `PPSPEC %in% urine_specs` (e.g. cumulative amount excreted +#' or fraction of dose recovered). Returns one ggplot per unique combination +#' of `list_vars`. +#' +#' @param data A CDISC ADPP data frame (from `export_cdisc()$adpp`). +#' @param strat_var Column for treatment arm colour/grouping. Default: `"TRT01A"`. +#' @param param_var Column whose unique values label each x-axis position. +#' Default: `"PARAM"`. +#' @param value_var Column containing the numeric analysis value. Default: `"AVAL"`. +#' @param urine_specs Character vector of `PPSPEC` values treated as urine, +#' matched case-insensitively. Default: `c("URINE")`. +#' @param paramcd_filter Character vector of `PARAMCD` values to keep. Only +#' rows with a matching `PARAMCD` are plotted. Pass `NULL` to skip the +#' filter. Default: `"RCAMINT"` (cumulative amount recovered per interval). +#' @param time_end_var Column containing the collection interval end time +#' (ISO 8601 duration string or numeric hours). Used as a numeric x-axis +#' when parseable; falls back to `param_var` labels otherwise. +#' Default: `"PPENINT"`. +#' @param list_vars Columns used to split output into separate plots. +#' Default: `c("PPCAT")`. +#' @param title Optional plot title. +#' @param subtitle Optional plot subtitle. +#' @param footnote Optional footnote / caption. +#' @param xlab X-axis label. Default: `"Collection Interval"`. +#' @param ylab Y-axis label. Defaults to the label attribute of `value_var`. +#' +#' @return A named list of ggplot objects. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' plots <- p_pkpg01_cum(adpp) +#' plots[[1]] +#' } +#' +#' @import dplyr +#' @importFrom ggplot2 ggplot aes geom_line geom_point geom_errorbar labs +#' theme_bw theme element_text +#' @importFrom rlang .data +#' @importFrom stats sd +#' @export +p_pkpg01_cum <- function( # nolint: cyclocomp_linter + data, + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL", + urine_specs = c("URINE"), + paramcd_filter = "RCAMINT", + time_end_var = "PPENINT", + list_vars = c("PPCAT"), + title = "Mean Cumulative Amount Recovered in Urine", + subtitle = NULL, + footnote = NULL, + xlab = NULL, + ylab = NULL +) { + if ("PPSPEC" %in% names(data)) { + # Case-insensitive match (CDISC value is "URINE"; source casing varies). + data <- data[toupper(data$PPSPEC) %in% toupper(urine_specs), , drop = FALSE] + } else { + warning( + "p_pkpg01_cum: 'PPSPEC' column not found in data; the urine specimen ", + "filter was not applied. All rows are treated as urine. If your data ", + "contains non-urine records, the output will be incorrect. Ensure ", + "PPSPEC is present in the ADPP parameter data (from export_cdisc()$adpp)." + ) + } + if (!is.null(paramcd_filter) && "PARAMCD" %in% names(data) && nrow(data) > 0) { + available_paramcds <- sort(unique(data$PARAMCD)) + data <- data[data$PARAMCD %in% paramcd_filter, , drop = FALSE] + if (nrow(data) == 0) { + warning( + "p_pkpg01_cum: no rows matched paramcd_filter = c(", + paste(shQuote(paramcd_filter), collapse = ", "), "). ", + "Available PARAMCDs: ", + paste(shQuote(available_paramcds), collapse = ", "), + ". Returning an empty list. Pass NULL to skip the PARAMCD filter." + ) + return(list()) + } + } + if (nrow(data) == 0) return(list()) + + required_cols <- c(value_var, strat_var, param_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("p_pkpg01_cum: missing required columns: ", + paste(missing_cols, collapse = ", ")) + } + + data <- data[!is.na(data[[value_var]]), , drop = FALSE] + if (nrow(data) == 0) return(list()) + + data[[strat_var]] <- as.factor(data[[strat_var]]) + + y_label <- if (!is.null(ylab)) ylab else .get_var_label(data, value_var) + + .parse_ppenint <- function(x) { + x <- as.character(x) + # ISO 8601 duration: "PT12H" → 12, "PT1.5H" → 1.5, "Inf" → Inf + hrs <- suppressWarnings(as.numeric(x)) + iso <- grepl("^PT[0-9.]+H$", x, ignore.case = TRUE) + hrs[iso] <- as.numeric(sub("^PT([0-9.]+)H$", "\\1", x[iso], ignore.case = TRUE)) + hrs + } + + # use_numeric_x and x_var are evaluated per split subset inside .make_urine_plot + # so that each PPCAT page uses the correct axis based on its own PPENINT values. + # Evaluating them on the full dataset before splitting causes blank pages when + # one PPCAT subset has all-NA PPENINT after parsing. + .make_urine_plot <- function(df, page_title = title) { + # Deduplicate to one row per subject × stratum × x-axis variable. ADPP + # multi-interval data repeats the same value per dose event; duplicates make + # sd_val = 0, collapsing error bars to flat lines. + # AVISIT is included when present so multi-visit rows are preserved. + if ("USUBJID" %in% names(df)) { + dedup_cols <- intersect(c("USUBJID", strat_var, param_var, "AVISIT"), names(df)) + df <- df[!duplicated(df[dedup_cols]), , drop = FALSE] + } + # Determine x-axis type from this subset's data only + use_num <- time_end_var %in% names(df) && + !all(is.na(df[[time_end_var]])) && + !all(is.infinite(.parse_ppenint(df[[time_end_var]]))) + + if (use_num) { + df[[time_end_var]] <- .parse_ppenint(df[[time_end_var]]) + use_num <- !all(is.na(df[[time_end_var]])) + } + + if (use_num) { + x_var <- time_end_var + x_axis_label <- if (!is.null(xlab)) xlab else "Time (hours)" + } else { + param_levels <- sort(unique(df[[param_var]])) + df[[param_var]] <- factor(df[[param_var]], levels = param_levels) + x_var <- param_var + x_axis_label <- if (!is.null(xlab)) xlab else "Collection Interval" + } + + summary_df <- df %>% + dplyr::group_by(.data[[strat_var]], .data[[x_var]]) %>% + dplyr::summarise( + mean_val = mean(.data[[value_var]], na.rm = TRUE), + sd_val = stats::sd(.data[[value_var]], na.rm = TRUE), + .groups = "drop" + ) %>% + dplyr::mutate( + ymin = mean_val - sd_val, + ymax = mean_val + sd_val + ) + + p <- ggplot2::ggplot( + summary_df, + ggplot2::aes( + x = .data[[x_var]], + y = .data[["mean_val"]], + color = .data[[strat_var]], + group = .data[[strat_var]] + ) + ) + + ggplot2::geom_line(linewidth = 0.8) + + ggplot2::geom_point(size = 2.5) + + ggplot2::geom_errorbar( + ggplot2::aes(ymin = .data[["ymin"]], ymax = .data[["ymax"]]), + width = if (use_num) 0.5 else 0.2, alpha = 0.7 + ) + + ggplot2::labs( + title = page_title, + subtitle = subtitle, + caption = footnote, + x = x_axis_label, + y = y_label, + color = NULL + ) + + ggplot2::theme_bw() + + ggplot2::theme( + plot.title = ggplot2::element_text(family = "sans", size = 14, color = "black"), + plot.subtitle = ggplot2::element_text(family = "sans", size = 11, color = "black"), + axis.text.x = ggplot2::element_text(angle = 30, hjust = 1), + legend.position = "bottom" + ) + + if (use_num) { + x_breaks <- sort(unique(summary_df[[x_var]])) + p <- p + ggplot2::scale_x_continuous(breaks = x_breaks) + } + + p + } + + split_and_apply(data, list_vars, .make_urine_plot) +} + +#' @describeIn p_pkpg01_cum Mean percentage of dose recovered in urine (pkpg01 %). +#' Identical to [p_pkpg01_cum()] but defaults to a % dose recovered title and +#' y-axis label. +#' @param ... Additional arguments forwarded to [p_pkpg01_cum()]. +#' @export +p_pkpg01_per <- function( + data, + paramcd_filter = "FREXINT", + title = "Mean Percentage of Dose Recovered in Urine", + ylab = "Percent Dose Recovered (%)", + ... +) { + p_pkpg01_cum(data, paramcd_filter = paramcd_filter, title = title, ylab = ylab, ...) +} + +#' Dose-Proportionality Scatter Plot with Power-Model Regression (pkpg02) +#' +#' Plots individual AVAL values against dose (DOSEA) on a log-log scale with +#' one facet per PK parameter. A power-model regression line +#' (log y = a + b * log x) is overlaid on each facet together with the slope +#' estimate and its confidence interval, enabling visual assessment of +#' dose-proportionality (slope b = 1). +#' +#' @param data A CDISC ADPP data frame (from `export_cdisc()$adpp`). +#' @param dose_var Column containing the administered dose. Default: `"DOSEA"`. +#' @param value_var Column containing the PK parameter value. Default: `"AVAL"`. +#' @param param_var Column used as facet variable. Default: `"PARAM"`. +#' @param strat_var Column used for point colour. Default: `"TRT01A"`. +#' @param list_vars Columns used to split output into separate plots. +#' Default: `c("PPCAT", "PPSPEC")`. +#' @param ci_level Confidence level for the slope CI. Default: `0.90`. +#' @param log_scale Logical. When `TRUE` (default), both axes are log10-scaled. +#' @param title Optional plot title. +#' @param subtitle Optional plot subtitle. +#' @param footnote Optional footnote / caption. +#' @param xlab X-axis label. Defaults to `dose_var` label + unit. +#' @param ylab Y-axis label. Defaults to the label attribute of `value_var`. +#' +#' @return A named list of ggplot objects. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' plots <- p_pkpg02_doseprop(adpp) +#' plots[[1]] +#' } +#' +#' @import dplyr +#' @importFrom ggplot2 ggplot aes geom_point geom_line geom_text geom_errorbar +#' facet_wrap labs scale_x_log10 scale_y_log10 theme_bw theme element_text +#' @importFrom rlang .data +#' @importFrom stats lm coef confint predict sd +#' @export +p_pkpg02_doseprop <- function( # nolint: cyclocomp_linter + data, + dose_var = "DOSEA", + value_var = "AVAL", + param_var = "PARAM", + strat_var = "TRT01A", + list_vars = c("PPCAT", "PPSPEC"), + ci_level = 0.90, + log_scale = TRUE, + title = NULL, + subtitle = NULL, + footnote = NULL, + xlab = NULL, + ylab = NULL +) { + required_cols <- c(value_var, dose_var, param_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("p_pkpg02_doseprop: missing required columns: ", + paste(missing_cols, collapse = ", ")) + } + + data <- data[ + !is.na(data[[value_var]]) & !is.na(data[[dose_var]]) & + data[[value_var]] > 0 & data[[dose_var]] > 0, , + drop = FALSE + ] + if (nrow(data) == 0) return(list()) + + x_label <- if (!is.null(xlab)) { + xlab + } else { + dose_u <- if ("DOSEU" %in% names(data)) unique(data[["DOSEU"]])[1] else "" + base <- .get_var_label(data, dose_var) + if (nchar(dose_u) > 0) paste0(base, " (", dose_u, ")") else base + } + y_label <- if (!is.null(ylab)) ylab else .get_var_label(data, value_var) + + .fit_power <- function(df_param) { + df_f <- df_param[df_param[[value_var]] > 0 & df_param[[dose_var]] > 0, , drop = FALSE] + if (nrow(df_f) < 3) return(NULL) + fit_df <- data.frame(logy = log(df_f[[value_var]]), logx = log(df_f[[dose_var]])) + fit <- tryCatch(stats::lm(logy ~ logx, data = fit_df), error = function(e) NULL) + if (is.null(fit)) return(NULL) + ci <- tryCatch( + stats::confint(fit, level = ci_level), + error = function(e) matrix(c(NA, NA, NA, NA), nrow = 2) + ) + dose_seq <- exp(seq(log(min(df_f[[dose_var]])), log(max(df_f[[dose_var]])), length.out = 80)) + pred_y <- exp(stats::predict(fit, newdata = data.frame(logx = log(dose_seq)))) + pred_df <- setNames( + data.frame(dose_seq, pred_y), + c(dose_var, value_var) + ) + list(pred_df = pred_df, + slope = stats::coef(fit)[["logx"]], + slope_ci = ci["logx", ], + adj_r2 = summary(fit)$adj.r.squared) + } + + .make_dp_plot <- function(df) { + # Deduplicate to one row per subject × parameter × stratum. ADPP multi-interval + # data has identical rows per dose event; duplicates make sd_val = 0, collapsing + # error bars to flat lines while inflating the scatter point count. + # AVISIT is included when present so multi-visit rows are preserved. + if ("USUBJID" %in% names(df)) { + dedup_cols <- intersect(c("USUBJID", param_var, strat_var, "AVISIT"), names(df)) + df <- df[!duplicated(df[dedup_cols]), , drop = FALSE] + } + params <- unique(df[[param_var]]) + + fit_results <- lapply(params, function(p) { + fit <- .fit_power(df[df[[param_var]] == p, , drop = FALSE]) + if (!is.null(fit)) { + fit$pred_df[[param_var]] <- p + fit$param <- p + } + fit + }) + fit_results <- Filter(Negate(is.null), fit_results) + + point_aes <- if (strat_var %in% names(df)) { + ggplot2::aes(color = .data[[strat_var]]) + } else { + ggplot2::aes() + } + + p <- ggplot2::ggplot(df, ggplot2::aes(x = .data[[dose_var]], y = .data[[value_var]])) + + ggplot2::geom_point(point_aes, size = 2, alpha = 0.8) + + ggplot2::facet_wrap(stats::as.formula(paste("~", param_var)), scales = "free") + + ggplot2::labs( + title = title, + subtitle = subtitle, + caption = footnote, + x = x_label, + y = y_label, + color = NULL + ) + + ggplot2::theme_bw() + + ggplot2::theme( + plot.title = ggplot2::element_text(family = "sans", size = 14, color = "black"), + plot.subtitle = ggplot2::element_text(family = "sans", size = 11, color = "black"), + axis.text.x = ggplot2::element_text(angle = 30, hjust = 1), + legend.position = "bottom" + ) + + if (length(fit_results) > 0) { + pred_all <- do.call(rbind, lapply(fit_results, `[[`, "pred_df")) + p <- p + ggplot2::geom_line( + data = pred_all, + ggplot2::aes(x = .data[[dose_var]], y = .data[[value_var]]), + color = "black", + linewidth = 0.8, + inherit.aes = FALSE + ) + + annot_df <- do.call(rbind, lapply(fit_results, function(fit) { + # On a log10 x-scale, x = -Inf is transformed to log10(-Inf) = NaN, + # which geom_text treats as NA and silently drops the annotation row. + # Instead, anchor each label at the minimum positive dose for that + # parameter so it always appears at the left edge of the data cloud. + param_doses <- df[[dose_var]][df[[param_var]] == fit$param & + df[[dose_var]] > 0 & !is.na(df[[dose_var]])] + x_anchor <- if (length(param_doses) > 0) min(param_doses) else -Inf + setNames( + data.frame( + fit$param, + sprintf("\u03b2 = %.3f [%.3f, %.3f]\nadj. R\u00b2 = %.3f", + fit$slope, fit$slope_ci[1], fit$slope_ci[2], + fit$adj_r2), + x_anchor, Inf, + stringsAsFactors = FALSE + ), + c(param_var, "label", dose_var, value_var) + ) + })) + p <- p + ggplot2::geom_text( + data = annot_df, + ggplot2::aes(x = .data[[dose_var]], y = .data[[value_var]], label = .data[["label"]]), + # hjust = 0 left-aligns text from the anchor dose coordinate. Using + # -Inf / hjust = 0.05 (panel-edge idiom) would work on linear scales + # but is transformed to NaN by scale_x_log10() and silently dropped. + hjust = 0, + vjust = 1.5, + size = 2.8, + color = "black", + inherit.aes = FALSE + ) + } + + dose_summary <- df %>% + dplyr::group_by(.data[[dose_var]], .data[[param_var]]) %>% + dplyr::summarise( + mean_val = mean(.data[[value_var]], na.rm = TRUE), + sd_val = stats::sd(.data[[value_var]], na.rm = TRUE), + .groups = "drop" + ) %>% + dplyr::mutate( + # Per TLG catalog pkpg02: omit error bars when SD >= mean to avoid + # non-positive lower bounds on the log scale (log(<=0) is undefined). + ymin = ifelse(is.na(.data[["sd_val"]]) | .data[["sd_val"]] >= .data[["mean_val"]], + NA_real_, .data[["mean_val"]] - .data[["sd_val"]]), + ymax = ifelse(is.na(.data[["sd_val"]]) | .data[["sd_val"]] >= .data[["mean_val"]], + NA_real_, .data[["mean_val"]] + .data[["sd_val"]]) + ) + + p <- p + + ggplot2::geom_errorbar( + data = dose_summary, + ggplot2::aes( + x = .data[[dose_var]], + ymin = .data[["ymin"]], + ymax = .data[["ymax"]] + ), + width = 0.05, + color = "black", + inherit.aes = FALSE, + na.rm = TRUE + ) + + ggplot2::geom_point( + data = dose_summary, + ggplot2::aes(x = .data[[dose_var]], y = .data[["mean_val"]]), + shape = 2, + size = 3, + color = "black", + inherit.aes = FALSE + ) + + if (log_scale) { + p <- p + ggplot2::scale_x_log10() + ggplot2::scale_y_log10() + } + p + } + + split_and_apply(data, list_vars, .make_dp_plot) +} diff --git a/R/l_pkcl01.R b/R/l_pkcl01.R index 00568aa92..bbe54a36c 100644 --- a/R/l_pkcl01.R +++ b/R/l_pkcl01.R @@ -127,6 +127,8 @@ l_pkcl01 <- function( "AVALU" %in% names(data) & var_name == "AVAL" ~ paste0(Label, " ($AVALU)"), "RRLTU" %in% names(data) & var_name == "AFRLT" ~ paste0(Label, " ($RRLTU)"), "RRLTU" %in% names(data) & var_name == "NFRLT" ~ paste0(Label, " ($RRLTU)"), + "RRLTU" %in% names(data) & var_name == "ARRLT" ~ paste0(Label, " ($RRLTU)"), + "RRLTU" %in% names(data) & var_name == "NRRLT" ~ paste0(Label, " ($RRLTU)"), .default = Label ) ) %>% @@ -239,3 +241,87 @@ l_pkcl01 <- function( setNames(unique(data_grouped[["id_list"]])) } + +#' Wrapper around aNCA::l_pkcl01() for TAD-based concentration listings. +#' @param data Data to be passed into the listing function. +#' @param ... Any other parameters to be passed into the listing function. +#' @returns A named list of listing_df objects. +#' @export +l_pkcl01_tad <- function(data, ...) { + data <- apply_labels(data) + l_pkcl01(data, displaying_vars = c("NRRLT", "ARRLT", "AVAL"), ...) +} + +#' Urine Concentration and Volume Listing (pkcl02) +#' +#' Filters ADNCA to urine specimen rows (where `PCSPEC %in% urine_specs`) then +#' delegates to [l_pkcl01()] with VOLUME and VOLUMEU added to the displayed +#' columns when those columns are present in the data. +#' +#' @param data A CDISC ADNCA data frame (from `export_cdisc()$adnca`). +#' @param urine_specs Character vector of specimen type values to keep, matched +#' case-insensitively against `PCSPEC`. Default: `c("URINE")`. +#' @param listgroup_vars Character vector of columns used to split output into +#' separate listings. Default: `c("PARAM", "PCSPEC")`. When `PCSPEC` is +#' absent from `data`, it is silently removed from this vector. +#' @param displaying_vars Character vector of columns to display. When `NULL` +#' (default), uses `c("NFRLT", "AFRLT", "AVAL")` plus `VOLUME`/`VOLUMEU` +#' if those columns exist in the data. +#' @param ... Additional arguments forwarded to [l_pkcl01()]. +#' +#' @return A named list of `listing_df` objects. +#' +#' @examples +#' \dontrun{ +#' adnca <- export_cdisc(res_nca)$adnca +#' listings <- l_pkcl02_uri(adnca) +#' print(listings[[1]]) +#' } +#' +#' @export +l_pkcl02_uri <- function( + data, + urine_specs = c("URINE"), + listgroup_vars = c("PARAM", "PCSPEC"), + displaying_vars = NULL, + ... +) { + if ("PCSPEC" %in% names(data)) { + # Case-insensitive match so "Urine"/"urine" are also kept (CDISC value is + # "URINE", but source data casing varies). + data <- data[toupper(data$PCSPEC) %in% toupper(urine_specs), , drop = FALSE] + } else { + warning( + "l_pkcl02_uri: 'PCSPEC' column not found in data; the urine specimen ", + "filter was not applied. All rows are treated as urine. If your data ", + "contains non-urine records, the output will be incorrect. Ensure ", + "PCSPEC is present in the source concentration data." + ) + # Drop PCSPEC from listgroup_vars so l_pkcl01's all_of() doesn't fail on an + # absent column — mirrors the intersect() guard used by split_and_apply(). + listgroup_vars <- intersect(listgroup_vars, names(data)) + } + if (nrow(data) == 0) { + stop( + "l_pkcl02_uri: no urine concentration data found. ", + "Ensure PCSPEC contains one of: ", + paste(urine_specs, collapse = ", ") + ) + } + + if (is.null(displaying_vars)) { + vol_vars <- intersect(c("VOLUME", "VOLUMEU"), names(data)) + displaying_vars <- c("NFRLT", "AFRLT", "AVAL", vol_vars) + } + + l_pkcl01( + data, + listgroup_vars = listgroup_vars, + displaying_vars = displaying_vars, + title = paste0( + "Listing of Urine PK Concentration and Volume ", + "by Treatment Group, Subject and Nominal Time, PK Population" + ), + ... + ) +} diff --git a/R/l_pkpl01.R b/R/l_pkpl01.R new file mode 100644 index 000000000..61ab55e8c --- /dev/null +++ b/R/l_pkpl01.R @@ -0,0 +1,185 @@ +#' Individual PK Parameters Listing (pkpl01) +#' +#' Creates individual-level listings of PK parameters from ADPP data using the +#' same engine as [l_pkcl01()]. Returns one listing per unique combination of +#' `listgroup_vars` (default: `PPCAT` x `PPSPEC`). +#' +#' @param data A CDISC ADPP data frame (from `export_cdisc()$adpp`). +#' @param listgroup_vars Character vector of columns used to split the output +#' into separate listings. Default: `c("PPCAT", "PPSPEC")`. +#' @param grouping_vars Character vector of key/header columns within each +#' listing (shown as indented row keys). Default: `c("TRT01A", "USUBJID")`. +#' @param param_var Column whose unique values become display columns after +#' pivoting wide. Default: `"PARAM"`. +#' @param value_var Column containing the numeric analysis value. Default: `"AVAL"`. +#' @param unit_var Column containing the parameter unit used to build column +#' headers (`" ()"`). Default: `"AVALU"`. +#' @param title Main listing title string. +#' @param subtitle Per-listing subtitle. Supports `$VAR` / `!VAR` annotation +#' syntax. Defaults to the unique values of `listgroup_vars`. +#' @param footnote Footnote string. +#' +#' @return A named list of `listing_df` objects (one per `listgroup_vars` +#' combination), suitable for printing in a Shiny `verbatimTextOutput`. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' listings <- l_pkpl01(adpp) +#' print(listings[[1]]) +#' } +#' +#' @import dplyr formatters +#' @importFrom stats setNames +#' @importFrom tidyr pivot_wider +#' @export +l_pkpl01 <- function( + data, + listgroup_vars = c("PPCAT", "PPSPEC"), + grouping_vars = c("TRT01A", "USUBJID"), + param_var = "PARAM", + value_var = "AVAL", + unit_var = "AVALU", + title = "Listing of Individual PK Parameters", + subtitle = NULL, + footnote = NULL +) { + if (!requireNamespace("rlistings", quietly = TRUE)) { + stop( + "Package 'rlistings' is required for PK parameter listings. ", + "Install it with install.packages('rlistings')" + ) + } + + required_cols <- c(grouping_vars, param_var, value_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("l_pkpl01: missing required columns: ", + paste(missing_cols, collapse = ", ")) + } + + data <- apply_labels(data, type = "ADPP") + + if (is.null(subtitle)) { + subtitle <- paste( + paste0("!", listgroup_vars), + paste0("$", listgroup_vars), + sep = ": ", + collapse = "\n" + ) + } + + .make_wide_listing <- function(df) { + has_unit <- unit_var %in% names(df) + + col_labels <- if (has_unit) { + vapply(sort(unique(df[[param_var]])), function(p) { + u <- unique(df[[unit_var]][df[[param_var]] == p]) + u <- u[!is.na(u)][1] + if (!is.na(u) && nchar(u) > 0) paste0(p, " (", u, ")") else p + }, character(1)) + } else { + sort(unique(df[[param_var]])) + } + + wide <- df %>% + dplyr::mutate( + .val_fmt = round(as.numeric(.data[[value_var]]), 3) + ) %>% + dplyr::select(dplyr::all_of(c( + intersect(listgroup_vars, names(df)), + grouping_vars, param_var, ".val_fmt" + ))) %>% + tidyr::pivot_wider( + names_from = dplyr::all_of(param_var), + values_from = ".val_fmt", + # When a subject has multiple rows for the same PARAM (e.g. multi- + # interval ADPP), take the first value rather than creating list-columns. + values_fn = dplyr::first, + values_fill = NA_real_ + ) + + param_cols <- sort(unique(df[[param_var]])) + param_cols <- param_cols[param_cols %in% names(wide)] + + var_labels(wide)[param_cols] <- col_labels[ + match(param_cols, sort(unique(df[[param_var]]))) + ] + for (v in grouping_vars) { + if (v %in% names(wide)) { + lbl <- attr(df[[v]], "label") + if (!is.null(lbl)) var_labels(wide)[v] <- lbl + } + } + + # pivot_wider spreads param_var into column headers, so param_var is no longer + # a column in `wide`. Exclude it from key_cols so it is not silently dropped + # by intersect() — it already appears as the display columns (param_cols). + key_col_candidates <- setdiff(grouping_vars, param_var) + rlistings::as_listing( + df = wide, + key_cols = intersect(key_col_candidates, names(wide)), + disp_cols = intersect(param_cols, names(wide)), + main_title = parse_annotation(data = df, text = title), + subtitles = gsub("
", "\n", + parse_annotation(data = df, text = subtitle)), + main_footer = parse_annotation(data = df, text = footnote) + ) + } + + split_and_apply(data, listgroup_vars, .make_wide_listing) +} + +#' @describeIn l_pkpl01 Listing filtered to metabolite rows (pkpl01 M/P). +#' Uses the same METABFL -> PPCAT -> PARAM fallback as [t_pkpt03_MP_col()]. +#' @param ... Additional arguments forwarded to [l_pkpl01()]. +#' @export +l_pkpl01_mp <- function(data, ...) { + l_pkpl01(filter_metabolite_rows(data, "l_pkpl01_mp"), ...) +} + +#' Individual Treatment Comparison Listing (pkpl04) +#' +#' Produces a per-subject listing of individual PK parameter values organised +#' for treatment comparison. Each listing page covers one PPCAT/PPSPEC +#' combination. PK parameters become display columns (one column per PARAM value) +#' and the rows are keyed by `TRT01A` and `USUBJID`. +#' +#' @details +#' This listing shows the raw individual `AVAL` values from ADPP, not +#' pre-computed ratios. If your ADPP contains NCA ratio parameters (e.g. +#' metabolite-to-parent AUC ratios added via the aNCA ratio-calculation +#' module), those parameters are displayed here just like any other PARAM row. +#' The `_mp` suffix in the function name reflects its typical use with +#' metabolite/parent ratio parameters, but no metabolite filtering is applied -- +#' all PARAM values in the data are included. +#' +#' Note: `PARAM` is listed in `grouping_vars` so that it participates in the +#' `pivot_wider` step (each unique PARAM value becomes a column header). After +#' pivoting, `PARAM` is no longer a row-key column; the actual listing keys +#' are `TRT01A` and `USUBJID`. +#' +#' @inheritParams l_pkpl01 +#' @param grouping_vars Columns used to identify row keys before pivoting. +#' `PARAM` must be included so it is spread into display columns. +#' Default: `c("PARAM", "TRT01A", "USUBJID")`. +#' @param ... Additional arguments forwarded to [l_pkpl01()]. +#' +#' @return A named list of `listing_df` objects. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' listings <- l_pkpl04_mp(adpp) +#' print(listings[[1]]) +#' } +#' +#' @export +l_pkpl04_mp <- function( + data, + grouping_vars = c("PARAM", "TRT01A", "USUBJID"), + title = "Listing of Individual PK Parameter Values by Treatment", + ... +) { + l_pkpl01(data, grouping_vars = grouping_vars, title = title, ...) +} diff --git a/R/t_pkct01.R b/R/t_pkct01.R new file mode 100644 index 000000000..34a23000d --- /dev/null +++ b/R/t_pkct01.R @@ -0,0 +1,156 @@ +#' Summary Concentration Table (pkct01) +#' +#' Summarizes PK concentration data by treatment/dose group and nominal timepoint. +#' Returns one data frame per analyte/specimen combination containing descriptive +#' statistics across subjects at each scheduled timepoint. +#' +#' @param data A CDISC ADNCA data frame (from `export_cdisc()$adnca`). +#' @param list_vars Character vector of columns used to split the output into +#' separate tables. Default: `c("PARAM", "PCSPEC")`. +#' @param strat_var Column name used for treatment/dose stratification. +#' Default: `"TRT01A"`. +#' @param time_var Column name for the nominal timepoint axis. +#' Default: `"NFRLT"` (nominal time from first dose). +#' @param visit_var Column name for the visit/period reference label. +#' Default: `"ATPTREF"`. +#' @param blq_var Column containing the character analysis value used to detect +#' BLQ records. Default: `"AVALC"`. Records where this column equals `"BLQ"` +#' are counted separately and excluded from numeric summaries. When `blq_var` +#' is absent (as in `export_cdisc()$adnca`, which does not include `AVALC`), +#' BLQ is detected via `AVAL == 0`, consistent with the package convention +#' for post-imputation BLQ encoding. +#' +#' @return A named list of data frames, one per unique combination of +#' `list_vars`. Each data frame contains columns for `strat_var`, +#' `visit_var`, `time_var`, and the statistics: +#' `n`, `n_blq`, `Mean`, `SD`, `CV_pct`, `Median`, `GeoMean`, `GeoCV_pct`, `Min`, `Max`. +#' +#' @details +#' BLQ values are excluded from all numeric statistics and counted in `n_blq`. +#' When `blq_var` is present, BLQ is identified as `df[[blq_var]] == "BLQ"`. +#' When `blq_var` is absent, `AVAL == 0` is used as the fallback BLQ indicator. +#' `GeoMean` is computed on positive `AVAL` values only. +#' +#' @examples +#' \dontrun{ +#' adnca <- export_cdisc(res_nca)$adnca +#' tables <- t_pkct01(adnca) +#' tables[[1]] +#' } +#' +#' @importFrom stats sd median +#' @export +t_pkct01 <- function( # nolint: cyclocomp_linter + data, + list_vars = c("PARAM", "PCSPEC"), + strat_var = "TRT01A", + time_var = "NFRLT", + visit_var = "ATPTREF", + blq_var = "AVALC" +) { + required_cols <- c("AVAL", strat_var, time_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("t_pkct01: missing required columns: ", paste(missing_cols, collapse = ", ")) + } + + present_visit_var <- if (visit_var %in% names(data)) visit_var else NULL + has_blq_col <- blq_var %in% names(data) + + row_vars <- c(strat_var, present_visit_var, time_var) + + .summarise_group <- function(df) { + aval_num <- df$AVAL + is_blq <- if (has_blq_col) { + # Guard against NA in blq_var: NA != "BLQ" → NA, coerce to FALSE so those + # rows are neither counted as BLQ nor silently passed into numeric stats. + !is.na(df[[blq_var]]) & df[[blq_var]] == "BLQ" + } else { + !is.na(df$AVAL) & df$AVAL == 0 + } + aval_num[is_blq] <- NA_real_ + + # n = quantifiable + BLQ (regardless of whether AVAL is NA for BLQ rows). + # Using only !is.na(AVAL) would undercount when AVALC="BLQ" but AVAL=NA, + # causing n_blq > n — an impossible table entry. + n_total <- sum(!is.na(df$AVAL) | is_blq) + n_blq <- sum(is_blq, na.rm = TRUE) + vals <- aval_num[!is.na(aval_num)] + pos_vals <- vals[vals > 0] + gs <- if (length(pos_vals) > 1) sd(log(pos_vals)) else NA_real_ + + data.frame( + n = n_total, + n_blq = n_blq, + Mean = if (length(vals) > 0) round(mean(vals), 3) else NA_real_, + SD = if (length(vals) > 1) round(sd(vals), 3) else NA_real_, + CV_pct = if (length(vals) > 1 && mean(vals) != 0) + round(sd(vals) / mean(vals) * 100, 1) else NA_real_, + Median = if (length(vals) > 0) round(median(vals), 3) else NA_real_, + GeoMean = if (length(pos_vals) > 0) round(exp(mean(log(pos_vals))), 3) else NA_real_, + GeoCV_pct = if (!is.na(gs)) round(sqrt(exp(gs^2) - 1) * 100, 1) else NA_real_, + Min = if (length(vals) > 0) round(min(vals), 3) else NA_real_, + Max = if (length(vals) > 0) round(max(vals), 3) else NA_real_, + stringsAsFactors = FALSE + ) + } + + make_table <- function(df) { + # Coerce grouping columns to character so that R's NA becomes the string "NA" + # before interaction(). interaction(..., drop = TRUE) never creates a factor + # level for R's NA, so rows with NA in strat_var or time_var would be silently + # dropped (e.g. unscheduled samples with NFRLT = NA). Using the string "NA" + # keeps those rows visible in the table under an explicit "NA" label. + group_cols <- lapply(row_vars, function(v) { + x <- as.character(df[[v]]) + x[is.na(x)] <- "NA" + x + }) + groups <- do.call( + interaction, + c(group_cols, list(sep = " | ", drop = TRUE)) + ) + + rows <- lapply(levels(groups), function(grp) { + sub <- df[groups == grp, , drop = FALSE] + if (nrow(sub) == 0) return(NULL) + key <- sub[1, row_vars, drop = FALSE] + cbind(key, .summarise_group(sub), stringsAsFactors = FALSE) + }) + rows <- Filter(Negate(is.null), rows) + if (length(rows) == 0) return(data.frame()) + + result <- do.call(rbind, rows) + + # Order so each stratum's rows are contiguous: by strat_var, then the visit + # reference, then the nominal time. .natural_sort_key() makes the sort + # numeric-aware, so numeric NFRLT, factor levels, and character labels with + # embedded numbers (e.g. "DOSE 10" after "DOSE 2", arms "100 mg" after + # "50 mg") all order naturally rather than lexically; NA keys sort last. + order_keys <- lapply(row_vars, function(v) .natural_sort_key(result[[v]])) + result <- result[do.call(order, order_keys), , drop = FALSE] + rownames(result) <- NULL + .apply_stat_labels(apply_labels(result)) + } + + split_and_apply(data, list_vars, make_table) +} + +#' @describeIn t_pkct01 Stratify by dose instead of treatment arm (first dose). +#' @param ... Additional arguments forwarded to [t_pkct01()]. +#' @export +t_pkct01_dose <- function(data, ...) { + t_pkct01(data, strat_var = "DOSEA", ...) +} + +#' @describeIn t_pkct01 Summarize using time after dose (TAD) nominal time. +#' @export +t_pkct01_tad <- function(data, ...) { + t_pkct01(data, time_var = "NRRLT", ...) +} + +#' @describeIn t_pkct01 Stratify by dose using TAD nominal time. +#' @export +t_pkct01_dose_tad <- function(data, ...) { + t_pkct01(data, strat_var = "DOSEA", time_var = "NRRLT", ...) +} diff --git a/R/t_pkpt.R b/R/t_pkpt.R new file mode 100644 index 000000000..8f420e056 --- /dev/null +++ b/R/t_pkpt.R @@ -0,0 +1,395 @@ +#' Shared table builder for ADPP summary tables (pkpt03 / pkpt08 pattern). +#' +#' Deduplicates to one row per USUBJID x strat x param, then applies +#' `summary_fn` to the numeric values for each stratum/parameter combination. +#' Used internally by `t_pkpt03_col` and `t_pkpt08_uri` to avoid duplicating +#' the identical looping/cbind/rbind boilerplate. +#' +#' @param df Data frame (one split from `split_and_apply`). +#' @param strat_var,param_var,value_var Column name strings. +#' @param summary_fn Function that takes a numeric vector and returns a +#' one-row `data.frame` of summary statistics. +#' @return A labeled `data.frame`. +#' @noRd +.build_pkpp_table <- function(df, strat_var, param_var, value_var, summary_fn) { + if ("USUBJID" %in% names(df)) { + # Include AVISIT in the dedup key when present so that rows from different + # visits (genuinely different AVAL values) are kept. AVISIT is absent from + # single-interval ADPP; including it only when present is safe because + # !duplicated() still collapses true within-visit duplicates (same + # USUBJID × strat × param × AVISIT repeated per dose event). + dedup_cols <- intersect( + c("USUBJID", strat_var, param_var, "AVISIT"), + names(df) + ) + df <- df[!duplicated(df[dedup_cols]), , drop = FALSE] + } + # Natural-aware ordering so arms/params with embedded numbers (e.g. "10 mg" + # before "100 mg") sort numerically rather than lexically. + nat_sort <- function(v) v[order(.natural_sort_key(v))] + strats <- nat_sort(unique(df[[strat_var]])) + params <- nat_sort(unique(df[[param_var]])) + rows <- lapply(strats, function(s) { + sub_s <- df[df[[strat_var]] == s, , drop = FALSE] + lapply(params, function(p) { + vals <- sub_s[[value_var]][sub_s[[param_var]] == p] + key <- data.frame(strat = s, param = p, stringsAsFactors = FALSE) + names(key) <- c(strat_var, param_var) + cbind(key, summary_fn(vals), stringsAsFactors = FALSE) + }) + }) + flat <- unlist(rows, recursive = FALSE) + if (length(flat) == 0) return(data.frame()) + result <- do.call(rbind, flat) + rownames(result) <- NULL + .apply_stat_labels(apply_labels(result, type = "ADPP")) +} + +#' Summary PK Parameters Table -- statistics in columns (pkpt03) +#' +#' Summarizes pharmacokinetic parameters from ADPP data. Returns one data frame +#' per analyte (PPCAT) combination with PK parameters as rows and descriptive +#' statistics as columns. +#' +#' @param data A CDISC ADPP data frame (from `export_cdisc()$adpp`). +#' @param list_vars Character vector of columns used to split output into +#' separate tables. Default: `c("PPCAT")`. `AVISIT` is a conditional ADPP +#' column that is typically absent from `export_cdisc()$adpp`; it is silently +#' skipped when not present so there is no need to remove it manually, but +#' adding it only helps when your ADPP actually contains visit information. +#' @param strat_var Column for treatment/dose stratification. Default: `"TRT01A"`. +#' @param param_var Column containing parameter names shown as rows. +#' Default: `"PARAM"`. +#' @param value_var Column containing the numeric analysis value. Default: `"AVAL"`. +#' +#' @return A named list of data frames, one per combination of `list_vars`. +#' Each data frame has columns: `strat_var`, `param_var`, `n`, `Mean`, `SD`, +#' `CV_pct`, `GeoMean`, `GeoCV_pct`, `Median`, `Min`, `Max`. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' tables <- t_pkpt03_col(adpp) +#' tables[[1]] +#' } +#' +#' @importFrom stats sd median +#' @export +t_pkpt03_col <- function( + data, + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) { + required_cols <- c(value_var, strat_var, param_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("t_pkpt03_col: missing required columns: ", paste(missing_cols, collapse = ", ")) + } + + if (nrow(data) == 0) return(list(data.frame())) + + split_and_apply( + data, list_vars, + function(df) .build_pkpp_table(df, strat_var, param_var, value_var, .summarise_adpp) + ) +} + +#' @describeIn t_pkpt03_col Summary of metabolite-to-parent ratios (stats in columns). +#' Filters to metabolite rows using `METABFL` (preferred) or, when absent from ADPP, +#' falls back to rows where `PPCAT` or `PARAM` contains "metab" (case-insensitive). +#' `METABFL` is present in ADPP only when it was included as a grouping variable in +#' the NCA run. +#' @param ... Additional arguments forwarded to [t_pkpt03_col()]. +#' @export +t_pkpt03_MP_col <- function(data, ...) { # nolint: object_name_linter + t_pkpt03_col(filter_metabolite_rows(data, "t_pkpt03_MP_col"), ...) +} + +#' Mean Dose-Normalized PK Parameters Table (pkpt07) +#' +#' Filters ADPP to dose-normalized parameters and summarizes them with the +#' same column layout as [t_pkpt03_col()]. These parameters must have been +#' computed during the NCA run -- they are not derived on the fly. +#' +#' @param data A CDISC ADPP data frame (from `export_cdisc()$adpp`). +#' @param paramcd_var Column containing parameter codes used to detect +#' dose-normalized parameters. Default: `"PARAMCD"`. +#' @param paramcd_filter Character vector of CDISC dose-normalized PARAMCDs to +#' keep. Defaults to the standard codes used in this package: +#' `c("CMAXD", "AUCLSTD", "AUCIFOD", "AUCTLSTD")`. Pass `NULL` to fall +#' back to the regex `grepl("[A-Z0-9]D$", PARAMCD)` pattern, which keeps +#' any code whose last two characters are an uppercase letter/digit followed +#' by `D`. +#' @inheritParams t_pkpt03_col +#' +#' @return Named list of data frames (same format as [t_pkpt03_col()]). +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' tables <- t_pkpt07_norm(adpp) +#' # Include a custom dose-normalized code: +#' tables <- t_pkpt07_norm(adpp, paramcd_filter = c("CMAXD", "AUCLSTD", "MYPARAMD")) +#' } +#' +#' @export +t_pkpt07_norm <- function( + data, + paramcd_var = "PARAMCD", + paramcd_filter = c("CMAXD", "AUCLSTD", "AUCIFOD", "AUCTLSTD"), + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) { + if (paramcd_var %in% names(data)) { + if (!is.null(paramcd_filter)) { + data <- data[data[[paramcd_var]] %in% paramcd_filter, , drop = FALSE] + } else { + # Fallback regex: last two chars are [A-Z0-9] then D (e.g. CMAXD, AUCLSTD). + # The simple "D$" pattern was too broad — it matched any code ending in D, + # including non-dose-normalized codes like AUCCUMD or study-specific codes. + data <- data[grepl("[A-Z0-9]D$", data[[paramcd_var]]), , drop = FALSE] + } + } else { + warning( + "t_pkpt07_norm: column '", paramcd_var, "' not found in data; ", + "dose-normalization filter could not be applied. All parameters are ", + "included. Ensure PARAMCD is exported from your NCA run to use this table." + ) + } + if (nrow(data) == 0) { + stop( + "t_pkpt07_norm: no dose-normalized parameters found in ADPP. ", + "Include dose-normalized NCA parameters (e.g. Cmax/D, AUClast/D) ", + "in your NCA parameter selection to use this table." + ) + } + t_pkpt03_col( + data, + list_vars = list_vars, + strat_var = strat_var, + param_var = param_var, + value_var = value_var + ) +} + +#' Mean Urine Amount and Percent Recovered Table (pkpt08) +#' +#' Filters ADPP to urine specimen records and summarizes cumulative amount +#' excreted (Ae) and percentage of dose recovered (Fe%) with descriptive +#' statistics in columns. Per the TLG catalog specification for pkpt08, +#' the summary includes n, Mean, SD, CV%, Median, Min, Max -- without +#' geometric mean or geometric CV% (those are omitted because urine recovery +#' parameters are not log-normally distributed by convention). +#' +#' @param data A CDISC ADPP data frame. Urine records are identified by +#' `PPSPEC %in% urine_specs`. +#' @param urine_specs Character vector of specimen types considered urine, +#' matched case-insensitively. Default: `c("URINE")`. +#' @inheritParams t_pkpt03_col +#' +#' @return Named list of data frames with columns: `strat_var`, `param_var`, +#' `n`, `Mean`, `SD`, `CV_pct`, `Median`, `Min`, `Max`. +#' Use [t_pkpt03_col()] instead if geometric mean statistics are needed. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' tables <- t_pkpt08_uri(adpp) +#' } +#' +#' @importFrom stats sd median +#' @export +t_pkpt08_uri <- function( + data, + urine_specs = c("URINE"), + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) { + if ("PPSPEC" %in% names(data)) { + # Case-insensitive match (CDISC value is "URINE"; source casing varies). + data <- data[toupper(data$PPSPEC) %in% toupper(urine_specs), , drop = FALSE] + } else { + warning( + "t_pkpt08_uri: 'PPSPEC' column not found in data; the urine specimen ", + "filter was not applied. All rows are treated as urine. If your data ", + "contains non-urine records, the output will be incorrect. Ensure ", + "PPSPEC is present in the ADPP parameter data (from export_cdisc()$adpp)." + ) + } + if (nrow(data) == 0) { + stop( + "t_pkpt08_uri: no urine PK parameter data found in ADPP. ", + "Ensure urine NCA parameters (e.g. Ae, Fe) were computed and ", + "PPSPEC contains one of: ", paste(urine_specs, collapse = ", ") + ) + } + + required_cols <- c(value_var, strat_var, param_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("t_pkpt08_uri: missing required columns: ", + paste(missing_cols, collapse = ", ")) + } + + split_and_apply( + data, list_vars, + function(df) { + .build_pkpp_table( + df, strat_var, param_var, value_var, + function(v) .summarise_adpp(v, include_geo = FALSE) + ) + } + ) +} + +#' GMR Table with Confidence Intervals (pkpt11) +#' +#' Computes geometric mean ratios (GMR) with 90% confidence intervals for +#' selected PK parameters, comparing each treatment arm to a reference arm. +#' +#' @param data A CDISC ADPP data frame. +#' @param ref_arm Character string identifying the reference treatment arm in +#' `strat_var`. If `NULL` (default), the first arm in sorted order is used. +#' @param ci_level Confidence level for the geometric mean ratio CI. +#' Default: `0.90`. +#' @inheritParams t_pkpt03_col +#' +#' @return Named list of data frames, one per combination of `list_vars`. +#' Each data frame has columns: `strat_var`, `param_var`, `n_ref`, `n_trt`, +#' `GMR`, `CI_lower`, `CI_upper`. +#' +#' @details +#' The confidence interval is computed on the log scale using a two-sample +#' t-test approach: `exp(log_ratio +/- t * SE)` where SE is derived from the +#' pooled within-group standard deviations on the log scale. +#' +#' @examples +#' \dontrun{ +#' adpp <- export_cdisc(res_nca)$adpp +#' tables <- t_pkpt11_gmr(adpp, ref_arm = "Placebo") +#' } +#' +#' @importFrom stats qt sd +#' @export +t_pkpt11_gmr <- function( + data, + ref_arm = NULL, + ci_level = 0.90, + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) { + required_cols <- c(value_var, strat_var, param_var) + missing_cols <- setdiff(required_cols, names(data)) + if (length(missing_cols) > 0) { + stop("t_pkpt11_gmr: missing required columns: ", paste(missing_cols, collapse = ", ")) + } + + arms <- sort(unique(data[[strat_var]])) + if (is.null(ref_arm)) ref_arm <- arms[1] + if (!ref_arm %in% arms) { + stop("t_pkpt11_gmr: ref_arm '", ref_arm, "' not found in '", strat_var, "'.") + } + trt_arms <- setdiff(arms, ref_arm) + + alpha <- 1 - ci_level + + .gmr_row <- function(ref_vals, trt_vals, strat, param) { + ref_log <- log(ref_vals[ref_vals > 0 & !is.na(ref_vals)]) + trt_log <- log(trt_vals[trt_vals > 0 & !is.na(trt_vals)]) + nr <- length(ref_log) + nt <- length(trt_log) + + if (nr < 2 || nt < 2) { + gmr <- ci_lo <- ci_hi <- NA_real_ + } else { + log_ratio <- mean(trt_log) - mean(ref_log) + se <- sqrt(sd(ref_log)^2 / nr + sd(trt_log)^2 / nt) + if (se == 0) { + # Both arms have identical log-PK values; within-group variance is zero + # and the Welch df formula yields 0/0 = NaN. max(NaN, 1) returns NaN + # in R (max does not suppress NaN without na.rm = TRUE), so qt() would + # produce NaN CI bounds instead of NA. Return NA to signal that the CI + # is undefined when there is no within-group variability. + gmr <- round(exp(log_ratio), 3) + ci_lo <- ci_hi <- NA_real_ + } else { + df <- (se^2)^2 / ((sd(ref_log)^2 / nr)^2 / (nr - 1) + + (sd(trt_log)^2 / nt)^2 / (nt - 1)) + t_crit <- qt(1 - alpha / 2, df = max(df, 1, na.rm = TRUE)) + gmr <- round(exp(log_ratio), 3) + ci_lo <- round(exp(log_ratio - t_crit * se), 3) + ci_hi <- round(exp(log_ratio + t_crit * se), 3) + } + } + data.frame( + strat = strat, + param = param, + n_ref = nr, + n_trt = nt, + GMR = gmr, + CI_lower = ci_lo, + CI_upper = ci_hi, + stringsAsFactors = FALSE + ) + } + + make_table <- function(df) { + # Deduplicate to one row per subject × parameter × stratum before computing + # GMR. ADPP multi-interval duplicates inflate n and produce falsely narrow CIs. + # Include AVISIT in the key when present so multi-visit rows are preserved. + if ("USUBJID" %in% names(df)) { + dedup_cols <- intersect( + c("USUBJID", strat_var, param_var, "AVISIT"), + names(df) + ) + df <- df[!duplicated(df[dedup_cols]), , drop = FALSE] + } + + arms_in_split <- unique(df[[strat_var]]) + + if (!ref_arm %in% arms_in_split) { + warning( + "t_pkpt11_gmr: reference arm '", ref_arm, "' is absent from this ", + "data split. Returning an empty table for this page." + ) + return(data.frame()) + } + + trt_in_split <- intersect(trt_arms, arms_in_split) + if (length(trt_in_split) == 0) { + warning( + "t_pkpt11_gmr: no treatment arms other than '", ref_arm, + "' found in this data split. Returning an empty table." + ) + return(data.frame()) + } + + params <- sort(unique(df[[param_var]])) + ref_data <- df[df[[strat_var]] == ref_arm, , drop = FALSE] + + rows <- unlist(lapply(trt_in_split, function(s) { + trt_data <- df[df[[strat_var]] == s, , drop = FALSE] + lapply(params, function(p) { + ref_v <- ref_data[[value_var]][ref_data[[param_var]] == p] + trt_v <- trt_data[[value_var]][trt_data[[param_var]] == p] + .gmr_row(ref_v, trt_v, s, p) + }) + }), recursive = FALSE) + + result <- do.call(rbind, rows) + names(result)[names(result) == "strat"] <- strat_var + names(result)[names(result) == "param"] <- param_var + rownames(result) <- NULL + apply_labels(result, type = "ADPP") + } + + split_and_apply(data, list_vars, make_table) +} diff --git a/R/utils-tlg.R b/R/utils-tlg.R new file mode 100644 index 000000000..f7cfc4f8f --- /dev/null +++ b/R/utils-tlg.R @@ -0,0 +1,220 @@ +#' Split a data frame by grouping variables and apply a function to each subset +#' +#' Common pattern used by all TLG functions that return one output object per +#' analyte/visit/specimen combination. When `list_vars` is empty (or none of +#' the variables are present in `data`), `fn` is called on the full data frame +#' and the result is returned as a single-element named list +#' `list(all = ...)`. Otherwise the data is split by the interaction of +#' `list_vars` columns and `fn` is applied to each subset; the results are +#' named by the interaction key. +#' +#' @param data A data frame. +#' @param list_vars Character vector of column names to split by. Absent +#' columns are silently skipped. +#' @param fn A function that takes a data frame and returns a single output +#' object (plot, table, listing, ...). +#' +#' @return A named list of `fn` outputs. +#' @noRd +split_and_apply <- function(data, list_vars, fn) { + present <- intersect(list_vars, names(data)) + + if (length(present) == 0) { + return(list(all = fn(data))) + } + + # Rows where any split column is NA are excluded: they cannot be assigned to a + # meaningful group and would otherwise appear as a spurious "NA / PLASMA" page. + complete_rows <- rowSums(is.na(data[, present, drop = FALSE])) == 0 + if (!all(complete_rows)) { + warning( + "split_and_apply: ", sum(!complete_rows), " row(s) with NA in split ", + "variable(s) [", paste(present, collapse = ", "), "] were excluded." + ) + data <- data[complete_rows, , drop = FALSE] + } + + if (nrow(data) == 0) return(list(all = fn(data))) + + split_keys <- do.call( + interaction, + c( + lapply(present, function(v) as.character(data[[v]])), + list(sep = " / ", drop = TRUE) + ) + ) + + results <- lapply(levels(split_keys), function(key) { + fn(data[split_keys == key, , drop = FALSE]) + }) + setNames(results, levels(split_keys)) +} + +#' Filter ADPP rows to metabolite records +#' +#' Applies a three-tier fallback to identify metabolite rows in ADPP: +#' 1. `METABFL` column -- preferred when included as a grouping variable in +#' the NCA run (non-missing, non-empty values are kept). +#' 2. `PPCAT` containing "metab" (case-insensitive) -- used when `METABFL` +#' is absent or all-missing. +#' 3. `PARAM` containing "metab" (case-insensitive) -- final fallback. +#' +#' Throws an informative error when no metabolite data can be found. +#' +#' @param data A CDISC ADPP data frame. +#' @param caller Character string naming the calling function, used in the +#' error message. Default: `"filter_metabolite_rows"`. +#' +#' @return A filtered data frame containing only metabolite rows. +#' @noRd +filter_metabolite_rows <- function( + data, caller = "filter_metabolite_rows") { + # Preferred: explicit METABFL flag set by the NCA grouping variable + if ("METABFL" %in% names(data) && + any(!is.na(data$METABFL) & data$METABFL != "")) { + return( + data[!is.na(data$METABFL) & data$METABFL != "", , drop = FALSE] + ) + } + + # Fallback: PPCAT or PARAM column containing "metab" + for (col in c("PPCAT", "PARAM")) { + if (col %in% names(data) && + any(grepl("metab", data[[col]], ignore.case = TRUE))) { + return( + data[grepl("metab", data[[col]], ignore.case = TRUE), , + drop = FALSE] + ) + } + } + + stop( + caller, ": no metabolite data found. ", + "METABFL is absent or all missing, and no PPCAT/PARAM values ", + "contain 'metab'. To use this output, include METABFL as a ", + "grouping variable in your NCA run, or ensure metabolite rows ", + "are labelled with 'metab' in PPCAT or PARAM." + ) +} + +#' Compute descriptive statistics for a numeric vector of PK values. +#' +#' Returns a one-row data frame of n, Mean, SD, CV%, GeoMean, GeoCV%, Median, +#' Min, Max. When `include_geo = FALSE`, the GeoMean and GeoCV_pct columns +#' are omitted (used for urine parameters that are not log-normally distributed +#' by convention). +#' +#' Used by [t_pkpt03_col()], [t_pkpt08_uri()], and [t_pkpt11_gmr()] via +#' [.build_pkpp_table()]. Placed here so future table functions can reuse it +#' without duplicating the stat logic. +#' +#' @param vals Numeric vector (NAs already handled by caller or this function). +#' @param include_geo Logical. Include GeoMean and GeoCV_pct columns. +#' Default: `TRUE`. +#' @noRd +.summarise_adpp <- function(vals, include_geo = TRUE) { # nolint: cyclocomp_linter + vals <- vals[!is.na(vals)] + pos <- vals[vals > 0] + n <- length(vals) + mn <- if (n > 0) mean(vals) else NA_real_ + s <- if (n > 1) sd(vals) else NA_real_ + out <- data.frame( + n = n, + Mean = round(mn, 3), + SD = round(s, 3), + CV_pct = if (!is.na(mn) && mn != 0 && !is.na(s)) + round(s / mn * 100, 1) else NA_real_, + stringsAsFactors = FALSE + ) + if (include_geo) { + gm <- if (length(pos) > 0) exp(mean(log(pos))) else NA_real_ + gs <- if (length(pos) > 1) sd(log(pos)) else NA_real_ + out <- cbind(out, data.frame( + GeoMean = round(gm, 3), + GeoCV_pct = if (!is.na(gs)) round(sqrt(exp(gs^2) - 1) * 100, 1) else NA_real_, + stringsAsFactors = FALSE + )) + } + cbind(out, data.frame( + Median = if (n > 0) round(median(vals), 3) else NA_real_, + Min = if (n > 0) round(min(vals), 3) else NA_real_, + Max = if (n > 0) round(max(vals), 3) else NA_real_, + stringsAsFactors = FALSE + )) +} + +#' Human-readable display labels for the descriptive-statistic columns shared by +#' the summary tables (`t_pkct01`, and everything built via [.build_pkpp_table()]). +#' +#' The data frames keep their terse programmatic column names (`GeoMean`, +#' `CV_pct`, ...) so downstream code and tests can reference them; these labels +#' are attached as the `label` attribute and promoted to the rendered column +#' header by `define_cols(header_from_label = TRUE)`. +#' @noRd +.STAT_LABELS <- c( + n = "n", + n_blq = "Number BLQ", + Mean = "Mean", + SD = "SD", + CV_pct = "CV%", + Median = "Median", + GeoMean = "Geometric Mean", + GeoCV_pct = "Geometric CV%", + Min = "Min", + Max = "Max" +) + +#' Attach readable labels to the statistic columns of a summary table. +#' +#' Only columns present in both the data frame and [.STAT_LABELS] are touched; +#' grouping/key columns (already labelled via [apply_labels()]) are left as-is. +#' +#' @param df A summary-table data frame. +#' @return `df` with `label` attributes set on its statistic columns. +#' @noRd +.apply_stat_labels <- function(df) { + for (col in intersect(names(df), names(.STAT_LABELS))) { + attr(df[[col]], "label") <- unname(.STAT_LABELS[[col]]) + } + df +} + +#' Build an `order()` key that sorts embedded numbers numerically. +#' +#' `order()` on a character vector is lexical, so "DOSE 10" would sort before +#' "DOSE 2" and arms like "100 mg" before "50 mg". This returns a key whose +#' lexical order matches natural order: numeric columns are returned unchanged +#' (already numeric-sortable), factors are returned as their level codes (so an +#' upstream-defined order is respected), and for character values each run of +#' digits is zero-padded to a fixed width. `NA` keys sort last, as with the +#' default `order()`. +#' +#' @param x A vector (numeric, factor, or character). +#' @return A vector suitable as an argument to [order()]. +#' @noRd +.natural_sort_key <- function(x) { + if (is.numeric(x)) return(x) + if (is.factor(x)) return(as.integer(x)) + vapply(as.character(x), function(s) { + if (is.na(s)) return(NA_character_) + parts <- regmatches(s, gregexpr("[0-9]+|[^0-9]+", s))[[1]] + is_num <- grepl("^[0-9]+$", parts) + parts[is_num] <- formatC(parts[is_num], width = 12, flag = "0") + paste(parts, collapse = "") + }, character(1), USE.NAMES = FALSE) +} + +#' Return the label attribute of a column, falling back to the column name. +#' +#' Used by TLG plot functions to label axes. When a column has a +#' `formatters`-style `label` attribute it is used; otherwise the column name +#' string is returned unchanged. +#' +#' @param data A data frame. +#' @param var Character scalar column name. +#' @return A character scalar label. +#' @noRd +.get_var_label <- function(data, var) { + lbl <- attr(data[[var]], "label") + if (!is.null(lbl)) lbl else var +} diff --git a/R/zzz.R b/R/zzz.R index 8c636c2c2..b99241bda 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -113,6 +113,11 @@ "Variable", "adj.r.squared", "aucs", + ".iqr", + ".q1", + ".q3", + "mean_val", + "sd_val", "calculate_ratio_app", "color", diff --git a/inst/WORDLIST b/inst/WORDLIST index 4d990a028..7fab852e7 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -12,12 +12,15 @@ AUCINT AUCLSTD AUCPEO AUCPEP +AUCTLSTD AUCall AUCinf AUCint AUClast AVAL +AVALC AVALU +AVISIT AdjustingFactor Ae AggregateSubject @@ -54,7 +57,10 @@ EXTRAVASCULAR Extravascular FABS FREL +FREXINT +GMR INTRAVASCULAR +ISO Kezia Kobana LAMZ @@ -65,6 +71,7 @@ METABFL MRTMDO MRTMDP MSCW +MYPARAMD Metab Multidose NCA @@ -85,7 +92,10 @@ PKNCAresult PKNCAresults PKSUM PPANMETH +PPCAT +PPENINT PPORRES +PPSPEC PPSTRES PPSTRESU PPSUMFL @@ -121,10 +131,12 @@ SMS STUDYID SelectInputs Summarise +TAD TLG TLGs TMAX TRT +TRT01A TRTRINT TestGroups TestParameter @@ -133,6 +145,7 @@ Tlast Tmax Tooltip UI +URINE USUBJID UX VOLUMEU @@ -187,21 +200,29 @@ logslope mL macroparameters md +metab multidose nav nca ng normalised oligo +organised pak +parseable pc pcspec pharmacodynamics pharmacokinetic pharmacokinetics pkcg +pkcl +pkct pkgdown pknca +pkpg +pkpl +pkpt plotly pptest pptestcd diff --git a/inst/shiny/app.R b/inst/shiny/app.R index 55e5c4c96..37fd78137 100644 --- a/inst/shiny/app.R +++ b/inst/shiny/app.R @@ -244,7 +244,11 @@ server <- function(input, output, session) { ) # TLG - tab_tlg_server("tlg", tab_nca_outputs$processed_pknca_data) + tab_tlg_server( + "tlg", + tab_nca_outputs$processed_pknca_data, + adpp = tab_nca_outputs$adpp + ) # ABOUT ---- tab_about_server("about") diff --git a/inst/shiny/modules/common/reactable.R b/inst/shiny/modules/common/reactable.R index e101b33be..0f9111af0 100644 --- a/inst/shiny/modules/common/reactable.R +++ b/inst/shiny/modules/common/reactable.R @@ -151,6 +151,10 @@ reactable_server <- function( #' @param max_px Integer. Maximum allowable base width in pixels. Default is 150. #' @param expand_factor Integer. Multiplier to convert character count to pixels. Default is 8. #' @param overrides A named list of [reactable::colDef()] objects to override defaults. +#' @param header_from_label Logical. When `TRUE`, columns that carry a `label` +#' attribute use that label as the visible column header (with the raw column +#' name kept as a hover tooltip). When `FALSE` (default, used by most app +#' tables), the raw column name is the header and the label is the tooltip. #' #' @return A named list of [reactable::colDef()] objects. #' @@ -180,19 +184,35 @@ reactable_server <- function( #' if (interactive()) { #' reactable(adpc, columns = col_defs) #' } -define_cols <- function(data, max_px = 150, expand_factor = 8, overrides = list()) { +define_cols <- function(data, max_px = 150, expand_factor = 8, overrides = list(), + header_from_label = FALSE) { if (is.null(data)) { return(NULL) } defs <- purrr::imap(data, \(values, col_name) { - # Define width based on max character length - max_char <- max(nchar(as.character(values)), nchar(col_name), na.rm = TRUE) - calc_width <- max_char * expand_factor + 20 - # Label for tooltip + # Label for tooltip / header label <- unname(attr(values, "label")) + # Define width based on max character length, accounting for whichever text + # ends up in the header. + header_text <- if (header_from_label && !is.null(label)) label else col_name + max_char <- max(nchar(as.character(values)), nchar(header_text), na.rm = TRUE) + calc_width <- max_char * expand_factor + 20 min_width <- min(calc_width, max_px) max_width <- 5 * max_px - if (!is.null(label)) { + if (!is.null(label) && header_from_label) { + reactable::colDef( + html = TRUE, + header = htmltools::tags$span( + label, + `data-toggle` = "tooltip", + `data-placement` = "top", + title = col_name + ), + minWidth = min_width, + maxWidth = max_width, + resizable = TRUE + ) + } else if (!is.null(label)) { reactable::colDef( html = TRUE, header = htmltools::tags$span( diff --git a/inst/shiny/modules/tab_nca.R b/inst/shiny/modules/tab_nca.R index bb0f8ae60..ae577e757 100644 --- a/inst/shiny/modules/tab_nca.R +++ b/inst/shiny/modules/tab_nca.R @@ -340,7 +340,9 @@ tab_nca_server <- function(id, pknca_data, extra_group_vars, settings_override, additional_analysis_server("non_nca", processed_pknca_data, extra_group_vars) #' Parameter datasets module - parameter_datasets_server("parameter_datasets", res_nca_tagged, extra_group_vars, settings) + cdisc <- parameter_datasets_server( + "parameter_datasets", res_nca_tagged, extra_group_vars, settings + ) #' Parameter plots module #' res_nca: base results for picker initialization (stable across exclusion changes) @@ -348,7 +350,11 @@ tab_nca_server <- function(id, pknca_data, extra_group_vars, settings_override, parameter_plots_server("parameter_plots", res_nca, res_nca_tagged) # return results for use in other modules - list(res_nca = res_nca, processed_pknca_data = processed_pknca_data) + list( + res_nca = res_nca, + processed_pknca_data = processed_pknca_data, + adpp = reactive(cdisc()$adpp) + ) }) } diff --git a/inst/shiny/modules/tab_nca/parameter_datasets.R b/inst/shiny/modules/tab_nca/parameter_datasets.R index 6212d02fc..4a6a183a8 100644 --- a/inst/shiny/modules/tab_nca/parameter_datasets.R +++ b/inst/shiny/modules/tab_nca/parameter_datasets.R @@ -45,6 +45,8 @@ parameter_datasets_server <- function(id, res_nca, grouping_vars = reactive(char observeEvent(CDISC(), { session$userData$results$CDISC <- CDISC()[c("pp", "adpp", "adnca")] }) + + CDISC }) } diff --git a/inst/shiny/modules/tab_tlg.R b/inst/shiny/modules/tab_tlg.R index af331ae86..819c9a17f 100644 --- a/inst/shiny/modules/tab_tlg.R +++ b/inst/shiny/modules/tab_tlg.R @@ -65,7 +65,7 @@ tab_tlg_ui <- function(id) { ), card(reactable_ui(ns("selected_tlg_table"))), ), - nav_panel("Tables", "To be added"), + nav_panel("Tables", uiOutput(ns("tables"), class = "tlg-module"), value = "Tables"), nav_panel("Listings", uiOutput(ns("listings"), class = "tlg-module"), value = "Listings"), nav_panel("Graphs", uiOutput(ns("graphs"), class = "tlg-module"), value = "Graphs"), # disable loader for initial empty UI render # @@ -75,7 +75,7 @@ tab_tlg_ui <- function(id) { ) } -tab_tlg_server <- function(id, data) { +tab_tlg_server <- function(id, data, adpp = reactive(NULL)) { moduleServer(id, function(input, output, session) { log_trace("{session$ns(id)}: Attaching server.") @@ -232,7 +232,6 @@ tab_tlg_server <- function(id, data) { # Submit the TLG order, filter selected TLGs tlg_order_filtered <- reactive({ req(data()) - print(tlg_order()) tlg_order_filt <- tlg_order()[tlg_order()$Selection, ] log_debug("Submitted TLGs:\n", paste0("* ", tlg_order_filt$Description, collapse = "\n")) @@ -240,43 +239,80 @@ tab_tlg_server <- function(id, data) { }) %>% bindEvent(c(input$submit_tlg_order)) - # Create and render Graph interface and modules - output$graphs <- renderUI({ - req(tlg_order_filtered()) - tlg_order_graphs <- filter(tlg_order_filtered(), Type == "Graph") %>% - select("id") %>% - pull() - - panels <- lapply(tlg_order_graphs, function(g_id) { - graph_ui <- { - g_def <- .TLG_DEFINITIONS[[g_id]] - module_id <- paste0( - g_id, - paste0(sample(c(letters, 0:9), 5, replace = TRUE), collapse = "") - ) + # Normalized ADNCA concentration data for graph/listing modules + conc_data <- reactive({ + req(data()) + filter_tlg_excluded(data()$conc$data) + }) - if (exists(g_def$fun)) { - tlg_module_server(module_id, data, "graph", get(g_def$fun), g_def$options) - tlg_module_ui(session$ns(module_id), "graph", g_def$options) - } else { - tags$div("Graph not implemented yet") + # ADPP with PPSUMFL-excluded rows removed (mirrors conc_data for ADNCA) + adpp_data <- reactive({ + validate(need( + !is.null(adpp()), + "ADPP data is not available. Run NCA first to view PK parameter outputs." + )) + filter_tlg_excluded(adpp()) + }) + + # Track which module IDs have already been registered for this session. + # tlg_module_server() calls Shiny's moduleServer(), which registers reactive + # observers (pagination buttons, entries-per-page, etc.) every time it is + # called. Because renderUI re-executes on re-submit, calling + # tlg_module_server() with the same ID a second time would accumulate + # duplicate observers that fire multiple times per user action. + # output$tlg_output is safely deduplicated by Shiny (second assignment + # destroys the first), but observers are not — only this environment prevents + # the duplication. The environment lives inside moduleServer(), so it is + # fresh per Shiny session and does not leak across sessions. + .registered_modules <- new.env(parent = emptyenv()) + + # Shared helper: build navset_pill_list panels for one TLG type. + # Factored out to eliminate the copy-paste across table / graph / listing + # renderUI blocks. `id_suffix` must be unique per type to produce + # deterministic, stable module IDs. + .build_tlg_panels <- function(g_ids, type, id_suffix) { + lapply(g_ids, function(g_id) { + g_def <- .TLG_DEFINITIONS[[g_id]] + module_id <- paste0(g_id, id_suffix) + tlg_data <- if (g_def$dataset == "ADPP") adpp_data else conc_data + + panel_ui <- if (exists(g_def$fun)) { + # Only register the Shiny module once per session to avoid accumulating + # duplicate pagination observers on re-submit. + if (!exists(module_id, envir = .registered_modules, inherits = FALSE)) { + tlg_module_server(module_id, tlg_data, type, get(g_def$fun), g_def$options) + assign(module_id, TRUE, envir = .registered_modules) } + tlg_module_ui(session$ns(module_id), type, g_def$options) + } else { + tags$div(paste(tools::toTitleCase(type), "not implemented yet")) } - nav_panel(g_def$label, graph_ui) + nav_panel(g_def$label, panel_ui) }) + } + # Create and render Table interface and modules + output$tables <- renderUI({ + req(tlg_order_filtered()) + ids <- filter(tlg_order_filtered(), Type == "Table") %>% pull("id") + panels <- .build_tlg_panels(ids, "table", "_tbl") panels$"widths" <- c(2, 10) + do.call(navset_pill_list, panels) + }) + # Create and render Graph interface and modules + output$graphs <- renderUI({ + req(tlg_order_filtered()) + ids <- filter(tlg_order_filtered(), Type == "Graph") %>% pull("id") + panels <- .build_tlg_panels(ids, "graph", "_grp") + panels$"widths" <- c(2, 10) do.call(navset_pill_list, panels) }) output$listings <- renderUI({ req(tlg_order_filtered()) - - tlg_order_listings <- filter(tlg_order_filtered(), Type == "Listing") %>% - select("id") %>% - pull() + ids <- filter(tlg_order_filtered(), Type == "Listing") %>% pull("id") if (!requireNamespace("rlistings", quietly = TRUE)) { panels <- list(nav_panel( @@ -288,28 +324,10 @@ tab_tlg_server <- function(id, data) { ) )) } else { - panels <- lapply(tlg_order_listings, function(g_id) { - list_ui <- { - g_def <- .TLG_DEFINITIONS[[g_id]] - module_id <- paste0( - g_id, - paste0(sample(c(letters, 0:9), 5, replace = TRUE), collapse = "") - ) - - if (exists(g_def$fun)) { - tlg_module_server(module_id, data, "listing", get(g_def$fun), g_def$options) - tlg_module_ui(session$ns(module_id), "listing", g_def$options) - } else { - tags$div("Listing not implemented yet") - } - } - - nav_panel(g_def$label, list_ui) - }) + panels <- .build_tlg_panels(ids, "listing", "_lst") } panels$"widths" <- c(2, 10) - do.call(navset_pill_list, panels) }) }) diff --git a/inst/shiny/modules/tab_tlg/tlg_module.R b/inst/shiny/modules/tab_tlg/tlg_module.R index 4a1f20030..8707d782d 100644 --- a/inst/shiny/modules/tab_tlg/tlg_module.R +++ b/inst/shiny/modules/tab_tlg/tlg_module.R @@ -8,17 +8,24 @@ #' To read more check out documentation for each function of the module and the contributing #' guidelines. -#' Filter out rows excluded from TLGs via PKSUM1F. -#' Rows with PKSUM1F == "Y" are removed. -#' @param data A data frame (typically conc$data). +#' Filter out rows excluded from TLGs. +#' +#' Removes rows flagged for exclusion from summary tables. +#' - ADNCA data: removes rows where `PKSUM1F == "Y"`. +#' - ADPP data: removes rows where `PPSUMFL == "Y"`. +#' Both flags are checked so the function works on either dataset. +#' +#' @param data A data frame (ADNCA or ADPP). #' @return The filtered data frame. #' @noRd filter_tlg_excluded <- function(data) { if ("PKSUM1F" %in% names(data)) { - data[data$PKSUM1F != "Y", , drop = FALSE] - } else { - data + data <- data[is.na(data$PKSUM1F) | data$PKSUM1F != "Y", , drop = FALSE] + } + if ("PPSUMFL" %in% names(data)) { + data <- data[is.na(data$PPSUMFL) | data$PPSUMFL != "Y", , drop = FALSE] } + data } #' Function generating UI for a TLG module. @@ -101,8 +108,9 @@ tlg_module_ui <- function(id, type, options) { shinycssloaders::withSpinner( switch( type, - graph = uiOutput(ns("tlg_output")), - listing = verbatimTextOutput(ns("tlg_output")) + graph = uiOutput(ns("tlg_output")), + listing = verbatimTextOutput(ns("tlg_output")), + table = uiOutput(ns("tlg_output")) ) ) ) @@ -116,12 +124,13 @@ tlg_module_ui <- function(id, type, options) { #' @param render_list function that renders the list of entries, actual implementation of the TLG #' @param options list of options to customize input parameters #' -tlg_module_server <- function(id, data, type, render_list, options = NULL) { +tlg_module_server <- function(id, data, type, render_list, options = NULL) { # nolint: cyclocomp_linter moduleServer(id, function(input, output, session) { render_fn <- switch( type, - "graph" = renderUI, - "listing" = renderPrint + "graph" = renderUI, + "listing" = renderPrint, + "table" = renderUI ) current_page <- reactiveVal(1) @@ -179,14 +188,12 @@ tlg_module_server <- function(id, data, type, render_list, options = NULL) { list_options <- purrr::keep(list_options, function(value) all(!value %in% c(NULL, "", 0, NA))) tryCatch({ - tlg_data <- filter_tlg_excluded(data()$conc$data) - do.call(render_list, purrr::list_modify(list(data = tlg_data), !!!list_options)) + do.call(render_list, purrr::list_modify(list(data = data()), !!!list_options)) }, error = function(e) { log_error("Error in list rendering:") print(e) - "Error: list rendering failed with current options. - Check the R console for more information." + paste0("Error: ", conditionMessage(e)) }) }) %>% debounce(750) @@ -199,7 +206,42 @@ tlg_module_server <- function(id, data, type, render_list, options = NULL) { page_start <- page_end - entries_per_page() + 1 if (page_end > num_plots) page_end <- num_plots - unname(tlg_list()[page_start:page_end]) + page_slice <- tlg_list()[page_start:page_end] + page_items <- unname(page_slice) + + if (type == "table") { + # Names carry the split key (e.g. "Drug A / PLASMA"); render them as a + # header above each table so stacked analyte/specimen tables are + # distinguishable. "all" is the sentinel used by split_and_apply() for + # un-split single tables and gets no header. + page_names <- names(page_slice) + purrr::imap(page_items, function(df, i) { + body <- if (!is.data.frame(df)) { + tags$pre(as.character(df)) + } else if (ncol(df) == 0) { + tags$p("No data available for this table.") + } else { + reactable::reactable(df, columns = define_cols(df, header_from_label = TRUE)) + } + nm <- page_names[i] + if (!is.null(nm) && nzchar(nm) && nm != "all") { + tagList(tags$h4(nm, class = "tlg-table-group-header"), body) + } else { + body + } + }) + } else if (type == "listing") { + for (item in page_items) print(item) + } else { + lapply(page_items, function(item) { + if (is.character(item)) return(tags$pre(item)) + if (inherits(item, c("gg", "ggplot"))) { + plotly::ggplotly(item) + } else { + item + } + }) + } }) options_values <- lapply(names(options), function(option) { diff --git a/inst/shiny/modules/tab_tlg/tlg_option_select.R b/inst/shiny/modules/tab_tlg/tlg_option_select.R index 7a45d9784..19a51b984 100644 --- a/inst/shiny/modules/tab_tlg/tlg_option_select.R +++ b/inst/shiny/modules/tab_tlg/tlg_option_select.R @@ -8,11 +8,12 @@ tlg_option_select_ui <- function(id, opt_def, data) { label <- if (is.null(opt_def$label)) sub(".*-(.*)", "\\1", id) else opt_def$label + conc_df <- if (is.data.frame(data())) data() else data()$conc$data choices <- { if (isTRUE(opt_def$choices == ".colnames")) { - names(data()$conc$data) + names(conc_df) } else if (length(opt_def$choices) == 1 && grepl("^\\$", opt_def$choices)) { - unique(data()$conc$data[, sub("^\\$", "", opt_def$choices)]) + unique(conc_df[, sub("^\\$", "", opt_def$choices)]) } else { opt_def$choices } diff --git a/inst/shiny/modules/tab_tlg/tlg_option_table.R b/inst/shiny/modules/tab_tlg/tlg_option_table.R index 7cb985587..c0792e27e 100644 --- a/inst/shiny/modules/tab_tlg/tlg_option_table.R +++ b/inst/shiny/modules/tab_tlg/tlg_option_table.R @@ -61,10 +61,11 @@ tlg_option_table_server <- function(id, opt_def, data, reset_trigger) { select = dropdown_extra( id = session$ns(colname), choices = { + conc_df <- if (is.data.frame(data())) data() else data()$conc$data if (isTRUE(def$choices == ".colnames")) { - names(data()$conc$data) + names(conc_df) } else if (length(def$choices) == 1 && grepl("^\\$", def$choices)) { - unique(data()$conc$data[, sub("^\\$", "", def$choices)]) + unique(conc_df[, sub("^\\$", "", def$choices)]) } else { def$choices } diff --git a/inst/shiny/tlg.yaml b/inst/shiny/tlg.yaml index 1b4009e05..d398cd75d 100644 --- a/inst/shiny/tlg.yaml +++ b/inst/shiny/tlg.yaml @@ -386,7 +386,7 @@ g_pkcg02_sbs: label: "pkcg02 - Combined Side-by-Side" description: "Side-by-Side Linear and Log scale plots of concentration vs. time (over laid by cohort/TRT/dose/patient/subject)" link: https://insightsengineering.github.io/tlg-catalog/stable/graphs/pharmacokinetic/pkcg02.html - fun: g_pkcg02_log + fun: g_pkcg02_sbs condition: null options: plotgroup_vars: diff --git a/man/g_pkcg01_sbs.Rd b/man/g_pkcg01_sbs.Rd new file mode 100644 index 000000000..6de8fe2d0 --- /dev/null +++ b/man/g_pkcg01_sbs.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkcg.R +\name{g_pkcg01_sbs} +\alias{g_pkcg01_sbs} +\title{Wrapper around aNCA::pkcg01() function. Calls the function with \code{SBS} scale argument.} +\usage{ +g_pkcg01_sbs(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the plotting function.} +} +\value{ +ggplot2 object for pkcg01. +} +\description{ +Wrapper around aNCA::pkcg01() function. Calls the function with \code{SBS} scale argument. +} diff --git a/man/g_pkcg02_sbs.Rd b/man/g_pkcg02_sbs.Rd new file mode 100644 index 000000000..3b7b14a35 --- /dev/null +++ b/man/g_pkcg02_sbs.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkcg.R +\name{g_pkcg02_sbs} +\alias{g_pkcg02_sbs} +\title{Wrapper around aNCA::pkcg02() function. Calls the function with \code{SBS} scale argument.} +\usage{ +g_pkcg02_sbs(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the plotting function.} +} +\value{ +ggplot2 object for pkcg02. +} +\description{ +Wrapper around aNCA::pkcg02() function. Calls the function with \code{SBS} scale argument. +} diff --git a/man/g_pkcg03_sbs.Rd b/man/g_pkcg03_sbs.Rd new file mode 100644 index 000000000..28c31f3e2 --- /dev/null +++ b/man/g_pkcg03_sbs.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkcg.R +\name{g_pkcg03_sbs} +\alias{g_pkcg03_sbs} +\title{Wrapper around aNCA::pkcg03() function. Calls the function with \code{SBS} scale argument.} +\usage{ +g_pkcg03_sbs(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the plotting function.} +} +\value{ +ggplot2 object for pkcg03. +} +\description{ +Wrapper around aNCA::pkcg03() function. Calls the function with \code{SBS} scale argument. +} diff --git a/man/l_pkcl01_tad.Rd b/man/l_pkcl01_tad.Rd new file mode 100644 index 000000000..dcb4e1126 --- /dev/null +++ b/man/l_pkcl01_tad.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/l_pkcl01.R +\name{l_pkcl01_tad} +\alias{l_pkcl01_tad} +\title{Wrapper around aNCA::l_pkcl01() for TAD-based concentration listings.} +\usage{ +l_pkcl01_tad(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the listing function.} + +\item{...}{Any other parameters to be passed into the listing function.} +} +\value{ +A named list of listing_df objects. +} +\description{ +Wrapper around aNCA::l_pkcl01() for TAD-based concentration listings. +} diff --git a/man/l_pkcl02_uri.Rd b/man/l_pkcl02_uri.Rd new file mode 100644 index 000000000..1946d1fc3 --- /dev/null +++ b/man/l_pkcl02_uri.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/l_pkcl01.R +\name{l_pkcl02_uri} +\alias{l_pkcl02_uri} +\title{Urine Concentration and Volume Listing (pkcl02)} +\usage{ +l_pkcl02_uri( + data, + urine_specs = c("URINE"), + listgroup_vars = c("PARAM", "PCSPEC"), + displaying_vars = NULL, + ... +) +} +\arguments{ +\item{data}{A CDISC ADNCA data frame (from \code{export_cdisc()$adnca}).} + +\item{urine_specs}{Character vector of specimen type values to keep, matched +case-insensitively against \code{PCSPEC}. Default: \code{c("URINE")}.} + +\item{listgroup_vars}{Character vector of columns used to split output into +separate listings. Default: \code{c("PARAM", "PCSPEC")}. When \code{PCSPEC} is +absent from \code{data}, it is silently removed from this vector.} + +\item{displaying_vars}{Character vector of columns to display. When \code{NULL} +(default), uses \code{c("NFRLT", "AFRLT", "AVAL")} plus \code{VOLUME}/\code{VOLUMEU} +if those columns exist in the data.} + +\item{...}{Additional arguments forwarded to \code{\link[=l_pkcl01]{l_pkcl01()}}.} +} +\value{ +A named list of \code{listing_df} objects. +} +\description{ +Filters ADNCA to urine specimen rows (where \code{PCSPEC \%in\% urine_specs}) then +delegates to \code{\link[=l_pkcl01]{l_pkcl01()}} with VOLUME and VOLUMEU added to the displayed +columns when those columns are present in the data. +} +\examples{ +\dontrun{ +adnca <- export_cdisc(res_nca)$adnca +listings <- l_pkcl02_uri(adnca) +print(listings[[1]]) +} + +} diff --git a/man/l_pkpl01.Rd b/man/l_pkpl01.Rd new file mode 100644 index 000000000..c1c2d0e03 --- /dev/null +++ b/man/l_pkpl01.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/l_pkpl01.R +\name{l_pkpl01} +\alias{l_pkpl01} +\alias{l_pkpl01_mp} +\title{Individual PK Parameters Listing (pkpl01)} +\usage{ +l_pkpl01( + data, + listgroup_vars = c("PPCAT", "PPSPEC"), + grouping_vars = c("TRT01A", "USUBJID"), + param_var = "PARAM", + value_var = "AVAL", + unit_var = "AVALU", + title = "Listing of Individual PK Parameters", + subtitle = NULL, + footnote = NULL +) + +l_pkpl01_mp(data, ...) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{listgroup_vars}{Character vector of columns used to split the output +into separate listings. Default: \code{c("PPCAT", "PPSPEC")}.} + +\item{grouping_vars}{Character vector of key/header columns within each +listing (shown as indented row keys). Default: \code{c("TRT01A", "USUBJID")}.} + +\item{param_var}{Column whose unique values become display columns after +pivoting wide. Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} + +\item{unit_var}{Column containing the parameter unit used to build column +headers (\code{" ()"}). Default: \code{"AVALU"}.} + +\item{title}{Main listing title string.} + +\item{subtitle}{Per-listing subtitle. Supports \verb{$VAR} / \code{!VAR} annotation +syntax. Defaults to the unique values of \code{listgroup_vars}.} + +\item{footnote}{Footnote string.} + +\item{...}{Additional arguments forwarded to \code{\link[=l_pkpl01]{l_pkpl01()}}.} +} +\value{ +A named list of \code{listing_df} objects (one per \code{listgroup_vars} +combination), suitable for printing in a Shiny \code{verbatimTextOutput}. +} +\description{ +Creates individual-level listings of PK parameters from ADPP data using the +same engine as \code{\link[=l_pkcl01]{l_pkcl01()}}. Returns one listing per unique combination of +\code{listgroup_vars} (default: \code{PPCAT} x \code{PPSPEC}). +} +\section{Functions}{ +\itemize{ +\item \code{l_pkpl01_mp()}: Listing filtered to metabolite rows (pkpl01 M/P). +Uses the same METABFL -> PPCAT -> PARAM fallback as \code{\link[=t_pkpt03_MP_col]{t_pkpt03_MP_col()}}. + +}} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +listings <- l_pkpl01(adpp) +print(listings[[1]]) +} + +} diff --git a/man/l_pkpl04_mp.Rd b/man/l_pkpl04_mp.Rd new file mode 100644 index 000000000..bce634ae8 --- /dev/null +++ b/man/l_pkpl04_mp.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/l_pkpl01.R +\name{l_pkpl04_mp} +\alias{l_pkpl04_mp} +\title{Individual Treatment Comparison Listing (pkpl04)} +\usage{ +l_pkpl04_mp( + data, + grouping_vars = c("PARAM", "TRT01A", "USUBJID"), + title = "Listing of Individual PK Parameter Values by Treatment", + ... +) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{grouping_vars}{Columns used to identify row keys before pivoting. +\code{PARAM} must be included so it is spread into display columns. +Default: \code{c("PARAM", "TRT01A", "USUBJID")}.} + +\item{title}{Main listing title string.} + +\item{...}{Additional arguments forwarded to \code{\link[=l_pkpl01]{l_pkpl01()}}.} +} +\value{ +A named list of \code{listing_df} objects. +} +\description{ +Produces a per-subject listing of individual PK parameter values organised +for treatment comparison. Each listing page covers one PPCAT/PPSPEC +combination. PK parameters become display columns (one column per PARAM value) +and the rows are keyed by \code{TRT01A} and \code{USUBJID}. +} +\details{ +This listing shows the raw individual \code{AVAL} values from ADPP, not +pre-computed ratios. If your ADPP contains NCA ratio parameters (e.g. +metabolite-to-parent AUC ratios added via the aNCA ratio-calculation +module), those parameters are displayed here just like any other PARAM row. +The \verb{_mp} suffix in the function name reflects its typical use with +metabolite/parent ratio parameters, but no metabolite filtering is applied -- +all PARAM values in the data are included. + +Note: \code{PARAM} is listed in \code{grouping_vars} so that it participates in the +\code{pivot_wider} step (each unique PARAM value becomes a column header). After +pivoting, \code{PARAM} is no longer a row-key column; the actual listing keys +are \code{TRT01A} and \code{USUBJID}. +} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +listings <- l_pkpl04_mp(adpp) +print(listings[[1]]) +} + +} diff --git a/man/p_pkcg03_lin_dose.Rd b/man/p_pkcg03_lin_dose.Rd new file mode 100644 index 000000000..412ca3a33 --- /dev/null +++ b/man/p_pkcg03_lin_dose.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkcg.R +\name{p_pkcg03_lin_dose} +\alias{p_pkcg03_lin_dose} +\title{Wrapper around aNCA::pkcg03() function. Mean linear plot grouped by dose.} +\usage{ +p_pkcg03_lin_dose(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the plotting function.} +} +\value{ +ggplot2 object for pkcg03. +} +\description{ +Wrapper around aNCA::pkcg03() function. Mean linear plot grouped by dose. +} diff --git a/man/p_pkcg03_log_dose.Rd b/man/p_pkcg03_log_dose.Rd new file mode 100644 index 000000000..a4d29d475 --- /dev/null +++ b/man/p_pkcg03_log_dose.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkcg.R +\name{p_pkcg03_log_dose} +\alias{p_pkcg03_log_dose} +\title{Wrapper around aNCA::pkcg03() function. Mean log plot grouped by dose.} +\usage{ +p_pkcg03_log_dose(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the plotting function.} +} +\value{ +ggplot2 object for pkcg03. +} +\description{ +Wrapper around aNCA::pkcg03() function. Mean log plot grouped by dose. +} diff --git a/man/p_pkcg03_sbs_dose.Rd b/man/p_pkcg03_sbs_dose.Rd new file mode 100644 index 000000000..d7f25a14e --- /dev/null +++ b/man/p_pkcg03_sbs_dose.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkcg.R +\name{p_pkcg03_sbs_dose} +\alias{p_pkcg03_sbs_dose} +\title{Wrapper around aNCA::pkcg03() function. Mean side-by-side plot grouped by dose.} +\usage{ +p_pkcg03_sbs_dose(data, ...) +} +\arguments{ +\item{data}{Data to be passed into the plotting function.} + +\item{...}{Any other parameters to be passed into the plotting function.} +} +\value{ +ggplot2 object for pkcg03. +} +\description{ +Wrapper around aNCA::pkcg03() function. Mean side-by-side plot grouped by dose. +} diff --git a/man/p_pkpg01_cum.Rd b/man/p_pkpg01_cum.Rd new file mode 100644 index 000000000..5af4566a4 --- /dev/null +++ b/man/p_pkpg01_cum.Rd @@ -0,0 +1,93 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkpg.R +\name{p_pkpg01_cum} +\alias{p_pkpg01_cum} +\alias{p_pkpg01_per} +\title{Mean Urine PK Parameter Profile Plot (pkpg01)} +\usage{ +p_pkpg01_cum( + data, + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL", + urine_specs = c("URINE"), + paramcd_filter = "RCAMINT", + time_end_var = "PPENINT", + list_vars = c("PPCAT"), + title = "Mean Cumulative Amount Recovered in Urine", + subtitle = NULL, + footnote = NULL, + xlab = NULL, + ylab = NULL +) + +p_pkpg01_per( + data, + paramcd_filter = "FREXINT", + title = "Mean Percentage of Dose Recovered in Urine", + ylab = "Percent Dose Recovered (\%)", + ... +) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{strat_var}{Column for treatment arm colour/grouping. Default: \code{"TRT01A"}.} + +\item{param_var}{Column whose unique values label each x-axis position. +Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} + +\item{urine_specs}{Character vector of \code{PPSPEC} values treated as urine, +matched case-insensitively. Default: \code{c("URINE")}.} + +\item{paramcd_filter}{Character vector of \code{PARAMCD} values to keep. Only +rows with a matching \code{PARAMCD} are plotted. Pass \code{NULL} to skip the +filter. Default: \code{"RCAMINT"} (cumulative amount recovered per interval).} + +\item{time_end_var}{Column containing the collection interval end time +(ISO 8601 duration string or numeric hours). Used as a numeric x-axis +when parseable; falls back to \code{param_var} labels otherwise. +Default: \code{"PPENINT"}.} + +\item{list_vars}{Columns used to split output into separate plots. +Default: \code{c("PPCAT")}.} + +\item{title}{Optional plot title.} + +\item{subtitle}{Optional plot subtitle.} + +\item{footnote}{Optional footnote / caption.} + +\item{xlab}{X-axis label. Default: \code{"Collection Interval"}.} + +\item{ylab}{Y-axis label. Defaults to the label attribute of \code{value_var}.} + +\item{...}{Additional arguments forwarded to \code{\link[=p_pkpg01_cum]{p_pkpg01_cum()}}.} +} +\value{ +A named list of ggplot objects. +} +\description{ +Computes mean (+/- SD) of a urine PK parameter per treatment arm across +collection intervals and draws a connected line plot. Designed for ADPP +data filtered to \code{PPSPEC \%in\% urine_specs} (e.g. cumulative amount excreted +or fraction of dose recovered). Returns one ggplot per unique combination +of \code{list_vars}. +} +\section{Functions}{ +\itemize{ +\item \code{p_pkpg01_per()}: Mean percentage of dose recovered in urine (pkpg01 \%). +Identical to \code{\link[=p_pkpg01_cum]{p_pkpg01_cum()}} but defaults to a \% dose recovered title and +y-axis label. + +}} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +plots <- p_pkpg01_cum(adpp) +plots[[1]] +} + +} diff --git a/man/p_pkpg02_doseprop.Rd b/man/p_pkpg02_doseprop.Rd new file mode 100644 index 000000000..60b6b93ad --- /dev/null +++ b/man/p_pkpg02_doseprop.Rd @@ -0,0 +1,68 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkpg.R +\name{p_pkpg02_doseprop} +\alias{p_pkpg02_doseprop} +\title{Dose-Proportionality Scatter Plot with Power-Model Regression (pkpg02)} +\usage{ +p_pkpg02_doseprop( + data, + dose_var = "DOSEA", + value_var = "AVAL", + param_var = "PARAM", + strat_var = "TRT01A", + list_vars = c("PPCAT", "PPSPEC"), + ci_level = 0.9, + log_scale = TRUE, + title = NULL, + subtitle = NULL, + footnote = NULL, + xlab = NULL, + ylab = NULL +) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{dose_var}{Column containing the administered dose. Default: \code{"DOSEA"}.} + +\item{value_var}{Column containing the PK parameter value. Default: \code{"AVAL"}.} + +\item{param_var}{Column used as facet variable. Default: \code{"PARAM"}.} + +\item{strat_var}{Column used for point colour. Default: \code{"TRT01A"}.} + +\item{list_vars}{Columns used to split output into separate plots. +Default: \code{c("PPCAT", "PPSPEC")}.} + +\item{ci_level}{Confidence level for the slope CI. Default: \code{0.90}.} + +\item{log_scale}{Logical. When \code{TRUE} (default), both axes are log10-scaled.} + +\item{title}{Optional plot title.} + +\item{subtitle}{Optional plot subtitle.} + +\item{footnote}{Optional footnote / caption.} + +\item{xlab}{X-axis label. Defaults to \code{dose_var} label + unit.} + +\item{ylab}{Y-axis label. Defaults to the label attribute of \code{value_var}.} +} +\value{ +A named list of ggplot objects. +} +\description{ +Plots individual AVAL values against dose (DOSEA) on a log-log scale with +one facet per PK parameter. A power-model regression line +(log y = a + b * log x) is overlaid on each facet together with the slope +estimate and its confidence interval, enabling visual assessment of +dose-proportionality (slope b = 1). +} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +plots <- p_pkpg02_doseprop(adpp) +plots[[1]] +} + +} diff --git a/man/p_pkpg03_boxp.Rd b/man/p_pkpg03_boxp.Rd new file mode 100644 index 000000000..5690d2509 --- /dev/null +++ b/man/p_pkpg03_boxp.Rd @@ -0,0 +1,70 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkpg.R +\name{p_pkpg03_boxp} +\alias{p_pkpg03_boxp} +\alias{p_pkpg04_boxp} +\title{Boxplot of Primary PK Parameters (pkpg03)} +\usage{ +p_pkpg03_boxp( + data, + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL", + list_vars = c("PPCAT", "PPSPEC"), + all_points = FALSE, + title = NULL, + subtitle = NULL, + footnote = NULL, + ylab = NULL +) + +p_pkpg04_boxp(data, ...) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{strat_var}{Column used for x-axis grouping (treatment arms). +Default: \code{"TRT01A"}.} + +\item{param_var}{Column whose unique values each become a separate plot. +Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} + +\item{list_vars}{Columns used to split output into separate plot pages. +Default: \code{c("PPCAT", "PPSPEC")}.} + +\item{all_points}{Logical. When \code{TRUE}, individual data points are overlaid +on the boxes (pkpg04 style). Default: \code{FALSE}.} + +\item{title}{Optional plot title string.} + +\item{subtitle}{Optional plot subtitle string.} + +\item{footnote}{Optional footnote string.} + +\item{ylab}{Y-axis label. Defaults to the label attribute of \code{value_var}.} + +\item{...}{Additional arguments forwarded to \code{\link[=p_pkpg03_boxp]{p_pkpg03_boxp()}}.} +} +\value{ +A named list of ggplot objects. +} +\description{ +Produces one boxplot per PK parameter with treatment arms on the x-axis. +Returns a named list of ggplot objects, one per \code{PPCAT} x \code{PPSPEC} +combination in the ADPP data. +} +\section{Functions}{ +\itemize{ +\item \code{p_pkpg04_boxp()}: Boxplot with all individual data points overlaid (pkpg04). + +}} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +plots <- p_pkpg03_boxp(adpp) +plots[[1]] +} + +} diff --git a/man/p_pkpg06_mp.Rd b/man/p_pkpg06_mp.Rd new file mode 100644 index 000000000..063020e29 --- /dev/null +++ b/man/p_pkpg06_mp.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/g_pkpg.R +\name{p_pkpg06_mp} +\alias{p_pkpg06_mp} +\title{Boxplot of Metabolite/Parent PK Parameter Ratios (pkpg06)} +\usage{ +p_pkpg06_mp(data, ...) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{...}{Additional arguments forwarded to \code{\link[=p_pkpg03_boxp]{p_pkpg03_boxp()}}.} +} +\value{ +A named list of ggplot objects (same format as \code{\link[=p_pkpg03_boxp]{p_pkpg03_boxp()}}). +} +\description{ +Filters ADPP to metabolite rows using the same fallback logic as +\code{\link[=t_pkpt03_MP_col]{t_pkpt03_MP_col()}} (METABFL preferred, then PPCAT/PARAM grep for "metab"), +then delegates to \code{\link[=p_pkpg03_boxp]{p_pkpg03_boxp()}}. +} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +plots <- p_pkpg06_mp(adpp) +plots[[1]] +} + +} diff --git a/man/t_pkct01.Rd b/man/t_pkct01.Rd new file mode 100644 index 000000000..e89aa35da --- /dev/null +++ b/man/t_pkct01.Rd @@ -0,0 +1,82 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/t_pkct01.R +\name{t_pkct01} +\alias{t_pkct01} +\alias{t_pkct01_dose} +\alias{t_pkct01_tad} +\alias{t_pkct01_dose_tad} +\title{Summary Concentration Table (pkct01)} +\usage{ +t_pkct01( + data, + list_vars = c("PARAM", "PCSPEC"), + strat_var = "TRT01A", + time_var = "NFRLT", + visit_var = "ATPTREF", + blq_var = "AVALC" +) + +t_pkct01_dose(data, ...) + +t_pkct01_tad(data, ...) + +t_pkct01_dose_tad(data, ...) +} +\arguments{ +\item{data}{A CDISC ADNCA data frame (from \code{export_cdisc()$adnca}).} + +\item{list_vars}{Character vector of columns used to split the output into +separate tables. Default: \code{c("PARAM", "PCSPEC")}.} + +\item{strat_var}{Column name used for treatment/dose stratification. +Default: \code{"TRT01A"}.} + +\item{time_var}{Column name for the nominal timepoint axis. +Default: \code{"NFRLT"} (nominal time from first dose).} + +\item{visit_var}{Column name for the visit/period reference label. +Default: \code{"ATPTREF"}.} + +\item{blq_var}{Column containing the character analysis value used to detect +BLQ records. Default: \code{"AVALC"}. Records where this column equals \code{"BLQ"} +are counted separately and excluded from numeric summaries. When \code{blq_var} +is absent (as in \code{export_cdisc()$adnca}, which does not include \code{AVALC}), +BLQ is detected via \code{AVAL == 0}, consistent with the package convention +for post-imputation BLQ encoding.} + +\item{...}{Additional arguments forwarded to \code{\link[=t_pkct01]{t_pkct01()}}.} +} +\value{ +A named list of data frames, one per unique combination of +\code{list_vars}. Each data frame contains columns for \code{strat_var}, +\code{visit_var}, \code{time_var}, and the statistics: +\code{n}, \code{n_blq}, \code{Mean}, \code{SD}, \code{CV_pct}, \code{Median}, \code{GeoMean}, \code{GeoCV_pct}, \code{Min}, \code{Max}. +} +\description{ +Summarizes PK concentration data by treatment/dose group and nominal timepoint. +Returns one data frame per analyte/specimen combination containing descriptive +statistics across subjects at each scheduled timepoint. +} +\details{ +BLQ values are excluded from all numeric statistics and counted in \code{n_blq}. +When \code{blq_var} is present, BLQ is identified as \code{df[[blq_var]] == "BLQ"}. +When \code{blq_var} is absent, \code{AVAL == 0} is used as the fallback BLQ indicator. +\code{GeoMean} is computed on positive \code{AVAL} values only. +} +\section{Functions}{ +\itemize{ +\item \code{t_pkct01_dose()}: Stratify by dose instead of treatment arm (first dose). + +\item \code{t_pkct01_tad()}: Summarize using time after dose (TAD) nominal time. + +\item \code{t_pkct01_dose_tad()}: Stratify by dose using TAD nominal time. + +}} +\examples{ +\dontrun{ +adnca <- export_cdisc(res_nca)$adnca +tables <- t_pkct01(adnca) +tables[[1]] +} + +} diff --git a/man/t_pkpt03_col.Rd b/man/t_pkpt03_col.Rd new file mode 100644 index 000000000..91d933978 --- /dev/null +++ b/man/t_pkpt03_col.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/t_pkpt.R +\name{t_pkpt03_col} +\alias{t_pkpt03_col} +\alias{t_pkpt03_MP_col} +\title{Summary PK Parameters Table -- statistics in columns (pkpt03)} +\usage{ +t_pkpt03_col( + data, + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) + +t_pkpt03_MP_col(data, ...) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{list_vars}{Character vector of columns used to split output into +separate tables. Default: \code{c("PPCAT")}. \code{AVISIT} is a conditional ADPP +column that is typically absent from \code{export_cdisc()$adpp}; it is silently +skipped when not present so there is no need to remove it manually, but +adding it only helps when your ADPP actually contains visit information.} + +\item{strat_var}{Column for treatment/dose stratification. Default: \code{"TRT01A"}.} + +\item{param_var}{Column containing parameter names shown as rows. +Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} + +\item{...}{Additional arguments forwarded to \code{\link[=t_pkpt03_col]{t_pkpt03_col()}}.} +} +\value{ +A named list of data frames, one per combination of \code{list_vars}. +Each data frame has columns: \code{strat_var}, \code{param_var}, \code{n}, \code{Mean}, \code{SD}, +\code{CV_pct}, \code{GeoMean}, \code{GeoCV_pct}, \code{Median}, \code{Min}, \code{Max}. +} +\description{ +Summarizes pharmacokinetic parameters from ADPP data. Returns one data frame +per analyte (PPCAT) combination with PK parameters as rows and descriptive +statistics as columns. +} +\section{Functions}{ +\itemize{ +\item \code{t_pkpt03_MP_col()}: Summary of metabolite-to-parent ratios (stats in columns). +Filters to metabolite rows using \code{METABFL} (preferred) or, when absent from ADPP, +falls back to rows where \code{PPCAT} or \code{PARAM} contains "metab" (case-insensitive). +\code{METABFL} is present in ADPP only when it was included as a grouping variable in +the NCA run. + +}} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +tables <- t_pkpt03_col(adpp) +tables[[1]] +} + +} diff --git a/man/t_pkpt07_norm.Rd b/man/t_pkpt07_norm.Rd new file mode 100644 index 000000000..a1b57a02f --- /dev/null +++ b/man/t_pkpt07_norm.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/t_pkpt.R +\name{t_pkpt07_norm} +\alias{t_pkpt07_norm} +\title{Mean Dose-Normalized PK Parameters Table (pkpt07)} +\usage{ +t_pkpt07_norm( + data, + paramcd_var = "PARAMCD", + paramcd_filter = c("CMAXD", "AUCLSTD", "AUCIFOD", "AUCTLSTD"), + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) +} +\arguments{ +\item{data}{A CDISC ADPP data frame (from \code{export_cdisc()$adpp}).} + +\item{paramcd_var}{Column containing parameter codes used to detect +dose-normalized parameters. Default: \code{"PARAMCD"}.} + +\item{paramcd_filter}{Character vector of CDISC dose-normalized PARAMCDs to +keep. Defaults to the standard codes used in this package: +\code{c("CMAXD", "AUCLSTD", "AUCIFOD", "AUCTLSTD")}. Pass \code{NULL} to fall +back to the regex \code{grepl("[A-Z0-9]D$", PARAMCD)} pattern, which keeps +any code whose last two characters are an uppercase letter/digit followed +by \code{D}.} + +\item{list_vars}{Character vector of columns used to split output into +separate tables. Default: \code{c("PPCAT")}. \code{AVISIT} is a conditional ADPP +column that is typically absent from \code{export_cdisc()$adpp}; it is silently +skipped when not present so there is no need to remove it manually, but +adding it only helps when your ADPP actually contains visit information.} + +\item{strat_var}{Column for treatment/dose stratification. Default: \code{"TRT01A"}.} + +\item{param_var}{Column containing parameter names shown as rows. +Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} +} +\value{ +Named list of data frames (same format as \code{\link[=t_pkpt03_col]{t_pkpt03_col()}}). +} +\description{ +Filters ADPP to dose-normalized parameters and summarizes them with the +same column layout as \code{\link[=t_pkpt03_col]{t_pkpt03_col()}}. These parameters must have been +computed during the NCA run -- they are not derived on the fly. +} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +tables <- t_pkpt07_norm(adpp) +# Include a custom dose-normalized code: +tables <- t_pkpt07_norm(adpp, paramcd_filter = c("CMAXD", "AUCLSTD", "MYPARAMD")) +} + +} diff --git a/man/t_pkpt08_uri.Rd b/man/t_pkpt08_uri.Rd new file mode 100644 index 000000000..efb855097 --- /dev/null +++ b/man/t_pkpt08_uri.Rd @@ -0,0 +1,55 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/t_pkpt.R +\name{t_pkpt08_uri} +\alias{t_pkpt08_uri} +\title{Mean Urine Amount and Percent Recovered Table (pkpt08)} +\usage{ +t_pkpt08_uri( + data, + urine_specs = c("URINE"), + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) +} +\arguments{ +\item{data}{A CDISC ADPP data frame. Urine records are identified by +\code{PPSPEC \%in\% urine_specs}.} + +\item{urine_specs}{Character vector of specimen types considered urine, +matched case-insensitively. Default: \code{c("URINE")}.} + +\item{list_vars}{Character vector of columns used to split output into +separate tables. Default: \code{c("PPCAT")}. \code{AVISIT} is a conditional ADPP +column that is typically absent from \code{export_cdisc()$adpp}; it is silently +skipped when not present so there is no need to remove it manually, but +adding it only helps when your ADPP actually contains visit information.} + +\item{strat_var}{Column for treatment/dose stratification. Default: \code{"TRT01A"}.} + +\item{param_var}{Column containing parameter names shown as rows. +Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} +} +\value{ +Named list of data frames with columns: \code{strat_var}, \code{param_var}, +\code{n}, \code{Mean}, \code{SD}, \code{CV_pct}, \code{Median}, \code{Min}, \code{Max}. +Use \code{\link[=t_pkpt03_col]{t_pkpt03_col()}} instead if geometric mean statistics are needed. +} +\description{ +Filters ADPP to urine specimen records and summarizes cumulative amount +excreted (Ae) and percentage of dose recovered (Fe\%) with descriptive +statistics in columns. Per the TLG catalog specification for pkpt08, +the summary includes n, Mean, SD, CV\%, Median, Min, Max -- without +geometric mean or geometric CV\% (those are omitted because urine recovery +parameters are not log-normally distributed by convention). +} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +tables <- t_pkpt08_uri(adpp) +} + +} diff --git a/man/t_pkpt11_gmr.Rd b/man/t_pkpt11_gmr.Rd new file mode 100644 index 000000000..77712f118 --- /dev/null +++ b/man/t_pkpt11_gmr.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/t_pkpt.R +\name{t_pkpt11_gmr} +\alias{t_pkpt11_gmr} +\title{GMR Table with Confidence Intervals (pkpt11)} +\usage{ +t_pkpt11_gmr( + data, + ref_arm = NULL, + ci_level = 0.9, + list_vars = c("PPCAT"), + strat_var = "TRT01A", + param_var = "PARAM", + value_var = "AVAL" +) +} +\arguments{ +\item{data}{A CDISC ADPP data frame.} + +\item{ref_arm}{Character string identifying the reference treatment arm in +\code{strat_var}. If \code{NULL} (default), the first arm in sorted order is used.} + +\item{ci_level}{Confidence level for the geometric mean ratio CI. +Default: \code{0.90}.} + +\item{list_vars}{Character vector of columns used to split output into +separate tables. Default: \code{c("PPCAT")}. \code{AVISIT} is a conditional ADPP +column that is typically absent from \code{export_cdisc()$adpp}; it is silently +skipped when not present so there is no need to remove it manually, but +adding it only helps when your ADPP actually contains visit information.} + +\item{strat_var}{Column for treatment/dose stratification. Default: \code{"TRT01A"}.} + +\item{param_var}{Column containing parameter names shown as rows. +Default: \code{"PARAM"}.} + +\item{value_var}{Column containing the numeric analysis value. Default: \code{"AVAL"}.} +} +\value{ +Named list of data frames, one per combination of \code{list_vars}. +Each data frame has columns: \code{strat_var}, \code{param_var}, \code{n_ref}, \code{n_trt}, +\code{GMR}, \code{CI_lower}, \code{CI_upper}. +} +\description{ +Computes geometric mean ratios (GMR) with 90\% confidence intervals for +selected PK parameters, comparing each treatment arm to a reference arm. +} +\details{ +The confidence interval is computed on the log scale using a two-sample +t-test approach: \verb{exp(log_ratio +/- t * SE)} where SE is derived from the +pooled within-group standard deviations on the log scale. +} +\examples{ +\dontrun{ +adpp <- export_cdisc(res_nca)$adpp +tables <- t_pkpt11_gmr(adpp, ref_arm = "Placebo") +} + +} diff --git a/tests/testthat/test-export_cdisc.R b/tests/testthat/test-export_cdisc.R index 0b4f7907e..ac90051f8 100644 --- a/tests/testthat/test-export_cdisc.R +++ b/tests/testthat/test-export_cdisc.R @@ -84,7 +84,8 @@ describe("export_cdisc", { result <- export_cdisc(test_pknca_res) adpp <- result$adpp expect_s3_class(adpp, "data.frame") - expect_true(all(names(adpp) %in% CDISC_COLS$ADPP$Variable)) + allowed_cols <- c(CDISC_COLS$ADPP$Variable, "DOSEA", "DOSEU") + expect_true(all(names(adpp) %in% allowed_cols)) expect_equal(nrow(adpp), 12) expect_equal( unname(formatters::var_labels(adpp)), diff --git a/tests/testthat/test-g_pkpg.R b/tests/testthat/test-g_pkpg.R new file mode 100644 index 000000000..362d719fc --- /dev/null +++ b/tests/testthat/test-g_pkpg.R @@ -0,0 +1,363 @@ +# Shared fixture: minimal ADPP-like data frame +pkpg_data <- data.frame( + USUBJID = rep(paste0("S", 1:6), each = 2), + TRT01A = rep(c("10mg", "10mg", "10mg", "50mg", "50mg", "50mg"), each = 2), + PARAM = rep(c("Cmax", "AUClast"), 6), + PARAMCD = rep(c("CMAX", "AUCLST"), 6), + AVAL = c(5, 20, 6, 22, 7, 21, 10, 40, 11, 38, 9, 42), + AVALU = "ng/mL", + PPCAT = "DrugA Plasma", + PPSPEC = "SERUM", + METABFL = NA_character_, + stringsAsFactors = FALSE +) + +pkpg_metab_data <- pkpg_data +pkpg_metab_data$PPCAT <- ifelse( + pkpg_metab_data$TRT01A == "50mg", "Metab-DrugA Plasma", "DrugA Plasma" +) +pkpg_metab_data$METABFL <- ifelse( + pkpg_metab_data$TRT01A == "50mg", "Y", NA_character_ +) + +describe("p_pkpg03_boxp", { + it("returns a named list of ggplot objects", { + result <- p_pkpg03_boxp(pkpg_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("splits output by PPCAT/PPSPEC when present", { + result <- p_pkpg03_boxp(pkpg_data) + expect_equal(length(result), 1) + expect_true(grepl("DrugA Plasma", names(result)[1])) + }) + + it("produces one entry per PPCAT/PPSPEC combination", { + two_cats <- rbind( + pkpg_data, + transform(pkpg_data, PPCAT = "DrugB Plasma") + ) + result <- p_pkpg03_boxp(two_cats) + expect_equal(length(result), 2) + }) + + it("returns list with 'all' when list_vars absent from data", { + data_bare <- pkpg_data[, setdiff(names(pkpg_data), c("PPCAT", "PPSPEC"))] + result <- p_pkpg03_boxp(data_bare) + expect_equal(names(result), "all") + }) + + it("stops with informative error when required columns are missing", { + bad <- pkpg_data[, setdiff(names(pkpg_data), "AVAL")] + expect_error(p_pkpg03_boxp(bad), "missing required columns") + }) + + it("returns empty list when all AVAL values are NA", { + data_na <- pkpg_data + data_na$AVAL <- NA_real_ + result <- p_pkpg03_boxp(data_na) + expect_equal(length(result), 0) + }) + + it("uses facets — one panel per PARAM value", { + result <- p_pkpg03_boxp(pkpg_data)[[1]] + facet_vars <- as.character(result$facet$params$facets) + expect_true(any(grepl("PARAM", facet_vars))) + }) + + it("does not overlay individual points when all_points = FALSE", { + result <- p_pkpg03_boxp(pkpg_data, all_points = FALSE)[[1]] + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_false(any(layer_classes == "GeomJitter")) + }) +}) + +describe("p_pkpg04_boxp", { + it("returns ggplot objects like p_pkpg03_boxp", { + result <- p_pkpg04_boxp(pkpg_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("overlays individual jitter points (all_points = TRUE)", { + result <- p_pkpg04_boxp(pkpg_data)[[1]] + # geom_jitter registers as "GeomPoint" internally + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_true(any(layer_classes == "GeomPoint")) + }) + + it("suppresses boxplot outlier points when all_points = TRUE", { + result <- p_pkpg04_boxp(pkpg_data)[[1]] + box_layer <- result$layers[[ + which(sapply(result$layers, function(l) class(l$geom)[1]) == "GeomBoxplot") + ]] + expect_true(is.na(box_layer$geom_params$outlier_gp$shape)) + }) +}) + +describe("p_pkpg06_mp", { + it("filters to metabolite rows using METABFL (preferred path)", { + result <- p_pkpg06_mp(pkpg_metab_data) + # Only metabolite arm rows reach the plot — check it returns a ggplot + expect_s3_class(result[[1]], "ggplot") + # Plot data should only contain metabolite arm (50mg) + plot_df <- result[[1]]$data + expect_true(all(plot_df$TRT01A == "50mg")) + }) + + it("falls back to PPCAT grep when METABFL absent", { + data_ppcat <- pkpg_data + data_ppcat$PPCAT <- ifelse( + data_ppcat$TRT01A == "50mg", "Metab-DrugA", "DrugA" + ) + data_ppcat <- data_ppcat[, setdiff(names(data_ppcat), "METABFL")] + result <- p_pkpg06_mp(data_ppcat) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("falls back to PARAM grep when METABFL and PPCAT absent", { + data_param <- pkpg_data + data_param$PARAM <- ifelse(data_param$TRT01A == "50mg", + paste0("Metab-", data_param$PARAM), + data_param$PARAM) + data_param <- data_param[, setdiff(names(data_param), c("METABFL", "PPCAT"))] # nolint + result <- p_pkpg06_mp(data_param) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("stops with informative error when no metabolite data found", { + data_no_metab <- pkpg_data[, setdiff(names(pkpg_data), "METABFL")] + expect_error(p_pkpg06_mp(data_no_metab), "no metabolite data found") + }) +}) + +# --- p_pkpg01_cum / p_pkpg01_per fixtures ----------------------------------- + +pkpg01_data <- data.frame( + USUBJID = rep(paste0("S", 1:4), each = 3), + TRT01A = rep(c("10mg", "10mg", "50mg", "50mg"), each = 3), + PARAM = rep(c("Ae 0-2h", "Ae 0-4h", "Ae 0-8h"), 4), + PARAMCD = rep("RCAMINT", 12), + AVAL = c(10, 25, 40, 12, 28, 42, 20, 45, 70, 22, 48, 72), + AVALU = "mg", + PPCAT = "DrugA", + PPSPEC = "URINE", + stringsAsFactors = FALSE +) + +pkpg01_per_data <- data.frame( + USUBJID = rep(paste0("S", 1:4), each = 3), + TRT01A = rep(c("10mg", "10mg", "50mg", "50mg"), each = 3), + PARAM = rep(c("Fe 0-2h", "Fe 0-4h", "Fe 0-8h"), 4), + PARAMCD = rep("FREXINT", 12), + AVAL = c(5, 12, 20, 6, 14, 21, 10, 22, 35, 11, 24, 36), + AVALU = "fraction", + PPCAT = "DrugA", + PPSPEC = "URINE", + stringsAsFactors = FALSE +) + +describe("p_pkpg01_cum", { + it("returns a named list of ggplot objects", { + result <- p_pkpg01_cum(pkpg01_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("returns empty list when no urine rows found", { + data_serum <- pkpg01_data + data_serum$PPSPEC <- "SERUM" + expect_equal(length(p_pkpg01_cum(data_serum)), 0) + }) + + it("returns empty list when all AVAL values are NA", { + data_na <- pkpg01_data + data_na$AVAL <- NA_real_ + expect_equal(length(p_pkpg01_cum(data_na)), 0) + }) + + it("stops with informative error when required columns are missing", { + bad <- pkpg01_data[, setdiff(names(pkpg01_data), "AVAL")] + expect_error(p_pkpg01_cum(bad), "missing required columns") + }) + + it("has line and point geoms", { + result <- p_pkpg01_cum(pkpg01_data)[[1]] + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_true(any(layer_classes == "GeomLine")) + expect_true(any(layer_classes == "GeomPoint")) + }) + + it("has error bar geom", { + result <- p_pkpg01_cum(pkpg01_data)[[1]] + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_true(any(layer_classes == "GeomErrorbar")) + }) + + it("splits by list_vars into one entry per combination", { + two_cats <- rbind( + pkpg01_data, + transform(pkpg01_data, PPCAT = "DrugB") + ) + result <- p_pkpg01_cum(two_cats) + expect_equal(length(result), 2) + }) + + it("returns single 'all' entry when list_vars absent from data", { + data_bare <- pkpg01_data[, setdiff(names(pkpg01_data), c("PPCAT", "PPSPEC"))] + result <- suppressWarnings(p_pkpg01_cum(data_bare)) + expect_equal(names(result), "all") + }) + + it("warns when PPSPEC column is absent and skips the urine filter", { + data_no_ppspec <- pkpg01_data[, setdiff(names(pkpg01_data), "PPSPEC")] + expect_warning( + p_pkpg01_cum(data_no_ppspec), + "PPSPEC.*not found" + ) + }) + + it("filters to RCAMINT params, not FREXINT", { + combined <- rbind(pkpg01_data, pkpg01_per_data) + result <- p_pkpg01_cum(combined)[[1]] + x_vals <- as.character(result$data$PARAM) + expect_true(all(grepl("^Ae", x_vals))) + }) + + it("skips PARAMCD filter when PARAMCD column absent", { + data_no_pcd <- pkpg01_data[, setdiff(names(pkpg01_data), "PARAMCD")] + result <- p_pkpg01_cum(data_no_pcd) + expect_equal(length(result), 1) + }) + + it("warns and returns empty list when paramcd_filter matches no rows", { + expect_warning( + result <- p_pkpg01_cum(pkpg01_data, paramcd_filter = "NONEXISTENT"), + "no rows matched paramcd_filter" + ) + expect_equal(length(result), 0) + }) +}) + +describe("p_pkpg01_per", { + it("returns ggplot objects (delegates to p_pkpg01_cum)", { + result <- p_pkpg01_per(pkpg01_per_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("uses percent recovered title by default", { + result <- p_pkpg01_per(pkpg01_per_data)[[1]] + expect_true(grepl("Percent", result$labels$title, ignore.case = TRUE)) + }) + + it("filters to FREXINT params, not RCAMINT", { + combined <- rbind(pkpg01_data, pkpg01_per_data) + result <- p_pkpg01_per(combined)[[1]] + x_vals <- as.character(result$data$PARAM) + expect_true(all(grepl("^Fe", x_vals))) + }) + + it("warns and returns empty list when only RCAMINT rows present (no FREXINT)", { + expect_warning( + result <- p_pkpg01_per(pkpg01_data), + "no rows matched paramcd_filter" + ) + expect_equal(length(result), 0) + }) +}) + +# --- p_pkpg02_doseprop fixtures --------------------------------------------- + +pkpg02_data <- data.frame( + USUBJID = rep(paste0("S", 1:6), each = 2), + TRT01A = rep(c("5mg", "5mg", "10mg", "10mg", "20mg", "20mg"), each = 2), + DOSEA = rep(c(5, 5, 10, 10, 20, 20), each = 2), + DOSEU = "mg", + PARAM = rep(c("Cmax", "AUClast"), 6), + PARAMCD = rep(c("CMAX", "AUCLST"), 6), + AVAL = c(5, 20, 9.8, 39, 20, 78, 5.2, 21, 10.1, 41, 19.8, 77), + AVALU = "ng/mL", + PPCAT = "DrugA Plasma", + PPSPEC = "SERUM", + stringsAsFactors = FALSE +) + +describe("p_pkpg02_doseprop", { + it("returns a named list of ggplot objects", { + result <- p_pkpg02_doseprop(pkpg02_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "ggplot")) + }) + + it("stops with informative error when required columns are missing", { + bad <- pkpg02_data[, setdiff(names(pkpg02_data), "DOSEA")] + expect_error(p_pkpg02_doseprop(bad), "missing required columns") + }) + + it("returns empty list when all values are non-positive", { + data_zero <- pkpg02_data + data_zero$AVAL <- -1 + expect_equal(length(p_pkpg02_doseprop(data_zero)), 0) + }) + + it("uses facets — one panel per PARAM value", { + result <- p_pkpg02_doseprop(pkpg02_data)[[1]] + facet_vars <- as.character(result$facet$params$facets) + expect_true(any(grepl("PARAM", facet_vars))) + }) + + it("has a scatter (point) layer", { + result <- p_pkpg02_doseprop(pkpg02_data)[[1]] + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_true(any(layer_classes == "GeomPoint")) + }) + + it("adds regression line layer when enough data points exist", { + result <- p_pkpg02_doseprop(pkpg02_data)[[1]] + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_true(any(layer_classes == "GeomLine")) + }) + + it("adds slope annotation (GeomText) per facet", { + result <- p_pkpg02_doseprop(pkpg02_data)[[1]] + layer_classes <- sapply(result$layers, function(l) class(l$geom)[1]) + expect_true(any(layer_classes == "GeomText")) + }) + + it("annotation x-coordinate is finite when log_scale = TRUE (default)", { + # Regression: -Inf mapped through log10() becomes NaN/NA, causing geom_text + # to silently drop the annotation row. Ensure the data passed to the + # GeomText layer has a finite x-coordinate so the label is always rendered. + result <- p_pkpg02_doseprop(pkpg02_data)[[1]] + geom_text_idx <- sapply(result$layers, function(l) inherits(l$geom, "GeomText")) + text_layer <- result$layers[geom_text_idx][[1]] + annot_data <- text_layer$data + expect_true(all(is.finite(annot_data[["DOSEA"]])), + info = "annotation DOSEA (x-anchor) must be finite for log10 scale to render it") + }) + + it("applies log10 scales when log_scale = TRUE (default)", { + result <- p_pkpg02_doseprop(pkpg02_data)[[1]] + trans_names <- sapply(result$scales$scales, function(s) s$trans$name) + expect_true(any(trans_names == "log-10")) + }) + + it("does not apply log scales when log_scale = FALSE", { + result <- p_pkpg02_doseprop(pkpg02_data, log_scale = FALSE)[[1]] + trans_names <- sapply(result$scales$scales, function(s) s$trans$name) + expect_false(any(trans_names == "log-10")) + }) + + it("splits by list_vars into one entry per PPCAT/PPSPEC combination", { + two_specs <- rbind( + pkpg02_data, + transform(pkpg02_data, PPSPEC = "URINE") + ) + result <- p_pkpg02_doseprop(two_specs) + expect_equal(length(result), 2) + }) +}) diff --git a/tests/testthat/test-l_pkcl01.R b/tests/testthat/test-l_pkcl01.R index 62fcb7a20..4504d0c50 100644 --- a/tests/testthat/test-l_pkcl01.R +++ b/tests/testthat/test-l_pkcl01.R @@ -253,3 +253,80 @@ describe("l_pkcl01", { }) }) + +# --- l_pkcl02_uri ----------------------------------------------------------- + +uri_data <- data.frame( + PARAM = rep("DrugA", 4), + PCSPEC = rep(c("URINE", "SERUM"), each = 2), + TRT01A = rep(c("10mg", "50mg"), 2), + USUBJID = c("S1", "S2", "S3", "S4"), + ATPTREF = "DOSE 1", + NFRLT = c(0, 2, 0, 2), + AFRLT = c(0.1, 2.1, 0.1, 2.1), + AVAL = c(1.2, 3.4, 5.6, 7.8), + AVALU = "mg/mL", + VOLUME = c(100, 120, 110, 130), + VOLUMEU = "mL", + stringsAsFactors = FALSE +) + +describe("l_pkcl02_uri", { + skip_if_not_installed("rlistings") + + it("returns a named list of listing_df objects", { + result <- l_pkcl02_uri(uri_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("filters to URINE rows only", { + result <- l_pkcl02_uri(uri_data) + listing_df <- result[[1]] + expect_equal(nrow(listing_df), 2) + }) + + it("matches urine specimens case-insensitively", { + # Lowercase 'urine' must still be kept even though the default spec is + # 'URINE' (CDISC); non-urine rows are dropped. + mixed <- uri_data + mixed$PCSPEC <- c("urine", "urine", "SERUM", "serum") + result <- l_pkcl02_uri(mixed) + expect_equal(sum(purrr::map_int(result, nrow)), 2L) + }) + + it("includes VOLUME and VOLUMEU in displaying_vars by default", { + result <- l_pkcl02_uri(uri_data)[[1]] + expect_true("VOLUME" %in% names(result)) + }) + + it("does not include VOLUME when column is absent from data", { + data_no_vol <- uri_data[, setdiff(names(uri_data), c("VOLUME", "VOLUMEU"))] + result <- l_pkcl02_uri(data_no_vol)[[1]] + expect_false("VOLUME" %in% names(result)) + }) + + it("stops with informative error when no urine rows found", { + data_serum <- uri_data[uri_data$PCSPEC == "SERUM", , drop = FALSE] + expect_error(l_pkcl02_uri(data_serum), "no urine concentration data found") + }) + + it("accepts custom displaying_vars", { + result <- l_pkcl02_uri(uri_data, displaying_vars = c("NFRLT", "AVAL")) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("passes through ... to l_pkcl01 (e.g. custom footnote)", { + result <- l_pkcl02_uri(uri_data, footnote = "test footnote") + expect_type(result, "list") + }) + + it("warns when PCSPEC column is absent and skips the urine filter", { + data_no_pcspec <- uri_data[, setdiff(names(uri_data), "PCSPEC"), drop = FALSE] + expect_warning( + l_pkcl02_uri(data_no_pcspec), + "PCSPEC.*column not found" + ) + }) +}) diff --git a/tests/testthat/test-l_pkpl01.R b/tests/testthat/test-l_pkpl01.R new file mode 100644 index 000000000..98bc5527f --- /dev/null +++ b/tests/testthat/test-l_pkpl01.R @@ -0,0 +1,148 @@ +# Shared fixture: minimal ADPP-like data frame +pkpl_data <- data.frame( + USUBJID = rep(paste0("S", 1:4), each = 2), + TRT01A = rep(c("10mg", "10mg", "50mg", "50mg"), each = 2), + PARAM = rep(c("Cmax", "AUClast"), 4), + PARAMCD = rep(c("CMAX", "AUCLST"), 4), + AVAL = c(5, 20, 6, 22, 10, 40, 11, 38), + AVALU = rep(c("ng/mL", "ng/mL*h"), 4), + PPCAT = "DrugA Plasma", + PPSPEC = "SERUM", + METABFL = NA_character_, + stringsAsFactors = FALSE +) + +pkpl_metab_data <- pkpl_data +pkpl_metab_data$PPCAT <- ifelse( + pkpl_metab_data$TRT01A == "50mg", "Metab-DrugA Plasma", "DrugA Plasma" +) +pkpl_metab_data$METABFL <- ifelse( + pkpl_metab_data$TRT01A == "50mg", "Y", NA_character_ +) + +describe("l_pkpl01 (rlistings not installed)", { + it("stops with informative error when rlistings is unavailable", { + testthat::with_mocked_bindings( + requireNamespace = function(pkg, quietly = FALSE) { + if (pkg == "rlistings") FALSE else TRUE + }, + .package = "base", + code = { + expect_error(l_pkpl01(pkpl_data), "Package 'rlistings' is required") + } + ) + }) +}) + +describe("l_pkpl01", { + it("returns a named list", { + result <- l_pkpl01(pkpl_data) + expect_type(result, "list") + expect_true(length(result) >= 1) + }) + + it("each element is a listing_df", { + result <- l_pkpl01(pkpl_data) + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("splits by PPCAT/PPSPEC — one entry per combination", { + two_cats <- rbind( + pkpl_data, + transform(pkpl_data, PPCAT = "DrugB Plasma") + ) + result <- l_pkpl01(two_cats) + expect_equal(length(result), 2) + }) + + it("stops with informative error when required columns are missing", { + bad <- pkpl_data[, setdiff(names(pkpl_data), "AVAL")] + expect_error(l_pkpl01(bad), "missing required columns") + }) + + it("pivots PARAM to columns — each unique PARAM becomes a column", { + result <- l_pkpl01(pkpl_data)[[1]] + expect_true("Cmax" %in% names(result) || "AUClast" %in% names(result)) + expect_false("PARAM" %in% names(result)) + }) + + it("uses custom grouping_vars", { + result <- l_pkpl01(pkpl_data, grouping_vars = c("TRT01A")) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("handles multi-interval ADPP (duplicate PARAM rows per subject) without error", { + # Simulate ADPP with two dose intervals: same USUBJID+PARAM appears twice + dup_data <- rbind(pkpl_data, pkpl_data) + dup_data$AVAL <- dup_data$AVAL + runif(nrow(dup_data), 0, 1) + # pivot_wider must not produce list-columns; values_fn = first deduplicates + expect_no_error({ + result <- l_pkpl01(dup_data) + }) + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) +}) + +describe("l_pkpl01_mp", { + it("filters to metabolite rows via METABFL (preferred path)", { + result <- l_pkpl01_mp(pkpl_metab_data) + # Only Metab-DrugA rows — listing name contains "Metab" + expect_true(all(grepl("Metab", names(result), ignore.case = TRUE))) + }) + + it("falls back to PPCAT grep when METABFL absent", { + data_ppcat <- pkpl_data + data_ppcat$PPCAT <- ifelse( + data_ppcat$TRT01A == "50mg", "Metab-DrugA", "DrugA" + ) + data_ppcat <- data_ppcat[, setdiff(names(data_ppcat), "METABFL")] + result <- l_pkpl01_mp(data_ppcat) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("falls back to PARAM grep when METABFL and PPCAT absent", { + data_param <- pkpl_data + data_param$PARAM <- ifelse( + data_param$TRT01A == "50mg", + paste0("Metab-", data_param$PARAM), + data_param$PARAM + ) + data_param <- data_param[, + setdiff(names(data_param), c("METABFL", "PPCAT")) + ] + result <- l_pkpl01_mp(data_param) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("stops with informative error when no metabolite data found", { + data_no_metab <- pkpl_data[, setdiff(names(pkpl_data), "METABFL")] + expect_error(l_pkpl01_mp(data_no_metab), "no metabolite data found") + }) +}) + +describe("l_pkpl04_mp", { + it("returns a named list of listing_df objects", { + result <- l_pkpl04_mp(pkpl_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "listing_df")) + }) + + it("has PARAM as a key (grouping) column", { + result <- l_pkpl04_mp(pkpl_data)[[1]] + # l_pkpl04_mp has PARAM in grouping_vars so it appears in the listing + expect_true(length(result) > 0) + expect_s3_class(result, "listing_df") + }) + + it("splits by PPCAT/PPSPEC — consistent with l_pkpl01", { + two_specs <- rbind( + pkpl_data, + transform(pkpl_data, PPSPEC = "URINE") + ) + result <- l_pkpl04_mp(two_specs) + expect_equal(length(result), 2) + }) +}) diff --git a/tests/testthat/test-reactable.R b/tests/testthat/test-reactable.R new file mode 100644 index 000000000..c06d18dd4 --- /dev/null +++ b/tests/testthat/test-reactable.R @@ -0,0 +1,41 @@ +# Source the common reactable module to test the pure define_cols() helper. +local({ + library(shiny) + shiny_dir <- system.file("shiny", package = "aNCA") + source( + file.path(shiny_dir, "modules", "common", "reactable.R"), + local = TRUE + ) +}, +envir = parent.env(environment())) + +describe("define_cols", { + labelled_df <- function() { + df <- data.frame(GeoMean = 1.0, stringsAsFactors = FALSE) + attr(df$GeoMean, "label") <- "Geometric Mean" + df + } + + it("uses the label as the header and the column name as tooltip when header_from_label = TRUE", { + defs <- define_cols(labelled_df(), header_from_label = TRUE) + header <- as.character(defs$GeoMean$header) + expect_match(header, "Geometric Mean") # visible header = label + expect_match(header, 'title="GeoMean"') # raw name demoted to tooltip + }) + + it("keeps the column name as the header by default (unchanged app behaviour)", { + defs <- define_cols(labelled_df(), header_from_label = FALSE) + header <- as.character(defs$GeoMean$header) + expect_match(header, ">GeoMean<") # visible header = column name + expect_match(header, 'title="Geometric Mean"') # label is the tooltip + }) + + it("falls back to the column name when a column has no label", { + defs <- define_cols(data.frame(x = 1:3), header_from_label = TRUE) + expect_equal(defs$x$name, "x") + }) + + it("returns NULL for NULL input", { + expect_null(define_cols(NULL)) + }) +}) diff --git a/tests/testthat/test-t_pkct01.R b/tests/testthat/test-t_pkct01.R new file mode 100644 index 000000000..093241dd2 --- /dev/null +++ b/tests/testthat/test-t_pkct01.R @@ -0,0 +1,159 @@ +# Shared fixture: minimal ADNCA-like data frame +pkct01_data <- data.frame( + PARAM = rep(c("Drug A", "Drug B"), each = 12), + PCSPEC = rep("PLASMA", 24), + TRT01A = rep(rep(c("10mg", "50mg"), each = 6), 2), + DOSEA = rep(rep(c(10, 50), each = 6), 2), + ATPTREF = rep("Day 1", 24), + NFRLT = rep(rep(c(0, 1, 2), each = 2), 4), + NRRLT = rep(rep(c(0, 1, 2), each = 2), 4), + AVAL = c(0, 0, 5, 6, 3, 4, # Drug A / 10mg + 0, 0, 10, 11, 7, 8, # Drug A / 50mg + 0, 0, 2, 3, 1, 2, # Drug B / 10mg + 0, 0, 4, 5, 3, 3), # Drug B / 50mg + AVALC = c(rep("BLQ", 2), "5", "6", "3", "4", + rep("BLQ", 2), "10", "11", "7", "8", + rep("BLQ", 2), "2", "3", "1", "2", + rep("BLQ", 2), "4", "5", "3", "3"), + stringsAsFactors = FALSE +) + +describe("t_pkct01", { + it("returns a named list with one entry per PARAM/PCSPEC combination", { + result <- t_pkct01(pkct01_data) + expect_type(result, "list") + expect_equal(length(result), 2) + expect_true(all(grepl("PLASMA", names(result)))) + }) + + it("each element is a data frame", { + result <- t_pkct01(pkct01_data) + purrr::walk(result, ~ expect_s3_class(.x, "data.frame")) + }) + + it("output contains expected statistic columns", { + result <- t_pkct01(pkct01_data)[[1]] + expected_cols <- c("TRT01A", "ATPTREF", "NFRLT", + "n", "n_blq", "Mean", "SD", "CV_pct", + "Median", "GeoMean", "Min", "Max") + expect_true(all(expected_cols %in% names(result))) + }) + + it("BLQ rows produce NA for numeric stats and non-zero n_blq", { + result <- t_pkct01(pkct01_data)[[1]] + blq_rows <- result[result$NFRLT == 0, ] + expect_true(all(is.na(blq_rows$Mean))) + expect_true(all(blq_rows$n_blq > 0)) + }) + + it("non-BLQ rows have correct n and numeric stats", { + result <- t_pkct01(pkct01_data)[[1]] + row_t1 <- result[result$TRT01A == "10mg" & result$NFRLT == 1, ] + expect_equal(row_t1$n, 2) + expect_equal(row_t1$n_blq, 0) + expect_equal(row_t1$Mean, round(mean(c(5, 6)), 3)) + expect_equal(row_t1$Min, 5) + expect_equal(row_t1$Max, 6) + }) + + it("stops with informative error when required columns are missing", { + bad <- pkct01_data[, setdiff(names(pkct01_data), "AVAL")] + expect_error(t_pkct01(bad), "missing required columns") + }) + + it("returns single list entry when list_vars not present in data", { + data_no_pcspec <- pkct01_data[, setdiff(names(pkct01_data), "PCSPEC")] + result <- t_pkct01(data_no_pcspec, list_vars = c("PARAM", "PCSPEC")) + expect_equal(length(result), 2) # PARAM still present + }) + + it("falls back to AVAL==0 for BLQ detection when blq_var column is absent", { + data_no_avalc <- pkct01_data[, setdiff(names(pkct01_data), "AVALC")] + result <- t_pkct01(data_no_avalc)[[1]] + blq_rows <- result[result$NFRLT == 0, ] + # AVAL==0 rows should still be counted as BLQ and excluded from stats + expect_true(all(is.na(blq_rows$Mean))) + expect_true(all(blq_rows$n_blq > 0)) + }) + + it("AVAL==0 fallback: n_blq matches count of zero-AVAL rows per group", { + data_no_avalc <- pkct01_data[, setdiff(names(pkct01_data), "AVALC")] + result <- t_pkct01(data_no_avalc)[[1]] + row <- result[result$TRT01A == "10mg" & result$NFRLT == 0, ] + # 10mg arm at NFRLT=0 has 2 rows with AVAL=0 + expect_equal(row$n_blq, 2L) + expect_equal(row$n, 2L) + }) + + it("orders rows by stratum then by numeric (not lexical) time", { + # Two arms; NFRLT includes 10 to catch a lexical sort that would place + # "10" before "2". Input order deliberately interleaves arms/times. + d <- data.frame( + PARAM = "Drug A", + PCSPEC = "PLASMA", + TRT01A = rep(c("B_arm", "A_arm"), each = 4), + ATPTREF = "Day 1", + NFRLT = rep(c(2, 10, 2, 10), 2), + AVAL = 1:8, + AVALC = as.character(1:8), + stringsAsFactors = FALSE + ) + result <- t_pkct01(d)[[1]] + # Each arm's rows are contiguous: an arm value never reappears after a switch + expect_equal(anyDuplicated(rle(as.character(result$TRT01A))$values), 0L) + # Within each arm, time is ascending and numeric (2 before 10) + purrr::walk(split(result$NFRLT, result$TRT01A), ~ expect_false(is.unsorted(.x))) + }) + + it("orders treatment arms and visits naturally (10 mg before 100, DOSE 2 before DOSE 10)", { + d <- data.frame( + PARAM = "Drug A", + PCSPEC = "PLASMA", + TRT01A = rep(c("100 mg", "10 mg"), each = 4), + ATPTREF = rep(c("DOSE 10", "DOSE 2"), times = 4), + NFRLT = 1, + AVAL = 1:8, + AVALC = as.character(1:8), + stringsAsFactors = FALSE + ) + result <- t_pkct01(d)[[1]] + # Arms natural-sorted: every "10 mg" row precedes every "100 mg" row + expect_true(max(which(result$TRT01A == "10 mg")) < + min(which(result$TRT01A == "100 mg"))) + # Within an arm, "DOSE 2" precedes "DOSE 10" + arm <- result[result$TRT01A == "10 mg", ] + expect_equal(arm$ATPTREF, c("DOSE 2", "DOSE 10")) + }) + + it("attaches readable labels to statistic columns", { + result <- t_pkct01(pkct01_data)[[1]] + expect_equal(attr(result$GeoMean, "label"), "Geometric Mean") + expect_equal(attr(result$GeoCV_pct, "label"), "Geometric CV%") + expect_equal(attr(result$CV_pct, "label"), "CV%") + expect_equal(attr(result$n_blq, "label"), "Number BLQ") + }) +}) + +describe("t_pkct01_dose", { + it("stratifies by DOSEA instead of TRT01A", { + result <- t_pkct01_dose(pkct01_data)[[1]] + expect_true("DOSEA" %in% names(result)) + expect_false("TRT01A" %in% names(result)) + }) +}) + +describe("t_pkct01_tad", { + it("uses NRRLT as time variable instead of NFRLT", { + result <- t_pkct01_tad(pkct01_data)[[1]] + expect_true("NRRLT" %in% names(result)) + expect_false("NFRLT" %in% names(result)) + }) +}) + +describe("t_pkct01_dose_tad", { + it("uses DOSEA for stratification and NRRLT for time", { + result <- t_pkct01_dose_tad(pkct01_data)[[1]] + expect_true("DOSEA" %in% names(result)) + expect_true("NRRLT" %in% names(result)) + }) +}) diff --git a/tests/testthat/test-t_pkpt.R b/tests/testthat/test-t_pkpt.R new file mode 100644 index 000000000..7bdc0b5e6 --- /dev/null +++ b/tests/testthat/test-t_pkpt.R @@ -0,0 +1,253 @@ +# Shared fixture: minimal ADPP-like data frame +pkpt_data <- data.frame( + USUBJID = rep(paste0("S", 1:6), each = 3), + TRT01A = rep(c("10mg", "10mg", "10mg", "50mg", "50mg", "50mg"), each = 3), + DOSEA = rep(c(10, 10, 10, 50, 50, 50), each = 3), + AVISIT = "Day 1", + PARAM = rep(c("Cmax", "AUClast", "Tmax"), 6), + PARAMCD = rep(c("CMAX", "AUCLST", "TMAX"), 6), + AVAL = c(5, 20, 1, 6, 22, 1.2, 7, 21, 0.9, + 10, 40, 1.5, 11, 38, 1.3, 9, 42, 1.4), + AVALU = rep(c("ng/mL", "ng/mL*h", "h"), 6), + PPCAT = "Drug A Plasma", + PPSPEC = "Plasma", + METABFL = NA_character_, + stringsAsFactors = FALSE +) + +# Metabolite variant: mark some rows as metabolite +pkpt_metab_data <- pkpt_data +pkpt_metab_data$METABFL[pkpt_metab_data$TRT01A == "50mg"] <- "Y" + +describe("t_pkpt03_col", { + it("returns a named list of data frames", { + result <- t_pkpt03_col(pkpt_data) + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "data.frame")) + }) + + it("contains expected statistic columns", { + result <- t_pkpt03_col(pkpt_data)[[1]] + expected <- c("TRT01A", "PARAM", "n", "Mean", "SD", "CV_pct", + "GeoMean", "GeoCV_pct", "Median", "Min", "Max") + expect_true(all(expected %in% names(result))) + }) + + it("computes correct n per treatment and parameter", { + result <- t_pkpt03_col(pkpt_data)[[1]] + row_cmax_10 <- result[result$TRT01A == "10mg" & result$PARAM == "Cmax", ] + expect_equal(row_cmax_10$n, 3) + }) + + it("computes Mean correctly", { + result <- t_pkpt03_col(pkpt_data)[[1]] + row <- result[result$TRT01A == "10mg" & result$PARAM == "Cmax", ] + expect_equal(row$Mean, round(mean(c(5, 6, 7)), 3)) + }) + + it("attaches readable labels to statistic columns", { + result <- t_pkpt03_col(pkpt_data)[[1]] + expect_equal(attr(result$GeoMean, "label"), "Geometric Mean") + expect_equal(attr(result$GeoCV_pct, "label"), "Geometric CV%") + expect_equal(attr(result$CV_pct, "label"), "CV%") + }) + + it("orders treatment arms naturally (9 mg before 10 mg, not lexically)", { + nat <- pkpt_data + nat$TRT01A <- ifelse(nat$TRT01A == "10mg", "9 mg", "10 mg") + result <- t_pkpt03_col(nat)[[1]] + expect_true(max(which(result$TRT01A == "9 mg")) < + min(which(result$TRT01A == "10 mg"))) + }) + + it("returns NA for SD when only one observation", { + one_obs <- pkpt_data[pkpt_data$USUBJID == "S1", ] + result <- t_pkpt03_col(one_obs)[[1]] + row <- result[result$PARAM == "Cmax", ] + expect_true(is.na(row$SD)) + }) + + it("stops with informative error when required columns are missing", { + bad <- pkpt_data[, setdiff(names(pkpt_data), "AVAL")] + expect_error(t_pkpt03_col(bad), "missing required columns") + }) + + it("produces one table per PPCAT when split by PPCAT (default)", { + two_cats <- rbind( + pkpt_data, + transform(pkpt_data, PPCAT = "DrugB Plasma") + ) + result <- t_pkpt03_col(two_cats) + expect_equal(length(result), 2) + }) + + it("splits by AVISIT when explicitly passed in list_vars", { + two_visits <- rbind( + pkpt_data, + transform(pkpt_data, AVISIT = "Day 7") + ) + result <- t_pkpt03_col(two_visits, list_vars = c("AVISIT", "PPCAT")) + expect_equal(length(result), 2) + }) +}) + +describe("t_pkpt03_MP_col", { + it("filters to metabolite rows before summarizing (METABFL path)", { + result <- t_pkpt03_MP_col(pkpt_metab_data)[[1]] + # Only 50mg arm has METABFL set — only that arm should appear + expect_true(all(result$TRT01A == "50mg")) + }) + + it("falls back to PPCAT when METABFL absent and PPCAT contains 'metab'", { + # Simulate ADPP without METABFL: PPCAT identifies metabolite rows + data_ppcat <- pkpt_data + data_ppcat$PPCAT <- ifelse(data_ppcat$TRT01A == "50mg", "Metab-DrugA Plasma", "DrugA Plasma") + data_ppcat <- data_ppcat[, setdiff(names(data_ppcat), "METABFL")] + result <- t_pkpt03_MP_col(data_ppcat)[[1]] + expect_true(all(result$TRT01A == "50mg")) + }) + + it("falls back to PARAM when METABFL and PPCAT both absent but PARAM contains 'metab'", { + data_param <- pkpt_data + data_param$PARAM <- ifelse(data_param$TRT01A == "50mg", + paste0("Metab-", data_param$PARAM), + data_param$PARAM) + data_param <- data_param[, setdiff(names(data_param), c("METABFL", "PPCAT"))] + result <- t_pkpt03_MP_col(data_param)[[1]] + expect_true(all(result$TRT01A == "50mg")) + }) + + it("stops when METABFL absent and no 'metab' in PPCAT or PARAM", { + data_no_metabfl <- pkpt_data[, setdiff(names(pkpt_data), "METABFL")] + expect_error(t_pkpt03_MP_col(data_no_metabfl), "no metabolite data found") + }) + + it("stops with informative error when METABFL is all missing", { + expect_error(t_pkpt03_MP_col(pkpt_data), "no metabolite data found") + }) +}) + +describe("t_pkpt07_norm", { + it("filters to dose-normalized parameters (PARAMCD ending in D)", { + data_with_dn <- pkpt_data + data_with_dn$PARAMCD <- rep(c("CMAXD", "AUCTLSTD", "TMAX"), 6) + data_with_dn$PARAM <- rep(c("Cmax/D", "AUClast/D", "Tmax"), 6) + result <- t_pkpt07_norm(data_with_dn)[[1]] + expect_true(all(grepl("D$", result$PARAM) | result$PARAM == "Tmax")) + expect_false("Tmax" %in% result$PARAM) # TMAX doesn't end in D + }) + + it("stops with informative error when no dose-normalized params found", { + expect_error(t_pkpt07_norm(pkpt_data), "no dose-normalized parameters") + }) +}) + +describe("t_pkpt08_uri", { + it("filters to urine records before summarizing", { + data_mixed <- pkpt_data + data_mixed$PPSPEC[data_mixed$TRT01A == "10mg"] <- "URINE" + result <- t_pkpt08_uri(data_mixed)[[1]] + # Only urine rows (10mg arm) survive the filter + expect_true(all(result$TRT01A == "10mg")) + }) + + it("stops with informative error when no urine records present", { + expect_error( + t_pkpt08_uri(pkpt_data), # all Plasma + "no urine PK parameter data found" + ) + }) + + it("warns when PPSPEC column is absent and skips the urine filter", { + data_no_ppspec <- pkpt_data[, setdiff(names(pkpt_data), "PPSPEC")] + expect_warning( + t_pkpt08_uri(data_no_ppspec), + "PPSPEC.*not found" + ) + }) +}) + +describe("t_pkpt11_gmr", { + it("returns a named list of data frames", { + result <- t_pkpt11_gmr(pkpt_data, ref_arm = "10mg") + expect_type(result, "list") + purrr::walk(result, ~ expect_s3_class(.x, "data.frame")) + }) + + it("contains GMR, CI_lower, CI_upper columns", { + result <- t_pkpt11_gmr(pkpt_data, ref_arm = "10mg")[[1]] + expect_true(all(c("GMR", "CI_lower", "CI_upper") %in% names(result))) + }) + + it("GMR is ratio of geometric means (50mg / 10mg)", { + result <- t_pkpt11_gmr(pkpt_data, ref_arm = "10mg")[[1]] + row <- result[result$PARAM == "Cmax", ] + gm_10 <- exp(mean(log(c(5, 6, 7)))) + gm_50 <- exp(mean(log(c(10, 11, 9)))) + expect_equal(row$GMR, round(gm_50 / gm_10, 3)) + }) + + it("CI_lower < GMR < CI_upper", { + result <- t_pkpt11_gmr(pkpt_data, ref_arm = "10mg")[[1]] + expect_true(all(result$CI_lower < result$GMR, na.rm = TRUE)) + expect_true(all(result$GMR < result$CI_upper, na.rm = TRUE)) + }) + + it("uses first sorted arm as reference when ref_arm is NULL", { + result <- t_pkpt11_gmr(pkpt_data)[[1]] + # "10mg" sorts before "50mg", so 10mg is ref → only 50mg rows appear + expect_true(all(result$TRT01A == "50mg")) + }) + + it("stops with informative error when ref_arm not found", { + expect_error( + t_pkpt11_gmr(pkpt_data, ref_arm = "100mg"), + "not found" + ) + }) + + it("stops when required columns are missing", { + bad <- pkpt_data[, setdiff(names(pkpt_data), "AVAL")] + expect_error(t_pkpt11_gmr(bad), "missing required columns") + }) + + it("returns NA (not NaN) CI bounds when both arms have zero within-arm log-variance", { + # Regression: when sd(log(ref_vals)) == sd(log(trt_vals)) == 0, the Welch df + # formula yields 0/0 = NaN. max(NaN, 1) returns NaN in R (not 1), so qt() + # returns NaN and CI bounds become NaN rather than NA, corrupting the table. + zero_var_data <- data.frame( + USUBJID = paste0("S", 1:6), + TRT01A = c("10mg", "10mg", "10mg", "50mg", "50mg", "50mg"), + PARAM = "Cmax", + PARAMCD = "CMAX", + AVAL = c(5, 5, 5, 10, 10, 10), # identical values within each arm + AVALU = "ng/mL", + PPCAT = "DrugA Plasma", + PPSPEC = "PLASMA", + stringsAsFactors = FALSE + ) + result <- t_pkpt11_gmr(zero_var_data, ref_arm = "10mg")[[1]] + row <- result[result$PARAM == "Cmax", ] + expect_true(is.na(row$CI_lower), info = "CI_lower should be NA, not NaN") + expect_true(is.na(row$CI_upper), info = "CI_upper should be NA, not NaN") + # GMR itself is still computable (ratio of identical geometric means) + expect_true(is.finite(row$GMR)) + }) + + it("returns empty data frame and warns when ref_arm absent from a sub-split", { + # Create two-split data where ref_arm "10mg" only exists in one PPCAT + split_data <- rbind( + pkpt_data, + transform(pkpt_data[pkpt_data$TRT01A == "50mg", ], + PPCAT = "DrugB Plasma") + ) + # "DrugB Plasma" split has only 50mg rows — ref_arm "10mg" is absent + expect_warning( + result <- t_pkpt11_gmr(split_data, ref_arm = "10mg"), + "reference arm" + ) + # The DrugA split returns a normal table; the DrugB split is empty + drug_b_key <- grep("DrugB", names(result), value = TRUE) + expect_equal(nrow(result[[drug_b_key]]), 0) + }) +}) diff --git a/tests/testthat/test-tlg_module.R b/tests/testthat/test-tlg_module.R index cc8f297f9..a2f560c37 100644 --- a/tests/testthat/test-tlg_module.R +++ b/tests/testthat/test-tlg_module.R @@ -55,6 +55,167 @@ describe("filter_tlg_excluded", { result <- filter_tlg_excluded(df) expect_equal(nrow(result), 0) }) + + it("removes rows where PPSUMFL is 'Y' (ADPP exclusion flag)", { + df <- data.frame( + x = 1:4, + PPSUMFL = c("", "Y", "", "Y"), + stringsAsFactors = FALSE + ) + result <- filter_tlg_excluded(df) + expect_equal(nrow(result), 2) + expect_equal(result$x, c(1L, 3L)) + }) + + it("filters both PKSUM1F and PPSUMFL when both are present", { + df <- data.frame( + x = 1:4, + PKSUM1F = c("Y", "", "", ""), + PPSUMFL = c("", "Y", "", ""), + stringsAsFactors = FALSE + ) + result <- filter_tlg_excluded(df) + # rows 1 and 2 removed; rows 3 and 4 kept + expect_equal(nrow(result), 2) + expect_equal(result$x, c(3L, 4L)) + }) + + it("returns all rows when PPSUMFL is absent", { + df <- data.frame(x = 1:3, stringsAsFactors = FALSE) + expect_equal(nrow(filter_tlg_excluded(df)), 3) + }) +}) + +# --------------------------------------------------------------------------- +# .tlg_module_edit_widget +# --------------------------------------------------------------------------- + +describe(".tlg_module_edit_widget", { + it("returns an h1 group-label tag when opt_id contains '.group_label'", { + result <- .tlg_module_edit_widget( + "section.group_label", "My Section", data = NULL + ) + html <- as.character(result) + expect_true(grepl("tlg-group-label", html)) + expect_true(grepl("My Section", html)) + }) + + it("dispatches to the numeric UI widget for type 'numeric'", { + opt_def <- list(type = "numeric", label = "A Number", default = 1) + result <- .tlg_module_edit_widget("mod-myopt", opt_def, data = NULL) + html <- as.character(result) + # tlg_option_numeric_ui returns a numericInput + expect_true(grepl("number", html, ignore.case = TRUE)) + }) + + it("dispatches to the select UI widget for type 'select'", { + opt_def <- list( + type = "select", + label = "A Choice", + choices = c("X", "Y"), + default = NULL, + multiple = FALSE + ) + result <- .tlg_module_edit_widget("mod-myopt", opt_def, data = NULL) + html <- as.character(result) + # tlg_option_select_ui returns a selectInput + expect_true(grepl("X", html)) + expect_true(grepl("Y", html)) + }) +}) + +# --------------------------------------------------------------------------- +# tlg_module_server +# --------------------------------------------------------------------------- + +describe("tlg_module_server", { + test_data <- shiny::reactive( + list(conc = list(data = data.frame( + NFRLT = 1:3, AVAL = c(5, 4, 3), stringsAsFactors = FALSE + ))) + ) + render_list_ok <- function(data, ...) list("plot_a", "plot_b", "plot_c") + + it("skips character-valued options (group label markers)", { + # options[[opt]] is a plain string → is.character() branch returns NULL, + # so it is excluded from options_values (line 206 in tlg_module.R). + # The resulting reactiveValues object should have no entries. + expect_no_error( + shiny::testServer( + tlg_module_server, + args = list( + data = test_data, + type = "graph", + render_list = render_list_ok, + options = list(section_title = "My Section") + ), + { + expect_equal(length(reactiveValuesToList(options_values)), 0) + } + ) + ) + }) + + it("page navigation: next_page increments current_page", { + shiny::testServer( + tlg_module_server, + args = list( + data = test_data, + type = "graph", + render_list = render_list_ok, + options = list() + ), + { + session$setInputs(next_page = 1) + session$flushReact() + expect_equal(current_page(), 2) + } + ) + }) + + it("page navigation: previous_page decrements current_page", { + shiny::testServer( + tlg_module_server, + args = list( + data = test_data, + type = "graph", + render_list = render_list_ok, + options = list() + ), + { + session$setInputs(next_page = 1) + session$flushReact() + session$setInputs(previous_page = 1) + session$flushReact() + expect_equal(current_page(), 1) + } + ) + }) + + it("select_page returns NULL early when value is empty string", { + shiny::testServer( + tlg_module_server, + args = list( + data = test_data, + type = "graph", + render_list = render_list_ok, + options = list() + ), + { + # Setting select_page to "" should hit the early-return guard + # and leave current_page unchanged at its initial value of 1 + session$setInputs(select_page = "") + session$flushReact() + expect_equal(current_page(), 1) + } + ) + }) + + # Note: the tryCatch error-handler path inside tlg_list (lines 181-190 of + # tlg_module.R) is not unit-tested here. The handler calls log_error() + # which requires a running Shiny session; the debounce(750) reactive also + # caches and re-throws the error before the tryCatch return value can be + # observed. This path is covered by end-to-end / integration tests. }) # ---------------------------------------------------------------------------