139 feat/blq options

NEWS.md

@@ -11,6 +11,7 @@
 * New Parameter Selection section in NCA tab allowing to select parameters by study type (#795)
 * The App optionally maps end of sample collection (AEFRLT) for excretion rate parameter calculations: ERTLST, ERTMAX. (#745)
 * Option to upload multiple input files, which will be bound together to form a single ADNCA data set (#821)
+* BLQ imputation rules can be applied to the NCA via `NCA Setup > Data Imputation` (#139)
 
 
 ## Bugs fixed

R/PKNCA.R

@@ -176,6 +176,7 @@ PKNCA_create_data_object <- function(adnca_data, nca_exclude_reason_columns = NU
     intervals = intervals, #TODO: should be default
     units = PKNCA_build_units_table(pknca_conc, pknca_dose)
   )
+
   pknca_data_object
 }
 

R/intervals.R

@@ -53,8 +53,10 @@ format_pkncadata_intervals <- function(pknca_conc,
   dose_groups <- unname(unlist(pknca_dose$columns$groups))
   time_column <- pknca_dose$columns$time
   # Obtain all possible pknca parameters
-  params <- setdiff(names(PKNCA::get.interval.cols()),
-                    c("start", "end"))
+  params <- setdiff(
+    names(PKNCA::get.interval.cols()),
+    c("start", "end")
+  )
 
   # Select conc data and for time column give priority to non-predose samples
   sub_pknca_conc <- pknca_conc$data %>%
@@ -67,29 +69,32 @@ format_pkncadata_intervals <- function(pknca_conc,
     group_by(!!!syms(dose_groups)) %>%
     mutate(is_one_dose = length(unique(DOSNOA)) == 1) %>%
     ungroup() %>%
-    select(any_of(c(dose_groups,
-                    time_column, "DOSNOA", "is_one_dose")))
+    select(any_of(c(
+      dose_groups,
+      time_column, "DOSNOA", "is_one_dose"
+    )))
 
   # Based on dose times create a data frame with start and end times
   dose_intervals <- left_join(sub_pknca_dose,
-                              sub_pknca_conc,
-                              by = intersect(names(sub_pknca_dose), c(conc_groups, "DOSNOA")),
-                              relationship = "many-to-many") %>%
-
+    sub_pknca_conc,
+    by = intersect(names(sub_pknca_dose), c(conc_groups, "DOSNOA")),
+    relationship = "many-to-many"
+  ) %>%
     # Pick 1 per concentration group and dose number
     group_by(!!!syms(dose_groups), DOSNOA) %>%
     mutate(max_end = max(ARRLT, na.rm = TRUE)) %>% # calculate max end time for Dose group
     filter(ARRLT >= 0) %>% # filter out negative ARRLT values
     group_by(!!!syms(c(conc_groups, "DOSNOA"))) %>%
     slice(1) %>% # slice one row per conc group
     ungroup() %>%
-
     # Make start from last dose (pknca_dose) or first concentration (pknca_conc)
-    mutate(start = if (start_from_last_dose) !!sym(time_column)
-           else !!sym(time_column) + !!sym("ARRLT")) %>%
+    mutate(start = if (start_from_last_dose) {
+      !!sym(time_column)
+    } else {
+      !!sym(time_column) + !!sym("ARRLT")
+    }) %>%
     group_by(!!!syms(conc_groups)) %>%
     arrange(start) %>%
-
     # Make end based on next dose time (if no more, TRTRINT or last NFRLT)
     mutate(end = if (has_trtrint) {
       case_when(
@@ -104,17 +109,16 @@ format_pkncadata_intervals <- function(pknca_conc,
         is_one_dose ~ Inf,
         TRUE ~ start + max_end
       )
-    }
-    ) %>%
+    }) %>%
     ungroup() %>%
-    select(any_of(c("start", "end", conc_groups,
-                    "ATPTREF", "DOSNOA", "VOLUME"))) %>%
-
+    select(any_of(c(
+      "start", "end", conc_groups,
+      "ATPTREF", "DOSNOA", "VOLUME"
+    ))) %>%
     # Create logical columns with only TRUE for the NCA parameters requested by the user
     mutate(!!!setNames(rep(FALSE, length(params)), params)) %>%
     # Identify the intervals as the base ones for the NCA analysis
     mutate(type_interval = "main")
-
 }
 
 #' Update an intervals data frame with user-selected parameters by study type
@@ -124,12 +128,22 @@ format_pkncadata_intervals <- function(pknca_conc,
 #' @param study_types_df A data frame mapping analysis profiles to their study type.
 #' @param auc_data A data frame containing partial AUC ranges.
 #' @param impute Logical indicating whether to impute start values for parameters.
+#' @param blq_imputation_rule A list defining the Below Limit of Quantification (BLQ)
+#' imputation rule using PKNCA format. The list should either contain three elements named:
+#' `first`, `middle`, and `last` or two elements named `before.tmax` and `after.tmax`.
+#' Each element can be a numeric value (substituting the BLQ value), or a string such as
+#' `"drop"` (ignores the value) or `"keep"` (keeps the value as 0). Default is NULL,
+#' which does not specify any BLQ imputation in any interval.
 #'
 #' @returns An updated PKNCAdata object with parameter intervals based on user selections.
 #'
-update_main_intervals <- function(data, parameter_selections,
-                                  study_types_df, auc_data, impute = TRUE) {
-
+update_main_intervals <- function(
+  data,
+  parameter_selections,
+  study_types_df, auc_data,
+  impute = TRUE,
+  blq_imputation_rule = NULL
+) {
   all_pknca_params <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end"))
 
   # Determine the grouping columns from the study_types_df
@@ -189,9 +203,32 @@ update_main_intervals <- function(data, parameter_selections,
 
   # Impute start values if requested
   if (impute) {
-    data <- apply_imputation(data)
+    data <- create_start_impute(data)
+  }
+
+  ############################################
+  # Define a BLQ imputation method for PKNCA
+  # and apply it only for non-observational parameters
+
+  if (!is.null(blq_imputation_rule)) {
+    PKNCA_impute_method_blq <<- function(conc.group, time.group, ...) { # nolint
+      PKNCA::clean.conc.blq(conc = conc.group, time = time.group, conc.blq = blq_imputation_rule)
+    }
+
+    data$intervals <- data$intervals %>%
+      mutate(
+        impute = ifelse(
+          is.na(impute) | impute == "",
+          "blq",
+          paste0("blq, ", impute)
+        )
+      )
   }
 
+  ############################################
+  # Remove any imputation from the observational parameters
+  data <- rm_impute_obs_params(data, metadata_nca_parameters)
+
   data
 }
 
@@ -201,25 +238,34 @@ update_main_intervals <- function(data, parameter_selections,
 #' selectively removing imputation for parameters that are not dependent on AUC.
 #'
 #' @param data A PKNCAdata object.
-#' @param nca_parameters A dataset containing the mapping between PKNCA terms and CDISC terms.
+#' @param metadata_nca_parameters A data frame mapping PKNCA parameters (`PKNCA`)
+#' and information on their parameter dependencies ('Depends').
 #' @returns A PKNCAdata object with imputation rules applied.
 #' @import dplyr
 #'
-apply_imputation <- function(data, nca_parameters = metadata_nca_parameters) {
-  data <- create_start_impute(data)
-
+rm_impute_obs_params <- function(data, metadata_nca_parameters = metadata_nca_parameters) {
   # Don't impute parameters that are not AUC dependent
-  params_auc_dep <- nca_parameters %>%
+  params_auc_dep <- metadata_nca_parameters %>%
     filter(grepl("auc|aumc", PKNCA) | grepl("auc", Depends)) %>%
     pull(PKNCA)
 
-  params_not_to_impute <- nca_parameters %>%
-    filter(!grepl("auc|aumc", PKNCA),
-           !grepl(paste0(params_auc_dep, collapse = "|"), Depends)) %>%
+  params_not_to_impute <- metadata_nca_parameters %>%
+    filter(
+      !grepl("auc|aumc", PKNCA),
+      !grepl(paste0(params_auc_dep, collapse = "|"), Depends)
+    ) %>%
     pull(PKNCA) %>%
     intersect(names(PKNCA::get.interval.cols()))
 
   all_impute_methods <- na.omit(unique(data$intervals$impute))
+  if (length(all_impute_methods) == 0) {
+    return(data)
+  }
+  all_impute_methods <- all_impute_methods %>%
+    strsplit(split = ",") %>%
+    unlist() %>%
+    trimws() %>%
+    unique()
 
   data$intervals <- Reduce(function(d, ti_arg) {
     interval_remove_impute(

R/zzz.R

@@ -58,6 +58,7 @@
     "PCTPTNUM",
     "PCTPTREF",
     "PKNCA",
+    "PKNCA_impute_method_blq",
     "PPANMETH",
     "PPORRES",
     "PPORRESU",
@@ -124,6 +125,7 @@
     "exclude_half.life",
     "facet_title",
     "format_fun",
+    "has_param_to_impute",
     "id_list",
     "id_plot",
     "id_variable_col",
@@ -132,6 +134,7 @@
     "interval_name_col",
     "interval_next",
     "interval_prev",
+    "impute",
     "is.excluded.hl",
     "is.included.hl",
     "is.iv",
@@ -153,6 +156,8 @@
     "nom_dose_time",
     "nom_interval_next",
     "nom_interval_prev",
+    "param_to_impute_is_not_na",
+    "param_to_impute_is_not_false",
     "pknca_units_tbl",
     "ppanmeth_ref_groups",
     "ppanmeth_test_groups",

inst/shiny/modules/tab_nca/setup.R

@@ -21,7 +21,8 @@ setup_ui <- function(id) {
     nav_panel(
       "Settings",
       fluidRow(
-        column(6,
+        column(
+          6,
           fileInput(
             ns("settings_upload"),
             width = "100%",
@@ -30,7 +31,8 @@ setup_ui <- function(id) {
             accept = ".rds"
           )
         ),
-        column(6,
+        column(
+          6,
           downloadButton(
             ns("settings_download"),
             label = "Download settings"
@@ -123,7 +125,8 @@ setup_server <- function(id, data, adnca_data) {
         parameter_selections = parameters_output$selections(),
         study_types_df = parameters_output$types_df(),
         auc_data = settings()$partial_aucs,
-        impute = settings()$data_imputation$impute_c0
+        impute = settings()$data_imputation$impute_c0,
+        blq_imputation_rule = settings()$data_imputation$blq_imputation_rule
       )
 
       if (nrow(final_data$intervals) == 0) {
@@ -157,8 +160,10 @@ setup_server <- function(id, data, adnca_data) {
     # Only parameters required for the slope plots are set in intervals
     # NCA dynamic changes/filters based on user selections
     slopes_pknca_data <- reactive({
-      req(adnca_data(), settings(), settings()$profile,
-          settings()$analyte, settings()$pcspec)
+      req(
+        adnca_data(), settings(), settings()$profile,
+        settings()$analyte, settings()$pcspec
+      )
       log_trace("Updating PKNCA::data object for slopes.")
 
       df <- PKNCA_update_data_object(