From ddf2683a5c5f6fdf20f265b611a404cb46de698d Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 5 Feb 2025 00:25:09 +0100 Subject: [PATCH 01/49] feat: add functions to remove and add impute --- R/intervals_support_funs.R | 244 +++++++++++++++++++++++++++++++++++++ 1 file changed, 244 insertions(+) create mode 100644 R/intervals_support_funs.R diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R new file mode 100644 index 00000000..185df6a7 --- /dev/null +++ b/R/intervals_support_funs.R @@ -0,0 +1,244 @@ +# Load necessary library +library(dplyr) + +#' Remove specified imputation methods from the intervals in a PKNCAdata object. +#' +#' @param data A PKNCAdata object containing the intervals and data components. +#' @param target_impute A character string specifying the imputation method to be removed. +#' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. +#' @param target_groups A named list specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. +#' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. +#' @examples +#' d_conc <- data.frame( +#' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), +#' time = rep(0:5, 2), +#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), +#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +#' ) +#' +#' d_dose <- data.frame( +#' dose = c(100, 200), +#' time = c(0, 0), +#' treatment = c("A", "B"), +#' ID = c(1, 2) +#' ) +#' +#' o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") +#' o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) +#' +#' intervals <- data.frame( +#' start = c(0, 0, 0), +#' end = c(24, 48, Inf), +#' half.life = c(TRUE, FALSE, TRUE), +#' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), +#' ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), +#' ROUTE = c("intravascular", "oral", "intravascular") +#' ) +#' +#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) +#' +#' # Apply interval_remove_impute function +#' o_data <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = list(ANALYTE = "Analyte1", ROUTE = "intravascular")) +#' +#' # Print updated intervals +#' print("Updated intervals:") +#' print(o_data$intervals) +#' +#' @export +interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL) { + # Validate the input + if (missing(data) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + + if (!("intervals" %in% names(data)) || !("PKNCAdata" %in% class(data))) { + stop("'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + } + + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + + # Get all parameter column names in the PKNCAdata object + all_param_options <- names(sapply(PKNCA.options()$single.dose.aucs, is.logical)) + logical_cols <- names(which(colSums(data$intervals[sapply(data$intervals, is.logical)]) > 1)) + param_cols <- intersect(logical_cols, all_param_options) + + # Handle target_params + if (is.null(target_params)) { + # Take all logical columns in data$intervals that are known parameters + target_params <- param_cols + } else { + # Check that all target_params are logical columns in data$intervals and known parameters + missing_params <- setdiff(target_params, param_cols) + if (length(missing_params) > 0) { + stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) + target_params <- intersect(target_params, param_cols) + } + } + + # Determine the name of the impute column + impute_col <- if (!is.na(data$impute)) { + data$impute + } else if ("impute" %in% colnames(data$intervals)) { + "impute" + } else { + stop("The 'data$intervals' object must contain an impute column either defined in the PKNCAdata object or called `impute`.") + } + + # Identify the targeted intervals to which the action is applied + mask_target_rows <- data$intervals %>% + mutate( + is.in.groups = if (!is.null(target_groups)) rowSums(across(all_of(names(target_groups)), ~ . %in% target_groups)) == length(target_groups) else TRUE, + is.in.params = rowSums(across(any_of(target_params), ~ . == TRUE)) > 0, + is.in.impute = grepl( + pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), + .data[[impute_col]] + ), + target_rows = is.in.groups & is.in.params & is.in.impute + ) %>% + pull(target_rows) + + # Create the new version intervals for the target parameters + new_intervals_without_impute <- data$intervals %>% + filter(mask_target_rows) %>% + mutate(across(any_of(param_cols), ~FALSE)) %>% + mutate(across(any_of(target_params), ~TRUE)) %>% + rowwise() %>% + mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), + collapse = "," + )) %>% + mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% + ungroup() %>% + as.data.frame() + + # Make parameters FALSE in target intervals + data$intervals[mask_target_rows, target_params] <- FALSE + + # Combine and remove intervals where all logical parameter columns are FALSE + data$intervals <- rbind(data$intervals, new_intervals_without_impute) %>% + filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) + + return(data) +} + + + +# Now create an alternative function that adds imputations to the intervals +#' Add specified imputation methods to the intervals in a PKNCAdata object. +#' +#' @param data A PKNCAdata object containing the intervals and data components. +#' @param target_impute A character string specifying the imputation method to be added. +#' @param after Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf). +#' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. +#' @param target_groups A named list specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. +#' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. +#' @examples +#' d_conc <- data.frame( +#' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), +#' time = rep(0:5, 2), +#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), +#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +#' ) +#' +#' d_dose <- data.frame( +#' dose = c(100, 200), +#' time = c(0, 0), +#' treatment = c("A", "B"), +#' ID = c(1, 2) +#' ) +#' +#' o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") +#' o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) +#' +#' intervals <- data.frame( +#' start = c(0, 0, 0), +#' end = c(24, 48, Inf), +#' half.life = c(TRUE, FALSE, TRUE), +#' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), +#' ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), +#' ROUTE = c("intravascular", "oral", "intravascular") +#' ) +#' +#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) +#' +#' # Apply interval_add_impute function +#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = list(ANALYTE = "Analyte1", ROUTE = "intravascular")) +#' +#' # Print updated intervals +#' print("Updated intervals:") +#' print(o_data$intervals) +#' +#' @export +interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { + # Validate the input + if (missing(data) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + + if (!("intervals" %in% names(data)) || !("PKNCAdata" %in% class(data))) { + stop("'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + } + + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + + # Get all parameter column names in the PKNCAdata object + all_param_options <- names(sapply(PKNCA.options()$single.dose.aucs, is.logical)) + logical_cols <- names(which(colSums(data$intervals[sapply(data$intervals, is.logical)]) > 1)) + param_cols <- intersect(logical_cols, all_param_options) + + # Handle target_params + if (is.null(target_params)) { + # Take all logical columns in data$intervals that are known parameters + target_params <- param_cols + } else { + # Check that all target_params are logical columns in data$intervals and known parameters + missing_params <- setdiff(target_params, param_cols) + if (length(missing_params) > 0) { + stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) + target_params <- intersect(target_params, param_cols) + } + } + + # Determine the name of the impute column + impute_col <- if (!is.na(data$impute)) { + data$impute + } else if ("impute" %in% colnames(data$intervals)) { + "impute" + } else { + stop("The 'data$intervals' object must contain an impute column either defined in the PKNCAdata object or called `impute`.") + } + + # Identify the targeted intervals to which the action is applied + mask_target_rows <- data$intervals %>% + mutate( + is.in.groups = if (!is.null(target_groups)) rowSums(across(all_of(names(target_groups)), ~ . %in% target_groups)) == length(target_groups) else TRUE, + is.in.params = rowSums(across(any_of(target_params), ~ . == TRUE)) > 0, + target_rows = is.in.groups & is.in.params + ) %>% + pull(target_rows) + + # Add the imputation method to the targeted intervals + new_intervals_with_impute <- data$intervals %>% + filter(mask_target_rows) %>% + mutate(across(any_of(param_cols), ~FALSE)) %>% + mutate(across(any_of(target_params), ~TRUE)) %>% + rowwise() %>% + mutate(!!impute_col := { + impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) + impute_methods <- append(impute_methods, target_impute, after) + paste(unique(impute_methods[impute_methods != ""]), collapse = ",") + }) %>% + as.data.frame() + + # Set to FALSE all target parameters in the target intervals + data$intervals[mask_target_rows, target_params] <- FALSE + + # Combine and remove intervals where all logical parameter columns are FALSE + data$intervals <- rbind(data$intervals, new_intervals_with_impute) %>% + filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) + + return(data) +} From b8eb907ad86fb229a494899a088e04c97879403d Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 5 Feb 2025 00:45:59 +0100 Subject: [PATCH 02/49] testing: add tests for interval_remove_impute --- R/test-intervals_support_funs.R | 140 ++++++++++++++++++++++++++++++++ 1 file changed, 140 insertions(+) create mode 100644 R/test-intervals_support_funs.R diff --git a/R/test-intervals_support_funs.R b/R/test-intervals_support_funs.R new file mode 100644 index 00000000..1f3a08f9 --- /dev/null +++ b/R/test-intervals_support_funs.R @@ -0,0 +1,140 @@ +library(testthat) +library(PKNCA) + +# Source the function file if it's not already in the environment +# source("path/to/your/function_file.R") + +# Create sample data for testing +d_conc <- data.frame( + conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), + time = rep(0:5, 2), + analyte = rep(c("Analyte1", "Analyte2"), each = 6), + id = 1, + include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +) + +d_dose <- data.frame( + dose = c(100, 200), + time = c(0, 2.5), + id = 1 +) + +intervals <- data.frame( + start = c(0, 0, 0), + end = c(24, 48, Inf), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), + id = 1, + analyte = c("Analyte1", "Analyte2", "Analyte1") +) + +o_conc <- PKNCAconc(d_conc, conc ~ time | id / analyte, include_half.life = "include_hl") +o_dose <- PKNCAdose(d_dose, dose ~ time | id) +o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) + +# Test cases with unexpected inputs + +test_that("interval_remove_impute throws an error if either data or target_impute is missing", { + expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_remove_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") +}) + +test_that("interval_remove_impute throws an error for non-character target_impute", { + expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") +}) + +test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { + expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + o_data_no_intervals <- PKNCAdata(o_conc, o_dose) + o_data_no_intervals$intervals <- NULL + expect_error(interval_remove_impute(o_data_no_intervals, target_impute = "start_conc0"), "'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") +}) + +test_that("interval_remove_impute throws an error for unknown target_params", { + expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") +}) + +test_that("interval_remove_impute handles impute column with different names", { + o_data_changed_impute_name <- o_data + o_data_changed_impute_name$impute <- "impute_col" + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute_col), + data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute_col = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles impute column with NA values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c(NA_character_, NA_character_, NA_character_))) +}) + + +# Test intervals for expected outputs with different inputs + +test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles specified target_params correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) + # half.life has no start_conc0 imputations + expect_equal(result$intervals %>% filter(half.life) %>% select(analyte, half.life, impute), + data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) + # cmax has the same exact imputations as before + expect_equal(result$intervals %>% filter(cmax) %>% select(analyte, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(analyte, cmax, impute)) +}) + +test_that("interval_remove_impute handles target_groups correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = list(analyte = "Analyte1")) + # Analyte1 has no start_conc0 imputations + expect_equal(result$intervals %>% filter(analyte == "Analyte1") %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_predose", NA_character_))) + + # Analyte2 has the same exact imputations as before + expect_equal(result$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute), + o_data$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute)) +}) + +test_that("interval_remove_impute handles multiple target_params correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles with specifity impute character metod with multiple imputes", { + o_data_multiple_imputes <- o_data + o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") + result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", "start_predose"))) +}) + From 9d48e884bb626e93d3a336eaa1d1a5968ee94093 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Fri, 7 Feb 2025 17:13:55 +0100 Subject: [PATCH 03/49] feat: allow PKNCAdata$intervals as a data input --- R/intervals_support_funs.R | 64 ++++++++++++++++++++++++-------------- 1 file changed, 40 insertions(+), 24 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 185df6a7..afaf97ba 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -45,14 +45,18 @@ library(dplyr) #' print(o_data$intervals) #' #' @export -interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL) { +interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL) { # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } - if (!("intervals" %in% names(data)) || !("PKNCAdata" %in% class(data))) { - stop("'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + if (is.data.frame(data)) { + intervals <- data + } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { + intervals <- data$intervals + } else { + stop("'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") } if (!is.character(target_impute)) { @@ -60,16 +64,15 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } # Get all parameter column names in the PKNCAdata object - all_param_options <- names(sapply(PKNCA.options()$single.dose.aucs, is.logical)) - logical_cols <- names(which(colSums(data$intervals[sapply(data$intervals, is.logical)]) > 1)) - param_cols <- intersect(logical_cols, all_param_options) + all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) + param_cols <- intersect(names(intervals), all_param_options) # Handle target_params if (is.null(target_params)) { - # Take all logical columns in data$intervals that are known parameters + # Take all logical columns in intervals that are known parameters target_params <- param_cols } else { - # Check that all target_params are logical columns in data$intervals and known parameters + # Check that all target_params are logical columns in intervals and known parameters missing_params <- setdiff(target_params, param_cols) if (length(missing_params) > 0) { stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) @@ -78,16 +81,21 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } # Determine the name of the impute column - impute_col <- if (!is.na(data$impute)) { - data$impute - } else if ("impute" %in% colnames(data$intervals)) { + impute_col <- if (!is.null(impute_column)) { + if (!impute_column %in% colnames(intervals)) { + stop("The 'intervals' object does not contain the specified impute column.") + } + impute_column + } else if ("PKNCAdata" %in% class(data) && !is.na(data$impute)) { + intervals$impute + } else if ("impute" %in% colnames(intervals)) { "impute" } else { - stop("The 'data$intervals' object must contain an impute column either defined in the PKNCAdata object or called `impute`.") + stop("The 'intervals' object must contain an impute column either defined in the PKNCAdata object or called `impute`.") } # Identify the targeted intervals to which the action is applied - mask_target_rows <- data$intervals %>% + mask_target_rows <- intervals %>% mutate( is.in.groups = if (!is.null(target_groups)) rowSums(across(all_of(names(target_groups)), ~ . %in% target_groups)) == length(target_groups) else TRUE, is.in.params = rowSums(across(any_of(target_params), ~ . == TRUE)) > 0, @@ -100,7 +108,7 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta pull(target_rows) # Create the new version intervals for the target parameters - new_intervals_without_impute <- data$intervals %>% + new_intervals_without_impute <- intervals %>% filter(mask_target_rows) %>% mutate(across(any_of(param_cols), ~FALSE)) %>% mutate(across(any_of(target_params), ~TRUE)) %>% @@ -113,17 +121,20 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta as.data.frame() # Make parameters FALSE in target intervals - data$intervals[mask_target_rows, target_params] <- FALSE + intervals[mask_target_rows, target_params] <- FALSE # Combine and remove intervals where all logical parameter columns are FALSE - data$intervals <- rbind(data$intervals, new_intervals_without_impute) %>% + intervals <- rbind(intervals, new_intervals_without_impute) %>% filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) - return(data) + if (is.data.frame(data)) { + return(intervals) + } else { + data$intervals <- intervals + return(data) + } } - - # Now create an alternative function that adds imputations to the intervals #' Add specified imputation methods to the intervals in a PKNCAdata object. #' @@ -185,7 +196,7 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params } # Get all parameter column names in the PKNCAdata object - all_param_options <- names(sapply(PKNCA.options()$single.dose.aucs, is.logical)) + all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) logical_cols <- names(which(colSums(data$intervals[sapply(data$intervals, is.logical)]) > 1)) param_cols <- intersect(logical_cols, all_param_options) @@ -195,7 +206,7 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params target_params <- param_cols } else { # Check that all target_params are logical columns in data$intervals and known parameters - missing_params <- setdiff(target_params, param_cols) + missing_params <- setdiff(target_params, logical_cols) if (length(missing_params) > 0) { stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) target_params <- intersect(target_params, param_cols) @@ -203,12 +214,17 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params } # Determine the name of the impute column - impute_col <- if (!is.na(data$impute)) { + impute_col <- if (!is.null(impute_column)) { + if (!impute_column %in% colnames(intervals)) { + stop("The 'intervals' object does not contain the specified impute column.") + } + impute_column + } else if ("PKNCAdata" %in% class(data) && !is.na(data$impute)) { data$impute - } else if ("impute" %in% colnames(data$intervals)) { + } else if ("impute" %in% colnames(intervals)) { "impute" } else { - stop("The 'data$intervals' object must contain an impute column either defined in the PKNCAdata object or called `impute`.") + stop("The 'data' object must contain an impute column either defined as PKNCAdata$impute or otherwise the intervals default column name `impute`.") } # Identify the targeted intervals to which the action is applied From 7bd6bb8d0b9d3b08f97776ee88850abaf39c0cb6 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 8 Feb 2025 09:59:21 +0100 Subject: [PATCH 04/49] fix: interval_remove_impute; remove library & return, warn if no $impute, improve example --- R/intervals_support_funs.R | 40 +++++++++++++++++--------------------- 1 file changed, 18 insertions(+), 22 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index afaf97ba..5974ad7f 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -1,17 +1,13 @@ -# Load necessary library -library(dplyr) - #' Remove specified imputation methods from the intervals in a PKNCAdata object. #' -#' @param data A PKNCAdata object containing the intervals and data components. +#' @inheritParams interval_add_impute #' @param target_impute A character string specifying the imputation method to be removed. -#' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. -#' @param target_groups A named list specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. #' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. #' @examples #' d_conc <- data.frame( #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), #' time = rep(0:5, 2), +#' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6), #' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) #' ) @@ -19,26 +15,25 @@ library(dplyr) #' d_dose <- data.frame( #' dose = c(100, 200), #' time = c(0, 0), -#' treatment = c("A", "B"), #' ID = c(1, 2) #' ) #' -#' o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") -#' o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) +#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) #' #' intervals <- data.frame( #' start = c(0, 0, 0), -#' end = c(24, 48, Inf), +#' end = c(3, 5, Inf), #' half.life = c(TRUE, FALSE, TRUE), +#' cmax = c(TRUE, TRUE, TRUE), #' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), -#' ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), -#' ROUTE = c("intravascular", "oral", "intravascular") +#' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) #' #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_remove_impute function -#' o_data <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = list(ANALYTE = "Analyte1", ROUTE = "intravascular")) +#' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = list(analyte = "Analyte1")) #' #' # Print updated intervals #' print("Updated intervals:") @@ -69,10 +64,10 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta # Handle target_params if (is.null(target_params)) { - # Take all logical columns in intervals that are known parameters - target_params <- param_cols + # Take all parameter columns present with at least one TRUE value + target_params <- param_cols[colSums(intervals[param_cols]) > 0] } else { - # Check that all target_params are logical columns in intervals and known parameters + # Check that all target_params are present in the intervals missing_params <- setdiff(target_params, param_cols) if (length(missing_params) > 0) { stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) @@ -91,7 +86,8 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } else if ("impute" %in% colnames(intervals)) { "impute" } else { - stop("The 'intervals' object must contain an impute column either defined in the PKNCAdata object or called `impute`.") + warning("The 'intervals' object does not contain an impute default/custom column. No imputation to remove.") + return(data) } # Identify the targeted intervals to which the action is applied @@ -127,15 +123,15 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta intervals <- rbind(intervals, new_intervals_without_impute) %>% filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) + # Depending on the input return the corresponding updated object if (is.data.frame(data)) { - return(intervals) + intervals } else { data$intervals <- intervals - return(data) + data } } -# Now create an alternative function that adds imputations to the intervals #' Add specified imputation methods to the intervals in a PKNCAdata object. #' #' @param data A PKNCAdata object containing the intervals and data components. @@ -155,7 +151,6 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' d_dose <- data.frame( #' dose = c(100, 200), #' time = c(0, 0), -#' treatment = c("A", "B"), #' ID = c(1, 2) #' ) #' @@ -224,7 +219,8 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params } else if ("impute" %in% colnames(intervals)) { "impute" } else { - stop("The 'data' object must contain an impute column either defined as PKNCAdata$impute or otherwise the intervals default column name `impute`.") + intervals$impute <- NA_character_ + "impute" } # Identify the targeted intervals to which the action is applied From cad38826dff624c0836aeb43d1e30c08c4239df9 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 8 Feb 2025 18:33:06 +0100 Subject: [PATCH 05/49] refactor: interval_remove_impute / target_groups as a data.frame input --- R/intervals_support_funs.R | 43 +++++++++++++++++++------------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 5974ad7f..51531401 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -33,7 +33,7 @@ #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_remove_impute function -#' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = list(analyte = "Analyte1")) +#' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) #' #' # Print updated intervals #' print("Updated intervals:") @@ -90,25 +90,27 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta return(data) } - # Identify the targeted intervals to which the action is applied - mask_target_rows <- intervals %>% - mutate( - is.in.groups = if (!is.null(target_groups)) rowSums(across(all_of(names(target_groups)), ~ . %in% target_groups)) == length(target_groups) else TRUE, - is.in.params = rowSums(across(any_of(target_params), ~ . == TRUE)) > 0, - is.in.impute = grepl( - pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), - .data[[impute_col]] - ), - target_rows = is.in.groups & is.in.params & is.in.impute - ) %>% - pull(target_rows) + # Identify the targeted intervals based on the groups + if (!is.null(target_groups)) { + target_intervals <- inner_join(intervals, target_groups, by = names(target_groups)) + } else { + target_intervals <- intervals + } + + # Identify the targeted intervals based on the impute method and parameters + target_intervals <- target_intervals %>% + filter(rowSums(across(any_of(target_params), ~ . == TRUE)) > 0) %>% + filter(grepl( + pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), + .data[[impute_col]] + )) - # Create the new version intervals for the target parameters - new_intervals_without_impute <- intervals %>% - filter(mask_target_rows) %>% + # Create the new version intervals only for the target parameters + new_intervals_without_impute <- target_intervals %>% mutate(across(any_of(param_cols), ~FALSE)) %>% mutate(across(any_of(target_params), ~TRUE)) %>% rowwise() %>% + # Eliminate the target impute method from the impute column mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), collapse = "," )) %>% @@ -116,11 +118,10 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta ungroup() %>% as.data.frame() - # Make parameters FALSE in target intervals - intervals[mask_target_rows, target_params] <- FALSE - - # Combine and remove intervals where all logical parameter columns are FALSE - intervals <- rbind(intervals, new_intervals_without_impute) %>% + # Make parameters FALSE in original intervals and join the new ones + intervals <- intervals %>% + anti_join(target_intervals, by = names(intervals)) %>% + bind_rows(new_intervals_without_impute) %>% filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) # Depending on the input return the corresponding updated object From 1a4b4d20a8b813afce0074486d0f82f31cba5d48 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 8 Feb 2025 20:25:48 +0100 Subject: [PATCH 06/49] feat: interval_add_impute takes df inputs (data, targe_groups) & creates $impute if missing --- R/intervals_support_funs.R | 105 +++++++++++++++++++++---------------- 1 file changed, 59 insertions(+), 46 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 51531401..61d22b59 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -2,6 +2,7 @@ #' #' @inheritParams interval_add_impute #' @param target_impute A character string specifying the imputation method to be removed. +#' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. #' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -45,7 +46,7 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } - + if (is.data.frame(data)) { intervals <- data } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { @@ -53,15 +54,15 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } else { stop("'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") } - + if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } - + # Get all parameter column names in the PKNCAdata object all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(intervals), all_param_options) - + # Handle target_params if (is.null(target_params)) { # Take all parameter columns present with at least one TRUE value @@ -74,7 +75,7 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta target_params <- intersect(target_params, param_cols) } } - + # Determine the name of the impute column impute_col <- if (!is.null(impute_column)) { if (!impute_column %in% colnames(intervals)) { @@ -86,10 +87,10 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } else if ("impute" %in% colnames(intervals)) { "impute" } else { - warning("The 'intervals' object does not contain an impute default/custom column. No imputation to remove.") + warning("The 'intervals' object does not contain the impute default/custom column. No imputation to remove.") return(data) } - + # Identify the targeted intervals based on the groups if (!is.null(target_groups)) { target_intervals <- inner_join(intervals, target_groups, by = names(target_groups)) @@ -104,7 +105,7 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), .data[[impute_col]] )) - + # Create the new version intervals only for the target parameters new_intervals_without_impute <- target_intervals %>% mutate(across(any_of(param_cols), ~FALSE)) %>% @@ -112,18 +113,18 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta rowwise() %>% # Eliminate the target impute method from the impute column mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), - collapse = "," + collapse = "," )) %>% mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% ungroup() %>% as.data.frame() - + # Make parameters FALSE in original intervals and join the new ones intervals <- intervals %>% anti_join(target_intervals, by = names(intervals)) %>% bind_rows(new_intervals_without_impute) %>% filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) - + # Depending on the input return the corresponding updated object if (is.data.frame(data)) { intervals @@ -135,11 +136,12 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' Add specified imputation methods to the intervals in a PKNCAdata object. #' -#' @param data A PKNCAdata object containing the intervals and data components. +#' @param data A PKNCAdata object containing the intervals and data components, or a data frame of intervals. #' @param target_impute A character string specifying the imputation method to be added. #' @param after Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf). #' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. -#' @param target_groups A named list specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. +#' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. +#' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. #' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -170,45 +172,49 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_add_impute function -#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = list(ANALYTE = "Analyte1", ROUTE = "intravascular")) +#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) #' #' # Print updated intervals #' print("Updated intervals:") #' print(o_data$intervals) #' #' @export -interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { +interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL) { # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } - - if (!("intervals" %in% names(data)) || !("PKNCAdata" %in% class(data))) { - stop("'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + + if (is.data.frame(data)) { + intervals <- data + } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { + intervals <- data$intervals + } else { + stop("'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") } - + if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } - + # Get all parameter column names in the PKNCAdata object all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) - logical_cols <- names(which(colSums(data$intervals[sapply(data$intervals, is.logical)]) > 1)) + logical_cols <- names(which(colSums(intervals[sapply(intervals, is.logical)]) > 1)) param_cols <- intersect(logical_cols, all_param_options) - + # Handle target_params if (is.null(target_params)) { - # Take all logical columns in data$intervals that are known parameters + # Take all logical columns in intervals that are known parameters target_params <- param_cols } else { - # Check that all target_params are logical columns in data$intervals and known parameters + # Check that all target_params are logical columns in intervals and known parameters missing_params <- setdiff(target_params, logical_cols) if (length(missing_params) > 0) { stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) target_params <- intersect(target_params, param_cols) } } - + # Determine the name of the impute column impute_col <- if (!is.null(impute_column)) { if (!impute_column %in% colnames(intervals)) { @@ -223,19 +229,20 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params intervals$impute <- NA_character_ "impute" } - - # Identify the targeted intervals to which the action is applied - mask_target_rows <- data$intervals %>% - mutate( - is.in.groups = if (!is.null(target_groups)) rowSums(across(all_of(names(target_groups)), ~ . %in% target_groups)) == length(target_groups) else TRUE, - is.in.params = rowSums(across(any_of(target_params), ~ . == TRUE)) > 0, - target_rows = is.in.groups & is.in.params - ) %>% - pull(target_rows) - + + # Identify the targeted intervals based on the groups + if (!is.null(target_groups)) { + target_intervals <- inner_join(intervals, target_groups, by = names(target_groups)) + } else { + target_intervals <- intervals + } + + # Identify the targeted intervals based on the parameters + target_intervals <- target_intervals %>% + filter(rowSums(across(any_of(target_params), ~ . == TRUE)) > 0) + # Add the imputation method to the targeted intervals - new_intervals_with_impute <- data$intervals %>% - filter(mask_target_rows) %>% + new_intervals_with_impute <- target_intervals %>% mutate(across(any_of(param_cols), ~FALSE)) %>% mutate(across(any_of(target_params), ~TRUE)) %>% rowwise() %>% @@ -244,14 +251,20 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params impute_methods <- append(impute_methods, target_impute, after) paste(unique(impute_methods[impute_methods != ""]), collapse = ",") }) %>% + ungroup() %>% as.data.frame() - - # Set to FALSE all target parameters in the target intervals - data$intervals[mask_target_rows, target_params] <- FALSE - - # Combine and remove intervals where all logical parameter columns are FALSE - data$intervals <- rbind(data$intervals, new_intervals_with_impute) %>% - filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) - - return(data) + + # Make parameters FALSE in original intervals and join the new ones + intervals <- intervals %>% + anti_join(target_intervals, by = names(intervals)) %>% + bind_rows(new_intervals_with_impute) %>% + filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) + + # Depending on the input return the corresponding updated object + if (is.data.frame(data)) { + intervals + } else { + data$intervals <- intervals + data + } } From 75f7cf116958deb90a2771b313452d17f37c03a5 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 8 Feb 2025 20:39:33 +0100 Subject: [PATCH 07/49] feat: include arg allow_duplication to interval_add_impute --- R/intervals_support_funs.R | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 61d22b59..e833f3a2 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -179,7 +179,7 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' print(o_data$intervals) #' #' @export -interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL) { +interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE) { # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") @@ -248,8 +248,14 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params rowwise() %>% mutate(!!impute_col := { impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) - impute_methods <- append(impute_methods, target_impute, after) - paste(unique(impute_methods[impute_methods != ""]), collapse = ",") + if (!allow_duplication && target_impute %in% impute_methods) { + # If duplication is not allowed, do not add the impute method if it already exists + .data[[impute_col]] + } else { + # Add the impute method after the specified position + impute_methods <- append(impute_methods, target_impute, after) + paste(impute_methods[impute_methods != ""], collapse = ",") + } }) %>% ungroup() %>% as.data.frame() From bee905aaf9e729dac26c5096fd1d8a9bb263c2a3 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 12:32:57 +0100 Subject: [PATCH 08/49] fix: target_params only params changed for impute. Also keep intervals order (with optional arg to specify) --- R/intervals_support_funs.R | 59 ++++++++++++++++++++++++++------------ 1 file changed, 40 insertions(+), 19 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index e833f3a2..5dfe08c2 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -3,6 +3,8 @@ #' @inheritParams interval_add_impute #' @param target_impute A character string specifying the imputation method to be removed. #' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. +#' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. +#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE. #' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -36,17 +38,14 @@ #' # Apply interval_remove_impute function #' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) #' -#' # Print updated intervals -#' print("Updated intervals:") -#' print(o_data$intervals) -#' #' @export -interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL) { +interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } + # Determine if data is a PKNCAdata object or a data frame of intervals if (is.data.frame(data)) { intervals <- data } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { @@ -59,6 +58,9 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta stop("'target_impute' must be a character string.") } + # Add an index column to preserve the original order + intervals <- intervals %>% mutate(index = row_number()) + # Get all parameter column names in the PKNCAdata object all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(intervals), all_param_options) @@ -83,11 +85,11 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } impute_column } else if ("PKNCAdata" %in% class(data) && !is.na(data$impute)) { - intervals$impute + data$impute } else if ("impute" %in% colnames(intervals)) { "impute" } else { - warning("The 'intervals' object does not contain the impute default/custom column. No imputation to remove.") + warning("No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") return(data) } @@ -117,13 +119,22 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta )) %>% mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% ungroup() %>% + # Make sure the class of the impute_col remains the same + mutate(!!impute_col := as.character(.data[[impute_col]])) %>% as.data.frame() + # Eliminate from the old intervals the target parameters + old_intervals_with_impute <- target_intervals %>% + mutate(across(any_of(target_params), ~FALSE)) %>% + mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) + # Make parameters FALSE in original intervals and join the new ones intervals <- intervals %>% anti_join(target_intervals, by = names(intervals)) %>% - bind_rows(new_intervals_without_impute) %>% - filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) + bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% + filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) %>% + arrange(index) %>% + select(-index) # Depending on the input return the corresponding updated object if (is.data.frame(data)) { @@ -142,11 +153,14 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. #' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. #' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. +#' @param allow_duplication A boolean specifying whether to allow creating duplicates of the target_impute in the impute column (optional). Default is TRUE. +#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE. #' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. #' @examples #' d_conc <- data.frame( #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), #' time = rep(0:5, 2), +#' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6), #' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) #' ) @@ -162,11 +176,11 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' #' intervals <- data.frame( #' start = c(0, 0, 0), -#' end = c(24, 48, Inf), +#' end = c(3, 5, Inf), #' half.life = c(TRUE, FALSE, TRUE), +#' cmax = c(TRUE, TRUE, TRUE), #' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), -#' ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), -#' ROUTE = c("intravascular", "oral", "intravascular") +#' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) #' #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) @@ -174,17 +188,14 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' # Apply interval_add_impute function #' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) #' -#' # Print updated intervals -#' print("Updated intervals:") -#' print(o_data$intervals) -#' #' @export -interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE) { +interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } + # Determine if data is a PKNCAdata object or a data frame of intervals if (is.data.frame(data)) { intervals <- data } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { @@ -197,6 +208,9 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params stop("'target_impute' must be a character string.") } + # Add an index column to preserve the original order + intervals <- intervals %>% mutate(index = row_number()) + # Get all parameter column names in the PKNCAdata object all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) logical_cols <- names(which(colSums(intervals[sapply(intervals, is.logical)]) > 1)) @@ -260,11 +274,18 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params ungroup() %>% as.data.frame() + # Eliminate from the old intervals the target parameters + old_intervals_without_impute <- target_intervals %>% + mutate(across(any_of(target_params), ~FALSE)) %>% + mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) + # Make parameters FALSE in original intervals and join the new ones intervals <- intervals %>% anti_join(target_intervals, by = names(intervals)) %>% - bind_rows(new_intervals_with_impute) %>% - filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) + bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% + filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) %>% + arrange(index) %>% + select(-index) # Depending on the input return the corresponding updated object if (is.data.frame(data)) { From 67f7d8b40ebaa95e203116404f3cd81930792968 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 12:33:41 +0100 Subject: [PATCH 09/49] tests: refine tests for the changes in the function and add new ones --- R/test-intervals_support_funs.R | 196 +++++++++++++++++++++++++++----- 1 file changed, 166 insertions(+), 30 deletions(-) diff --git a/R/test-intervals_support_funs.R b/R/test-intervals_support_funs.R index 1f3a08f9..555d0ed6 100644 --- a/R/test-intervals_support_funs.R +++ b/R/test-intervals_support_funs.R @@ -1,5 +1,6 @@ library(testthat) library(PKNCA) +library(dplyr) # Source the function file if it's not already in the environment # source("path/to/your/function_file.R") @@ -9,14 +10,14 @@ d_conc <- data.frame( conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), time = rep(0:5, 2), analyte = rep(c("Analyte1", "Analyte2"), each = 6), - id = 1, - include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) + include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE), + ID = rep(1:2, each = 6) ) d_dose <- data.frame( dose = c(100, 200), - time = c(0, 2.5), - id = 1 + time = c(0, 0), + ID = c(1, 2) ) intervals <- data.frame( @@ -25,12 +26,12 @@ intervals <- data.frame( half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), - id = 1, - analyte = c("Analyte1", "Analyte2", "Analyte1") + ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + ID = c(1, 2, 1) ) -o_conc <- PKNCAconc(d_conc, conc ~ time | id / analyte, include_half.life = "include_hl") -o_dose <- PKNCAdose(d_dose, dose ~ time | id) +o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "include_hl") +o_dose <- PKNCAdose(d_dose, dose ~ time | ID) o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) # Test cases with unexpected inputs @@ -46,10 +47,10 @@ test_that("interval_remove_impute throws an error for non-character target_imput }) test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") o_data_no_intervals <- PKNCAdata(o_conc, o_dose) o_data_no_intervals$intervals <- NULL - expect_error(interval_remove_impute(o_data_no_intervals, target_impute = "start_conc0"), "'data' object must be a PKNCAdata object with 'intervals' and 'data' components.") + expect_error(interval_remove_impute(o_data_no_intervals, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") }) test_that("interval_remove_impute throws an error for unknown target_params", { @@ -62,8 +63,8 @@ test_that("interval_remove_impute handles impute column with different names", { o_data_changed_impute_name$impute <- "impute_col" o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute_col), - data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute_col = c("start_predose", "start_predose", NA))) @@ -73,20 +74,28 @@ test_that("interval_remove_impute handles impute column with NA values correctly o_data_with_na_impute <- o_data o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c(NA_character_, NA_character_, NA_character_))) }) +test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { + o_data_no_impute <- o_data + o_data_no_impute$intervals <- o_data_no_impute$intervals %>% select(-impute) + result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") + expect_equal(result, o_data_no_impute) + expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), + "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") +}) # Test intervals for expected outputs with different inputs test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) @@ -95,46 +104,173 @@ test_that("interval_remove_impute with no optional parameters uses all relevant test_that("interval_remove_impute handles specified target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) # half.life has no start_conc0 imputations - expect_equal(result$intervals %>% filter(half.life) %>% select(analyte, half.life, impute), - data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) # cmax has the same exact imputations as before - expect_equal(result$intervals %>% filter(cmax) %>% select(analyte, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(analyte, cmax, impute)) + expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) }) test_that("interval_remove_impute handles target_groups correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = list(analyte = "Analyte1")) + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(ANALYTE = "Analyte1")) # Analyte1 has no start_conc0 imputations - expect_equal(result$intervals %>% filter(analyte == "Analyte1") %>% select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte1", "Analyte1"), + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_predose", NA_character_))) # Analyte2 has the same exact imputations as before - expect_equal(result$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute), - o_data$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute)) + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), + o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) }) test_that("interval_remove_impute handles multiple target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte2", "Analyte1", "Analyte1"), + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) }) -test_that("interval_remove_impute handles with specifity impute character metod with multiple imputes", { +test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { o_data_multiple_imputes <- o_data o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", "start_predose"))) }) + +test_that("interval_remove_impute handles correctly argument new_rows_after_original", { + + # When true the new rows are added after the original rows + result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), + half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), + cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), + impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) + + # When false the new rows are added at the end of the data frame + result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), + half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), + impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) +}) + + +### Test interval_add_impute + +test_that("interval_add_impute throws an error if either data or target_impute is missing", { + expect_error(interval_add_impute(), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_add_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") +}) + +test_that("interval_add_impute throws an error for non-character target_impute", { + expect_error(interval_add_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") +}) + +test_that("interval_add_impute throws an error when input data is a non PKNCAdata object or has no intervals", { + expect_error(interval_add_impute(o_data$conc, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") + o_data_no_intervals <- PKNCAdata(o_conc, o_dose) + o_data_no_intervals$intervals <- NULL + expect_error(interval_add_impute(o_data_no_intervals, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") +}) + +test_that("interval_add_impute throws an error for unknown target_params", { + expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") +}) + +test_that("interval_add_impute handles impute column with different names", { + o_data_changed_impute_name <- o_data + o_data_changed_impute_name$impute <- "impute_col" + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +}) + +test_that("interval_add_impute handles impute column with NA values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("new_impute", "new_impute", "new_impute"))) +}) + +test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { + result <- interval_add_impute(o_data, target_impute = "new_impute") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +}) + +test_that("interval_add_impute handles specified target_params correctly", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life")) + expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) + expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) +}) + +test_that("interval_add_impute handles target_groups correctly", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(ANALYTE = "Analyte1")) + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), + o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) +}) + +test_that("interval_add_impute handles multiple target_params correctly", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +}) + +test_that("interval_add_impute handles allow_duplication correctly", { + + # When allow_duplication is FALSE, intervals with already the same impute method do not add it + result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose,start_conc0", "start_conc0"))) + + # When allow_duplication is TRUE, intervals with already the same impute method add it + result2 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = TRUE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,start_conc0", "start_predose,start_conc0", "start_conc0,start_conc0"))) + +}) + From b210bfe3d9b7bc1fce62abf2b831dacd738edbcc Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 13:06:23 +0100 Subject: [PATCH 10/49] fix: new_rows_after_original in intervals_add_impute --- R/intervals_support_funs.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 5dfe08c2..1eb31b77 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -272,12 +272,12 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params } }) %>% ungroup() %>% + mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% as.data.frame() # Eliminate from the old intervals the target parameters old_intervals_without_impute <- target_intervals %>% - mutate(across(any_of(target_params), ~FALSE)) %>% - mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) + mutate(across(any_of(target_params), ~FALSE)) # Make parameters FALSE in original intervals and join the new ones intervals <- intervals %>% From d7411a13c332f1e9f4924428b8deb46f950a2546 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 13:06:32 +0100 Subject: [PATCH 11/49] tests: add missing test for new_rows_after_original in intervals_add_impute --- R/test-intervals_support_funs.R | 38 +++++++++++++++++++++++++++------ 1 file changed, 31 insertions(+), 7 deletions(-) diff --git a/R/test-intervals_support_funs.R b/R/test-intervals_support_funs.R index 555d0ed6..c35ce952 100644 --- a/R/test-intervals_support_funs.R +++ b/R/test-intervals_support_funs.R @@ -1,10 +1,3 @@ -library(testthat) -library(PKNCA) -library(dplyr) - -# Source the function file if it's not already in the environment -# source("path/to/your/function_file.R") - # Create sample data for testing d_conc <- data.frame( conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), @@ -274,3 +267,34 @@ test_that("interval_add_impute handles allow_duplication correctly", { }) +test_that("interval_add_impute handles correctly argument new_rows_after_original", { + + # When true the new rows are added after the original rows + result1 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = TRUE) + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose", + "start_conc0,start_predose,new_impute", + "start_predose", + "start_predose,new_impute", + "start_conc0", + "start_conc0,new_impute")) + ) + + + # When false the new rows are added at the end of the data frame + result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), + cmax = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", + "start_predose", + "start_conc0", + "start_conc0,start_predose,new_impute", + "start_predose,new_impute", + "start_conc0,new_impute")) + ) +}) From e0d54a45e8863c6b143b3d14db672e1dabc136ed Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 13:13:21 +0100 Subject: [PATCH 12/49] move: test-intervals_support_funs.R to tests/testthat --- {R => tests/testthat}/test-intervals_support_funs.R | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename {R => tests/testthat}/test-intervals_support_funs.R (100%) diff --git a/R/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R similarity index 100% rename from R/test-intervals_support_funs.R rename to tests/testthat/test-intervals_support_funs.R From c490275b25c684613dc4e6ad1a558660695cd26b Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 13:21:47 +0100 Subject: [PATCH 13/49] style: namespace all dplyr functions --- R/intervals_support_funs.R | 68 +++++++++++++++++++------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 1eb31b77..f055cfda 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -59,7 +59,7 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta } # Add an index column to preserve the original order - intervals <- intervals %>% mutate(index = row_number()) + intervals <- dplyr::mutate(intervals, index = dplyr::row_number()) # Get all parameter column names in the PKNCAdata object all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) @@ -95,46 +95,46 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta # Identify the targeted intervals based on the groups if (!is.null(target_groups)) { - target_intervals <- inner_join(intervals, target_groups, by = names(target_groups)) + target_intervals <- dplyr::inner_join(intervals, target_groups, by = names(target_groups)) } else { target_intervals <- intervals } # Identify the targeted intervals based on the impute method and parameters target_intervals <- target_intervals %>% - filter(rowSums(across(any_of(target_params), ~ . == TRUE)) > 0) %>% - filter(grepl( + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) %>% + dplyr::filter(grepl( pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), .data[[impute_col]] )) # Create the new version intervals only for the target parameters new_intervals_without_impute <- target_intervals %>% - mutate(across(any_of(param_cols), ~FALSE)) %>% - mutate(across(any_of(target_params), ~TRUE)) %>% - rowwise() %>% + dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% + dplyr::rowwise() %>% # Eliminate the target impute method from the impute column - mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), - collapse = "," + dplyr::mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), + collapse = "," )) %>% - mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% - ungroup() %>% + dplyr::mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% + dplyr::ungroup() %>% # Make sure the class of the impute_col remains the same - mutate(!!impute_col := as.character(.data[[impute_col]])) %>% + dplyr::mutate(!!impute_col := as.character(.data[[impute_col]])) %>% as.data.frame() # Eliminate from the old intervals the target parameters old_intervals_with_impute <- target_intervals %>% - mutate(across(any_of(target_params), ~FALSE)) %>% - mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) %>% + dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) # Make parameters FALSE in original intervals and join the new ones intervals <- intervals %>% - anti_join(target_intervals, by = names(intervals)) %>% - bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% - filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) %>% - arrange(index) %>% - select(-index) + dplyr::anti_join(target_intervals, by = names(intervals)) %>% + dplyr::bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% + dplyr::arrange(index) %>% + dplyr::select(-index) # Depending on the input return the corresponding updated object if (is.data.frame(data)) { @@ -209,7 +209,7 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params } # Add an index column to preserve the original order - intervals <- intervals %>% mutate(index = row_number()) + intervals <- dplyr::mutate(intervals, index = dplyr::row_number()) # Get all parameter column names in the PKNCAdata object all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) @@ -246,21 +246,21 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params # Identify the targeted intervals based on the groups if (!is.null(target_groups)) { - target_intervals <- inner_join(intervals, target_groups, by = names(target_groups)) + target_intervals <- dplyr::inner_join(intervals, target_groups, by = names(target_groups)) } else { target_intervals <- intervals } # Identify the targeted intervals based on the parameters target_intervals <- target_intervals %>% - filter(rowSums(across(any_of(target_params), ~ . == TRUE)) > 0) + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) # Add the imputation method to the targeted intervals new_intervals_with_impute <- target_intervals %>% - mutate(across(any_of(param_cols), ~FALSE)) %>% - mutate(across(any_of(target_params), ~TRUE)) %>% - rowwise() %>% - mutate(!!impute_col := { + dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% + dplyr::rowwise() %>% + dplyr::mutate(!!impute_col := { impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) if (!allow_duplication && target_impute %in% impute_methods) { # If duplication is not allowed, do not add the impute method if it already exists @@ -271,21 +271,21 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params paste(impute_methods[impute_methods != ""], collapse = ",") } }) %>% - ungroup() %>% - mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% + dplyr::ungroup() %>% + dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% as.data.frame() # Eliminate from the old intervals the target parameters old_intervals_without_impute <- target_intervals %>% - mutate(across(any_of(target_params), ~FALSE)) + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) # Make parameters FALSE in original intervals and join the new ones intervals <- intervals %>% - anti_join(target_intervals, by = names(intervals)) %>% - bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% - filter(rowSums(across(any_of(param_cols), as.numeric)) > 0) %>% - arrange(index) %>% - select(-index) + dplyr::anti_join(target_intervals, by = names(intervals)) %>% + dplyr::bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% + dplyr::arrange(index) %>% + dplyr::select(-index) # Depending on the input return the corresponding updated object if (is.data.frame(data)) { From a85d8168145fbb68bb3b45d2d88c4154859656ea Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 13:22:59 +0100 Subject: [PATCH 14/49] style: remove PKNCA namespacing --- R/intervals_support_funs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index f055cfda..4d4e41d6 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -212,7 +212,7 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params intervals <- dplyr::mutate(intervals, index = dplyr::row_number()) # Get all parameter column names in the PKNCAdata object - all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) logical_cols <- names(which(colSums(intervals[sapply(intervals, is.logical)]) > 1)) param_cols <- intersect(logical_cols, all_param_options) From 51bfe487fe26295bd2eff0afb605e593cc296126 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 15:15:41 +0100 Subject: [PATCH 15/49] refactor: make functions S3 methods. adjust tests for warnings/errors --- R/intervals_support_funs.R | 129 +++++++++---------- tests/testthat/test-intervals_support_funs.R | 16 +-- 2 files changed, 69 insertions(+), 76 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 4d4e41d6..f230c135 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -40,37 +40,44 @@ #' #' @export interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } - - # Determine if data is a PKNCAdata object or a data frame of intervals - if (is.data.frame(data)) { - intervals <- data - } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { - intervals <- data$intervals - } else { - stop("'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") + if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { + stop("The 'data' object must be a PKNCAdata object or a data frame.") } - if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } + UseMethod("interval_remove_impute") +} + +#' @export +interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { + if (is.null(impute_column) && !is.na(data$impute)) { + impute_column <- data$impute + } + data$intervals <- interval_remove_impute(data$intervals, target_impute, target_params, target_groups, impute_column, new_rows_after_original) + data +} + +#' @export +interval_remove_impute.data.frame <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { + # Add an index column to preserve the original order - intervals <- dplyr::mutate(intervals, index = dplyr::row_number()) + data <- dplyr::mutate(data, index = dplyr::row_number()) - # Get all parameter column names in the PKNCAdata object + # Get all parameter column names in the data frame all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) - param_cols <- intersect(names(intervals), all_param_options) + param_cols <- intersect(names(data), all_param_options) # Handle target_params if (is.null(target_params)) { # Take all parameter columns present with at least one TRUE value - target_params <- param_cols[colSums(intervals[param_cols]) > 0] + target_params <- param_cols[colSums(data[param_cols]) > 0] } else { - # Check that all target_params are present in the intervals + # Check that all target_params are present in the data frame missing_params <- setdiff(target_params, param_cols) if (length(missing_params) > 0) { stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) @@ -80,24 +87,22 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta # Determine the name of the impute column impute_col <- if (!is.null(impute_column)) { - if (!impute_column %in% colnames(intervals)) { - stop("The 'intervals' object does not contain the specified impute column.") + if (!impute_column %in% colnames(data)) { + stop("The 'data' object does not contain the specified impute column.") } impute_column - } else if ("PKNCAdata" %in% class(data) && !is.na(data$impute)) { - data$impute - } else if ("impute" %in% colnames(intervals)) { + } else if ("impute" %in% colnames(data)) { "impute" } else { - warning("No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") - return(data) + warning("No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") + return(data %>% dplyr::select(-index)) } # Identify the targeted intervals based on the groups if (!is.null(target_groups)) { - target_intervals <- dplyr::inner_join(intervals, target_groups, by = names(target_groups)) + target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) } else { - target_intervals <- intervals + target_intervals <- data } # Identify the targeted intervals based on the impute method and parameters @@ -129,20 +134,14 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) # Make parameters FALSE in original intervals and join the new ones - intervals <- intervals %>% - dplyr::anti_join(target_intervals, by = names(intervals)) %>% + data <- data %>% + dplyr::anti_join(target_intervals, by = names(data)) %>% dplyr::bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% dplyr::arrange(index) %>% dplyr::select(-index) - # Depending on the input return the corresponding updated object - if (is.data.frame(data)) { - intervals - } else { - data$intervals <- intervals - data - } + data } #' Add specified imputation methods to the intervals in a PKNCAdata object. @@ -190,38 +189,44 @@ interval_remove_impute <- function(data, target_impute, target_params = NULL, ta #' #' @export interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - # Validate the input if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } - - # Determine if data is a PKNCAdata object or a data frame of intervals - if (is.data.frame(data)) { - intervals <- data - } else if ("intervals" %in% names(data) && "PKNCAdata" %in% class(data)) { - intervals <- data$intervals - } else { - stop("'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") + if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { + stop("The 'data' object must be a PKNCAdata object or a data frame.") } - if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } + UseMethod("interval_add_impute") +} + +#' @export +interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { + if (is.null(impute_column) && !is.na(data$impute)) { + impute_column <- data$impute + } + data$intervals <- interval_add_impute(data$intervals, target_impute, after, target_params, target_groups, impute_column, allow_duplication, new_rows_after_original) + data +} + +#' @export +interval_add_impute.data.frame <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { # Add an index column to preserve the original order - intervals <- dplyr::mutate(intervals, index = dplyr::row_number()) + data <- dplyr::mutate(data, index = dplyr::row_number()) - # Get all parameter column names in the PKNCAdata object - all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) - logical_cols <- names(which(colSums(intervals[sapply(intervals, is.logical)]) > 1)) + # Get all parameter column names in the data frame + all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + logical_cols <- names(which(colSums(data[sapply(data, is.logical)]) > 1)) param_cols <- intersect(logical_cols, all_param_options) # Handle target_params if (is.null(target_params)) { - # Take all logical columns in intervals that are known parameters + # Take all logical columns in data that are known parameters target_params <- param_cols } else { - # Check that all target_params are logical columns in intervals and known parameters + # Check that all target_params are logical columns in data and known parameters missing_params <- setdiff(target_params, logical_cols) if (length(missing_params) > 0) { stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) @@ -231,24 +236,22 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params # Determine the name of the impute column impute_col <- if (!is.null(impute_column)) { - if (!impute_column %in% colnames(intervals)) { - stop("The 'intervals' object does not contain the specified impute column.") + if (!impute_column %in% colnames(data)) { + stop("The 'data' object does not contain the specified impute column.") } impute_column - } else if ("PKNCAdata" %in% class(data) && !is.na(data$impute)) { - data$impute - } else if ("impute" %in% colnames(intervals)) { + } else if ("impute" %in% colnames(data)) { "impute" } else { - intervals$impute <- NA_character_ + data$impute <- NA_character_ "impute" } # Identify the targeted intervals based on the groups if (!is.null(target_groups)) { - target_intervals <- dplyr::inner_join(intervals, target_groups, by = names(target_groups)) + target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) } else { - target_intervals <- intervals + target_intervals <- data } # Identify the targeted intervals based on the parameters @@ -280,18 +283,12 @@ interval_add_impute <- function(data, target_impute, after = Inf, target_params dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) # Make parameters FALSE in original intervals and join the new ones - intervals <- intervals %>% - dplyr::anti_join(target_intervals, by = names(intervals)) %>% + data <- data %>% + dplyr::anti_join(target_intervals, by = names(data)) %>% dplyr::bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% dplyr::arrange(index) %>% dplyr::select(-index) - # Depending on the input return the corresponding updated object - if (is.data.frame(data)) { - intervals - } else { - data$intervals <- intervals - data - } + data } diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index c35ce952..9285906e 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -40,10 +40,8 @@ test_that("interval_remove_impute throws an error for non-character target_imput }) test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") - o_data_no_intervals <- PKNCAdata(o_conc, o_dose) - o_data_no_intervals$intervals <- NULL - expect_error(interval_remove_impute(o_data_no_intervals, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") + expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") + expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) }) test_that("interval_remove_impute throws an error for unknown target_params", { @@ -80,7 +78,7 @@ test_that("interval_remove_impute handles missing impute column by not modifying result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") expect_equal(result, o_data_no_impute) expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), - "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") + "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") }) # Test intervals for expected outputs with different inputs @@ -174,10 +172,8 @@ test_that("interval_add_impute throws an error for non-character target_impute", }) test_that("interval_add_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_add_impute(o_data$conc, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") - o_data_no_intervals <- PKNCAdata(o_conc, o_dose) - o_data_no_intervals$intervals <- NULL - expect_error(interval_add_impute(o_data_no_intervals, target_impute = "start_conc0"), "'data' must be a PKNCAdata object with 'intervals' and 'data' components or a data frame of intervals.") + expect_error(interval_add_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") + expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) }) test_that("interval_add_impute throws an error for unknown target_params", { @@ -251,7 +247,7 @@ test_that("interval_add_impute handles allow_duplication correctly", { # When allow_duplication is FALSE, intervals with already the same impute method do not add it result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), From dec1962ace31accef5635c962af26a17ca554c63 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 15:25:35 +0100 Subject: [PATCH 16/49] refactor: order functions in the script alphabetically --- R/intervals_support_funs.R | 575 ++++++++++--------- tests/testthat/test-intervals_support_funs.R | 265 ++++----- 2 files changed, 424 insertions(+), 416 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index f230c135..eca01cfe 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -1,294 +1,299 @@ -#' Remove specified imputation methods from the intervals in a PKNCAdata object. -#' -#' @inheritParams interval_add_impute -#' @param target_impute A character string specifying the imputation method to be removed. -#' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. -#' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. -#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE. -#' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. -#' @examples -#' d_conc <- data.frame( -#' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), -#' time = rep(0:5, 2), -#' ID = rep(1:2, each = 6), -#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), -#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) -#' ) -#' -#' d_dose <- data.frame( -#' dose = c(100, 200), -#' time = c(0, 0), -#' ID = c(1, 2) -#' ) -#' -#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) -#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) -#' -#' intervals <- data.frame( -#' start = c(0, 0, 0), -#' end = c(3, 5, Inf), -#' half.life = c(TRUE, FALSE, TRUE), -#' cmax = c(TRUE, TRUE, TRUE), -#' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), -#' analyte = c("Analyte1", "Analyte2", "Analyte1") -#' ) -#' -#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) -#' -#' # Apply interval_remove_impute function -#' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) -#' -#' @export -interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - if (missing(data) || missing(target_impute)) { - stop("Both 'data' and 'target_impute' must be provided.") - } - if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { - stop("The 'data' object must be a PKNCAdata object or a data frame.") - } - if (!is.character(target_impute)) { - stop("'target_impute' must be a character string.") - } - - UseMethod("interval_remove_impute") -} - -#' @export -interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - if (is.null(impute_column) && !is.na(data$impute)) { - impute_column <- data$impute - } - data$intervals <- interval_remove_impute(data$intervals, target_impute, target_params, target_groups, impute_column, new_rows_after_original) - data -} - -#' @export -interval_remove_impute.data.frame <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - - # Add an index column to preserve the original order - data <- dplyr::mutate(data, index = dplyr::row_number()) - - # Get all parameter column names in the data frame - all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) - param_cols <- intersect(names(data), all_param_options) - - # Handle target_params - if (is.null(target_params)) { - # Take all parameter columns present with at least one TRUE value - target_params <- param_cols[colSums(data[param_cols]) > 0] - } else { - # Check that all target_params are present in the data frame - missing_params <- setdiff(target_params, param_cols) - if (length(missing_params) > 0) { - stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) - target_params <- intersect(target_params, param_cols) - } - } - - # Determine the name of the impute column - impute_col <- if (!is.null(impute_column)) { - if (!impute_column %in% colnames(data)) { - stop("The 'data' object does not contain the specified impute column.") - } - impute_column - } else if ("impute" %in% colnames(data)) { - "impute" - } else { - warning("No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") - return(data %>% dplyr::select(-index)) - } - - # Identify the targeted intervals based on the groups - if (!is.null(target_groups)) { - target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) - } else { - target_intervals <- data - } - - # Identify the targeted intervals based on the impute method and parameters - target_intervals <- target_intervals %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) %>% - dplyr::filter(grepl( - pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), - .data[[impute_col]] - )) - - # Create the new version intervals only for the target parameters - new_intervals_without_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% - dplyr::rowwise() %>% - # Eliminate the target impute method from the impute column - dplyr::mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), - collapse = "," - )) %>% - dplyr::mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% - dplyr::ungroup() %>% - # Make sure the class of the impute_col remains the same - dplyr::mutate(!!impute_col := as.character(.data[[impute_col]])) %>% - as.data.frame() - - # Eliminate from the old intervals the target parameters - old_intervals_with_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) %>% - dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) - - # Make parameters FALSE in original intervals and join the new ones - data <- data %>% - dplyr::anti_join(target_intervals, by = names(data)) %>% - dplyr::bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% - dplyr::arrange(index) %>% - dplyr::select(-index) - - data -} - -#' Add specified imputation methods to the intervals in a PKNCAdata object. -#' -#' @param data A PKNCAdata object containing the intervals and data components, or a data frame of intervals. -#' @param target_impute A character string specifying the imputation method to be added. -#' @param after Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf). -#' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. -#' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. -#' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. -#' @param allow_duplication A boolean specifying whether to allow creating duplicates of the target_impute in the impute column (optional). Default is TRUE. -#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE. -#' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. -#' @examples -#' d_conc <- data.frame( -#' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), -#' time = rep(0:5, 2), -#' ID = rep(1:2, each = 6), -#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), -#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) -#' ) -#' -#' d_dose <- data.frame( -#' dose = c(100, 200), -#' time = c(0, 0), -#' ID = c(1, 2) -#' ) -#' -#' o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") -#' o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) -#' -#' intervals <- data.frame( -#' start = c(0, 0, 0), -#' end = c(3, 5, Inf), -#' half.life = c(TRUE, FALSE, TRUE), -#' cmax = c(TRUE, TRUE, TRUE), -#' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), -#' analyte = c("Analyte1", "Analyte2", "Analyte1") -#' ) -#' -#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) -#' -#' # Apply interval_add_impute function -#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) -#' -#' @export -interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - if (missing(data) || missing(target_impute)) { - stop("Both 'data' and 'target_impute' must be provided.") - } - if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { - stop("The 'data' object must be a PKNCAdata object or a data frame.") - } - if (!is.character(target_impute)) { - stop("'target_impute' must be a character string.") - } - UseMethod("interval_add_impute") -} - -#' @export -interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - if (is.null(impute_column) && !is.na(data$impute)) { - impute_column <- data$impute - } - data$intervals <- interval_add_impute(data$intervals, target_impute, after, target_params, target_groups, impute_column, allow_duplication, new_rows_after_original) - data -} - -#' @export -interval_add_impute.data.frame <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - - # Add an index column to preserve the original order - data <- dplyr::mutate(data, index = dplyr::row_number()) +# Create sample data for testing +d_conc <- data.frame( + conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), + time = rep(0:5, 2), + analyte = rep(c("Analyte1", "Analyte2"), each = 6), + include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE), + ID = rep(1:2, each = 6) +) + +d_dose <- data.frame( + dose = c(100, 200), + time = c(0, 0), + ID = c(1, 2) +) + +intervals <- data.frame( + start = c(0, 0, 0), + end = c(24, 48, Inf), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), + ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + ID = c(1, 2, 1) +) + +o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "include_hl") +o_dose <- PKNCAdose(d_dose, dose ~ time | ID) +o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) + + +### Test interval_add_impute + +test_that("interval_add_impute throws an error if either data or target_impute is missing", { + expect_error(interval_add_impute(), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_add_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") +}) + +test_that("interval_add_impute throws an error for non-character target_impute", { + expect_error(interval_add_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") +}) + +test_that("interval_add_impute throws an error when input data is a non PKNCAdata object or has no intervals", { + expect_error(interval_add_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") + expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) +}) + +test_that("interval_add_impute throws an error for unknown target_params", { + expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") +}) + +test_that("interval_add_impute handles impute column with different names", { + o_data_changed_impute_name <- o_data + o_data_changed_impute_name$impute <- "impute_col" + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +}) + +test_that("interval_add_impute handles impute column with NA values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("new_impute", "new_impute", "new_impute"))) +}) + +test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { + result <- interval_add_impute(o_data, target_impute = "new_impute") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +}) + +test_that("interval_add_impute handles specified target_params correctly", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life")) + expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) + expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) +}) + +test_that("interval_add_impute handles target_groups correctly", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(ANALYTE = "Analyte1")) + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), + o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) +}) + +test_that("interval_add_impute handles multiple target_params correctly", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +}) + +test_that("interval_add_impute handles allow_duplication correctly", { - # Get all parameter column names in the data frame - all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) - logical_cols <- names(which(colSums(data[sapply(data, is.logical)]) > 1)) - param_cols <- intersect(logical_cols, all_param_options) + # When allow_duplication is FALSE, intervals with already the same impute method do not add it + result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose,start_conc0", "start_conc0"))) - # Handle target_params - if (is.null(target_params)) { - # Take all logical columns in data that are known parameters - target_params <- param_cols - } else { - # Check that all target_params are logical columns in data and known parameters - missing_params <- setdiff(target_params, logical_cols) - if (length(missing_params) > 0) { - stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) - target_params <- intersect(target_params, param_cols) - } - } + # When allow_duplication is TRUE, intervals with already the same impute method add it + result2 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = TRUE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,start_conc0", "start_predose,start_conc0", "start_conc0,start_conc0"))) - # Determine the name of the impute column - impute_col <- if (!is.null(impute_column)) { - if (!impute_column %in% colnames(data)) { - stop("The 'data' object does not contain the specified impute column.") - } - impute_column - } else if ("impute" %in% colnames(data)) { - "impute" - } else { - data$impute <- NA_character_ - "impute" - } +}) + +test_that("interval_add_impute handles correctly argument new_rows_after_original", { - # Identify the targeted intervals based on the groups - if (!is.null(target_groups)) { - target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) - } else { - target_intervals <- data - } + # When true the new rows are added after the original rows + result1 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = TRUE) + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose", + "start_conc0,start_predose,new_impute", + "start_predose", + "start_predose,new_impute", + "start_conc0", + "start_conc0,new_impute")) + ) - # Identify the targeted intervals based on the parameters - target_intervals <- target_intervals %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) - # Add the imputation method to the targeted intervals - new_intervals_with_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% - dplyr::rowwise() %>% - dplyr::mutate(!!impute_col := { - impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) - if (!allow_duplication && target_impute %in% impute_methods) { - # If duplication is not allowed, do not add the impute method if it already exists - .data[[impute_col]] - } else { - # Add the impute method after the specified position - impute_methods <- append(impute_methods, target_impute, after) - paste(impute_methods[impute_methods != ""], collapse = ",") - } - }) %>% - dplyr::ungroup() %>% - dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% - as.data.frame() + # When false the new rows are added at the end of the data frame + result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), + cmax = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", + "start_predose", + "start_conc0", + "start_conc0,start_predose,new_impute", + "start_predose,new_impute", + "start_conc0,new_impute")) + ) +}) + + +### Test interval_remove_impute + + +test_that("interval_remove_impute throws an error if either data or target_impute is missing", { + expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_remove_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") +}) + +test_that("interval_remove_impute throws an error for non-character target_impute", { + expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") +}) + +test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { + expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") + expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) +}) + +test_that("interval_remove_impute throws an error for unknown target_params", { + expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") +}) + +test_that("interval_remove_impute handles impute column with different names", { + o_data_changed_impute_name <- o_data + o_data_changed_impute_name$impute <- "impute_col" + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute_col = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles impute column with NA values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c(NA_character_, NA_character_, NA_character_))) +}) + +test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { + o_data_no_impute <- o_data + o_data_no_impute$intervals <- o_data_no_impute$intervals %>% select(-impute) + result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") + expect_equal(result, o_data_no_impute) + expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), + "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") +}) + +# Test intervals for expected outputs with different inputs + +test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles specified target_params correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) + # half.life has no start_conc0 imputations + expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) + # cmax has the same exact imputations as before + expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) +}) + +test_that("interval_remove_impute handles target_groups correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(ANALYTE = "Analyte1")) + # Analyte1 has no start_conc0 imputations + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_predose", NA_character_))) - # Eliminate from the old intervals the target parameters - old_intervals_without_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) + # Analyte2 has the same exact imputations as before + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), + o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) +}) + +test_that("interval_remove_impute handles multiple target_params correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { + o_data_multiple_imputes <- o_data + o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") + result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", "start_predose"))) +}) + + +test_that("interval_remove_impute handles correctly argument new_rows_after_original", { - # Make parameters FALSE in original intervals and join the new ones - data <- data %>% - dplyr::anti_join(target_intervals, by = names(data)) %>% - dplyr::bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% - dplyr::arrange(index) %>% - dplyr::select(-index) + # When true the new rows are added after the original rows + result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), + half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), + cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), + impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) - data -} + # When false the new rows are added at the end of the data frame + result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), + half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), + impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) +}) + diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 9285906e..bd0ac144 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -27,137 +27,6 @@ o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "inc o_dose <- PKNCAdose(d_dose, dose ~ time | ID) o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) -# Test cases with unexpected inputs - -test_that("interval_remove_impute throws an error if either data or target_impute is missing", { - expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_remove_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") -}) - -test_that("interval_remove_impute throws an error for non-character target_impute", { - expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") -}) - -test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") - expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) -}) - -test_that("interval_remove_impute throws an error for unknown target_params", { - expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), - "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") -}) - -test_that("interval_remove_impute handles impute column with different names", { - o_data_changed_impute_name <- o_data - o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) - result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute_col = c("start_predose", "start_predose", NA))) -}) - -test_that("interval_remove_impute handles impute column with NA values correctly", { - o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) - result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c(NA_character_, NA_character_, NA_character_))) -}) - -test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { - o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals %>% select(-impute) - result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") - expect_equal(result, o_data_no_impute) - expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), - "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") -}) - -# Test intervals for expected outputs with different inputs - -test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) -}) - -test_that("interval_remove_impute handles specified target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) - # half.life has no start_conc0 imputations - expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) - # cmax has the same exact imputations as before - expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) -}) - -test_that("interval_remove_impute handles target_groups correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(ANALYTE = "Analyte1")) - # Analyte1 has no start_conc0 imputations - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1"), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_predose", NA_character_))) - - # Analyte2 has the same exact imputations as before - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), - o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) -}) - -test_that("interval_remove_impute handles multiple target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) -}) - -test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { - o_data_multiple_imputes <- o_data - o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") - result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", "start_predose"))) -}) - - -test_that("interval_remove_impute handles correctly argument new_rows_after_original", { - - # When true the new rows are added after the original rows - result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), - cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), - impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) - - # When false the new rows are added at the end of the data frame - result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), - half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), - impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) -}) - ### Test interval_add_impute @@ -294,3 +163,137 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina "start_conc0,new_impute")) ) }) + + +### Test interval_remove_impute + + +test_that("interval_remove_impute throws an error if either data or target_impute is missing", { + expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") + expect_error(interval_remove_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") +}) + +test_that("interval_remove_impute throws an error for non-character target_impute", { + expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") +}) + +test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { + expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") + expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) +}) + +test_that("interval_remove_impute throws an error for unknown target_params", { + expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") +}) + +test_that("interval_remove_impute handles impute column with different names", { + o_data_changed_impute_name <- o_data + o_data_changed_impute_name$impute <- "impute_col" + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute_col = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles impute column with NA values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c(NA_character_, NA_character_, NA_character_))) +}) + +test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { + o_data_no_impute <- o_data + o_data_no_impute$intervals <- o_data_no_impute$intervals %>% select(-impute) + result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") + expect_equal(result, o_data_no_impute) + expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), + "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") +}) + +# Test intervals for expected outputs with different inputs + +test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles specified target_params correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) + # half.life has no start_conc0 imputations + expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) + # cmax has the same exact imputations as before + expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) +}) + +test_that("interval_remove_impute handles target_groups correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(ANALYTE = "Analyte1")) + # Analyte1 has no start_conc0 imputations + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_predose", NA_character_))) + + # Analyte2 has the same exact imputations as before + expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), + o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) +}) + +test_that("interval_remove_impute handles multiple target_params correctly", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA))) +}) + +test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { + o_data_multiple_imputes <- o_data + o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") + result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") + expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", "start_predose"))) +}) + + +test_that("interval_remove_impute handles correctly argument new_rows_after_original", { + + # When true the new rows are added after the original rows + result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) + expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), + half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), + cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), + impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) + + # When false the new rows are added at the end of the data frame + result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) + expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), + data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), + half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), + impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) +}) + From c56b61a013b6f12767d66a38aac43adf9fda3563 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 15:54:34 +0100 Subject: [PATCH 17/49] fix: file duplicate from previous commit --- R/intervals_support_funs.R | 570 ++++++++++++++++++------------------- 1 file changed, 280 insertions(+), 290 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index eca01cfe..127d7736 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -1,299 +1,289 @@ -# Create sample data for testing -d_conc <- data.frame( - conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), - time = rep(0:5, 2), - analyte = rep(c("Analyte1", "Analyte2"), each = 6), - include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE), - ID = rep(1:2, each = 6) -) - -d_dose <- data.frame( - dose = c(100, 200), - time = c(0, 0), - ID = c(1, 2) -) - -intervals <- data.frame( - start = c(0, 0, 0), - end = c(24, 48, Inf), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), - ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - ID = c(1, 2, 1) -) - -o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "include_hl") -o_dose <- PKNCAdose(d_dose, dose ~ time | ID) -o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) - - -### Test interval_add_impute - -test_that("interval_add_impute throws an error if either data or target_impute is missing", { - expect_error(interval_add_impute(), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_add_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") -}) - -test_that("interval_add_impute throws an error for non-character target_impute", { - expect_error(interval_add_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") -}) - -test_that("interval_add_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_add_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") - expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) -}) - -test_that("interval_add_impute throws an error for unknown target_params", { - expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), - "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") -}) - -test_that("interval_add_impute handles impute column with different names", { - o_data_changed_impute_name <- o_data - o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) - result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -}) - -test_that("interval_add_impute handles impute column with NA values correctly", { - o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) - result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("new_impute", "new_impute", "new_impute"))) -}) - -test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { - result <- interval_add_impute(o_data, target_impute = "new_impute") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -}) - -test_that("interval_add_impute handles specified target_params correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life")) - expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) -}) - -test_that("interval_add_impute handles target_groups correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(ANALYTE = "Analyte1")) - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1"), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), - o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) -}) - -test_that("interval_add_impute handles multiple target_params correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -}) - -test_that("interval_add_impute handles allow_duplication correctly", { +#' Add specified imputation methods to the intervals in a PKNCAdata object. +#' +#' @param data A PKNCAdata object containing the intervals and data components, or a data frame of intervals. +#' @param target_impute A character string specifying the imputation method to be added. +#' @param after Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf). +#' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. +#' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. +#' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. +#' @param allow_duplication A boolean specifying whether to allow creating duplicates of the target_impute in the impute column (optional). Default is TRUE. +#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE. +#' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. +#' @examples +#' d_conc <- data.frame( +#' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), +#' time = rep(0:5, 2), +#' ID = rep(1:2, each = 6), +#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), +#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +#' ) +#' +#' d_dose <- data.frame( +#' dose = c(100, 200), +#' time = c(0, 0), +#' ID = c(1, 2) +#' ) +#' +#' o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") +#' o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) +#' +#' intervals <- data.frame( +#' start = c(0, 0, 0), +#' end = c(3, 5, Inf), +#' half.life = c(TRUE, FALSE, TRUE), +#' cmax = c(TRUE, TRUE, TRUE), +#' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), +#' analyte = c("Analyte1", "Analyte2", "Analyte1") +#' ) +#' +#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) +#' +#' # Apply interval_add_impute function +#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) +#' @export +interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { + if (missing(data) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { + stop("The 'data' object must be a PKNCAdata object or a data frame.") + } + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + UseMethod("interval_add_impute") +} + +#' @export +interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { + if (is.null(impute_column) && !is.na(data$impute)) { + impute_column <- data$impute + } + data$intervals <- interval_add_impute(data$intervals, target_impute, after, target_params, target_groups, impute_column, allow_duplication, new_rows_after_original) + data +} + +#' @export +interval_add_impute.data.frame <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - # When allow_duplication is FALSE, intervals with already the same impute method do not add it - result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose", "start_predose,start_conc0", "start_conc0"))) + # Add an index column to preserve the original order + data <- dplyr::mutate(data, index = dplyr::row_number()) - # When allow_duplication is TRUE, intervals with already the same impute method add it - result2 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = TRUE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,start_conc0", "start_predose,start_conc0", "start_conc0,start_conc0"))) + # Get all parameter column names in the data frame + all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + logical_cols <- names(which(colSums(data[sapply(data, is.logical)]) > 1)) + param_cols <- intersect(logical_cols, all_param_options) -}) - -test_that("interval_add_impute handles correctly argument new_rows_after_original", { + # Handle target_params + if (is.null(target_params)) { + # Take all logical columns in data that are known parameters + target_params <- param_cols + } else { + # Check that all target_params are logical columns in data and known parameters + missing_params <- setdiff(target_params, logical_cols) + if (length(missing_params) > 0) { + stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) + target_params <- intersect(target_params, param_cols) + } + } - # When true the new rows are added after the original rows - result1 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), - cmax = c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), - impute = c("start_conc0,start_predose", - "start_conc0,start_predose,new_impute", - "start_predose", - "start_predose,new_impute", - "start_conc0", - "start_conc0,new_impute")) - ) + # Determine the name of the impute column + impute_col <- if (!is.null(impute_column)) { + if (!impute_column %in% colnames(data)) { + stop("The 'data' object does not contain the specified impute column.") + } + impute_column + } else if ("impute" %in% colnames(data)) { + "impute" + } else { + data$impute <- NA_character_ + "impute" + } + # Identify the targeted intervals based on the groups + if (!is.null(target_groups)) { + target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) + } else { + target_intervals <- data + } - # When false the new rows are added at the end of the data frame - result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), - cmax = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose", - "start_predose", - "start_conc0", - "start_conc0,start_predose,new_impute", - "start_predose,new_impute", - "start_conc0,new_impute")) - ) -}) - - -### Test interval_remove_impute - - -test_that("interval_remove_impute throws an error if either data or target_impute is missing", { - expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_remove_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") -}) - -test_that("interval_remove_impute throws an error for non-character target_impute", { - expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") -}) - -test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") - expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) -}) - -test_that("interval_remove_impute throws an error for unknown target_params", { - expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), - "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") -}) - -test_that("interval_remove_impute handles impute column with different names", { - o_data_changed_impute_name <- o_data - o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) - result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute_col = c("start_predose", "start_predose", NA))) -}) - -test_that("interval_remove_impute handles impute column with NA values correctly", { - o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) - result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c(NA_character_, NA_character_, NA_character_))) -}) - -test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { - o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals %>% select(-impute) - result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") - expect_equal(result, o_data_no_impute) - expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), - "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") -}) - -# Test intervals for expected outputs with different inputs - -test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) -}) - -test_that("interval_remove_impute handles specified target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) - # half.life has no start_conc0 imputations - expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) - # cmax has the same exact imputations as before - expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) -}) - -test_that("interval_remove_impute handles target_groups correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(ANALYTE = "Analyte1")) - # Analyte1 has no start_conc0 imputations - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1"), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_predose", NA_character_))) + # Identify the targeted intervals based on the parameters + target_intervals <- target_intervals %>% + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) - # Analyte2 has the same exact imputations as before - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), - o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) -}) - -test_that("interval_remove_impute handles multiple target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) -}) - -test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { - o_data_multiple_imputes <- o_data - o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") - result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", "start_predose"))) -}) - - -test_that("interval_remove_impute handles correctly argument new_rows_after_original", { + # Add the imputation method to the targeted intervals + new_intervals_with_impute <- target_intervals %>% + dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% + dplyr::rowwise() %>% + dplyr::mutate(!!impute_col := { + impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) + if (!allow_duplication && target_impute %in% impute_methods) { + # If duplication is not allowed, do not add the impute method if it already exists + .data[[impute_col]] + } else { + # Add the impute method after the specified position + impute_methods <- append(impute_methods, target_impute, after) + paste(impute_methods[impute_methods != ""], collapse = ",") + } + }) %>% + dplyr::ungroup() %>% + dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% + as.data.frame() - # When true the new rows are added after the original rows - result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), - cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), - impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) + # Eliminate from the old intervals the target parameters + old_intervals_without_impute <- target_intervals %>% + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) - # When false the new rows are added at the end of the data frame - result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), - half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), - impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) -}) - + # Make parameters FALSE in original intervals and join the new ones + data <- data %>% + dplyr::anti_join(target_intervals, by = names(data)) %>% + dplyr::bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% + dplyr::arrange(index) %>% + dplyr::select(-index) + + data +} + + +#' Remove specified imputation methods from the intervals in a PKNCAdata object. +#' +#' @inheritParams interval_add_impute +#' @param target_impute A character string specifying the imputation method to be removed. +#' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. +#' @examples +#' d_conc <- data.frame( +#' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), +#' time = rep(0:5, 2), +#' ID = rep(1:2, each = 6), +#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), +#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +#' ) +#' +#' d_dose <- data.frame( +#' dose = c(100, 200), +#' time = c(0, 0), +#' ID = c(1, 2) +#' ) +#' +#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) +#' +#' intervals <- data.frame( +#' start = c(0, 0, 0), +#' end = c(3, 5, Inf), +#' half.life = c(TRUE, FALSE, TRUE), +#' cmax = c(TRUE, TRUE, TRUE), +#' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), +#' analyte = c("Analyte1", "Analyte2", "Analyte1") +#' ) +#' +#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) +#' +#' # Apply interval_remove_impute function +#' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) +#' @export +interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { + if (missing(data) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { + stop("The 'data' object must be a PKNCAdata object or a data frame.") + } + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + UseMethod("interval_remove_impute") +} + +#' @export +interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { + if (is.null(impute_column) && !is.na(data$impute)) { + impute_column <- data$impute + } + data$intervals <- interval_remove_impute(data$intervals, target_impute, target_params, target_groups, impute_column, new_rows_after_original) + data +} + +#' @export +interval_remove_impute.data.frame <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { + + # Add an index column to preserve the original order + data <- dplyr::mutate(data, index = dplyr::row_number()) + + # Get all parameter column names in the data frame + all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) + param_cols <- intersect(names(data), all_param_options) + + # Handle target_params + if (is.null(target_params)) { + # Take all parameter columns present with at least one TRUE value + target_params <- param_cols[colSums(data[param_cols]) > 0] + } else { + # Check that all target_params are present in the data frame + missing_params <- setdiff(target_params, param_cols) + if (length(missing_params) > 0) { + stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) + target_params <- intersect(target_params, param_cols) + } + } + + # Determine the name of the impute column + impute_col <- if (!is.null(impute_column)) { + if (!impute_column %in% colnames(data)) { + stop("The 'data' object does not contain the specified impute column.") + } + impute_column + } else if ("impute" %in% colnames(data)) { + "impute" + } else { + warning("No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") + return(data %>% dplyr::select(-index)) + } + + # Identify the targeted intervals based on the groups + if (!is.null(target_groups)) { + target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) + } else { + target_intervals <- data + } + + # Identify the targeted intervals based on the impute method and parameters + target_intervals <- target_intervals %>% + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) %>% + dplyr::filter(grepl( + pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), + .data[[impute_col]] + )) + + # Create the new version intervals only for the target parameters + new_intervals_without_impute <- target_intervals %>% + dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% + dplyr::rowwise() %>% + # Eliminate the target impute method from the impute column + dplyr::mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), + collapse = "," + )) %>% + dplyr::mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% + dplyr::ungroup() %>% + # Make sure the class of the impute_col remains the same + dplyr::mutate(!!impute_col := as.character(.data[[impute_col]])) %>% + as.data.frame() + + # Eliminate from the old intervals the target parameters + old_intervals_with_impute <- target_intervals %>% + dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) %>% + dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) + + # Make parameters FALSE in original intervals and join the new ones + data <- data %>% + dplyr::anti_join(target_intervals, by = names(data)) %>% + dplyr::bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% + dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% + dplyr::arrange(index) %>% + dplyr::select(-index) + + data +} From 5e7ddf033e0f0661a54caf0e0edd4b188bf5024e Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 15:55:13 +0100 Subject: [PATCH 18/49] style: clean code based on code factor feedback --- tests/testthat/test-intervals_support_funs.R | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index bd0ac144..dbde0f34 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -46,7 +46,7 @@ test_that("interval_add_impute throws an error when input data is a non PKNCAdat }) test_that("interval_add_impute throws an error for unknown target_params", { - expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param"), "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") }) @@ -83,7 +83,7 @@ test_that("interval_add_impute with no optional parameters uses all relevant cas }) test_that("interval_add_impute handles specified target_params correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life")) + result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = "half.life") expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), @@ -146,8 +146,8 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina "start_predose,new_impute", "start_conc0", "start_conc0,new_impute")) - ) - + ) + # When false the new rows are added at the end of the data frame result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) @@ -161,7 +161,7 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina "start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute")) - ) + ) }) @@ -184,7 +184,7 @@ test_that("interval_remove_impute throws an error when input data is a non PKNCA }) test_that("interval_remove_impute throws an error for unknown target_params", { - expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("unknown_param")), + expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param"), "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") }) @@ -232,7 +232,7 @@ test_that("interval_remove_impute with no optional parameters uses all relevant }) test_that("interval_remove_impute handles specified target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life")) + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "half.life") # half.life has no start_conc0 imputations expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), From 3e736cd2d62056e5a0c6feacca2d67ef162dc90f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 15:56:41 +0100 Subject: [PATCH 19/49] documentation: roxygenise new functions --- NAMESPACE | 6 +++ man/interval_add_impute.Rd | 72 +++++++++++++++++++++++++++++++++++ man/interval_remove_impute.Rd | 66 ++++++++++++++++++++++++++++++++ 3 files changed, 144 insertions(+) create mode 100644 man/interval_add_impute.Rd create mode 100644 man/interval_remove_impute.Rd diff --git a/NAMESPACE b/NAMESPACE index e1ee121a..07fa0df1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,10 @@ S3method(group_by,PKNCAresults) S3method(inner_join,PKNCAconc) S3method(inner_join,PKNCAdose) S3method(inner_join,PKNCAresults) +S3method(interval_add_impute,PKNCAdata) +S3method(interval_add_impute,data.frame) +S3method(interval_remove_impute,PKNCAdata) +S3method(interval_remove_impute,data.frame) S3method(is_sparse_pk,PKNCAconc) S3method(is_sparse_pk,PKNCAdata) S3method(is_sparse_pk,PKNCAresults) @@ -148,6 +152,8 @@ export(inner_join) export(interp.extrap.conc) export(interp.extrap.conc.dose) export(interpolate.conc) +export(interval_add_impute) +export(interval_remove_impute) export(is_sparse_pk) export(left_join) export(mutate) diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd new file mode 100644 index 00000000..5e7bd8a9 --- /dev/null +++ b/man/interval_add_impute.Rd @@ -0,0 +1,72 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/intervals_support_funs.R +\name{interval_add_impute} +\alias{interval_add_impute} +\title{Add specified imputation methods to the intervals in a PKNCAdata object.} +\usage{ +interval_add_impute( + data, + target_impute, + after = Inf, + target_params = NULL, + target_groups = NULL, + impute_column = NULL, + allow_duplication = TRUE, + new_rows_after_original = TRUE +) +} +\arguments{ +\item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} + +\item{target_impute}{A character string specifying the imputation method to be added.} + +\item{after}{Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf).} + +\item{target_params}{A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken.} + +\item{target_groups}{A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered.} + +\item{impute_column}{A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used.} + +\item{allow_duplication}{A boolean specifying whether to allow creating duplicates of the target_impute in the impute column (optional). Default is TRUE.} + +\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE.} +} +\value{ +A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. +} +\description{ +Add specified imputation methods to the intervals in a PKNCAdata object. +} +\examples{ +d_conc <- data.frame( + conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), + time = rep(0:5, 2), + ID = rep(1:2, each = 6), + analyte = rep(c("Analyte1", "Analyte2"), each = 6), + include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +) + +d_dose <- data.frame( + dose = c(100, 200), + time = c(0, 0), + ID = c(1, 2) +) + +o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") +o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) + +intervals <- data.frame( + start = c(0, 0, 0), + end = c(3, 5, Inf), + half.life = c(TRUE, FALSE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), + analyte = c("Analyte1", "Analyte2", "Analyte1") +) + +o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) + +# Apply interval_add_impute function +o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) +} diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd new file mode 100644 index 00000000..dadad09f --- /dev/null +++ b/man/interval_remove_impute.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/intervals_support_funs.R +\name{interval_remove_impute} +\alias{interval_remove_impute} +\title{Remove specified imputation methods from the intervals in a PKNCAdata object.} +\usage{ +interval_remove_impute( + data, + target_impute, + target_params = NULL, + target_groups = NULL, + impute_column = NULL, + new_rows_after_original = TRUE +) +} +\arguments{ +\item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} + +\item{target_impute}{A character string specifying the imputation method to be removed.} + +\item{target_params}{A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken.} + +\item{target_groups}{A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered.} + +\item{impute_column}{A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used.} + +\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE.} +} +\value{ +A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. +} +\description{ +Remove specified imputation methods from the intervals in a PKNCAdata object. +} +\examples{ +d_conc <- data.frame( + conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), + time = rep(0:5, 2), + ID = rep(1:2, each = 6), + analyte = rep(c("Analyte1", "Analyte2"), each = 6), + include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +) + +d_dose <- data.frame( + dose = c(100, 200), + time = c(0, 0), + ID = c(1, 2) +) + +o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +o_dose <- PKNCAdose(d_dose, dose ~ time | ID) + +intervals <- data.frame( + start = c(0, 0, 0), + end = c(3, 5, Inf), + half.life = c(TRUE, FALSE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), + analyte = c("Analyte1", "Analyte2", "Analyte1") +) + +o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) + +# Apply interval_remove_impute function +o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) +} From c17ce48ea415d77618e2caea9feac923ff799c24 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 16:00:32 +0100 Subject: [PATCH 20/49] documentation: add a news message in new features --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index e7e49af9..f84cdab5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -32,6 +32,8 @@ the dosing including dose amount and route. * `group_vars()` methods were added for `PKNCAdata` and `PKNCAresults` objects. * If intervals have attributes on the columns, there will no longer be an error during parameter calculation, and the attributes are preserved (#381) +* New functions are available to simplify the edition of intervals: + `intervals_add_impute()`, `intervals_remove_impute()` # Minor changes (unlikely to affect PKNCA use) From dd149dc6a2bb9c13f500d8b62ef9d01a4a05cf52 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 16:11:50 +0100 Subject: [PATCH 21/49] fix: column name in intervals/PKNCAconc for tests --- tests/testthat/test-intervals_support_funs.R | 98 ++++++++++---------- 1 file changed, 49 insertions(+), 49 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index dbde0f34..cc22400d 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -19,7 +19,7 @@ intervals <- data.frame( half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), - ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + analyte = c("Analyte1", "Analyte2", "Analyte1"), ID = c(1, 2, 1) ) @@ -55,8 +55,8 @@ test_that("interval_add_impute handles impute column with different names", { o_data_changed_impute_name$impute <- "impute_col" o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute_col), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) @@ -66,8 +66,8 @@ test_that("interval_add_impute handles impute column with NA values correctly", o_data_with_na_impute <- o_data o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("new_impute", "new_impute", "new_impute"))) @@ -75,8 +75,8 @@ test_that("interval_add_impute handles impute column with NA values correctly", test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_add_impute(o_data, target_impute = "new_impute") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) @@ -84,29 +84,29 @@ test_that("interval_add_impute with no optional parameters uses all relevant cas test_that("interval_add_impute handles specified target_params correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = "half.life") - expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% filter(half.life) %>% select(analyte, half.life, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) + expect_equal(result$intervals %>% filter(cmax) %>% select(analyte, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(analyte, cmax, impute)) }) test_that("interval_add_impute handles target_groups correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(ANALYTE = "Analyte1")) - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1"), + result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(analyte = "Analyte1")) + expect_equal(result$intervals %>% filter(analyte == "Analyte1") %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), - o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) + expect_equal(result$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute), + o_data$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute)) }) test_that("interval_add_impute handles multiple target_params correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) @@ -116,16 +116,16 @@ test_that("interval_add_impute handles allow_duplication correctly", { # When allow_duplication is FALSE, intervals with already the same impute method do not add it result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result1$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", "start_predose,start_conc0", "start_conc0"))) # When allow_duplication is TRUE, intervals with already the same impute method add it result2 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = TRUE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result2$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose,start_conc0", "start_predose,start_conc0", "start_conc0,start_conc0"))) @@ -136,8 +136,8 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina # When true the new rows are added after the original rows result1 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), + expect_equal(result1$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), half.life = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), cmax = c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), impute = c("start_conc0,start_predose", @@ -151,8 +151,8 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina # When false the new rows are added at the end of the data frame result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), + expect_equal(result2$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), cmax = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", @@ -193,8 +193,8 @@ test_that("interval_remove_impute handles impute column with different names", { o_data_changed_impute_name$impute <- "impute_col" o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute_col), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute_col), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute_col = c("start_predose", "start_predose", NA))) @@ -204,8 +204,8 @@ test_that("interval_remove_impute handles impute column with NA values correctly o_data_with_na_impute <- o_data o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c(NA_character_, NA_character_, NA_character_))) @@ -224,8 +224,8 @@ test_that("interval_remove_impute handles missing impute column by not modifying test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) @@ -234,33 +234,33 @@ test_that("interval_remove_impute with no optional parameters uses all relevant test_that("interval_remove_impute handles specified target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "half.life") # half.life has no start_conc0 imputations - expect_equal(result$intervals %>% filter(half.life) %>% select(ANALYTE, half.life, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% filter(half.life) %>% select(analyte, half.life, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) # cmax has the same exact imputations as before - expect_equal(result$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(ANALYTE, cmax, impute)) + expect_equal(result$intervals %>% filter(cmax) %>% select(analyte, cmax, impute), + o_data$intervals %>% filter(cmax) %>% select(analyte, cmax, impute)) }) test_that("interval_remove_impute handles target_groups correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(ANALYTE = "Analyte1")) + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) # Analyte1 has no start_conc0 imputations - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte1") %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1"), + expect_equal(result$intervals %>% filter(analyte == "Analyte1") %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_predose", NA_character_))) # Analyte2 has the same exact imputations as before - expect_equal(result$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute), - o_data$intervals %>% filter(ANALYTE == "Analyte2") %>% select(ANALYTE, half.life, cmax, impute)) + expect_equal(result$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute), + o_data$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute)) }) test_that("interval_remove_impute handles multiple target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) @@ -270,8 +270,8 @@ test_that("interval_remove_impute handles with specificity impute character meth o_data_multiple_imputes <- o_data o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1"), + expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", "start_predose"))) @@ -282,16 +282,16 @@ test_that("interval_remove_impute handles correctly argument new_rows_after_orig # When true the new rows are added after the original rows result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), + expect_equal(result1$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) # When false the new rows are added at the end of the data frame result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(ANALYTE, half.life, cmax, impute), - data.frame(ANALYTE = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), + expect_equal(result2$intervals %>% select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) From 751a92650788731cabfee9f955994ef6dcb36679 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 16:24:29 +0100 Subject: [PATCH 22/49] fix: add namespacing to dplyr functions in tests --- tests/testthat/test-intervals_support_funs.R | 56 ++++++++++---------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index cc22400d..12cff4e6 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -55,7 +55,7 @@ test_that("interval_add_impute handles impute column with different names", { o_data_changed_impute_name$impute <- "impute_col" o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute_col), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -66,7 +66,7 @@ test_that("interval_add_impute handles impute column with NA values correctly", o_data_with_na_impute <- o_data o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -75,7 +75,7 @@ test_that("interval_add_impute handles impute column with NA values correctly", test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_add_impute(o_data, target_impute = "new_impute") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -84,28 +84,28 @@ test_that("interval_add_impute with no optional parameters uses all relevant cas test_that("interval_add_impute handles specified target_params correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = "half.life") - expect_equal(result$intervals %>% filter(half.life) %>% select(analyte, half.life, impute), + expect_equal(result$intervals %>% dplyr::filter(half.life) %>% dplyr::select(analyte, half.life, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% filter(cmax) %>% select(analyte, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(analyte, cmax, impute)) + expect_equal(result$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute), + o_data$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute)) }) test_that("interval_add_impute handles target_groups correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(analyte = "Analyte1")) - expect_equal(result$intervals %>% filter(analyte == "Analyte1") %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte1") %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute), - o_data$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute)) + expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute), + o_data$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute)) }) test_that("interval_add_impute handles multiple target_params correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -116,7 +116,7 @@ test_that("interval_add_impute handles allow_duplication correctly", { # When allow_duplication is FALSE, intervals with already the same impute method do not add it result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) - expect_equal(result1$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result1$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -124,7 +124,7 @@ test_that("interval_add_impute handles allow_duplication correctly", { # When allow_duplication is TRUE, intervals with already the same impute method add it result2 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = TRUE) - expect_equal(result2$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result2$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -136,7 +136,7 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina # When true the new rows are added after the original rows result1 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result1$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), half.life = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), cmax = c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), @@ -151,7 +151,7 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina # When false the new rows are added at the end of the data frame result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result2$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), cmax = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE), @@ -193,7 +193,7 @@ test_that("interval_remove_impute handles impute column with different names", { o_data_changed_impute_name$impute <- "impute_col" o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute_col), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -204,7 +204,7 @@ test_that("interval_remove_impute handles impute column with NA values correctly o_data_with_na_impute <- o_data o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -213,7 +213,7 @@ test_that("interval_remove_impute handles impute column with NA values correctly test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals %>% select(-impute) + o_data_no_impute$intervals <- o_data_no_impute$intervals %>% dplyr::select(-impute) result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") expect_equal(result, o_data_no_impute) expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), @@ -224,7 +224,7 @@ test_that("interval_remove_impute handles missing impute column by not modifying test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -234,32 +234,32 @@ test_that("interval_remove_impute with no optional parameters uses all relevant test_that("interval_remove_impute handles specified target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "half.life") # half.life has no start_conc0 imputations - expect_equal(result$intervals %>% filter(half.life) %>% select(analyte, half.life, impute), + expect_equal(result$intervals %>% dplyr::filter(half.life) %>% dplyr::select(analyte, half.life, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) # cmax has the same exact imputations as before - expect_equal(result$intervals %>% filter(cmax) %>% select(analyte, cmax, impute), - o_data$intervals %>% filter(cmax) %>% select(analyte, cmax, impute)) + expect_equal(result$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute), + o_data$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute)) }) test_that("interval_remove_impute handles target_groups correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) # Analyte1 has no start_conc0 imputations - expect_equal(result$intervals %>% filter(analyte == "Analyte1") %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte1") %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_predose", NA_character_))) # Analyte2 has the same exact imputations as before - expect_equal(result$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute), - o_data$intervals %>% filter(analyte == "Analyte2") %>% select(analyte, half.life, cmax, impute)) + expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute), + o_data$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute)) }) test_that("interval_remove_impute handles multiple target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -270,7 +270,7 @@ test_that("interval_remove_impute handles with specificity impute character meth o_data_multiple_imputes <- o_data o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -282,7 +282,7 @@ test_that("interval_remove_impute handles correctly argument new_rows_after_orig # When true the new rows are added after the original rows result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result1$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), @@ -290,7 +290,7 @@ test_that("interval_remove_impute handles correctly argument new_rows_after_orig # When false the new rows are added at the end of the data frame result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% select(analyte, half.life, cmax, impute), + expect_equal(result2$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), From f49e066241e5cb0613543b90ca4c510a8527c56e Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 16:33:58 +0100 Subject: [PATCH 23/49] fix: add namespacing to all dplyr functions --- tests/testthat/test-intervals_support_funs.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 12cff4e6..3dc28de0 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -53,7 +53,7 @@ test_that("interval_add_impute throws an error for unknown target_params", { test_that("interval_add_impute handles impute column with different names", { o_data_changed_impute_name <- o_data o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% dplyr::rename(impute_col = impute) result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), @@ -64,7 +64,7 @@ test_that("interval_add_impute handles impute column with different names", { test_that("interval_add_impute handles impute column with NA values correctly", { o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% dplyr::mutate(impute = NA_character_) result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), @@ -191,7 +191,7 @@ test_that("interval_remove_impute throws an error for unknown target_params", { test_that("interval_remove_impute handles impute column with different names", { o_data_changed_impute_name <- o_data o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% rename(impute_col = impute) + o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% dplyr::rename(impute_col = impute) result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), @@ -202,7 +202,7 @@ test_that("interval_remove_impute handles impute column with different names", { test_that("interval_remove_impute handles impute column with NA values correctly", { o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% mutate(impute = NA_character_) + o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% dplyr::mutate(impute = NA_character_) result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), @@ -268,7 +268,7 @@ test_that("interval_remove_impute handles multiple target_params correctly", { test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { o_data_multiple_imputes <- o_data - o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% mutate(impute = "start_conc0,start_predose") + o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% dplyr::mutate(impute = "start_conc0,start_predose") result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), From d9cb49220daa4b97e43ea4b3499b0c477d619eb1 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 16:51:22 +0100 Subject: [PATCH 24/49] fix: prevent a expected warning to produce an issue in tests --- tests/testthat/test-intervals_support_funs.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 3dc28de0..cecdf247 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -214,7 +214,7 @@ test_that("interval_remove_impute handles impute column with NA values correctly test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { o_data_no_impute <- o_data o_data_no_impute$intervals <- o_data_no_impute$intervals %>% dplyr::select(-impute) - result <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") + result <- suppressWarnings(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0")) expect_equal(result, o_data_no_impute) expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") From 4feab5a65ff29a17591a95d4ad093c273dc434c4 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 17:04:58 +0100 Subject: [PATCH 25/49] fix: example in documentation for interval_add_impute --- R/intervals_support_funs.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 127d7736..cc2b7664 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -24,8 +24,8 @@ #' ID = c(1, 2) #' ) #' -#' o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") -#' o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) +#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) #' #' intervals <- data.frame( #' start = c(0, 0, 0), @@ -39,7 +39,7 @@ #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_add_impute function -#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) +#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) #' @export interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { if (missing(data) || missing(target_impute)) { From 673745e70c81e99029811afc02dbaaf1118fa05b Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sun, 9 Feb 2025 17:42:09 +0100 Subject: [PATCH 26/49] refactor: substitute dynamic calls with dplyr & limit documentation lines in rd --- R/intervals_support_funs.R | 36 ++++++++++++++++++++--------------- man/interval_add_impute.Rd | 28 ++++++++++++++++----------- man/interval_remove_impute.Rd | 18 +++++++++++------- 3 files changed, 49 insertions(+), 33 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index cc2b7664..859369cc 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -1,13 +1,19 @@ -#' Add specified imputation methods to the intervals in a PKNCAdata object. +#' Add specified imputation methods to the intervals in a PKNCAdata or data.frame object. #' #' @param data A PKNCAdata object containing the intervals and data components, or a data frame of intervals. #' @param target_impute A character string specifying the imputation method to be added. -#' @param after Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf). -#' @param target_params A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken. -#' @param target_groups A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered. -#' @param impute_column A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used. -#' @param allow_duplication A boolean specifying whether to allow creating duplicates of the target_impute in the impute column (optional). Default is TRUE. -#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE. +#' @param after Numeric value specifying the position after which the imputation method should be added (optional). +#' First is 0, last Inf. If missing, the imputation method is added at the end (Inf). +#' @param target_params A character vector specifying the parameters to be targeted (optional). +#' If missing, all TRUE in the intervals are taken. +#' @param target_groups A data frame specifying the intervals to be targeted (optional). +#' If missing, all relevant groups are considered. +#' @param impute_column A character string specifying the name of the impute column (optional). +#' If missing, the default name "impute" is used. +#' @param allow_duplication A boolean specifying whether to allow creating duplicates of the target_impute +#' in the impute column (optional). Default is TRUE. +#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows +#' (optional). Default is TRUE. #' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -116,7 +122,7 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, tar dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% dplyr::rowwise() %>% - dplyr::mutate(!!impute_col := { + dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~{ impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) if (!allow_duplication && target_impute %in% impute_methods) { # If duplication is not allowed, do not add the impute method if it already exists @@ -126,7 +132,7 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, tar impute_methods <- append(impute_methods, target_impute, after) paste(impute_methods[impute_methods != ""], collapse = ",") } - }) %>% + })) %>% dplyr::ungroup() %>% dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% as.data.frame() @@ -147,11 +153,11 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, tar } -#' Remove specified imputation methods from the intervals in a PKNCAdata object. +#' Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object. #' #' @inheritParams interval_add_impute #' @param target_impute A character string specifying the imputation method to be removed. -#' @return A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. +#' @return A modified object with the specified imputation methods removed from the targeted intervals. #' @examples #' d_conc <- data.frame( #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), @@ -263,13 +269,13 @@ interval_remove_impute.data.frame <- function(data, target_impute, target_params dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% dplyr::rowwise() %>% # Eliminate the target impute method from the impute column - dplyr::mutate(!!impute_col := paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), + dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~ paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), collapse = "," - )) %>% - dplyr::mutate(!!impute_col := ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]])) %>% + ))) %>% + dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~ ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]]))) %>% dplyr::ungroup() %>% # Make sure the class of the impute_col remains the same - dplyr::mutate(!!impute_col := as.character(.data[[impute_col]])) %>% + dplyr::mutate(dplyr::across(any_of(impute_col), ~ as.character(.data[[impute_col]]))) %>% as.data.frame() # Eliminate from the old intervals the target parameters diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index 5e7bd8a9..57bb2f7c 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/intervals_support_funs.R \name{interval_add_impute} \alias{interval_add_impute} -\title{Add specified imputation methods to the intervals in a PKNCAdata object.} +\title{Add specified imputation methods to the intervals in a PKNCAdata or data.frame object.} \usage{ interval_add_impute( data, @@ -20,23 +20,29 @@ interval_add_impute( \item{target_impute}{A character string specifying the imputation method to be added.} -\item{after}{Numeric value specifying the position after which the imputation method should be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf).} +\item{after}{Numeric value specifying the position after which the imputation method should be added (optional). +First is 0, last Inf. If missing, the imputation method is added at the end (Inf).} -\item{target_params}{A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken.} +\item{target_params}{A character vector specifying the parameters to be targeted (optional). +If missing, all TRUE in the intervals are taken.} -\item{target_groups}{A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered.} +\item{target_groups}{A data frame specifying the intervals to be targeted (optional). +If missing, all relevant groups are considered.} -\item{impute_column}{A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used.} +\item{impute_column}{A character string specifying the name of the impute column (optional). +If missing, the default name "impute" is used.} -\item{allow_duplication}{A boolean specifying whether to allow creating duplicates of the target_impute in the impute column (optional). Default is TRUE.} +\item{allow_duplication}{A boolean specifying whether to allow creating duplicates of the target_impute +in the impute column (optional). Default is TRUE.} -\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE.} +\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows +(optional). Default is TRUE.} } \value{ A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. } \description{ -Add specified imputation methods to the intervals in a PKNCAdata object. +Add specified imputation methods to the intervals in a PKNCAdata or data.frame object. } \examples{ d_conc <- data.frame( @@ -53,8 +59,8 @@ d_dose <- data.frame( ID = c(1, 2) ) -o_conc <- PKNCAconc(d_conc, conc ~ time | analyte, include_half.life = "include_hl") -o_dose <- PKNCAdose(d_dose, dose ~ time | treatment + ID) +o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +o_dose <- PKNCAdose(d_dose, dose ~ time | ID) intervals <- data.frame( start = c(0, 0, 0), @@ -68,5 +74,5 @@ intervals <- data.frame( o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) # Apply interval_add_impute function -o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(ANALYTE = "Analyte1", ROUTE = "intravascular")) +o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) } diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index dadad09f..42b9a847 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/intervals_support_funs.R \name{interval_remove_impute} \alias{interval_remove_impute} -\title{Remove specified imputation methods from the intervals in a PKNCAdata object.} +\title{Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object.} \usage{ interval_remove_impute( data, @@ -18,19 +18,23 @@ interval_remove_impute( \item{target_impute}{A character string specifying the imputation method to be removed.} -\item{target_params}{A character vector specifying the parameters to be targeted (optional). If missing, all TRUE in the intervals are taken.} +\item{target_params}{A character vector specifying the parameters to be targeted (optional). +If missing, all TRUE in the intervals are taken.} -\item{target_groups}{A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered.} +\item{target_groups}{A data frame specifying the intervals to be targeted (optional). +If missing, all relevant groups are considered.} -\item{impute_column}{A character string specifying the name of the impute column (optional). If missing, the default name "impute" is used.} +\item{impute_column}{A character string specifying the name of the impute column (optional). +If missing, the default name "impute" is used.} -\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows (optional). Default is TRUE.} +\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows +(optional). Default is TRUE.} } \value{ -A modified PKNCAdata object with the specified imputation methods removed from the targeted intervals. +A modified object with the specified imputation methods removed from the targeted intervals. } \description{ -Remove specified imputation methods from the intervals in a PKNCAdata object. +Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object. } \examples{ d_conc <- data.frame( From 0124aa0f0f92a7ec1761686a1c9caa243aa9b68f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Mon, 10 Feb 2025 18:10:35 +0100 Subject: [PATCH 27/49] fix: simplify general S3 fun, remove checking tests, update news --- NEWS.md | 2 +- R/intervals_support_funs.R | 30 +++++++++----------- tests/testthat/test-intervals_support_funs.R | 25 +++++++--------- 3 files changed, 26 insertions(+), 31 deletions(-) diff --git a/NEWS.md b/NEWS.md index f84cdab5..dbc6b01a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -32,7 +32,7 @@ the dosing including dose amount and route. * `group_vars()` methods were added for `PKNCAdata` and `PKNCAresults` objects. * If intervals have attributes on the columns, there will no longer be an error during parameter calculation, and the attributes are preserved (#381) -* New functions are available to simplify the edition of intervals: +* New functions are available to simplify the modification of intervals: `intervals_add_impute()`, `intervals_remove_impute()` # Minor changes (unlikely to affect PKNCA use) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 859369cc..e79087c5 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -47,23 +47,15 @@ #' # Apply interval_add_impute function #' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) #' @export -interval_add_impute <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - if (missing(data) || missing(target_impute)) { - stop("Both 'data' and 'target_impute' must be provided.") - } - if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { - stop("The 'data' object must be a PKNCAdata object or a data frame.") - } - if (!is.character(target_impute)) { - stop("'target_impute' must be a character string.") - } +interval_add_impute <- function(data, ...) { UseMethod("interval_add_impute") } #' @export interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - if (is.null(impute_column) && !is.na(data$impute)) { - impute_column <- data$impute + if (!"impute" %in% names(data$intervals) && !is.na(data$impute)) { + data$intervals$impute <- data$impute + data$impute <- NA_character_ } data$intervals <- interval_add_impute(data$intervals, target_impute, after, target_params, target_groups, impute_column, allow_duplication, new_rows_after_original) data @@ -71,10 +63,17 @@ interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, targ #' @export interval_add_impute.data.frame <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - + + if (missing(data) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + # Add an index column to preserve the original order data <- dplyr::mutate(data, index = dplyr::row_number()) - + # Get all parameter column names in the data frame all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) logical_cols <- names(which(colSums(data[sapply(data, is.logical)]) > 1)) @@ -119,8 +118,7 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, tar # Add the imputation method to the targeted intervals new_intervals_with_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% + dplyr::mutate(dplyr::across(dplyr::any_of(setdiff(param_cols, target_params)), ~FALSE)) %>% dplyr::rowwise() %>% dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~{ impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index cecdf247..c11221f4 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -31,9 +31,7 @@ o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) ### Test interval_add_impute test_that("interval_add_impute throws an error if either data or target_impute is missing", { - expect_error(interval_add_impute(), "Both 'data' and 'target_impute' must be provided.") expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_add_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") }) test_that("interval_add_impute throws an error for non-character target_impute", { @@ -41,7 +39,6 @@ test_that("interval_add_impute throws an error for non-character target_impute", }) test_that("interval_add_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_add_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) }) @@ -50,17 +47,17 @@ test_that("interval_add_impute throws an error for unknown target_params", { "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") }) -test_that("interval_add_impute handles impute column with different names", { - o_data_changed_impute_name <- o_data - o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% dplyr::rename(impute_col = impute) - result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -}) +# test_that("interval_add_impute handles impute column with different names", { +# o_data_changed_impute_name <- o_data +# o_data_changed_impute_name$impute <- "impute_col" +# o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% dplyr::rename(impute_col = impute) +# result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") +# expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), +# data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), +# half.life = c(TRUE, TRUE, TRUE), +# cmax = c(TRUE, TRUE, TRUE), +# impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) +# }) test_that("interval_add_impute handles impute column with NA values correctly", { o_data_with_na_impute <- o_data From 4343e6f3d42f89a346e99a19736efb96abab4ce6 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Tue, 11 Feb 2025 18:20:09 +0100 Subject: [PATCH 28/49] refactor: interval_add_impute / substitute dplyr, removed unwanted args --- R/intervals_support_funs.R | 141 +++++++++++++++++-------------------- 1 file changed, 65 insertions(+), 76 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index e79087c5..d083f6b5 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -10,10 +10,8 @@ #' If missing, all relevant groups are considered. #' @param impute_column A character string specifying the name of the impute column (optional). #' If missing, the default name "impute" is used. -#' @param allow_duplication A boolean specifying whether to allow creating duplicates of the target_impute -#' in the impute column (optional). Default is TRUE. -#' @param new_rows_after_original A boolean specifying whether the new rows should be added after the original rows -#' (optional). Default is TRUE. +#' @details. If already present the target_impute method will be added substituting the existing one. All new intervals +#' created will be added right after their original ones. #' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -47,110 +45,98 @@ #' # Apply interval_add_impute function #' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) #' @export -interval_add_impute <- function(data, ...) { - UseMethod("interval_add_impute") +interval_add_impute <- function(data, target_impute, ...) { + UseMethod("interval_add_impute", data) } #' @export -interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { - if (!"impute" %in% names(data$intervals) && !is.na(data$impute)) { +interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { + # If the impute column is not present, add it to the intervals + if (!"impute" %in% names(data$intervals) && !is.null(data$impute)) { data$intervals$impute <- data$impute data$impute <- NA_character_ + } else if (class(data$intervals$impute) != "character") { + stop("The 'impute' column in the intervals must be a character column.") } - data$intervals <- interval_add_impute(data$intervals, target_impute, after, target_params, target_groups, impute_column, allow_duplication, new_rows_after_original) + data$intervals <- interval_add_impute.data.frame(data$intervals, target_impute, after, target_params, target_groups) data } -#' @export -interval_add_impute.data.frame <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, impute_column = NULL, allow_duplication = TRUE, new_rows_after_original = TRUE) { +# Helper function to process impute methods +add_impute_method <- Vectorize(function(impute_col_value, target_impute, after) { + impute_methods <- unlist(strsplit(ifelse(is.na(impute_col_value), "", impute_col_value), "[ ,]+")) |> + setdiff(target_impute) |> + append(target_impute, after) |> + paste(collapse = ",") +}, vectorize.args = "impute_col_value", USE.NAMES = FALSE) - if (missing(data) || missing(target_impute)) { +#' @export +interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { + # Validate inputs + if (missing(intervals) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } - + + # Ensure the impute column exists and is a character column + if (!"impute" %in% colnames(intervals)) { + intervals$impute <- NA_character_ + } else if (!is.character(intervals$impute)) { + stop("The 'impute' column in the data frame must be a character column.") + } + # Add an index column to preserve the original order - data <- dplyr::mutate(data, index = dplyr::row_number()) - + index_colname <- make.unique(c("index", names(intervals)))[1] + intervals[[index_colname]] <- 1:nrow(intervals) + # Get all parameter column names in the data frame - all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) - logical_cols <- names(which(colSums(data[sapply(data, is.logical)]) > 1)) - param_cols <- intersect(logical_cols, all_param_options) + all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) + param_cols <- intersect(names(intervals), all_param_options) - # Handle target_params + # If missing, define the target parameters as all parameter columns. Filter based on at least one TRUE value. if (is.null(target_params)) { - # Take all logical columns in data that are known parameters target_params <- param_cols } else { - # Check that all target_params are logical columns in data and known parameters - missing_params <- setdiff(target_params, logical_cols) - if (length(missing_params) > 0) { - stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) - target_params <- intersect(target_params, param_cols) - } + checkmate::assert_subset(target_params, choices = all_param_options, empty.ok = TRUE) } + target_param_rows <- rowSums(!is.na(replace(intervals[, target_params, drop = FALSE], FALSE, NA))) > 0 - # Determine the name of the impute column - impute_col <- if (!is.null(impute_column)) { - if (!impute_column %in% colnames(data)) { - stop("The 'data' object does not contain the specified impute column.") - } - impute_column - } else if ("impute" %in% colnames(data)) { - "impute" - } else { - data$impute <- NA_character_ - "impute" - } - - # Identify the targeted intervals based on the groups + # If missing, define the target groups as all intervals. Filter based on a perfect row match. if (!is.null(target_groups)) { - target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) + target_group_rows <- do.call(paste0, intervals[, names(target_groups), drop = FALSE]) %in% do.call(paste0, target_groups) } else { - target_intervals <- data + target_group_rows <- rep(TRUE, nrow(intervals)) } - # Identify the targeted intervals based on the parameters - target_intervals <- target_intervals %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) + # Combine the two conditions to get the final targeted rows (filter for intervals) + target_rows <- target_group_rows & target_param_rows - # Add the imputation method to the targeted intervals - new_intervals_with_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(setdiff(param_cols, target_params)), ~FALSE)) %>% - dplyr::rowwise() %>% - dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~{ - impute_methods <- unlist(strsplit(ifelse(is.na(.data[[impute_col]]), "", .data[[impute_col]]), ",")) - if (!allow_duplication && target_impute %in% impute_methods) { - # If duplication is not allowed, do not add the impute method if it already exists - .data[[impute_col]] - } else { - # Add the impute method after the specified position - impute_methods <- append(impute_methods, target_impute, after) - paste(impute_methods[impute_methods != ""], collapse = ",") - } - })) %>% - dplyr::ungroup() %>% - dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) %>% - as.data.frame() + # Create new intervals for the target parameters including the impute method and indexed right after the original intervals + new_intervals <- intervals[target_rows, ] + new_intervals[, setdiff(param_cols, target_params)] <- NA + new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) + new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 - # Eliminate from the old intervals the target parameters - old_intervals_without_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) + # Keep the original intervals without the target parameters and without the impute method + original_intervals <- intervals[target_rows, ] + original_intervals[, target_params] <- NA - # Make parameters FALSE in original intervals and join the new ones - data <- data %>% - dplyr::anti_join(target_intervals, by = names(data)) %>% - dplyr::bind_rows(old_intervals_without_impute, new_intervals_with_impute) %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% - dplyr::arrange(index) %>% - dplyr::select(-index) + # Combine non-modified intervals, new intervals, and original intervals + intervals <- rbind(intervals[!target_rows, ], original_intervals, new_intervals) - data + # Filter rows where all row values for param_cols are NA or FALSE + param_data <- intervals[, param_cols, drop = FALSE] + rows_no_params <- rowSums(!is.na(replace(param_data, param_data == FALSE, NA))) == 0 + intervals <- intervals[!rows_no_params, , drop = FALSE] + + # Order the data by the index column and then remove it + intervals <- intervals[order(intervals[, index_colname]), ] + rownames(intervals) <- 1:nrow(intervals) + intervals[, !names(intervals) %in% index_colname] } - #' Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object. #' #' @inheritParams interval_add_impute @@ -268,7 +254,7 @@ interval_remove_impute.data.frame <- function(data, target_impute, target_params dplyr::rowwise() %>% # Eliminate the target impute method from the impute column dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~ paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), - collapse = "," + collapse = "," ))) %>% dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~ ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]]))) %>% dplyr::ungroup() %>% @@ -291,3 +277,6 @@ interval_remove_impute.data.frame <- function(data, target_impute, target_params data } + + + From 26d2e7482004cd28493c278c35f155cf3e29fd33 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Tue, 11 Feb 2025 18:21:19 +0100 Subject: [PATCH 29/49] tests: interval_add_impute adapted to new error messages and defaults --- tests/testthat/test-intervals_support_funs.R | 87 ++++++++++++-------- 1 file changed, 51 insertions(+), 36 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index c11221f4..b83f3b2f 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -44,7 +44,7 @@ test_that("interval_add_impute throws an error when input data is a non PKNCAdat test_that("interval_add_impute throws an error for unknown target_params", { expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param"), - "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") + "") }) # test_that("interval_add_impute handles impute column with different names", { @@ -109,34 +109,45 @@ test_that("interval_add_impute handles multiple target_params correctly", { impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) }) -test_that("interval_add_impute handles allow_duplication correctly", { +test_that("interval_add_impute handles mixed TRUE/FALSE for cmax and half.life correctly", { + intervals_mixed <- data.frame( + start = c(0, 0, 0, 0), + end = c(24, 48, Inf, 72), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0", "start_predose"), + analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + ID = c(1, 2, 1, 2) + ) - # When allow_duplication is FALSE, intervals with already the same impute method do not add it - result1 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = FALSE) - expect_equal(result1$intervals %>% dplyr::select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose", "start_predose,start_conc0", "start_conc0"))) + o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) + result <- interval_add_impute(o_data_mixed, target_impute = "new_impute") + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute", "start_predose,new_impute"))) +}) + +test_that("interval_add_impute do not create duplicates but instead removes original ones and then adds impute method based on after", { - # When allow_duplication is TRUE, intervals with already the same impute method add it - result2 <- interval_add_impute(o_data, target_impute = "start_conc0", allow_duplication = TRUE) - expect_equal(result2$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + # When allow_duplication is FALSE, intervals with already the same impute method do not add it + result <- interval_add_impute(o_data, target_impute = "start_conc0", after=Inf) + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,start_conc0", "start_predose,start_conc0", "start_conc0,start_conc0"))) - + impute = c("start_predose,start_conc0", "start_predose,start_conc0", "start_conc0"))) }) -test_that("interval_add_impute handles correctly argument new_rows_after_original", { +test_that("interval_add_impute includes new rows with added imputations right after the original ones", { # When true the new rows are added after the original rows - result1 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + result <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax") + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(TRUE, FALSE, TRUE, FALSE, TRUE, FALSE), - cmax = c(FALSE, TRUE, FALSE, TRUE, FALSE, TRUE), + half.life = c(TRUE, NA, TRUE, NA, TRUE, NA), + cmax = c(NA, TRUE, NA, TRUE, NA, TRUE), impute = c("start_conc0,start_predose", "start_conc0,start_predose,new_impute", "start_predose", @@ -144,27 +155,10 @@ test_that("interval_add_impute handles correctly argument new_rows_after_origina "start_conc0", "start_conc0,new_impute")) ) - - - # When false the new rows are added at the end of the data frame - result2 <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% dplyr::select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE), - cmax = c(FALSE, FALSE, FALSE, TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose", - "start_predose", - "start_conc0", - "start_conc0,start_predose,new_impute", - "start_predose,new_impute", - "start_conc0,new_impute")) - ) }) ### Test interval_remove_impute - - test_that("interval_remove_impute throws an error if either data or target_impute is missing", { expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") @@ -274,6 +268,27 @@ test_that("interval_remove_impute handles with specificity impute character meth impute = c("start_predose", "start_predose", "start_predose"))) }) +test_that("interval_remove_impute handles mixed TRUE/FALSE for cmax and half.life correctly", { + intervals_mixed <- data.frame( + start = c(0, 0, 0, 0), + end = c(24, 48, Inf, 72), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0", "start_predose"), + analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + ID = c(1, 2, 1, 2) + ) + + o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) + + result <- interval_remove_impute(o_data_mixed, target_impute = "start_conc0", target_params = c("half.life", "cmax")) + + expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_predose", "start_predose", NA, "start_predose"))) +}) test_that("interval_remove_impute handles correctly argument new_rows_after_original", { From 8db55b2fd0e937859bac048600f383e27e9ebbda Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 12 Feb 2025 16:07:02 +0100 Subject: [PATCH 30/49] fix, refactor: consider NA params, change PKNCAdata$impute strategy, use base r --- R/intervals_support_funs.R | 240 ++++++++++--------- tests/testthat/test-intervals_support_funs.R | 177 +++++++------- 2 files changed, 210 insertions(+), 207 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index d083f6b5..ebd448ca 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -8,8 +8,6 @@ #' If missing, all TRUE in the intervals are taken. #' @param target_groups A data frame specifying the intervals to be targeted (optional). #' If missing, all relevant groups are considered. -#' @param impute_column A character string specifying the name of the impute column (optional). -#' If missing, the default name "impute" is used. #' @details. If already present the target_impute method will be added substituting the existing one. All new intervals #' created will be added right after their original ones. #' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. @@ -62,7 +60,15 @@ interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, targ data } -# Helper function to process impute methods +#' Add impute method to the impute column +#' +#' This is an internal helper function used to add an impute method to the impute column. +#' +#' @param impute_col_value The current value of the impute column. +#' @param target_impute The imputation method to be added. +#' @param after Numeric value specifying the position after which the imputation method should be added. +#' @return A character string or vector with the added impute method. +#' @keywords internal add_impute_method <- Vectorize(function(impute_col_value, target_impute, after) { impute_methods <- unlist(strsplit(ifelse(is.na(impute_col_value), "", impute_col_value), "[ ,]+")) |> setdiff(target_impute) |> @@ -79,68 +85,67 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } - + # Ensure the impute column exists and is a character column if (!"impute" %in% colnames(intervals)) { intervals$impute <- NA_character_ } else if (!is.character(intervals$impute)) { stop("The 'impute' column in the data frame must be a character column.") } - + # Add an index column to preserve the original order index_colname <- make.unique(c("index", names(intervals)))[1] intervals[[index_colname]] <- 1:nrow(intervals) - + # Get all parameter column names in the data frame all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(intervals), all_param_options) - + # If missing, define the target parameters as all parameter columns. Filter based on at least one TRUE value. if (is.null(target_params)) { target_params <- param_cols } else { checkmate::assert_subset(target_params, choices = all_param_options, empty.ok = TRUE) } - target_param_rows <- rowSums(!is.na(replace(intervals[, target_params, drop = FALSE], FALSE, NA))) > 0 - - # If missing, define the target groups as all intervals. Filter based on a perfect row match. + + # Ifentify the target interval rows based on: + ## 1. The target groups (perfect match) + target_rows <- rep(TRUE, nrow(intervals)) if (!is.null(target_groups)) { - target_group_rows <- do.call(paste0, intervals[, names(target_groups), drop = FALSE]) %in% do.call(paste0, target_groups) - } else { - target_group_rows <- rep(TRUE, nrow(intervals)) + target_groups_data <- intervals[, names(target_groups), drop = FALSE] + target_rows <- target_rows & (do.call(paste0, target_groups_data) %in% do.call(paste0, target_groups)) } + ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) + target_params_data <- intervals[, target_params, drop = FALSE] + target_rows <- target_rows & (rowSums(!is.na(replace(target_params_data, target_params_data == FALSE, NA))) > 0) - # Combine the two conditions to get the final targeted rows (filter for intervals) - target_rows <- target_group_rows & target_param_rows - - # Create new intervals for the target parameters including the impute method and indexed right after the original intervals + # Create for the target parameters new intervals with the new impute method. Index them to be after the original intervals. new_intervals <- intervals[target_rows, ] new_intervals[, setdiff(param_cols, target_params)] <- NA new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 - - # Keep the original intervals without the target parameters and without the impute method - original_intervals <- intervals[target_rows, ] - original_intervals[, target_params] <- NA - - # Combine non-modified intervals, new intervals, and original intervals - intervals <- rbind(intervals[!target_rows, ], original_intervals, new_intervals) - + + # Remove the target parameters from the original target intervals + intervals[target_rows, target_params] <- NA + + # Combine the new and original intervals + intervals <- rbind(intervals, new_intervals) + # Filter rows where all row values for param_cols are NA or FALSE param_data <- intervals[, param_cols, drop = FALSE] rows_no_params <- rowSums(!is.na(replace(param_data, param_data == FALSE, NA))) == 0 intervals <- intervals[!rows_no_params, , drop = FALSE] - - # Order the data by the index column and then remove it + + # Order the intervals by the index column and then remove it intervals <- intervals[order(intervals[, index_colname]), ] rownames(intervals) <- 1:nrow(intervals) intervals[, !names(intervals) %in% index_colname] } -#' Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object. +#' Remove specified imputation methods from the intervals in a PKNCAdata or data.frame (intervals) object. #' #' @inheritParams interval_add_impute -#' @param target_impute A character string specifying the imputation method to be removed. +#' @param target_impute A character string specifying the imputation method to remove. #' @return A modified object with the specified imputation methods removed from the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -148,7 +153,6 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' time = rep(0:5, 2), #' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6), -#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) #' ) #' #' d_dose <- data.frame( @@ -163,7 +167,6 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' intervals <- data.frame( #' start = c(0, 0, 0), #' end = c(3, 5, Inf), -#' half.life = c(TRUE, FALSE, TRUE), #' cmax = c(TRUE, TRUE, TRUE), #' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), #' analyte = c("Analyte1", "Analyte2", "Analyte1") @@ -174,109 +177,112 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' # Apply interval_remove_impute function #' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) #' @export -interval_remove_impute <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - if (missing(data) || missing(target_impute)) { - stop("Both 'data' and 'target_impute' must be provided.") - } - if (!inherits(data, "PKNCAdata") && !is.data.frame(data)) { - stop("The 'data' object must be a PKNCAdata object or a data frame.") - } - if (!is.character(target_impute)) { - stop("'target_impute' must be a character string.") - } - UseMethod("interval_remove_impute") +interval_remove_impute <- function(data, ...) { + UseMethod("interval_remove_impute", data) } #' @export -interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - if (is.null(impute_column) && !is.na(data$impute)) { - impute_column <- data$impute +interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, target_groups = NULL) { + # If the impute column is not present in the intervals... + ## a. If neither is in the global impute method, return the data as it is + if (!"impute" %in% colnames(data$intervals) && (is.null(data$impute) || is.na(data$impute))) { + warning("No default impute column or global method identified. No impute methods to remove") + return(data) + } else if (!"impute" %in% names(data$intervals) && (!is.null(data$impute) || !is.na(data$impute))) { + if (is.null(target_params) && is.null(target_groups)) { + ## b. If it is in the global impute and no target parameters or groups are specified, remove the global impute method + data$impute <- remove_impute_method(data$impute, target_impute) + return(data) + } else { + ## c. If it is in the global impute but target parameters or groups are specified, create a impute column in the intervals + data$intervals$impute <- data$impute + data$impute <- NA_character_ + } } - data$intervals <- interval_remove_impute(data$intervals, target_impute, target_params, target_groups, impute_column, new_rows_after_original) + data$intervals <- interval_remove_impute.data.frame(data$intervals, target_impute, target_params, target_groups) data } +#' Remove impute method from the impute column +#' +#' This is an internal helper function used to remove an impute method from the impute column. +#' +#' @param impute_col_value The current value of the impute column. +#' @param target_impute The imputation method to be removed. +#' @return A character string or vector without the specified impute method. +#' @details Resulting empty string values are replaced with NA_character_. +#' @keywords internal +remove_impute_method <- Vectorize(function(impute_col_value, target_impute, after) { + impute_methods <- unlist(strsplit(ifelse(is.na(impute_col_value), "", impute_col_value), "[ ,]+")) |> + setdiff(target_impute) |> + paste(collapse = ",") + if (impute_methods == "") NA_character_ else impute_methods +}, vectorize.args = "impute_col_value", USE.NAMES = FALSE) + #' @export -interval_remove_impute.data.frame <- function(data, target_impute, target_params = NULL, target_groups = NULL, impute_column = NULL, new_rows_after_original = TRUE) { - +interval_remove_impute.data.frame <- function(intervals, target_impute, target_params = NULL, target_groups = NULL) { + # Validate inputs + if (missing(intervals) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + + # Ensure the impute column exists and is a character column + if (!"impute" %in% colnames(intervals)) { + intervals$impute <- NA_character_ + } else if (!is.character(intervals$impute)) { + stop("The 'impute' column in the data frame must be a character column.") + } + # Add an index column to preserve the original order - data <- dplyr::mutate(data, index = dplyr::row_number()) - + index_colname <- make.unique(c("index", names(intervals)))[1] + intervals[[index_colname]] <- seq_len(nrow(intervals)) + # Get all parameter column names in the data frame all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) - param_cols <- intersect(names(data), all_param_options) - + param_cols <- intersect(names(intervals), all_param_options) + # Handle target_params if (is.null(target_params)) { - # Take all parameter columns present with at least one TRUE value - target_params <- param_cols[colSums(data[param_cols]) > 0] - } else { - # Check that all target_params are present in the data frame - missing_params <- setdiff(target_params, param_cols) - if (length(missing_params) > 0) { - stop("The following target_params are not interval columns and/or known PKNCA parameters: ", paste(missing_params, collapse = ", ")) - target_params <- intersect(target_params, param_cols) - } - } - - # Determine the name of the impute column - impute_col <- if (!is.null(impute_column)) { - if (!impute_column %in% colnames(data)) { - stop("The 'data' object does not contain the specified impute column.") - } - impute_column - } else if ("impute" %in% colnames(data)) { - "impute" + target_params <- param_cols } else { - warning("No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") - return(data %>% dplyr::select(-index)) + checkmate::assert_subset(target_params, choices = all_param_options) } - - # Identify the targeted intervals based on the groups + + # Ifentify the target interval rows based on: + ## 1. The target groups (perfect match) + target_rows <- rep(TRUE, nrow(intervals)) if (!is.null(target_groups)) { - target_intervals <- dplyr::inner_join(data, target_groups, by = names(target_groups)) - } else { - target_intervals <- data + target_groups_data <- intervals[, names(target_groups), drop = FALSE] + target_rows <- target_rows & (do.call(paste0, target_groups_data) %in% do.call(paste0, target_groups)) } - - # Identify the targeted intervals based on the impute method and parameters - target_intervals <- target_intervals %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(target_params), ~ . == TRUE)) > 0) %>% - dplyr::filter(grepl( - pattern = paste0(".*(", paste0(target_impute, collapse = ")|("), ").*"), - .data[[impute_col]] - )) - - # Create the new version intervals only for the target parameters - new_intervals_without_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(param_cols), ~FALSE)) %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~TRUE)) %>% - dplyr::rowwise() %>% - # Eliminate the target impute method from the impute column - dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~ paste0(setdiff(unlist(strsplit(.data[[impute_col]], ",")), target_impute), - collapse = "," - ))) %>% - dplyr::mutate(dplyr::across(dplyr::any_of(impute_col), ~ ifelse(.data[[impute_col]] == "", NA_character_, .data[[impute_col]]))) %>% - dplyr::ungroup() %>% - # Make sure the class of the impute_col remains the same - dplyr::mutate(dplyr::across(any_of(impute_col), ~ as.character(.data[[impute_col]]))) %>% - as.data.frame() - - # Eliminate from the old intervals the target parameters - old_intervals_with_impute <- target_intervals %>% - dplyr::mutate(dplyr::across(dplyr::any_of(target_params), ~FALSE)) %>% - dplyr::mutate(index = if (new_rows_after_original) index + 0.5 else index + max(index)) - - # Make parameters FALSE in original intervals and join the new ones - data <- data %>% - dplyr::anti_join(target_intervals, by = names(data)) %>% - dplyr::bind_rows(old_intervals_with_impute, new_intervals_without_impute) %>% - dplyr::filter(rowSums(dplyr::across(dplyr::any_of(param_cols), as.numeric)) > 0) %>% - dplyr::arrange(index) %>% - dplyr::select(-index) - - data -} + ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) + target_params_data <- intervals[, target_params, drop = FALSE] + target_rows <- target_rows & (rowSums(!is.na(replace(target_params_data, target_params_data == FALSE, NA))) > 0) + ## 3. The target impute method to be removed (contained in the string) + target_rows <- target_rows & grepl(target_impute, intervals$impute, fixed = TRUE) + + # Create new intervals for the target parameters excluding the impute method (and indexed after the original intervals) + new_intervals <- intervals[target_rows, ] + new_intervals[, setdiff(param_cols, target_params)] <- NA + new_intervals[["impute"]] <- remove_impute_method(new_intervals[["impute"]], target_impute) + new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 + # Remove the target parameters from the original target intervals + intervals[target_rows, target_params] <- NA + # Combine the new and original intervals + intervals <- rbind(intervals, new_intervals) + # Filter rows where all row values for param_cols are NA or FALSE + param_data <- intervals[, param_cols, drop = FALSE] + rows_no_params <- rowSums(!is.na(replace(param_data, param_data == FALSE, NA))) == 0 + intervals <- intervals[!rows_no_params, , drop = FALSE] + + # Order the intervals by the index column and then remove it + intervals <- intervals[order(intervals[, index_colname]), ] + rownames(intervals) <- seq_len(nrow(intervals)) + intervals[, !names(intervals) %in% index_colname] +} diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index b83f3b2f..9bbf8d61 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -38,41 +38,36 @@ test_that("interval_add_impute throws an error for non-character target_impute", expect_error(interval_add_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") }) -test_that("interval_add_impute throws an error when input data is a non PKNCAdata object or has no intervals", { +test_that("interval_add_impute throws an error when input data is a non PKNCAdata/data.frame object", { + expect_error(interval_add_impute(data = o_conc, target_impute = "start_conc0")) expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) }) test_that("interval_add_impute throws an error for unknown target_params", { - expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param"), - "") + expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param")) }) -# test_that("interval_add_impute handles impute column with different names", { -# o_data_changed_impute_name <- o_data -# o_data_changed_impute_name$impute <- "impute_col" -# o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% dplyr::rename(impute_col = impute) -# result <- interval_add_impute(o_data_changed_impute_name, target_impute = "new_impute") -# expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), -# data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), -# half.life = c(TRUE, TRUE, TRUE), -# cmax = c(TRUE, TRUE, TRUE), -# impute_col = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -# }) - test_that("interval_add_impute handles impute column with NA values correctly", { o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% dplyr::mutate(impute = NA_character_) + o_data_with_na_impute$intervals$impute <- NA_character_ result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("new_impute", "new_impute", "new_impute"))) }) +test_that("interval_add_impute handles missing impute column by creating it with NA_character_ and then adding the impute without warning", { + o_data_no_impute <- o_data + o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] + result <- suppressWarnings(interval_add_impute(o_data_no_impute, target_impute = "new_impute")) + expect_equal(result$intervals, transform(o_data_no_impute$intervals, impute = "new_impute")) +}) + test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_add_impute(o_data, target_impute = "new_impute") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -81,28 +76,28 @@ test_that("interval_add_impute with no optional parameters uses all relevant cas test_that("interval_add_impute handles specified target_params correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = "half.life") - expect_equal(result$intervals %>% dplyr::filter(half.life) %>% dplyr::select(analyte, half.life, impute), + expect_equal(result$intervals[result$intervals$half.life & !is.na(result$intervals$half.life), c("analyte", "half.life", "impute")] |> `rownames<-`(NULL), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute), - o_data$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute)) + expect_equal(result$intervals[result$intervals$cmax & !is.na(result$intervals$cmax), c("analyte", "cmax", "impute")] |> `rownames<-`(NULL), + o_data$intervals[o_data$intervals$cmax, c("analyte", "cmax", "impute")] |> `rownames<-`(NULL)) }) test_that("interval_add_impute handles target_groups correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(analyte = "Analyte1")) - expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte1") %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[result$intervals$analyte == "Analyte1", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute), - o_data$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute)) + expect_equal(result$intervals[result$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), + o_data$intervals[o_data$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL)) }) test_that("interval_add_impute handles multiple target_params correctly", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -122,7 +117,7 @@ test_that("interval_add_impute handles mixed TRUE/FALSE for cmax and half.life c o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) result <- interval_add_impute(o_data_mixed, target_impute = "new_impute") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), half.life = c(TRUE, FALSE, TRUE, FALSE), cmax = c(FALSE, TRUE, FALSE, TRUE), @@ -130,10 +125,8 @@ test_that("interval_add_impute handles mixed TRUE/FALSE for cmax and half.life c }) test_that("interval_add_impute do not create duplicates but instead removes original ones and then adds impute method based on after", { - - # When allow_duplication is FALSE, intervals with already the same impute method do not add it result <- interval_add_impute(o_data, target_impute = "start_conc0", after=Inf) - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -141,10 +134,8 @@ test_that("interval_add_impute do not create duplicates but instead removes orig }) test_that("interval_add_impute includes new rows with added imputations right after the original ones", { - - # When true the new rows are added after the original rows result <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), half.life = c(TRUE, NA, TRUE, NA, TRUE, NA), cmax = c(NA, TRUE, NA, TRUE, NA, TRUE), @@ -153,69 +144,69 @@ test_that("interval_add_impute includes new rows with added imputations right af "start_predose", "start_predose,new_impute", "start_conc0", - "start_conc0,new_impute")) - ) + "start_conc0,new_impute"))) }) ### Test interval_remove_impute test_that("interval_remove_impute throws an error if either data or target_impute is missing", { - expect_error(interval_remove_impute(), "Both 'data' and 'target_impute' must be provided.") expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") - expect_error(interval_remove_impute(target_impute = "start_conc0"), "Both 'data' and 'target_impute' must be provided.") }) test_that("interval_remove_impute throws an error for non-character target_impute", { expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") }) -test_that("interval_remove_impute throws an error when input data is a non PKNCAdata object or has no intervals", { - expect_error(interval_remove_impute(o_data$conc, target_impute = "start_conc0"), "The 'data' object must be a PKNCAdata object or a data frame") +test_that("interval_remove_impute throws an error when input data is a non PKNCAdata/data.frame object", { + expect_error(interval_remove_impute(data = o_conc, target_impute = "start_conc0")) expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) }) test_that("interval_remove_impute throws an error for unknown target_params", { - expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param"), - "The following target_params are not interval columns and/or known PKNCA parameters: unknown_param") -}) - -test_that("interval_remove_impute handles impute column with different names", { - o_data_changed_impute_name <- o_data - o_data_changed_impute_name$impute <- "impute_col" - o_data_changed_impute_name$intervals <- o_data_changed_impute_name$intervals %>% dplyr::rename(impute_col = impute) - result <- interval_remove_impute(o_data_changed_impute_name, target_impute = "start_conc0") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute_col), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute_col = c("start_predose", "start_predose", NA))) + expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param")) }) test_that("interval_remove_impute handles impute column with NA values correctly", { o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals <- o_data_with_na_impute$intervals %>% dplyr::mutate(impute = NA_character_) + o_data_with_na_impute$intervals$impute <- NA_character_ result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c(NA_character_, NA_character_, NA_character_))) }) -test_that("interval_remove_impute handles missing impute column by not modifying the dataset and warns the user", { +test_that("interval_remove_impute handles missing impute column & global impute by not modifying the dataset and warns the user", { o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals %>% dplyr::select(-impute) + o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] + o_data_no_impute$impute <- NA_character_ result <- suppressWarnings(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0")) expect_equal(result, o_data_no_impute) expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), - "No default impute column identified. No impute methods to remove. If there is an impute column, please specify it in argument 'impute_column'") + "No default impute column or global method identified. No impute methods to remove") }) -# Test intervals for expected outputs with different inputs +test_that("interval_remove_impute handles missing impute column, using global impute when possible in the best way", { + o_data_no_impute <- o_data + o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] + o_data_no_impute$impute <- "start_conc0, start_predose" + + # When targets are all intervals, global method is changed + result_without_row_targets <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") + expect_equal(result_without_row_targets$impute, "start_predose") + + # When targets are specific intervals, then a new column is created and the action handled appropriately + result_with_row_targets <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) + expect_equal(unique(result_with_row_targets$intervals[result_with_row_targets$intervals$analyte == "Analyte1", "impute"]), + "start_predose") + expect_equal(result_with_row_targets$intervals[result_with_row_targets$intervals$analyte == "Analyte2", "impute"], + "start_conc0, start_predose") +}) test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -224,33 +215,34 @@ test_that("interval_remove_impute with no optional parameters uses all relevant test_that("interval_remove_impute handles specified target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "half.life") - # half.life has no start_conc0 imputations - expect_equal(result$intervals %>% dplyr::filter(half.life) %>% dplyr::select(analyte, half.life, impute), + + # Target parameter's impute was changed + half.life_rows <- result$intervals$half.life & !is.na(result$intervals$half.life) + expect_equal(result$intervals[half.life_rows, c("analyte", "half.life", "impute")] |> `rownames<-`(NULL), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), impute = c("start_predose", "start_predose", NA))) - # cmax has the same exact imputations as before - expect_equal(result$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute), - o_data$intervals %>% dplyr::filter(cmax) %>% dplyr::select(analyte, cmax, impute)) + + # Non-target parameter has the same impute + cmax_rows <- result$intervals$cmax & !is.na(result$intervals$cmax) + expect_equal(result$intervals[cmax_rows, c("analyte", "cmax", "impute")] |> `rownames<-`(NULL), + o_data$intervals[o_data$intervals$cmax, c("analyte", "cmax", "impute")] |> `rownames<-`(NULL)) }) test_that("interval_remove_impute handles target_groups correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) - # Analyte1 has no start_conc0 imputations - expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte1") %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[result$intervals$analyte == "Analyte1", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), impute = c("start_predose", NA_character_))) - - # Analyte2 has the same exact imputations as before - expect_equal(result$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute), - o_data$intervals %>% dplyr::filter(analyte == "Analyte2") %>% dplyr::select(analyte, half.life, cmax, impute)) + expect_equal(result$intervals[result$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")], + o_data$intervals[o_data$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")]) }) test_that("interval_remove_impute handles multiple target_params correctly", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -259,9 +251,9 @@ test_that("interval_remove_impute handles multiple target_params correctly", { test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { o_data_multiple_imputes <- o_data - o_data_multiple_imputes$intervals <- o_data_multiple_imputes$intervals %>% dplyr::mutate(impute = "start_conc0,start_predose") + o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose" result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), @@ -283,29 +275,34 @@ test_that("interval_remove_impute handles mixed TRUE/FALSE for cmax and half.lif result <- interval_remove_impute(o_data_mixed, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals %>% dplyr::select(analyte, half.life, cmax, impute), + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), half.life = c(TRUE, FALSE, TRUE, FALSE), cmax = c(FALSE, TRUE, FALSE, TRUE), impute = c("start_predose", "start_predose", NA, "start_predose"))) }) -test_that("interval_remove_impute handles correctly argument new_rows_after_original", { - - # When true the new rows are added after the original rows - result1 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = TRUE) - expect_equal(result1$intervals %>% dplyr::select(analyte, half.life, cmax, impute), +test_that("interval_remove_impute removes properly all target_impute even if a method contains it several times", { + o_data_multiple_imputes <- o_data + o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose,start_conc0" + result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", "start_predose"))) +}) + +test_that("interval_add_impute includes new rows with added imputations right after the original ones", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_param = "cmax") + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(FALSE, TRUE, TRUE, FALSE, TRUE), - cmax = c(TRUE, FALSE, TRUE, TRUE, FALSE), - impute = c("start_predose", "start_conc0,start_predose", "start_predose", NA, "start_conc0"))) - - # When false the new rows are added at the end of the data frame - result2 <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "cmax", new_rows_after_original = FALSE) - expect_equal(result2$intervals %>% dplyr::select(analyte, half.life, cmax, impute), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte1", "Analyte1"), - half.life = c(FALSE, TRUE, FALSE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE, FALSE, FALSE), - impute = c("start_predose", "start_predose", NA, "start_conc0,start_predose", "start_conc0"))) + half.life = c(TRUE, NA, TRUE, TRUE, NA), + cmax = c(NA, TRUE, TRUE, NA, TRUE), + impute = c("start_conc0,start_predose", + "start_predose", + "start_predose", + "start_conc0", + NA_character_))) }) From 7c6077bdbc22896745feb7941440a18024cc04ee Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 12 Feb 2025 17:22:07 +0100 Subject: [PATCH 31/49] refactor: substitute Vectorize fun with Bill's fun (test: returns "" instead of NAs) Co-Authored-By: Bill Denney --- R/intervals_support_funs.R | 36 ++++++++++++-------- tests/testthat/test-intervals_support_funs.R | 18 +++++----- 2 files changed, 31 insertions(+), 23 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index ebd448ca..ebdba288 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -69,13 +69,17 @@ interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, targ #' @param after Numeric value specifying the position after which the imputation method should be added. #' @return A character string or vector with the added impute method. #' @keywords internal -add_impute_method <- Vectorize(function(impute_col_value, target_impute, after) { - impute_methods <- unlist(strsplit(ifelse(is.na(impute_col_value), "", impute_col_value), "[ ,]+")) |> - setdiff(target_impute) |> - append(target_impute, after) |> - paste(collapse = ",") -}, vectorize.args = "impute_col_value", USE.NAMES = FALSE) - +add_impute_method <- function(impute_vals, target_impute, after) { + # Make sure the character vector has length + if (length(impute_vals) == 0) return(impute_vals) + + # Remove the impute from the other methods in each value + impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) + strsplit(impute_vals, split = "[ ,]+") |> + lapply(FUN = setdiff, target_impute) |> + vapply(FUN = paste, collapse = ",", FUN.VALUE = "") + vapply(FUN = paste, collapse = ",", FUN.VALUE = "") +} #' @export interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { # Validate inputs @@ -207,17 +211,21 @@ interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params #' #' This is an internal helper function used to remove an impute method from the impute column. #' -#' @param impute_col_value The current value of the impute column. +#' @param impute_vals Character vector of impute methods. #' @param target_impute The imputation method to be removed. #' @return A character string or vector without the specified impute method. #' @details Resulting empty string values are replaced with NA_character_. #' @keywords internal -remove_impute_method <- Vectorize(function(impute_col_value, target_impute, after) { - impute_methods <- unlist(strsplit(ifelse(is.na(impute_col_value), "", impute_col_value), "[ ,]+")) |> - setdiff(target_impute) |> - paste(collapse = ",") - if (impute_methods == "") NA_character_ else impute_methods -}, vectorize.args = "impute_col_value", USE.NAMES = FALSE) +remove_impute_method <- function(impute_vals, target_impute){ + # Make sure the character vector has length + if (length(impute_vals) == 0) return(impute_vals) + + # Remove the impute from the other methods in each value + impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) + strsplit(impute_vals, split = "[ ,]+") |> + lapply(FUN = setdiff, target_impute) |> + vapply(FUN = paste, collapse = ",", FUN.VALUE = "") +} #' @export interval_remove_impute.data.frame <- function(intervals, target_impute, target_params = NULL, target_groups = NULL) { diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 9bbf8d61..980e6f62 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -210,7 +210,7 @@ test_that("interval_remove_impute with no optional parameters uses all relevant data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) + impute = c("start_predose", "start_predose", ""))) }) test_that("interval_remove_impute handles specified target_params correctly", { @@ -221,7 +221,7 @@ test_that("interval_remove_impute handles specified target_params correctly", { expect_equal(result$intervals[half.life_rows, c("analyte", "half.life", "impute")] |> `rownames<-`(NULL), data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) + impute = c("start_predose", "start_predose", ""))) # Non-target parameter has the same impute cmax_rows <- result$intervals$cmax & !is.na(result$intervals$cmax) @@ -235,7 +235,7 @@ test_that("interval_remove_impute handles target_groups correctly", { data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), cmax = c(TRUE, TRUE), - impute = c("start_predose", NA_character_))) + impute = c("start_predose", ""))) expect_equal(result$intervals[result$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")], o_data$intervals[o_data$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")]) }) @@ -246,7 +246,7 @@ test_that("interval_remove_impute handles multiple target_params correctly", { data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", NA))) + impute = c("start_predose", "start_predose", ""))) }) test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { @@ -270,16 +270,16 @@ test_that("interval_remove_impute handles mixed TRUE/FALSE for cmax and half.lif analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), ID = c(1, 2, 1, 2) ) - + o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) - + result <- interval_remove_impute(o_data_mixed, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), half.life = c(TRUE, FALSE, TRUE, FALSE), cmax = c(FALSE, TRUE, FALSE, TRUE), - impute = c("start_predose", "start_predose", NA, "start_predose"))) + impute = c("start_predose", "start_predose", "", "start_predose"))) }) test_that("interval_remove_impute removes properly all target_impute even if a method contains it several times", { @@ -303,6 +303,6 @@ test_that("interval_add_impute includes new rows with added imputations right af "start_predose", "start_predose", "start_conc0", - NA_character_))) + ""))) }) From cfd2bad6542c162ef78c010fdb95a0d8e911417f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 12 Feb 2025 17:34:39 +0100 Subject: [PATCH 32/49] fix: typpo in substituted fun add_impute_method --- R/intervals_support_funs.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index ebdba288..7057f2d9 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -77,7 +77,7 @@ add_impute_method <- function(impute_vals, target_impute, after) { impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) strsplit(impute_vals, split = "[ ,]+") |> lapply(FUN = setdiff, target_impute) |> - vapply(FUN = paste, collapse = ",", FUN.VALUE = "") + lapply(FUN = append, values = target_impute, after = after) |> vapply(FUN = paste, collapse = ",", FUN.VALUE = "") } #' @export @@ -99,7 +99,7 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf # Add an index column to preserve the original order index_colname <- make.unique(c("index", names(intervals)))[1] - intervals[[index_colname]] <- 1:nrow(intervals) + intervals[[index_colname]] <- seq_len(nrow(intervals)) # Get all parameter column names in the data frame all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) @@ -142,7 +142,7 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf # Order the intervals by the index column and then remove it intervals <- intervals[order(intervals[, index_colname]), ] - rownames(intervals) <- 1:nrow(intervals) + rownames(intervals) <- seq_len(nrow(intervals)) intervals[, !names(intervals) %in% index_colname] } From 84e1dd4b08b29dd9189dc6b09c95bfe4b5dbe426 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 12 Feb 2025 17:35:22 +0100 Subject: [PATCH 33/49] documentation: update manuals interval_add_impute & interval_remove_impute --- man/interval_add_impute.Rd | 24 +++++------------------- man/interval_remove_impute.Rd | 29 ++++------------------------- 2 files changed, 9 insertions(+), 44 deletions(-) diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index 57bb2f7c..0c858e8a 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -4,16 +4,7 @@ \alias{interval_add_impute} \title{Add specified imputation methods to the intervals in a PKNCAdata or data.frame object.} \usage{ -interval_add_impute( - data, - target_impute, - after = Inf, - target_params = NULL, - target_groups = NULL, - impute_column = NULL, - allow_duplication = TRUE, - new_rows_after_original = TRUE -) +interval_add_impute(data, target_impute, ...) } \arguments{ \item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} @@ -28,15 +19,6 @@ If missing, all TRUE in the intervals are taken.} \item{target_groups}{A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered.} - -\item{impute_column}{A character string specifying the name of the impute column (optional). -If missing, the default name "impute" is used.} - -\item{allow_duplication}{A boolean specifying whether to allow creating duplicates of the target_impute -in the impute column (optional). Default is TRUE.} - -\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows -(optional). Default is TRUE.} } \value{ A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. @@ -44,6 +26,10 @@ A modified PKNCAdata object with the specified imputation methods added to the t \description{ Add specified imputation methods to the intervals in a PKNCAdata or data.frame object. } +\details{ +. If already present the target_impute method will be added substituting the existing one. All new intervals +created will be added right after their original ones. +} \examples{ d_conc <- data.frame( conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index 42b9a847..4dec3514 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -2,39 +2,20 @@ % Please edit documentation in R/intervals_support_funs.R \name{interval_remove_impute} \alias{interval_remove_impute} -\title{Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object.} +\title{Remove specified imputation methods from the intervals in a PKNCAdata or data.frame (intervals) object.} \usage{ -interval_remove_impute( - data, - target_impute, - target_params = NULL, - target_groups = NULL, - impute_column = NULL, - new_rows_after_original = TRUE -) +interval_remove_impute(data, ...) } \arguments{ \item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} -\item{target_impute}{A character string specifying the imputation method to be removed.} - -\item{target_params}{A character vector specifying the parameters to be targeted (optional). -If missing, all TRUE in the intervals are taken.} - -\item{target_groups}{A data frame specifying the intervals to be targeted (optional). -If missing, all relevant groups are considered.} - -\item{impute_column}{A character string specifying the name of the impute column (optional). -If missing, the default name "impute" is used.} - -\item{new_rows_after_original}{A boolean specifying whether the new rows should be added after the original rows -(optional). Default is TRUE.} +\item{target_impute}{A character string specifying the imputation method to remove.} } \value{ A modified object with the specified imputation methods removed from the targeted intervals. } \description{ -Remove specified imputation methods from the intervals in a PKNCAdata or data.frame object. +Remove specified imputation methods from the intervals in a PKNCAdata or data.frame (intervals) object. } \examples{ d_conc <- data.frame( @@ -42,7 +23,6 @@ d_conc <- data.frame( time = rep(0:5, 2), ID = rep(1:2, each = 6), analyte = rep(c("Analyte1", "Analyte2"), each = 6), - include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) ) d_dose <- data.frame( @@ -57,7 +37,6 @@ o_dose <- PKNCAdose(d_dose, dose ~ time | ID) intervals <- data.frame( start = c(0, 0, 0), end = c(3, 5, Inf), - half.life = c(TRUE, FALSE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), analyte = c("Analyte1", "Analyte2", "Analyte1") From 29d9a6e8df59efa3b62b051aa7a868a578034339 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 12 Feb 2025 17:35:53 +0100 Subject: [PATCH 34/49] documentation: create manuals for add_impute_method & remove_impute_method --- man/add_impute_method.Rd | 22 ++++++++++++++++++++++ man/remove_impute_method.Rd | 23 +++++++++++++++++++++++ 2 files changed, 45 insertions(+) create mode 100644 man/add_impute_method.Rd create mode 100644 man/remove_impute_method.Rd diff --git a/man/add_impute_method.Rd b/man/add_impute_method.Rd new file mode 100644 index 00000000..dfc1965b --- /dev/null +++ b/man/add_impute_method.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/intervals_support_funs.R +\name{add_impute_method} +\alias{add_impute_method} +\title{Add impute method to the impute column} +\usage{ +add_impute_method(impute_vals, target_impute, after) +} +\arguments{ +\item{target_impute}{The imputation method to be added.} + +\item{after}{Numeric value specifying the position after which the imputation method should be added.} + +\item{impute_col_value}{The current value of the impute column.} +} +\value{ +A character string or vector with the added impute method. +} +\description{ +This is an internal helper function used to add an impute method to the impute column. +} +\keyword{internal} diff --git a/man/remove_impute_method.Rd b/man/remove_impute_method.Rd new file mode 100644 index 00000000..b4796174 --- /dev/null +++ b/man/remove_impute_method.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/intervals_support_funs.R +\name{remove_impute_method} +\alias{remove_impute_method} +\title{Remove impute method from the impute column} +\usage{ +remove_impute_method(impute_vals, target_impute) +} +\arguments{ +\item{impute_vals}{Character vector of impute methods.} + +\item{target_impute}{The imputation method to be removed.} +} +\value{ +A character string or vector without the specified impute method. +} +\description{ +This is an internal helper function used to remove an impute method from the impute column. +} +\details{ +Resulting empty string values are replaced with NA_character_. +} +\keyword{internal} From 9217ac6025c7c8eab54b961eaf920110abf009f8 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Wed, 12 Feb 2025 18:15:59 +0100 Subject: [PATCH 35/49] fix: solve example typpo/args, refactor class evaluation, update manuals --- R/intervals_support_funs.R | 21 +++++++++++++-------- man/add_impute_method.Rd | 4 ++-- man/interval_add_impute.Rd | 10 ++++++---- man/interval_remove_impute.Rd | 7 +++++-- 4 files changed, 26 insertions(+), 16 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 7057f2d9..c8476573 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -16,8 +16,7 @@ #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), #' time = rep(0:5, 2), #' ID = rep(1:2, each = 6), -#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), -#' include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) +#' analyte = rep(c("Analyte1", "Analyte2"), each = 6) #' ) #' #' d_dose <- data.frame( @@ -41,9 +40,12 @@ #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_add_impute function -#' o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) +#' o_data <- interval_add_impute(o_data, +#' target_impute = "start_conc0", +#' target_params = "half.life", +#' target_groups = data.frame(analyte = "Analyte1")) #' @export -interval_add_impute <- function(data, target_impute, ...) { +interval_add_impute <- function(data, ...) { UseMethod("interval_add_impute", data) } @@ -53,7 +55,7 @@ interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, targ if (!"impute" %in% names(data$intervals) && !is.null(data$impute)) { data$intervals$impute <- data$impute data$impute <- NA_character_ - } else if (class(data$intervals$impute) != "character") { + } else if (!is.character(data$intervals$impute)) { stop("The 'impute' column in the intervals must be a character column.") } data$intervals <- interval_add_impute.data.frame(data$intervals, target_impute, after, target_params, target_groups) @@ -64,7 +66,7 @@ interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, targ #' #' This is an internal helper function used to add an impute method to the impute column. #' -#' @param impute_col_value The current value of the impute column. +#' @param impute_vals Character vector of impute methods. #' @param target_impute The imputation method to be added. #' @param after Numeric value specifying the position after which the imputation method should be added. #' @return A character string or vector with the added impute method. @@ -156,7 +158,7 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), #' time = rep(0:5, 2), #' ID = rep(1:2, each = 6), -#' analyte = rep(c("Analyte1", "Analyte2"), each = 6), +#' analyte = rep(c("Analyte1", "Analyte2"), each = 6) #' ) #' #' d_dose <- data.frame( @@ -179,7 +181,10 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_remove_impute function -#' o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) +#' o_data <- interval_remove_impute(data = o_data, +#' target_impute = "start_conc0", +#' target_params = c("half.life"), +#' target_groups = data.frame(analyte = "Analyte1")) #' @export interval_remove_impute <- function(data, ...) { UseMethod("interval_remove_impute", data) diff --git a/man/add_impute_method.Rd b/man/add_impute_method.Rd index dfc1965b..a1c30746 100644 --- a/man/add_impute_method.Rd +++ b/man/add_impute_method.Rd @@ -7,11 +7,11 @@ add_impute_method(impute_vals, target_impute, after) } \arguments{ +\item{impute_vals}{Character vector of impute methods.} + \item{target_impute}{The imputation method to be added.} \item{after}{Numeric value specifying the position after which the imputation method should be added.} - -\item{impute_col_value}{The current value of the impute column.} } \value{ A character string or vector with the added impute method. diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index 0c858e8a..6e6ab7e6 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -4,7 +4,7 @@ \alias{interval_add_impute} \title{Add specified imputation methods to the intervals in a PKNCAdata or data.frame object.} \usage{ -interval_add_impute(data, target_impute, ...) +interval_add_impute(data, ...) } \arguments{ \item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} @@ -35,8 +35,7 @@ d_conc <- data.frame( conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), time = rep(0:5, 2), ID = rep(1:2, each = 6), - analyte = rep(c("Analyte1", "Analyte2"), each = 6), - include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE) + analyte = rep(c("Analyte1", "Analyte2"), each = 6) ) d_dose <- data.frame( @@ -60,5 +59,8 @@ intervals <- data.frame( o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) # Apply interval_add_impute function -o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) +o_data <- interval_add_impute(o_data, + target_impute = "start_conc0", + target_params = "half.life", + target_groups = data.frame(analyte = "Analyte1")) } diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index 4dec3514..9ea0fa74 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -22,7 +22,7 @@ d_conc <- data.frame( conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), time = rep(0:5, 2), ID = rep(1:2, each = 6), - analyte = rep(c("Analyte1", "Analyte2"), each = 6), + analyte = rep(c("Analyte1", "Analyte2"), each = 6) ) d_dose <- data.frame( @@ -45,5 +45,8 @@ intervals <- data.frame( o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) # Apply interval_remove_impute function -o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", target_params = c("half.life"), target_groups = data.frame(analyte = "Analyte1")) +o_data <- interval_remove_impute(data = o_data, + target_impute = "start_conc0", + target_params = c("half.life"), + target_groups = data.frame(analyte = "Analyte1")) } From a89ee52b172eaa4d63d107425fd24fdfbb80baf8 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 08:25:34 +0100 Subject: [PATCH 36/49] fix, tests: no matching interval & add_impute when method is already in after (do not split rows) --- R/intervals_support_funs.R | 71 ++++++++++++++------ tests/testthat/test-intervals_support_funs.R | 54 ++++++++++++++- 2 files changed, 102 insertions(+), 23 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index c8476573..05b44ec3 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -18,7 +18,7 @@ #' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6) #' ) -#' + #' d_dose <- data.frame( #' dose = c(100, 200), #' time = c(0, 0), @@ -31,7 +31,7 @@ #' intervals <- data.frame( #' start = c(0, 0, 0), #' end = c(3, 5, Inf), -#' half.life = c(TRUE, FALSE, TRUE), +#' half.life = c(TRUE, TRUE, TRUE), #' cmax = c(TRUE, TRUE, TRUE), #' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), #' analyte = c("Analyte1", "Analyte2", "Analyte1") @@ -40,7 +40,7 @@ #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_add_impute function -#' o_data <- interval_add_impute(o_data, +#' o_data <- interval_add_impute(o_data, #' target_impute = "start_conc0", #' target_params = "half.life", #' target_groups = data.frame(analyte = "Analyte1")) @@ -124,14 +124,32 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) target_params_data <- intervals[, target_params, drop = FALSE] target_rows <- target_rows & (rowSums(!is.na(replace(target_params_data, target_params_data == FALSE, NA))) > 0) - - # Create for the target parameters new intervals with the new impute method. Index them to be after the original intervals. + ## 3. The target impute method is not already present and correctly positioned + after_vals <- lapply(strsplit(intervals$impute, "[ ,]+"), function(x) { + after.x <- which(x == target_impute) + if (length(after.x) == 0) return(NA) + if (after.x == length(x)) Inf else after.x + }) |> unlist() + target_rows <- target_rows & (after_vals != after | is.na(after_vals)) + new_intervals <- intervals[target_rows, ] - new_intervals[, setdiff(param_cols, target_params)] <- NA - new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) - new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 - # Remove the target parameters from the original target intervals + # If no target intervals are found, nothing to change + if (nrow(new_intervals) == 0) { + warning("No intervals found with the specified target parameters, groups, and/or after-change needed. No changes made.") + return(intervals[, !names(intervals) %in% index_colname]) + + # If target intervals are found... + } else { + # The new imputation should not be used non-target parameters + new_intervals[, setdiff(param_cols, target_params)] <- NA + + # Index the new intervals to be after the original ones + new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) + new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 + } + + # Remove the target parameters calculation from the original target intervals intervals[target_rows, target_params] <- NA # Combine the new and original intervals @@ -160,30 +178,31 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6) #' ) -#' +#' #' d_dose <- data.frame( #' dose = c(100, 200), #' time = c(0, 0), #' ID = c(1, 2) #' ) -#' +#' #' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) #' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) -#' +#' #' intervals <- data.frame( #' start = c(0, 0, 0), #' end = c(3, 5, Inf), +#' half.life = c(TRUE, FALSE, TRUE), #' cmax = c(TRUE, TRUE, TRUE), #' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), #' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) -#' +#' #' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) -#' +#' #' # Apply interval_remove_impute function #' o_data <- interval_remove_impute(data = o_data, #' target_impute = "start_conc0", -#' target_params = c("half.life"), +#' target_params = "half.life", #' target_groups = data.frame(analyte = "Analyte1")) #' @export interval_remove_impute <- function(data, ...) { @@ -276,14 +295,24 @@ interval_remove_impute.data.frame <- function(intervals, target_impute, target_p target_rows <- target_rows & (rowSums(!is.na(replace(target_params_data, target_params_data == FALSE, NA))) > 0) ## 3. The target impute method to be removed (contained in the string) target_rows <- target_rows & grepl(target_impute, intervals$impute, fixed = TRUE) - - # Create new intervals for the target parameters excluding the impute method (and indexed after the original intervals) new_intervals <- intervals[target_rows, ] - new_intervals[, setdiff(param_cols, target_params)] <- NA - new_intervals[["impute"]] <- remove_impute_method(new_intervals[["impute"]], target_impute) - new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 + + # If no target intervals are found, nothing to change + if (nrow(new_intervals) == 0) { + warning("No intervals found with the specified target parameters, groups and/or impute method. No changes made.") + return(intervals[, !names(intervals) %in% index_colname]) + + # If target intervals are found... + } else { + # The new imputation should not involve non-target parameters + new_intervals[, setdiff(param_cols, target_params)] <- NA + + # Index the new intervals to be after the original ones + new_intervals[["impute"]] <- remove_impute_method(new_intervals[["impute"]], target_impute) + new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 + } - # Remove the target parameters from the original target intervals + # Remove the target parameters calculation from the original target intervals intervals[target_rows, target_params] <- NA # Combine the new and original intervals diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 980e6f62..0d6c282d 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -27,7 +27,6 @@ o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "inc o_dose <- PKNCAdose(d_dose, dose ~ time | ID) o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) - ### Test interval_add_impute test_that("interval_add_impute throws an error if either data or target_impute is missing", { @@ -104,6 +103,18 @@ test_that("interval_add_impute handles multiple target_params correctly", { impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) }) +test_that("interval_add_impute makes no changes and warns when no matching intervals are found", { + result <- suppressWarnings(interval_remove_impute(o_data, + target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte3"))) + expect_equal(result, o_data) + + expect_warning(interval_remove_impute(o_data, + target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte3")), + "No intervals found with the specified target parameters, groups and/or impute method. No changes made.") +}) + test_that("interval_add_impute handles mixed TRUE/FALSE for cmax and half.life correctly", { intervals_mixed <- data.frame( start = c(0, 0, 0, 0), @@ -147,6 +158,28 @@ test_that("interval_add_impute includes new rows with added imputations right af "start_conc0,new_impute"))) }) +test_that("interval_add_impute do not add a new interval row when a non-target parameter and a target parameter share the target impute at the after position",{ + intervals_mixed <- data.frame( + start = c(0, 0), + end = c(24, 48), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose"), + analyte = c("Analyte1", "Analyte2"), + ID = 1 + ) + + o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) + result <- suppressWarnings(interval_add_impute(o_data_mixed, + target_impute = "start_predose", + target_param = "cmax", + after = Inf)) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + data.frame(analyte = c("Analyte1", "Analyte2"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose"))) +}) ### Test interval_remove_impute test_that("interval_remove_impute throws an error if either data or target_impute is missing", { @@ -249,6 +282,18 @@ test_that("interval_remove_impute handles multiple target_params correctly", { impute = c("start_predose", "start_predose", ""))) }) +test_that("interval_remove_impute makes no changes and warns when no matching intervals are found", { + result <- suppressWarnings(interval_remove_impute(o_data, + target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte3"))) + expect_equal(result, o_data) + + expect_warning(interval_remove_impute(o_data, + target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte3")), + "No intervals found with the specified target parameters, groups and/or impute method. No changes made.") +}) + test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { o_data_multiple_imputes <- o_data o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose" @@ -293,7 +338,7 @@ test_that("interval_remove_impute removes properly all target_impute even if a m impute = c("start_predose", "start_predose", "start_predose"))) }) -test_that("interval_add_impute includes new rows with added imputations right after the original ones", { +test_that("interval_remove_impute includes new rows with added imputations right after the original ones", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_param = "cmax") expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), @@ -306,3 +351,8 @@ test_that("interval_add_impute includes new rows with added imputations right af ""))) }) +test_that("interval_add_impute and interval_remove_impute are inverses of each other", { + result_add <- interval_add_impute(o_data, target_impute = "new_impute") + result_remove <- interval_remove_impute(result_add, target_impute = "new_impute") + expect_equal(result_remove, o_data) +}) From 56bebd95c3c33d03ed034a7528ebe95d6330c25f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 08:25:52 +0100 Subject: [PATCH 37/49] documentation: roxygenise --- man/interval_add_impute.Rd | 5 ++--- man/interval_remove_impute.Rd | 3 ++- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index 6e6ab7e6..d8456798 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -37,7 +37,6 @@ d_conc <- data.frame( ID = rep(1:2, each = 6), analyte = rep(c("Analyte1", "Analyte2"), each = 6) ) - d_dose <- data.frame( dose = c(100, 200), time = c(0, 0), @@ -50,7 +49,7 @@ o_dose <- PKNCAdose(d_dose, dose ~ time | ID) intervals <- data.frame( start = c(0, 0, 0), end = c(3, 5, Inf), - half.life = c(TRUE, FALSE, TRUE), + half.life = c(TRUE, TRUE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), analyte = c("Analyte1", "Analyte2", "Analyte1") @@ -59,7 +58,7 @@ intervals <- data.frame( o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) # Apply interval_add_impute function -o_data <- interval_add_impute(o_data, +o_data <- interval_add_impute(o_data, target_impute = "start_conc0", target_params = "half.life", target_groups = data.frame(analyte = "Analyte1")) diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index 9ea0fa74..5f619942 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -37,6 +37,7 @@ o_dose <- PKNCAdose(d_dose, dose ~ time | ID) intervals <- data.frame( start = c(0, 0, 0), end = c(3, 5, Inf), + half.life = c(TRUE, FALSE, TRUE), cmax = c(TRUE, TRUE, TRUE), impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), analyte = c("Analyte1", "Analyte2", "Analyte1") @@ -47,6 +48,6 @@ o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) # Apply interval_remove_impute function o_data <- interval_remove_impute(data = o_data, target_impute = "start_conc0", - target_params = c("half.life"), + target_params = "half.life", target_groups = data.frame(analyte = "Analyte1")) } From f012d74ab9ee3aa013e5e3818d7c8456899a346b Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 08:59:37 +0100 Subject: [PATCH 38/49] fix: remove redundant conditional in the function --- R/intervals_support_funs.R | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 05b44ec3..4b4f1728 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -55,8 +55,6 @@ interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, targ if (!"impute" %in% names(data$intervals) && !is.null(data$impute)) { data$intervals$impute <- data$impute data$impute <- NA_character_ - } else if (!is.character(data$intervals$impute)) { - stop("The 'impute' column in the intervals must be a character column.") } data$intervals <- interval_add_impute.data.frame(data$intervals, target_impute, after, target_params, target_groups) data @@ -96,7 +94,7 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf if (!"impute" %in% colnames(intervals)) { intervals$impute <- NA_character_ } else if (!is.character(intervals$impute)) { - stop("The 'impute' column in the data frame must be a character column.") + stop("The 'impute' column in the intervals data.frame must be a character column.") } # Add an index column to preserve the original order @@ -265,7 +263,7 @@ interval_remove_impute.data.frame <- function(intervals, target_impute, target_p if (!"impute" %in% colnames(intervals)) { intervals$impute <- NA_character_ } else if (!is.character(intervals$impute)) { - stop("The 'impute' column in the data frame must be a character column.") + stop("The 'impute' column in the intervals data.frame must be a character column.") } # Add an index column to preserve the original order From d3d13f889ad5043e7c9977e01debf59dc9f2befb Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 09:00:33 +0100 Subject: [PATCH 39/49] test: add helper functions tests for code coverage --- tests/testthat/test-intervals_support_funs.R | 23 ++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 0d6c282d..1595e4dc 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -57,6 +57,13 @@ test_that("interval_add_impute handles impute column with NA values correctly", impute = c("new_impute", "new_impute", "new_impute"))) }) +test_that("interval_add_impute reports an error to the user when the impute column is not a character", { + o_data_not_character_impute <- o_data + o_data_not_character_impute$intervals$impute <- 1 + expect_error(interval_add_impute(o_data_not_character_impute, target_impute = "new_impute"), + "The 'impute' column in the intervals data.frame must be a character column.") +}) + test_that("interval_add_impute handles missing impute column by creating it with NA_character_ and then adding the impute without warning", { o_data_no_impute <- o_data o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] @@ -210,6 +217,13 @@ test_that("interval_remove_impute handles impute column with NA values correctly impute = c(NA_character_, NA_character_, NA_character_))) }) +test_that("interval_remove_impute reports an error to the user when the impute column is not a character", { + o_data_not_character_impute <- o_data + o_data_not_character_impute$intervals$impute <- 1 + expect_error(interval_remove_impute(o_data_not_character_impute, target_impute = "start_conc0"), + "The 'impute' column in the intervals data.frame must be a character column.") +}) + test_that("interval_remove_impute handles missing impute column & global impute by not modifying the dataset and warns the user", { o_data_no_impute <- o_data o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] @@ -356,3 +370,12 @@ test_that("interval_add_impute and interval_remove_impute are inverses of each o result_remove <- interval_remove_impute(result_add, target_impute = "new_impute") expect_equal(result_remove, o_data) }) + +# Specific tests for helper functions +test_that("add_impute_method do not crush when impute_vals is empty, but returns the empty vector", { + expect_equal(add_impute_method(c(), "new_impute"), c()) +}) + +test_that("remove_impute_method do not crush when impute_vals is empty, but returns the empty vector", { + expect_equal(remove_impute_method(c(), "new_impute"), c()) +}) From b9747e52e58abedccef6c7af8f70697039d19a74 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 09:01:09 +0100 Subject: [PATCH 40/49] documentation: solve news warning-issue in subtitle --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index dbc6b01a..c442f6cb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -35,7 +35,7 @@ the dosing including dose amount and route. * New functions are available to simplify the modification of intervals: `intervals_add_impute()`, `intervals_remove_impute()` -# Minor changes (unlikely to affect PKNCA use) +## Minor changes (unlikely to affect PKNCA use) * PKNCA will now verify the `intervals` data.frame when creating PKNCAdata. The checking includes confirming intended column naming and ensuring the correct From 23ba77dabbc0c7339a3be7aac210de7afcfa004b Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 09:32:39 +0100 Subject: [PATCH 41/49] documentation, fix: document ... argument & improve missing impute case --- R/intervals_support_funs.R | 9 ++++++--- man/interval_add_impute.Rd | 2 ++ man/interval_remove_impute.Rd | 2 ++ 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 4b4f1728..e542fa16 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -8,6 +8,7 @@ #' If missing, all TRUE in the intervals are taken. #' @param target_groups A data frame specifying the intervals to be targeted (optional). #' If missing, all relevant groups are considered. +#' @param ... arguments passed to `interval_add_impute`. #' @details. If already present the target_impute method will be added substituting the existing one. All new intervals #' created will be added right after their original ones. #' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. @@ -50,7 +51,7 @@ interval_add_impute <- function(data, ...) { } #' @export -interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { +interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, ...) { # If the impute column is not present, add it to the intervals if (!"impute" %in% names(data$intervals) && !is.null(data$impute)) { data$intervals$impute <- data$impute @@ -81,7 +82,7 @@ add_impute_method <- function(impute_vals, target_impute, after) { vapply(FUN = paste, collapse = ",", FUN.VALUE = "") } #' @export -interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf, target_params = NULL, target_groups = NULL) { +interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf, target_params = NULL, target_groups = NULL, ...) { # Validate inputs if (missing(intervals) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") @@ -168,6 +169,7 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' #' @inheritParams interval_add_impute #' @param target_impute A character string specifying the imputation method to remove. +#' @param ... arguments passed to `interval_remove_impute`. #' @return A modified object with the specified imputation methods removed from the targeted intervals. #' @examples #' d_conc <- data.frame( @@ -261,7 +263,8 @@ interval_remove_impute.data.frame <- function(intervals, target_impute, target_p # Ensure the impute column exists and is a character column if (!"impute" %in% colnames(intervals)) { - intervals$impute <- NA_character_ + warning("No default impute column identified. No impute methods to remove") + return(intervals) } else if (!is.character(intervals$impute)) { stop("The 'impute' column in the intervals data.frame must be a character column.") } diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index d8456798..91db2f4f 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -9,6 +9,8 @@ interval_add_impute(data, ...) \arguments{ \item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} +\item{...}{arguments passed to \code{interval_add_impute}.} + \item{target_impute}{A character string specifying the imputation method to be added.} \item{after}{Numeric value specifying the position after which the imputation method should be added (optional). diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index 5f619942..10c5226a 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -9,6 +9,8 @@ interval_remove_impute(data, ...) \arguments{ \item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} +\item{...}{arguments passed to \code{interval_remove_impute}.} + \item{target_impute}{A character string specifying the imputation method to remove.} } \value{ From 6d27838a092a2f12cf387a22a0513579e5190b45 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 15 Feb 2025 09:33:16 +0100 Subject: [PATCH 42/49] fix: consider test also for data.frame with missing impute column --- tests/testthat/test-intervals_support_funs.R | 40 +++++++++++--------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index 1595e4dc..d2e83d91 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -66,9 +66,11 @@ test_that("interval_add_impute reports an error to the user when the impute colu test_that("interval_add_impute handles missing impute column by creating it with NA_character_ and then adding the impute without warning", { o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] - result <- suppressWarnings(interval_add_impute(o_data_no_impute, target_impute = "new_impute")) - expect_equal(result$intervals, transform(o_data_no_impute$intervals, impute = "new_impute")) + o_data_no_impute$intervals$impute <- NULL + result_PKNCAdata <- interval_add_impute(o_data_no_impute, target_impute = "new_impute") + expect_equal(result_PKNCAdata$intervals, transform(o_data_no_impute$intervals, impute = "new_impute")) + result_data.frame <- interval_add_impute(o_data_no_impute$intervals, target_impute = "new_impute") + expect_equal(result_data.frame, transform(o_data_no_impute$intervals, impute = "new_impute")) }) test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { @@ -111,12 +113,12 @@ test_that("interval_add_impute handles multiple target_params correctly", { }) test_that("interval_add_impute makes no changes and warns when no matching intervals are found", { - result <- suppressWarnings(interval_remove_impute(o_data, + result <- suppressWarnings(interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte3"))) expect_equal(result, o_data) - - expect_warning(interval_remove_impute(o_data, + + expect_warning(interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte3")), "No intervals found with the specified target parameters, groups and/or impute method. No changes made.") @@ -157,15 +159,15 @@ test_that("interval_add_impute includes new rows with added imputations right af data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), half.life = c(TRUE, NA, TRUE, NA, TRUE, NA), cmax = c(NA, TRUE, NA, TRUE, NA, TRUE), - impute = c("start_conc0,start_predose", - "start_conc0,start_predose,new_impute", - "start_predose", - "start_predose,new_impute", - "start_conc0", + impute = c("start_conc0,start_predose", + "start_conc0,start_predose,new_impute", + "start_predose", + "start_predose,new_impute", + "start_conc0", "start_conc0,new_impute"))) }) -test_that("interval_add_impute do not add a new interval row when a non-target parameter and a target parameter share the target impute at the after position",{ +test_that("interval_add_impute do not add a new interval row when a non-target parameter and a target parameter share the target impute at the after position", { intervals_mixed <- data.frame( start = c(0, 0), end = c(24, 48), @@ -228,13 +230,17 @@ test_that("interval_remove_impute handles missing impute column & global impute o_data_no_impute <- o_data o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] o_data_no_impute$impute <- NA_character_ - result <- suppressWarnings(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0")) - expect_equal(result, o_data_no_impute) + result_PKNCAdata <- suppressWarnings(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0")) + expect_equal(result_PKNCAdata, o_data_no_impute) + result_data.frame <- suppressWarnings(interval_remove_impute(o_data_no_impute$intervals, target_impute = "start_conc0")) + expect_equal(result_data.frame, o_data_no_impute$intervals) expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), "No default impute column or global method identified. No impute methods to remove") + expect_warning(interval_remove_impute(o_data_no_impute$intervals, target_impute = "start_conc0"), + "No default impute column identified. No impute methods to remove") }) -test_that("interval_remove_impute handles missing impute column, using global impute when possible in the best way", { +test_that("interval_remove_impute.PKNCAdata handles missing impute column, using global impute when possible in the best way", { o_data_no_impute <- o_data o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] o_data_no_impute$impute <- "start_conc0, start_predose" @@ -373,9 +379,9 @@ test_that("interval_add_impute and interval_remove_impute are inverses of each o # Specific tests for helper functions test_that("add_impute_method do not crush when impute_vals is empty, but returns the empty vector", { - expect_equal(add_impute_method(c(), "new_impute"), c()) + expect_equal(add_impute_method(character(), "new_impute"), character()) }) test_that("remove_impute_method do not crush when impute_vals is empty, but returns the empty vector", { - expect_equal(remove_impute_method(c(), "new_impute"), c()) + expect_equal(remove_impute_method(character(), "new_impute"), character()) }) From e952d6acc247bbd877380b240cb6e14235ef116f Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 10:27:49 +0100 Subject: [PATCH 43/49] update: new developed funs --- R/intervals_support_funs.R | 483 +++++++++++++++++++++---------------- 1 file changed, 270 insertions(+), 213 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index e542fa16..ae9ebd2d 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -1,17 +1,17 @@ #' Add specified imputation methods to the intervals in a PKNCAdata or data.frame object. #' -#' @param data A PKNCAdata object containing the intervals and data components, or a data frame of intervals. +#' @param data A PKNCAdata object containing the intervals data frame, or a data frame of intervals. #' @param target_impute A character string specifying the imputation method to be added. -#' @param after Numeric value specifying the position after which the imputation method should be added (optional). +#' @param after Numeric value specifying the index in which the imputation will be added (optional). #' First is 0, last Inf. If missing, the imputation method is added at the end (Inf). -#' @param target_params A character vector specifying the parameters to be targeted (optional). +#' @param target_params A character vector specifying the parameters to be targeted (optional). #' If missing, all TRUE in the intervals are taken. -#' @param target_groups A data frame specifying the intervals to be targeted (optional). +#' @param target_groups A data frame specifying the intervals to be targeted (optional). #' If missing, all relevant groups are considered. #' @param ... arguments passed to `interval_add_impute`. -#' @details. If already present the target_impute method will be added substituting the existing one. All new intervals -#' created will be added right after their original ones. -#' @return A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. +#' @details If already present the target_impute method will be added substituting the existing one. +#' All new intervals created will be added right after their original ones. +#' @returns A modified PKNCAdata object with specified imputation methods on the target intervals. #' @examples #' d_conc <- data.frame( #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), @@ -19,15 +19,15 @@ #' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6) #' ) - +#' #' d_dose <- data.frame( #' dose = c(100, 200), #' time = c(0, 0), #' ID = c(1, 2) #' ) #' -#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) -#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) +#' o_conc <- PKNCA::PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCA::PKNCAdose(d_dose, dose ~ time | ID) #' #' intervals <- data.frame( #' start = c(0, 0, 0), @@ -38,7 +38,7 @@ #' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) #' -#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) +#' o_data <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_add_impute function #' o_data <- interval_add_impute(o_data, @@ -46,131 +46,16 @@ #' target_params = "half.life", #' target_groups = data.frame(analyte = "Analyte1")) #' @export -interval_add_impute <- function(data, ...) { +interval_add_impute <- function(data, target_impute, after, target_params, target_groups, ...) { UseMethod("interval_add_impute", data) } -#' @export -interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, target_params = NULL, target_groups = NULL, ...) { - # If the impute column is not present, add it to the intervals - if (!"impute" %in% names(data$intervals) && !is.null(data$impute)) { - data$intervals$impute <- data$impute - data$impute <- NA_character_ - } - data$intervals <- interval_add_impute.data.frame(data$intervals, target_impute, after, target_params, target_groups) - data -} - -#' Add impute method to the impute column -#' -#' This is an internal helper function used to add an impute method to the impute column. -#' -#' @param impute_vals Character vector of impute methods. -#' @param target_impute The imputation method to be added. -#' @param after Numeric value specifying the position after which the imputation method should be added. -#' @return A character string or vector with the added impute method. -#' @keywords internal -add_impute_method <- function(impute_vals, target_impute, after) { - # Make sure the character vector has length - if (length(impute_vals) == 0) return(impute_vals) - - # Remove the impute from the other methods in each value - impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) - strsplit(impute_vals, split = "[ ,]+") |> - lapply(FUN = setdiff, target_impute) |> - lapply(FUN = append, values = target_impute, after = after) |> - vapply(FUN = paste, collapse = ",", FUN.VALUE = "") -} -#' @export -interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf, target_params = NULL, target_groups = NULL, ...) { - # Validate inputs - if (missing(intervals) || missing(target_impute)) { - stop("Both 'data' and 'target_impute' must be provided.") - } - if (!is.character(target_impute)) { - stop("'target_impute' must be a character string.") - } - - # Ensure the impute column exists and is a character column - if (!"impute" %in% colnames(intervals)) { - intervals$impute <- NA_character_ - } else if (!is.character(intervals$impute)) { - stop("The 'impute' column in the intervals data.frame must be a character column.") - } - - # Add an index column to preserve the original order - index_colname <- make.unique(c("index", names(intervals)))[1] - intervals[[index_colname]] <- seq_len(nrow(intervals)) - - # Get all parameter column names in the data frame - all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) - param_cols <- intersect(names(intervals), all_param_options) - - # If missing, define the target parameters as all parameter columns. Filter based on at least one TRUE value. - if (is.null(target_params)) { - target_params <- param_cols - } else { - checkmate::assert_subset(target_params, choices = all_param_options, empty.ok = TRUE) - } - - # Ifentify the target interval rows based on: - ## 1. The target groups (perfect match) - target_rows <- rep(TRUE, nrow(intervals)) - if (!is.null(target_groups)) { - target_groups_data <- intervals[, names(target_groups), drop = FALSE] - target_rows <- target_rows & (do.call(paste0, target_groups_data) %in% do.call(paste0, target_groups)) - } - ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) - target_params_data <- intervals[, target_params, drop = FALSE] - target_rows <- target_rows & (rowSums(!is.na(replace(target_params_data, target_params_data == FALSE, NA))) > 0) - ## 3. The target impute method is not already present and correctly positioned - after_vals <- lapply(strsplit(intervals$impute, "[ ,]+"), function(x) { - after.x <- which(x == target_impute) - if (length(after.x) == 0) return(NA) - if (after.x == length(x)) Inf else after.x - }) |> unlist() - target_rows <- target_rows & (after_vals != after | is.na(after_vals)) - - new_intervals <- intervals[target_rows, ] - - # If no target intervals are found, nothing to change - if (nrow(new_intervals) == 0) { - warning("No intervals found with the specified target parameters, groups, and/or after-change needed. No changes made.") - return(intervals[, !names(intervals) %in% index_colname]) - - # If target intervals are found... - } else { - # The new imputation should not be used non-target parameters - new_intervals[, setdiff(param_cols, target_params)] <- NA - - # Index the new intervals to be after the original ones - new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) - new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 - } - - # Remove the target parameters calculation from the original target intervals - intervals[target_rows, target_params] <- NA - - # Combine the new and original intervals - intervals <- rbind(intervals, new_intervals) - - # Filter rows where all row values for param_cols are NA or FALSE - param_data <- intervals[, param_cols, drop = FALSE] - rows_no_params <- rowSums(!is.na(replace(param_data, param_data == FALSE, NA))) == 0 - intervals <- intervals[!rows_no_params, , drop = FALSE] - - # Order the intervals by the index column and then remove it - intervals <- intervals[order(intervals[, index_colname]), ] - rownames(intervals) <- seq_len(nrow(intervals)) - intervals[, !names(intervals) %in% index_colname] -} - -#' Remove specified imputation methods from the intervals in a PKNCAdata or data.frame (intervals) object. +#' Remove specified imputation from the intervals in a PKNCAdata or data.frame (intervals) object. #' #' @inheritParams interval_add_impute #' @param target_impute A character string specifying the imputation method to remove. #' @param ... arguments passed to `interval_remove_impute`. -#' @return A modified object with the specified imputation methods removed from the targeted intervals. +#' @returns A modified object with the specified imputations removed from the targeted intervals. #' @examples #' d_conc <- data.frame( #' conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), @@ -178,16 +63,16 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' ID = rep(1:2, each = 6), #' analyte = rep(c("Analyte1", "Analyte2"), each = 6) #' ) -#' +#' #' d_dose <- data.frame( #' dose = c(100, 200), #' time = c(0, 0), #' ID = c(1, 2) #' ) -#' -#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) -#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) -#' +#' +#' o_conc <- PKNCA::PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCA::PKNCAdose(d_dose, dose ~ time | ID) +#' #' intervals <- data.frame( #' start = c(0, 0, 0), #' end = c(3, 5, Inf), @@ -196,136 +81,308 @@ interval_add_impute.data.frame <- function(intervals, target_impute, after = Inf #' impute = c("start_conc0,start_predose", "start_predose", "start_conc0"), #' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) -#' -#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) -#' +#' +#' o_data <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals) +#' #' # Apply interval_remove_impute function #' o_data <- interval_remove_impute(data = o_data, #' target_impute = "start_conc0", #' target_params = "half.life", #' target_groups = data.frame(analyte = "Analyte1")) #' @export -interval_remove_impute <- function(data, ...) { +interval_remove_impute <- function(data, target_impute, ...) { UseMethod("interval_remove_impute", data) } #' @export -interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, target_groups = NULL) { +interval_add_impute.PKNCAdata <- function(data, target_impute, after = Inf, + target_params = NULL, target_groups = NULL, ...) { + # If the impute column is not present, add it to the intervals + if (!"impute" %in% names(data$intervals) && !is.null(data$impute)) { + data$intervals$impute <- data$impute + data$impute <- NA_character_ + } + data$intervals <- interval_add_impute.data.frame(data$intervals, target_impute, + after, target_params, target_groups) + data +} + +#' @export +interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params = NULL, + target_groups = NULL, ...) { # If the impute column is not present in the intervals... - ## a. If neither is in the global impute method, return the data as it is - if (!"impute" %in% colnames(data$intervals) && (is.null(data$impute) || is.na(data$impute))) { - warning("No default impute column or global method identified. No impute methods to remove") - return(data) - } else if (!"impute" %in% names(data$intervals) && (!is.null(data$impute) || !is.na(data$impute))) { + if (!"impute" %in% colnames(data$intervals)) { + if (is.null(data$impute) || is.na(data$impute)) { + # a. If there is neither a global impute, return the input as it is (nothing to remove) + warning("No default impute column or global method identified. No impute methods to remove") + return(data) + } + + # b & c. If there is a global impute.. if (is.null(target_params) && is.null(target_groups)) { - ## b. If it is in the global impute and no target parameters or groups are specified, remove the global impute method + # b. and user changes apply to all intervals, just remove global impute data$impute <- remove_impute_method(data$impute, target_impute) return(data) - } else { - ## c. If it is in the global impute but target parameters or groups are specified, create a impute column in the intervals - data$intervals$impute <- data$impute - data$impute <- NA_character_ } + + # c. but user changes are specific (target_params or target_groups), creates an impute column + data$intervals$impute <- data$impute + data$impute <- NA_character_ } - data$intervals <- interval_remove_impute.data.frame(data$intervals, target_impute, target_params, target_groups) + + data$intervals <- interval_remove_impute.data.frame(data$intervals, target_impute, + target_params, target_groups) data } -#' Remove impute method from the impute column -#' -#' This is an internal helper function used to remove an impute method from the impute column. -#' -#' @param impute_vals Character vector of impute methods. -#' @param target_impute The imputation method to be removed. -#' @return A character string or vector without the specified impute method. -#' @details Resulting empty string values are replaced with NA_character_. -#' @keywords internal -remove_impute_method <- function(impute_vals, target_impute){ - # Make sure the character vector has length - if (length(impute_vals) == 0) return(impute_vals) +#' @export +interval_add_impute.data.frame <- function(data, target_impute, after = Inf, + target_params = NULL, target_groups = NULL, ...) { + # Validate inputs + if (missing(data) || missing(target_impute)) { + stop("Both 'data' and 'target_impute' must be provided.") + } + if (!is.character(target_impute)) { + stop("'target_impute' must be a character string.") + } + if (is.na(target_impute) || target_impute == "") { + warning("No impute method specified. No changes made.") + return(data) + } - # Remove the impute from the other methods in each value - impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) - strsplit(impute_vals, split = "[ ,]+") |> - lapply(FUN = setdiff, target_impute) |> - vapply(FUN = paste, collapse = ",", FUN.VALUE = "") + # Ensure the impute column exists and is a character column + if (!"impute" %in% colnames(data)) { + data$impute <- NA_character_ + } else if (!is.character(data$impute)) { + stop("The 'impute' column in the intervals data.frame must be a character column.") + } + + # Add an index column to preserve the original order + index_colname <- make.unique(c("index", names(data)))[1] + data[[index_colname]] <- seq_len(nrow(data)) + + # Get all parameter column names in the data frame + all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + param_cols <- intersect(names(data), all_param_options) + + # If missing, define target parameters as all parameter columns with at least one TRUE. + if (is.null(target_params)) { + target_params <- param_cols + } + + assert_subset(target_params, all_param_options) + + # Identify the target interval rows based on: + target_rows <- identify_target_rows(data, target_impute, target_params, target_groups, after) + new_intervals <- data[target_rows, ] + + # If no target intervals are found, nothing to change + if (nrow(new_intervals) == 0) { + warning("No intervals found with the specified target parameters,", + " groups, and/or after-change needed. No changes made.") + return(data[, !names(data) %in% index_colname]) + + # If target intervals are found... + } else { + # The new imputation should not be used non-target parameters + new_intervals[, setdiff(param_cols, target_params)] <- FALSE + + # Index the new intervals to be after the original ones + new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) + new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 + } + + # Remove the target parameters calculation from the original target intervals + data[target_rows, target_params] <- FALSE + + # Combine the new and original intervals + data <- rbind(data, new_intervals) + + # Filter rows where all row values for param_cols are NA or FALSE + param_data <- data[, param_cols, drop = FALSE] + rows_no_params <- rowSums(replace(param_data, is.na(param_data), FALSE)) == 0 + data <- data[!rows_no_params, , drop = FALSE] + + # Order the intervals by the index column and then remove it + data <- data[order(data[[index_colname]]), ] + rownames(data) <- seq_len(nrow(data)) + data[, !names(data) %in% index_colname] } #' @export -interval_remove_impute.data.frame <- function(intervals, target_impute, target_params = NULL, target_groups = NULL) { +interval_remove_impute.data.frame <- function(data, + target_impute, + target_params = NULL, + target_groups = NULL, + ...) { # Validate inputs - if (missing(intervals) || missing(target_impute)) { + if (missing(data) || missing(target_impute)) { stop("Both 'data' and 'target_impute' must be provided.") } if (!is.character(target_impute)) { stop("'target_impute' must be a character string.") } - + if (is.na(target_impute) || target_impute == "") { + warning("No impute method specified. No changes made.") + return(data) + } + # Ensure the impute column exists and is a character column - if (!"impute" %in% colnames(intervals)) { + if (!"impute" %in% colnames(data)) { warning("No default impute column identified. No impute methods to remove") - return(intervals) - } else if (!is.character(intervals$impute)) { + return(data) + } else if (!is.character(data$impute)) { stop("The 'impute' column in the intervals data.frame must be a character column.") } - + # Add an index column to preserve the original order - index_colname <- make.unique(c("index", names(intervals)))[1] - intervals[[index_colname]] <- seq_len(nrow(intervals)) - + index_colname <- make.unique(c("index", names(data)))[1] + data[[index_colname]] <- seq_len(nrow(data)) + # Get all parameter column names in the data frame - all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) - param_cols <- intersect(names(intervals), all_param_options) - + all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + param_cols <- intersect(names(data), all_param_options) + # Handle target_params if (is.null(target_params)) { target_params <- param_cols - } else { - checkmate::assert_subset(target_params, choices = all_param_options) } - - # Ifentify the target interval rows based on: - ## 1. The target groups (perfect match) - target_rows <- rep(TRUE, nrow(intervals)) - if (!is.null(target_groups)) { - target_groups_data <- intervals[, names(target_groups), drop = FALSE] - target_rows <- target_rows & (do.call(paste0, target_groups_data) %in% do.call(paste0, target_groups)) - } - ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) - target_params_data <- intervals[, target_params, drop = FALSE] - target_rows <- target_rows & (rowSums(!is.na(replace(target_params_data, target_params_data == FALSE, NA))) > 0) - ## 3. The target impute method to be removed (contained in the string) - target_rows <- target_rows & grepl(target_impute, intervals$impute, fixed = TRUE) - new_intervals <- intervals[target_rows, ] + + assert_subset(target_params, all_param_options) + + # Identify the interval rows that need to be changed + target_rows <- identify_target_rows(data, target_impute, target_params, target_groups) + new_intervals <- data[target_rows, ] # If no target intervals are found, nothing to change if (nrow(new_intervals) == 0) { - warning("No intervals found with the specified target parameters, groups and/or impute method. No changes made.") - return(intervals[, !names(intervals) %in% index_colname]) - - # If target intervals are found... + warning(paste0("No intervals found with the specified target parameters,", + " groups and/or impute method. No changes made.")) + return(data[, !names(data) %in% index_colname]) + + # If target intervals are found... } else { # The new imputation should not involve non-target parameters - new_intervals[, setdiff(param_cols, target_params)] <- NA + new_intervals[, setdiff(param_cols, target_params)] <- FALSE # Index the new intervals to be after the original ones new_intervals[["impute"]] <- remove_impute_method(new_intervals[["impute"]], target_impute) new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 } - + # Remove the target parameters calculation from the original target intervals - intervals[target_rows, target_params] <- NA - + data[target_rows, target_params] <- FALSE + # Combine the new and original intervals - intervals <- rbind(intervals, new_intervals) + data <- rbind(data, new_intervals) + + # Filter rows where all row values for param_cols are NA/FALSE + param_data <- data[, param_cols, drop = FALSE] + rows_no_params <- rowSums(replace(param_data, is.na(param_data), FALSE)) == 0 + data <- data[!rows_no_params, , drop = FALSE] + + # Order the intervals by the index column and then remove it + data <- data[order(data[[index_colname]]), ] + rownames(data) <- seq_len(nrow(data)) + data[, !names(data) %in% index_colname] +} - # Filter rows where all row values for param_cols are NA or FALSE - param_data <- intervals[, param_cols, drop = FALSE] - rows_no_params <- rowSums(!is.na(replace(param_data, param_data == FALSE, NA))) == 0 - intervals <- intervals[!rows_no_params, , drop = FALSE] +#' Add impute method to the impute column +#' +#' This is an internal helper function used to add an impute method to the impute column. +#' +#' @param impute_vals Character vector of impute methods. +#' @param target_impute The imputation method to be added. +#' @param after Numeric value specifying the index position in which to add the impute. +#' @returns A character string or vector with the added impute method. +#' @keywords internal +add_impute_method <- function(impute_vals, target_impute, after) { + # Make sure the character vector has length + if (length(impute_vals) == 0) return(impute_vals) + + # Remove the impute from the other methods in each value + impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) + strsplit(impute_vals, split = "[ ,]+") |> + lapply(FUN = setdiff, target_impute) |> + lapply(FUN = append, values = target_impute, after = after) |> + vapply(FUN = paste, collapse = ",", FUN.VALUE = "") +} - # Order the intervals by the index column and then remove it - intervals <- intervals[order(intervals[, index_colname]), ] - rownames(intervals) <- seq_len(nrow(intervals)) - intervals[, !names(intervals) %in% index_colname] +#' Remove impute method from the impute column +#' +#' This is an internal helper function used to remove an impute method from the impute column. +#' +#' @param impute_vals Character vector of impute methods. +#' @param target_impute The imputation method to be removed. +#' @returns A character string or vector without the specified impute method. +#' @details Resulting empty string values are replaced with NA_character_. +#' @keywords internal +remove_impute_method <- function(impute_vals, target_impute) { + # Make sure the character vector has length + if (length(impute_vals) == 0) return(impute_vals) + + # Remove the impute from the other methods in each value + impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) + impute_vals <- strsplit(impute_vals, split = "[ ,]+") |> + lapply(FUN = setdiff, target_impute) |> + vapply(FUN = paste, collapse = ",", FUN.VALUE = "") + + # Replace empty strings with NA_character_ + ifelse(impute_vals == "", NA_character_, impute_vals) } + +#' Identify target rows based on groups, parameters, and impute method +#' +#' This is an internal helper function used to identify the target rows in the data frame +#' based on the specified groups, parameters, and impute method. +#' +#' @param data A data frame containing the intervals. +#' @param target_impute The imputation method to be added or removed. +#' @param target_params A character vector specifying the parameters to be targeted. +#' @param target_groups A data frame specifying the intervals to be targeted. +#' @param after Numeric value specifying the index position in which to add the impute (optional). +#' @returns A logical vector indicating the target rows. +#' @keywords internal +identify_target_rows <- function(data, target_impute, target_params, target_groups, after = NULL) { + # Identify the target interval rows based on: + ## 1. The target groups (perfect match) + is_target_group <- { + if (!is.null(target_groups)) { + sapply(data[, names(target_groups), drop = FALSE], paste0) %in% sapply(target_groups, paste0) + } else { + rep(TRUE, nrow(data)) + } + } + + ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) + target_params_data <- data[, target_params, drop = FALSE] + is_target_param <- rowSums(replace(target_params_data, is.na(target_params_data), FALSE)) > 0 + + ## 3. The target impute method is not present and correctly positioned (if after is provided) + if (!is.null(after)) { + after_vals <- sapply(strsplit(data$impute, "[ ,]+"), \(x) { + after_x <- which(x == target_impute) + if (length(after_x) == 0) return(TRUE) + if (after_x == length(x)) Inf else after_x + }) + is_after <- after_vals != after | is.na(after_vals) + } else { + is_after <- grepl(target_impute, data$impute, fixed = TRUE) + } + + is_target_group & is_target_param & is_after +} + +#' Checks if a vector is a subset of another. If there are any values in `a` that are not present +#' in `b`, throws an error. +#' @param a Vector to check. +#' @param b Vector with possible values. +#' @noRd +assert_subset <- function(a, b) { + if (!all(a %in% b)) { + stop( + "The following parameters are invalid interval columns: ", + paste0(setdiff(a, b), collapse = ", ") + ) + } +} \ No newline at end of file From a1c91fefa5c6f00e2bf2a7f30a1369092251a067 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 10:28:44 +0100 Subject: [PATCH 44/49] refactor: remove PKNCA namespace --- R/intervals_support_funs.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index ae9ebd2d..56596a57 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -26,8 +26,8 @@ #' ID = c(1, 2) #' ) #' -#' o_conc <- PKNCA::PKNCAconc(d_conc, conc ~ time | ID / analyte) -#' o_dose <- PKNCA::PKNCAdose(d_dose, dose ~ time | ID) +#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) #' #' intervals <- data.frame( #' start = c(0, 0, 0), @@ -38,7 +38,7 @@ #' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) #' -#' o_data <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals) +#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_add_impute function #' o_data <- interval_add_impute(o_data, @@ -70,8 +70,8 @@ interval_add_impute <- function(data, target_impute, after, target_params, targe #' ID = c(1, 2) #' ) #' -#' o_conc <- PKNCA::PKNCAconc(d_conc, conc ~ time | ID / analyte) -#' o_dose <- PKNCA::PKNCAdose(d_dose, dose ~ time | ID) +#' o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte) +#' o_dose <- PKNCAdose(d_dose, dose ~ time | ID) #' #' intervals <- data.frame( #' start = c(0, 0, 0), @@ -82,7 +82,7 @@ interval_add_impute <- function(data, target_impute, after, target_params, targe #' analyte = c("Analyte1", "Analyte2", "Analyte1") #' ) #' -#' o_data <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals) +#' o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) #' #' # Apply interval_remove_impute function #' o_data <- interval_remove_impute(data = o_data, @@ -162,7 +162,7 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, data[[index_colname]] <- seq_len(nrow(data)) # Get all parameter column names in the data frame - all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(data), all_param_options) # If missing, define target parameters as all parameter columns with at least one TRUE. @@ -240,7 +240,7 @@ interval_remove_impute.data.frame <- function(data, data[[index_colname]] <- seq_len(nrow(data)) # Get all parameter column names in the data frame - all_param_options <- setdiff(names(PKNCA::get.interval.cols()), c("start", "end")) + all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(data), all_param_options) # Handle target_params From 672a1995646c48e25c800745d496f36837b8e1a9 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 10:31:50 +0100 Subject: [PATCH 45/49] fix: use NA instead of FALSE for intervals parameter columns --- R/intervals_support_funs.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index 56596a57..a545640b 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -185,7 +185,7 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, # If target intervals are found... } else { # The new imputation should not be used non-target parameters - new_intervals[, setdiff(param_cols, target_params)] <- FALSE + new_intervals[, setdiff(param_cols, target_params)] <- NA # Index the new intervals to be after the original ones new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) @@ -193,7 +193,7 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, } # Remove the target parameters calculation from the original target intervals - data[target_rows, target_params] <- FALSE + data[target_rows, target_params] <- NA # Combine the new and original intervals data <- rbind(data, new_intervals) @@ -263,7 +263,7 @@ interval_remove_impute.data.frame <- function(data, # If target intervals are found... } else { # The new imputation should not involve non-target parameters - new_intervals[, setdiff(param_cols, target_params)] <- FALSE + new_intervals[, setdiff(param_cols, target_params)] <- NA # Index the new intervals to be after the original ones new_intervals[["impute"]] <- remove_impute_method(new_intervals[["impute"]], target_impute) @@ -271,7 +271,7 @@ interval_remove_impute.data.frame <- function(data, } # Remove the target parameters calculation from the original target intervals - data[target_rows, target_params] <- FALSE + data[target_rows, target_params] <- NA # Combine the new and original intervals data <- rbind(data, new_intervals) From 8b876d2f9a22ce87331f86a6707d49e4cbd0864a Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 11:41:17 +0100 Subject: [PATCH 46/49] update: improved tests using describe and it --- tests/testthat/test-intervals_support_funs.R | 861 +++++++++++-------- 1 file changed, 502 insertions(+), 359 deletions(-) diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index d2e83d91..e4e3fe26 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -3,7 +3,7 @@ d_conc <- data.frame( conc = c(1, 0.6, 0.2, 0.1, 0.9, 0.4, 1.2, 0.8, 0.3, 0.2, 1.1, 0.5), time = rep(0:5, 2), analyte = rep(c("Analyte1", "Analyte2"), each = 6), - include_hl = c(FALSE, NA, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE), + include_hl = c(FALSE, FALSE, TRUE, TRUE, TRUE, TRUE, FALSE, NA, TRUE, TRUE, TRUE, TRUE), ID = rep(1:2, each = 6) ) @@ -23,365 +23,508 @@ intervals <- data.frame( ID = c(1, 2, 1) ) -o_conc <- PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "include_hl") -o_dose <- PKNCAdose(d_dose, dose ~ time | ID) -o_data <- PKNCAdata(o_conc, o_dose, intervals = intervals) - -### Test interval_add_impute - -test_that("interval_add_impute throws an error if either data or target_impute is missing", { - expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") -}) - -test_that("interval_add_impute throws an error for non-character target_impute", { - expect_error(interval_add_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") -}) - -test_that("interval_add_impute throws an error when input data is a non PKNCAdata/data.frame object", { - expect_error(interval_add_impute(data = o_conc, target_impute = "start_conc0")) - expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) -}) - -test_that("interval_add_impute throws an error for unknown target_params", { - expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param")) -}) - -test_that("interval_add_impute handles impute column with NA values correctly", { - o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals$impute <- NA_character_ - result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("new_impute", "new_impute", "new_impute"))) -}) - -test_that("interval_add_impute reports an error to the user when the impute column is not a character", { - o_data_not_character_impute <- o_data - o_data_not_character_impute$intervals$impute <- 1 - expect_error(interval_add_impute(o_data_not_character_impute, target_impute = "new_impute"), +o_conc <- PKNCA::PKNCAconc(d_conc, conc ~ time | ID / analyte, include_half.life = "include_hl") +o_dose <- PKNCA::PKNCAdose(d_dose, dose ~ time | ID) +o_data <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals) + +describe("interval_add_impute", { + it("adds the impute method in the impute column of a dummy intervals dataframe", { + simple_df <- data.frame( + cmax = TRUE, + impute = c("", "m0", "m0,m1") + ) + expected_res <- data.frame( + cmax = TRUE, + impute = c("mlast", "m0,mlast", "m0,m1,mlast") + ) + res <- interval_add_impute(simple_df, target_impute = "mlast") + expect_equal(res, expected_res) + }) + + it("throws an error if either data or target_impute is missing", { + expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") + }) + + it("throws an error for non-character target_impute", { + expect_error(interval_add_impute(o_data, target_impute = 123), + "'target_impute' must be a character string.") + }) + + it("throws an error when input data is not a proper format object", { + expect_error(interval_add_impute(data = o_conc, target_impute = "start_conc0")) + expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) + }) + + it("throws an error for unknown target_params", { + expect_error(interval_add_impute(o_data, + target_impute = "start_conc0", + target_params = "unknown_param")) + }) + + it("handles impute column with FALSE values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals$impute <- NA_character_ + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = rep("new_impute", 3)) + result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("reports an error when the impute column is not a character", { + o_data_not_character_impute <- o_data + o_data_not_character_impute$intervals$impute <- 1 + expect_error(interval_add_impute(o_data_not_character_impute, target_impute = "new_impute"), "The 'impute' column in the intervals data.frame must be a character column.") -}) - -test_that("interval_add_impute handles missing impute column by creating it with NA_character_ and then adding the impute without warning", { - o_data_no_impute <- o_data - o_data_no_impute$intervals$impute <- NULL - result_PKNCAdata <- interval_add_impute(o_data_no_impute, target_impute = "new_impute") - expect_equal(result_PKNCAdata$intervals, transform(o_data_no_impute$intervals, impute = "new_impute")) - result_data.frame <- interval_add_impute(o_data_no_impute$intervals, target_impute = "new_impute") - expect_equal(result_data.frame, transform(o_data_no_impute$intervals, impute = "new_impute")) -}) - -test_that("interval_add_impute with no optional parameters uses all relevant cases, with new intervals below", { - result <- interval_add_impute(o_data, target_impute = "new_impute") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -}) - -test_that("interval_add_impute handles specified target_params correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = "half.life") - expect_equal(result$intervals[result$intervals$half.life & !is.na(result$intervals$half.life), c("analyte", "half.life", "impute")] |> `rownames<-`(NULL), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals[result$intervals$cmax & !is.na(result$intervals$cmax), c("analyte", "cmax", "impute")] |> `rownames<-`(NULL), - o_data$intervals[o_data$intervals$cmax, c("analyte", "cmax", "impute")] |> `rownames<-`(NULL)) -}) - -test_that("interval_add_impute handles target_groups correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_groups = data.frame(analyte = "Analyte1")) - expect_equal(result$intervals[result$intervals$analyte == "Analyte1", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), - data.frame(analyte = c("Analyte1", "Analyte1"), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_conc0,new_impute"))) - expect_equal(result$intervals[result$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), - o_data$intervals[o_data$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL)) -}) - -test_that("interval_add_impute handles multiple target_params correctly", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = c("half.life", "cmax")) - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute"))) -}) - -test_that("interval_add_impute makes no changes and warns when no matching intervals are found", { - result <- suppressWarnings(interval_remove_impute(o_data, - target_impute = "start_conc0", - target_groups = data.frame(analyte = "Analyte3"))) - expect_equal(result, o_data) - - expect_warning(interval_remove_impute(o_data, - target_impute = "start_conc0", - target_groups = data.frame(analyte = "Analyte3")), - "No intervals found with the specified target parameters, groups and/or impute method. No changes made.") -}) - -test_that("interval_add_impute handles mixed TRUE/FALSE for cmax and half.life correctly", { - intervals_mixed <- data.frame( - start = c(0, 0, 0, 0), - end = c(24, 48, Inf, 72), - half.life = c(TRUE, FALSE, TRUE, FALSE), - cmax = c(FALSE, TRUE, FALSE, TRUE), - impute = c("start_conc0,start_predose", "start_predose", "start_conc0", "start_predose"), - analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), - ID = c(1, 2, 1, 2) - ) - - o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) - result <- interval_add_impute(o_data_mixed, target_impute = "new_impute") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), - half.life = c(TRUE, FALSE, TRUE, FALSE), - cmax = c(FALSE, TRUE, FALSE, TRUE), - impute = c("start_conc0,start_predose,new_impute", "start_predose,new_impute", "start_conc0,new_impute", "start_predose,new_impute"))) -}) - -test_that("interval_add_impute do not create duplicates but instead removes original ones and then adds impute method based on after", { - result <- interval_add_impute(o_data, target_impute = "start_conc0", after=Inf) - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose,start_conc0", "start_predose,start_conc0", "start_conc0"))) -}) - -test_that("interval_add_impute includes new rows with added imputations right after the original ones", { - result <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(TRUE, NA, TRUE, NA, TRUE, NA), - cmax = c(NA, TRUE, NA, TRUE, NA, TRUE), - impute = c("start_conc0,start_predose", - "start_conc0,start_predose,new_impute", - "start_predose", - "start_predose,new_impute", - "start_conc0", - "start_conc0,new_impute"))) -}) - -test_that("interval_add_impute do not add a new interval row when a non-target parameter and a target parameter share the target impute at the after position", { - intervals_mixed <- data.frame( - start = c(0, 0), - end = c(24, 48), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_conc0,start_predose", "start_predose"), - analyte = c("Analyte1", "Analyte2"), - ID = 1 - ) - - o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) - result <- suppressWarnings(interval_add_impute(o_data_mixed, - target_impute = "start_predose", - target_param = "cmax", - after = Inf)) - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2"), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_conc0,start_predose", "start_predose"))) -}) - -### Test interval_remove_impute -test_that("interval_remove_impute throws an error if either data or target_impute is missing", { - expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") -}) - -test_that("interval_remove_impute throws an error for non-character target_impute", { - expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") -}) - -test_that("interval_remove_impute throws an error when input data is a non PKNCAdata/data.frame object", { - expect_error(interval_remove_impute(data = o_conc, target_impute = "start_conc0")) - expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) -}) - -test_that("interval_remove_impute throws an error for unknown target_params", { - expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param")) -}) - -test_that("interval_remove_impute handles impute column with NA values correctly", { - o_data_with_na_impute <- o_data - o_data_with_na_impute$intervals$impute <- NA_character_ - result <- interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c(NA_character_, NA_character_, NA_character_))) -}) - -test_that("interval_remove_impute reports an error to the user when the impute column is not a character", { - o_data_not_character_impute <- o_data - o_data_not_character_impute$intervals$impute <- 1 - expect_error(interval_remove_impute(o_data_not_character_impute, target_impute = "start_conc0"), - "The 'impute' column in the intervals data.frame must be a character column.") -}) - -test_that("interval_remove_impute handles missing impute column & global impute by not modifying the dataset and warns the user", { - o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] - o_data_no_impute$impute <- NA_character_ - result_PKNCAdata <- suppressWarnings(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0")) - expect_equal(result_PKNCAdata, o_data_no_impute) - result_data.frame <- suppressWarnings(interval_remove_impute(o_data_no_impute$intervals, target_impute = "start_conc0")) - expect_equal(result_data.frame, o_data_no_impute$intervals) - expect_warning(interval_remove_impute(o_data_no_impute, target_impute = "start_conc0"), - "No default impute column or global method identified. No impute methods to remove") - expect_warning(interval_remove_impute(o_data_no_impute$intervals, target_impute = "start_conc0"), - "No default impute column identified. No impute methods to remove") -}) - -test_that("interval_remove_impute.PKNCAdata handles missing impute column, using global impute when possible in the best way", { - o_data_no_impute <- o_data - o_data_no_impute$intervals <- o_data_no_impute$intervals[, !names(o_data_no_impute$intervals) %in% "impute"] - o_data_no_impute$impute <- "start_conc0, start_predose" - - # When targets are all intervals, global method is changed - result_without_row_targets <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0") - expect_equal(result_without_row_targets$impute, "start_predose") - - # When targets are specific intervals, then a new column is created and the action handled appropriately - result_with_row_targets <- interval_remove_impute(o_data_no_impute, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) - expect_equal(unique(result_with_row_targets$intervals[result_with_row_targets$intervals$analyte == "Analyte1", "impute"]), - "start_predose") - expect_equal(result_with_row_targets$intervals[result_with_row_targets$intervals$analyte == "Analyte2", "impute"], - "start_conc0, start_predose") -}) - -test_that("interval_remove_impute with no optional parameters uses all relevant cases, with new intervals below", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", ""))) -}) - -test_that("interval_remove_impute handles specified target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "half.life") - - # Target parameter's impute was changed - half.life_rows <- result$intervals$half.life & !is.na(result$intervals$half.life) - expect_equal(result$intervals[half.life_rows, c("analyte", "half.life", "impute")] |> `rownames<-`(NULL), - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", ""))) - - # Non-target parameter has the same impute - cmax_rows <- result$intervals$cmax & !is.na(result$intervals$cmax) - expect_equal(result$intervals[cmax_rows, c("analyte", "cmax", "impute")] |> `rownames<-`(NULL), - o_data$intervals[o_data$intervals$cmax, c("analyte", "cmax", "impute")] |> `rownames<-`(NULL)) -}) - -test_that("interval_remove_impute handles target_groups correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) - expect_equal(result$intervals[result$intervals$analyte == "Analyte1", c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), - data.frame(analyte = c("Analyte1", "Analyte1"), - half.life = c(TRUE, TRUE), - cmax = c(TRUE, TRUE), - impute = c("start_predose", ""))) - expect_equal(result$intervals[result$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")], - o_data$intervals[o_data$intervals$analyte == "Analyte2", c("analyte", "half.life", "cmax", "impute")]) -}) - -test_that("interval_remove_impute handles multiple target_params correctly", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", ""))) -}) - -test_that("interval_remove_impute makes no changes and warns when no matching intervals are found", { - result <- suppressWarnings(interval_remove_impute(o_data, - target_impute = "start_conc0", - target_groups = data.frame(analyte = "Analyte3"))) - expect_equal(result, o_data) + }) + + it("warns and makes no changes when target_impute is NA or empty", { + expect_warning({ + result <- interval_add_impute(o_data, target_impute = NA_character_) + expect_equal(result, o_data) + }, + "No impute method specified. No changes made." + ) + + expect_warning({ + result <- interval_add_impute(o_data, target_impute = "") + expect_equal(result, o_data) + }, + "No impute method specified. No changes made." + ) + }) + + it("creates missing impute col as NA_char & adds impute", { + d_no_imp <- o_data + d_no_imp$intervals$impute <- NULL + res <- interval_add_impute(d_no_imp, target_impute = "new_impute") + expect_equal(res$intervals, transform(d_no_imp$intervals, impute = "new_impute")) + res <- interval_add_impute(d_no_imp$intervals, target_impute = "new_impute") + expect_equal(res, transform(d_no_imp$intervals, impute = "new_impute")) + }) + + it("with no optional parameters uses all, with new intervals below", { + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", + "start_predose,new_impute", + "start_conc0,new_impute")) + result <- interval_add_impute(o_data, target_impute = "new_impute") + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("handles specified target_params correctly", { + expected_result_half_life <- data.frame( + analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", + "start_predose,new_impute", + "start_conc0,new_impute") + ) + expected_result_cmax <- o_data$intervals[o_data$intervals$cmax, + c("analyte", "cmax", "impute")] |> + `rownames<-`(NULL) + result <- interval_add_impute(o_data, target_impute = "new_impute", target_params = "half.life") + expect_equal(result$intervals[result$intervals$half.life & !is.na(result$intervals$half.life), + c("analyte", "half.life", "impute")] |> + `rownames<-`(NULL), expected_result_half_life) + expect_equal(result$intervals[result$intervals$cmax & !is.na(result$intervals$cmax), + c("analyte", "cmax", "impute")] |> + `rownames<-`(NULL), expected_result_cmax) + }) - expect_warning(interval_remove_impute(o_data, + it("handles target_groups correctly", { + expected_result_analyte1 <- data.frame(analyte = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", + "start_conc0,new_impute")) + expected_result_analyte2 <- o_data$intervals[o_data$intervals$analyte == "Analyte2", + c("analyte", "half.life", "cmax", "impute")] |> + `rownames<-`(NULL) + result <- interval_add_impute(o_data, target_impute = "new_impute", + target_groups = data.frame(analyte = "Analyte1")) + expect_equal(result$intervals[result$intervals$analyte == "Analyte1", + c("analyte", "half.life", "cmax", "impute")] |> + `rownames<-`(NULL), expected_result_analyte1) + expect_equal(result$intervals[result$intervals$analyte == "Analyte2", + c("analyte", "half.life", "cmax", "impute")] |> + `rownames<-`(NULL), expected_result_analyte2) + }) + + it("handles multiple target_params correctly", { + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_conc0,start_predose,new_impute", + "start_predose,new_impute", + "start_conc0,new_impute")) + result <- interval_add_impute(o_data, + target_impute = "new_impute", + target_params = c("half.life", "cmax")) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("makes no changes and warns when no matching intervals are found", { + expect_warning({ + res <- interval_remove_impute(o_data, + target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte3")) + expect_equal(res, o_data) + }, + paste0("No intervals found with the specified target parameters,", + " groups and/or impute method. No changes made.") + ) + }) + + it("handles mixed TRUE/FALSE for cmax and half.life correctly", { + intervals_mixed <- data.frame( + start = c(0, 0, 0, 0), + end = c(24, 48, Inf, 72), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0", "start_predose"), + analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + ID = c(1, 2, 1, 2) + ) + + o_data_mixed <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose,new_impute", + "start_predose,new_impute", + "start_conc0,new_impute", + "start_predose,new_impute")) + result <- interval_add_impute(o_data_mixed, target_impute = "new_impute") + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("does not create duplicates but removes the originals & adds impute method based on after", { + result <- interval_add_impute(o_data, target_impute = "start_conc0", after = Inf) + expected_result <- data.frame( + analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose,start_conc0", + "start_predose,start_conc0", + "start_conc0") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + expected_result) + }) + + it("adds new rows with added imputations after the original ones", { + result <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax") + expected_result <- data.frame( + analyte = c("Analyte1", "Analyte1", "Analyte2", + "Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, NA, TRUE, NA, TRUE, NA), + cmax = c(NA, TRUE, NA, TRUE, NA, TRUE), + impute = c("start_conc0,start_predose", + "start_conc0,start_predose,new_impute", + "start_predose", + "start_predose,new_impute", + "start_conc0", + "start_conc0,new_impute") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + expected_result) + }) + + it("does not add new interval if non-target & target params share target impute", { + intervals_mixed <- data.frame( + start = c(0, 0), + end = c(24, 48), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose"), + analyte = c("Analyte1", "Analyte2"), + ID = 1 + ) + + o_data_mixed <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) + result <- suppressWarnings(interval_add_impute(o_data_mixed, + target_impute = "start_predose", + target_param = "cmax", + after = Inf)) + expected_result <- data.frame( + analyte = c("Analyte1", "Analyte2"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_conc0,start_predose", "start_predose") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + expected_result) + }) +}) + +describe("interval_remove_impute", { + it("removes the impute method in the impute column of a dummy intervals dataframe", { + simple_df <- data.frame( + cmax = TRUE, + impute = c("", "m0", "m0,m1") + ) + expected_res <- data.frame( + cmax = TRUE, + impute = c("", NA_character_, "m1") + ) + res <- interval_remove_impute(simple_df, target_impute = "m0") + expect_equal(res, expected_res) + }) + + it("throws an error if either data or target_impute is missing", { + expect_error(interval_remove_impute(o_data), + "Both 'data' and 'target_impute' must be provided.") + }) + + it("throws an error for non-character target_impute", { + expect_error(interval_remove_impute(o_data, target_impute = 123), + "'target_impute' must be a character string.") + }) + + it("throws an error when input data is not in correct format", { + expect_error(interval_remove_impute(data = o_conc, target_impute = "start_conc0")) + expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) + }) + + it("throws an error for unknown target_params", { + expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", - target_groups = data.frame(analyte = "Analyte3")), - "No intervals found with the specified target parameters, groups and/or impute method. No changes made.") -}) - -test_that("interval_remove_impute handles with specificity impute character method with multiple imputes", { - o_data_multiple_imputes <- o_data - o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose" - result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", "start_predose"))) -}) - -test_that("interval_remove_impute handles mixed TRUE/FALSE for cmax and half.life correctly", { - intervals_mixed <- data.frame( - start = c(0, 0, 0, 0), - end = c(24, 48, Inf, 72), - half.life = c(TRUE, FALSE, TRUE, FALSE), - cmax = c(FALSE, TRUE, FALSE, TRUE), - impute = c("start_conc0,start_predose", "start_predose", "start_conc0", "start_predose"), - analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), - ID = c(1, 2, 1, 2) - ) - - o_data_mixed <- PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) - - result <- interval_remove_impute(o_data_mixed, target_impute = "start_conc0", target_params = c("half.life", "cmax")) - - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), - half.life = c(TRUE, FALSE, TRUE, FALSE), - cmax = c(FALSE, TRUE, FALSE, TRUE), - impute = c("start_predose", "start_predose", "", "start_predose"))) -}) - -test_that("interval_remove_impute removes properly all target_impute even if a method contains it several times", { - o_data_multiple_imputes <- o_data - o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose,start_conc0" - result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), - half.life = c(TRUE, TRUE, TRUE), - cmax = c(TRUE, TRUE, TRUE), - impute = c("start_predose", "start_predose", "start_predose"))) -}) - -test_that("interval_remove_impute includes new rows with added imputations right after the original ones", { - result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_param = "cmax") - expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], - data.frame(analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), - half.life = c(TRUE, NA, TRUE, TRUE, NA), - cmax = c(NA, TRUE, TRUE, NA, TRUE), - impute = c("start_conc0,start_predose", - "start_predose", - "start_predose", - "start_conc0", - ""))) -}) - -test_that("interval_add_impute and interval_remove_impute are inverses of each other", { - result_add <- interval_add_impute(o_data, target_impute = "new_impute") - result_remove <- interval_remove_impute(result_add, target_impute = "new_impute") - expect_equal(result_remove, o_data) -}) - -# Specific tests for helper functions -test_that("add_impute_method do not crush when impute_vals is empty, but returns the empty vector", { - expect_equal(add_impute_method(character(), "new_impute"), character()) -}) - -test_that("remove_impute_method do not crush when impute_vals is empty, but returns the empty vector", { - expect_equal(remove_impute_method(character(), "new_impute"), character()) + target_params = "unknown_param")) + }) + + it("handles impute column with FALSE values correctly", { + o_data_with_na_impute <- o_data + o_data_with_na_impute$intervals$impute <- NA_character_ + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c(NA_character_, NA_character_, NA_character_)) + result <- suppressWarnings( + interval_remove_impute(o_data_with_na_impute, target_impute = "start_conc0") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("reports an error when impute column is not a character", { + o_data_not_character_impute <- o_data + o_data_not_character_impute$intervals$impute <- 1 + expect_error(interval_remove_impute(o_data_not_character_impute, target_impute = "start_conc0"), + "The 'impute' column in the intervals data.frame must be a character column.") + }) + + it("warns and makes no changes when target_impute is NA or empty", { + expect_warning({ + result <- interval_remove_impute(o_data, target_impute = NA_character_) + expect_equal(result, o_data) + }, + "No impute method specified. No changes made." + ) + + expect_warning({ + result <- interval_remove_impute(o_data, target_impute = "") + expect_equal(result, o_data) + }, + "No impute method specified. No changes made." + ) + }) + + it("does not modify data if global impute & column are missing", { + d_no_imp <- o_data + d_no_imp$intervals <- d_no_imp$intervals[, !names(d_no_imp$intervals) %in% "impute"] + d_no_imp$impute <- NA_character_ + expect_warning({ + res <- interval_remove_impute(d_no_imp, target_impute = "start_conc0") + expect_equal(res, d_no_imp) + }, + paste0("No default impute column or global method identified.", + " No impute methods to remove") + ) + + expect_warning({ + res <- interval_remove_impute(d_no_imp$intervals, target_impute = "start_conc0") + expect_equal(res, d_no_imp$intervals) + }, "No default impute column identified. No impute methods to remove") + }) + + it("if impute col is missing uses global impute", { + o_d_no_imp <- o_data + o_d_no_imp$intervals <- o_d_no_imp$intervals[, !names(o_d_no_imp$intervals) %in% "impute"] + o_d_no_imp$impute <- "start_conc0, start_predose" + + # When targets are all intervals, global method is changed + res_no_target <- interval_remove_impute(o_d_no_imp, target_impute = "start_conc0") + expect_equal(res_no_target$impute, "start_predose") + + # When targets are specific intervals, then a new column is created and the action handled + res_target <- interval_remove_impute(o_d_no_imp, target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte1")) + expect_equal(unique(res_target$intervals[res_target$intervals$analyte == "Analyte1", "impute"]), + "start_predose") + expect_equal(res_target$intervals[res_target$intervals$analyte == "Analyte2", "impute"], + "start_conc0, start_predose") + }) + + it("with no optional parameters uses all relevant cases", { + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA_character_)) + result <- interval_remove_impute(o_data, target_impute = "start_conc0") + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("handles specified target_params correctly", { + expected_result_half_life <- data.frame( + analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA_character_) + ) + expected_result_cmax <- o_data$intervals[o_data$intervals$cmax, + c("analyte", "cmax", "impute")] |> + `rownames<-`(NULL) + result <- interval_remove_impute(o_data, + target_impute = "start_conc0", + target_params = "half.life") + expect_equal(result$intervals[result$intervals$half.life & !is.na(result$intervals$half.life), + c("analyte", "half.life", "impute")] |> + `rownames<-`(NULL), expected_result_half_life) + expect_equal(result$intervals[result$intervals$cmax & !is.na(result$intervals$cmax), + c("analyte", "cmax", "impute")] |> + `rownames<-`(NULL), expected_result_cmax) + }) + + it("handles target_groups correctly", { + expected_result_analyte1 <- data.frame(analyte = c("Analyte1", "Analyte1"), + half.life = c(TRUE, TRUE), + cmax = c(TRUE, TRUE), + impute = c("start_predose", NA_character_)) + expected_result_analyte2 <- o_data$intervals[o_data$intervals$analyte == "Analyte2", + c("analyte", "half.life", "cmax", "impute")] + result <- interval_remove_impute(o_data, target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte1")) + expect_equal(result$intervals[result$intervals$analyte == "Analyte1", + c("analyte", "half.life", "cmax", "impute")] |> + `rownames<-`(NULL), expected_result_analyte1) + expect_equal(result$intervals[result$intervals$analyte == "Analyte2", + c("analyte", "half.life", "cmax", "impute")], + expected_result_analyte2) + }) + + it("handles multiple target_params correctly", { + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", NA_character_)) + result <- interval_remove_impute( + o_data, + target_impute = "start_conc0", + target_params = c("half.life", "cmax") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("makes no changes and warns when no matching intervals found", { + expect_warning({ + res <- interval_remove_impute(o_data, + target_impute = "start_conc0", + target_groups = data.frame(analyte = "Analyte3")) + expect_equal(res, o_data) + paste0("No intervals found with the specified target parameters,", + " groups and/or impute method. No changes made.") + }) + }) + + it("handles properly impute character method with multiple imputes", { + o_data_multiple_imputes <- o_data + o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose" + result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") + expected_result <- data.frame( + analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", "start_predose") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + expected_result) + }) + + it("handles mixed TRUE/FALSE for cmax and half.life correctly", { + intervals_mixed <- data.frame( + start = c(0, 0, 0, 0), + end = c(24, 48, Inf, 72), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_conc0,start_predose", "start_predose", "start_conc0", "start_predose"), + analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + ID = c(1, 2, 1, 2) + ) + + o_data_mixed <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) + + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), + half.life = c(TRUE, FALSE, TRUE, FALSE), + cmax = c(FALSE, TRUE, FALSE, TRUE), + impute = c("start_predose", "start_predose", + NA_character_, "start_predose")) + result <- interval_remove_impute( + o_data_mixed, + target_impute = "start_conc0", + target_params = c("half.life", "cmax") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) + }) + + it("removes all target_impute even if is several times", { + o_data_multiple_imputes <- o_data + o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose,start_conc0" + result <- interval_remove_impute(o_data_multiple_imputes, target_impute = "start_conc0") + expected_result <- data.frame( + analyte = c("Analyte1", "Analyte2", "Analyte1"), + half.life = c(TRUE, TRUE, TRUE), + cmax = c(TRUE, TRUE, TRUE), + impute = c("start_predose", "start_predose", "start_predose") + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + expected_result) + }) + + it("includes new rows right after the original ones", { + result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_param = "cmax") + expected_result <- data.frame( + analyte = c("Analyte1", "Analyte1", "Analyte2", "Analyte1", "Analyte1"), + half.life = c(TRUE, NA, TRUE, TRUE, NA), + cmax = c(NA, TRUE, TRUE, NA, TRUE), + impute = c("start_conc0,start_predose", + "start_predose", + "start_predose", + "start_conc0", + NA_character_) + ) + expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], + expected_result) + }) +}) + +describe("interval_add_impute and interval_remove_impute", { + it("are inverses of each other", { + result_add <- interval_add_impute(o_data, target_impute = "new_impute") + result_remove <- interval_remove_impute(result_add, target_impute = "new_impute") + expect_equal(result_remove, o_data) + }) +}) + +describe("add_impute_method", { + it("does not crush when impute_vals is empty, returns the empty vector", { + expect_equal(add_impute_method(character(), "new_impute"), character()) + }) +}) + +describe("remove_impute_method", { + it("does not crush when impute_vals is empty, returns the empty vector", { + expect_equal(remove_impute_method(character(), "new_impute"), character()) + }) }) From 3a58074b36a63a6c9e5ba164875af74f4432e0ef Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 11:44:04 +0100 Subject: [PATCH 47/49] documentation: roxygenise --- man/add_impute_method.Rd | 2 +- man/identify_target_rows.Rd | 33 +++++++++++++++++++++++++++++++++ man/interval_add_impute.Rd | 24 ++++++++++++++++-------- man/interval_remove_impute.Rd | 14 +++++++------- 4 files changed, 57 insertions(+), 16 deletions(-) create mode 100644 man/identify_target_rows.Rd diff --git a/man/add_impute_method.Rd b/man/add_impute_method.Rd index a1c30746..3c1b0fda 100644 --- a/man/add_impute_method.Rd +++ b/man/add_impute_method.Rd @@ -11,7 +11,7 @@ add_impute_method(impute_vals, target_impute, after) \item{target_impute}{The imputation method to be added.} -\item{after}{Numeric value specifying the position after which the imputation method should be added.} +\item{after}{Numeric value specifying the index position in which to add the impute.} } \value{ A character string or vector with the added impute method. diff --git a/man/identify_target_rows.Rd b/man/identify_target_rows.Rd new file mode 100644 index 00000000..94ba5607 --- /dev/null +++ b/man/identify_target_rows.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/intervals_support_funs.R +\name{identify_target_rows} +\alias{identify_target_rows} +\title{Identify target rows based on groups, parameters, and impute method} +\usage{ +identify_target_rows( + data, + target_impute, + target_params, + target_groups, + after = NULL +) +} +\arguments{ +\item{data}{A data frame containing the intervals.} + +\item{target_impute}{The imputation method to be added or removed.} + +\item{target_params}{A character vector specifying the parameters to be targeted.} + +\item{target_groups}{A data frame specifying the intervals to be targeted.} + +\item{after}{Numeric value specifying the index position in which to add the impute (optional).} +} +\value{ +A logical vector indicating the target rows. +} +\description{ +This is an internal helper function used to identify the target rows in the data frame +based on the specified groups, parameters, and impute method. +} +\keyword{internal} diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index 91db2f4f..e99ffcda 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -4,16 +4,21 @@ \alias{interval_add_impute} \title{Add specified imputation methods to the intervals in a PKNCAdata or data.frame object.} \usage{ -interval_add_impute(data, ...) +interval_add_impute( + data, + target_impute, + after, + target_params, + target_groups, + ... +) } \arguments{ -\item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} - -\item{...}{arguments passed to \code{interval_add_impute}.} +\item{data}{A PKNCAdata object containing the intervals data frame, or a data frame of intervals.} \item{target_impute}{A character string specifying the imputation method to be added.} -\item{after}{Numeric value specifying the position after which the imputation method should be added (optional). +\item{after}{Numeric value specifying the index in which the imputation will be added (optional). First is 0, last Inf. If missing, the imputation method is added at the end (Inf).} \item{target_params}{A character vector specifying the parameters to be targeted (optional). @@ -21,16 +26,18 @@ If missing, all TRUE in the intervals are taken.} \item{target_groups}{A data frame specifying the intervals to be targeted (optional). If missing, all relevant groups are considered.} + +\item{...}{arguments passed to \code{interval_add_impute}.} } \value{ -A modified PKNCAdata object with the specified imputation methods added to the targeted intervals. +A modified PKNCAdata object with specified imputation methods on the target intervals. } \description{ Add specified imputation methods to the intervals in a PKNCAdata or data.frame object. } \details{ -. If already present the target_impute method will be added substituting the existing one. All new intervals -created will be added right after their original ones. +If already present the target_impute method will be added substituting the existing one. +All new intervals created will be added right after their original ones. } \examples{ d_conc <- data.frame( @@ -39,6 +46,7 @@ d_conc <- data.frame( ID = rep(1:2, each = 6), analyte = rep(c("Analyte1", "Analyte2"), each = 6) ) + d_dose <- data.frame( dose = c(100, 200), time = c(0, 0), diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index 10c5226a..a6dabc6c 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -2,22 +2,22 @@ % Please edit documentation in R/intervals_support_funs.R \name{interval_remove_impute} \alias{interval_remove_impute} -\title{Remove specified imputation methods from the intervals in a PKNCAdata or data.frame (intervals) object.} +\title{Remove specified imputation from the intervals in a PKNCAdata or data.frame (intervals) object.} \usage{ -interval_remove_impute(data, ...) +interval_remove_impute(data, target_impute, ...) } \arguments{ -\item{data}{A PKNCAdata object containing the intervals and data components, or a data frame of intervals.} - -\item{...}{arguments passed to \code{interval_remove_impute}.} +\item{data}{A PKNCAdata object containing the intervals data frame, or a data frame of intervals.} \item{target_impute}{A character string specifying the imputation method to remove.} + +\item{...}{arguments passed to \code{interval_remove_impute}.} } \value{ -A modified object with the specified imputation methods removed from the targeted intervals. +A modified object with the specified imputations removed from the targeted intervals. } \description{ -Remove specified imputation methods from the intervals in a PKNCAdata or data.frame (intervals) object. +Remove specified imputation from the intervals in a PKNCAdata or data.frame (intervals) object. } \examples{ d_conc <- data.frame( From c16ebafe668a542c8d6ed2499fedaf7cf36a3adc Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 11:55:24 +0100 Subject: [PATCH 48/49] lintr: remove trailing whitespaces --- R/intervals_support_funs.R | 72 ++++++++-------- tests/testthat/test-intervals_support_funs.R | 88 ++++++++++---------- 2 files changed, 80 insertions(+), 80 deletions(-) diff --git a/R/intervals_support_funs.R b/R/intervals_support_funs.R index a545640b..e8a56016 100644 --- a/R/intervals_support_funs.R +++ b/R/intervals_support_funs.R @@ -117,19 +117,19 @@ interval_remove_impute.PKNCAdata <- function(data, target_impute, target_params warning("No default impute column or global method identified. No impute methods to remove") return(data) } - + # b & c. If there is a global impute.. if (is.null(target_params) && is.null(target_groups)) { # b. and user changes apply to all intervals, just remove global impute data$impute <- remove_impute_method(data$impute, target_impute) return(data) } - + # c. but user changes are specific (target_params or target_groups), creates an impute column data$intervals$impute <- data$impute data$impute <- NA_character_ } - + data$intervals <- interval_remove_impute.data.frame(data$intervals, target_impute, target_params, target_groups) data @@ -149,60 +149,60 @@ interval_add_impute.data.frame <- function(data, target_impute, after = Inf, warning("No impute method specified. No changes made.") return(data) } - + # Ensure the impute column exists and is a character column if (!"impute" %in% colnames(data)) { data$impute <- NA_character_ } else if (!is.character(data$impute)) { stop("The 'impute' column in the intervals data.frame must be a character column.") } - + # Add an index column to preserve the original order index_colname <- make.unique(c("index", names(data)))[1] data[[index_colname]] <- seq_len(nrow(data)) - + # Get all parameter column names in the data frame all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(data), all_param_options) - + # If missing, define target parameters as all parameter columns with at least one TRUE. if (is.null(target_params)) { target_params <- param_cols } - + assert_subset(target_params, all_param_options) - + # Identify the target interval rows based on: target_rows <- identify_target_rows(data, target_impute, target_params, target_groups, after) new_intervals <- data[target_rows, ] - + # If no target intervals are found, nothing to change if (nrow(new_intervals) == 0) { warning("No intervals found with the specified target parameters,", " groups, and/or after-change needed. No changes made.") return(data[, !names(data) %in% index_colname]) - + # If target intervals are found... } else { # The new imputation should not be used non-target parameters new_intervals[, setdiff(param_cols, target_params)] <- NA - + # Index the new intervals to be after the original ones new_intervals[["impute"]] <- add_impute_method(new_intervals[["impute"]], target_impute, after) new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 } - + # Remove the target parameters calculation from the original target intervals data[target_rows, target_params] <- NA - + # Combine the new and original intervals data <- rbind(data, new_intervals) - + # Filter rows where all row values for param_cols are NA or FALSE param_data <- data[, param_cols, drop = FALSE] rows_no_params <- rowSums(replace(param_data, is.na(param_data), FALSE)) == 0 data <- data[!rows_no_params, , drop = FALSE] - + # Order the intervals by the index column and then remove it data <- data[order(data[[index_colname]]), ] rownames(data) <- seq_len(nrow(data)) @@ -226,7 +226,7 @@ interval_remove_impute.data.frame <- function(data, warning("No impute method specified. No changes made.") return(data) } - + # Ensure the impute column exists and is a character column if (!"impute" %in% colnames(data)) { warning("No default impute column identified. No impute methods to remove") @@ -234,53 +234,53 @@ interval_remove_impute.data.frame <- function(data, } else if (!is.character(data$impute)) { stop("The 'impute' column in the intervals data.frame must be a character column.") } - + # Add an index column to preserve the original order index_colname <- make.unique(c("index", names(data)))[1] data[[index_colname]] <- seq_len(nrow(data)) - + # Get all parameter column names in the data frame all_param_options <- setdiff(names(get.interval.cols()), c("start", "end")) param_cols <- intersect(names(data), all_param_options) - + # Handle target_params if (is.null(target_params)) { target_params <- param_cols } - + assert_subset(target_params, all_param_options) - + # Identify the interval rows that need to be changed target_rows <- identify_target_rows(data, target_impute, target_params, target_groups) new_intervals <- data[target_rows, ] - + # If no target intervals are found, nothing to change if (nrow(new_intervals) == 0) { warning(paste0("No intervals found with the specified target parameters,", " groups and/or impute method. No changes made.")) return(data[, !names(data) %in% index_colname]) - + # If target intervals are found... } else { # The new imputation should not involve non-target parameters new_intervals[, setdiff(param_cols, target_params)] <- NA - + # Index the new intervals to be after the original ones new_intervals[["impute"]] <- remove_impute_method(new_intervals[["impute"]], target_impute) new_intervals[[index_colname]] <- new_intervals[[index_colname]] + 0.5 } - + # Remove the target parameters calculation from the original target intervals data[target_rows, target_params] <- NA - + # Combine the new and original intervals data <- rbind(data, new_intervals) - + # Filter rows where all row values for param_cols are NA/FALSE param_data <- data[, param_cols, drop = FALSE] rows_no_params <- rowSums(replace(param_data, is.na(param_data), FALSE)) == 0 data <- data[!rows_no_params, , drop = FALSE] - + # Order the intervals by the index column and then remove it data <- data[order(data[[index_colname]]), ] rownames(data) <- seq_len(nrow(data)) @@ -299,7 +299,7 @@ interval_remove_impute.data.frame <- function(data, add_impute_method <- function(impute_vals, target_impute, after) { # Make sure the character vector has length if (length(impute_vals) == 0) return(impute_vals) - + # Remove the impute from the other methods in each value impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) strsplit(impute_vals, split = "[ ,]+") |> @@ -320,13 +320,13 @@ add_impute_method <- function(impute_vals, target_impute, after) { remove_impute_method <- function(impute_vals, target_impute) { # Make sure the character vector has length if (length(impute_vals) == 0) return(impute_vals) - + # Remove the impute from the other methods in each value impute_vals <- ifelse(is.na(impute_vals), "", impute_vals) impute_vals <- strsplit(impute_vals, split = "[ ,]+") |> lapply(FUN = setdiff, target_impute) |> vapply(FUN = paste, collapse = ",", FUN.VALUE = "") - + # Replace empty strings with NA_character_ ifelse(impute_vals == "", NA_character_, impute_vals) } @@ -353,11 +353,11 @@ identify_target_rows <- function(data, target_impute, target_params, target_grou rep(TRUE, nrow(data)) } } - + ## 2. The target parameters (at least one calculated: not-FALSE/not-NA) target_params_data <- data[, target_params, drop = FALSE] is_target_param <- rowSums(replace(target_params_data, is.na(target_params_data), FALSE)) > 0 - + ## 3. The target impute method is not present and correctly positioned (if after is provided) if (!is.null(after)) { after_vals <- sapply(strsplit(data$impute, "[ ,]+"), \(x) { @@ -369,7 +369,7 @@ identify_target_rows <- function(data, target_impute, target_params, target_grou } else { is_after <- grepl(target_impute, data$impute, fixed = TRUE) } - + is_target_group & is_target_param & is_after } @@ -385,4 +385,4 @@ assert_subset <- function(a, b) { paste0(setdiff(a, b), collapse = ", ") ) } -} \ No newline at end of file +} diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support_funs.R index e4e3fe26..1ecc67fa 100644 --- a/tests/testthat/test-intervals_support_funs.R +++ b/tests/testthat/test-intervals_support_funs.R @@ -40,27 +40,27 @@ describe("interval_add_impute", { res <- interval_add_impute(simple_df, target_impute = "mlast") expect_equal(res, expected_res) }) - + it("throws an error if either data or target_impute is missing", { expect_error(interval_add_impute(o_data), "Both 'data' and 'target_impute' must be provided.") }) - + it("throws an error for non-character target_impute", { expect_error(interval_add_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") }) - + it("throws an error when input data is not a proper format object", { expect_error(interval_add_impute(data = o_conc, target_impute = "start_conc0")) expect_no_error(interval_add_impute(data = o_data, target_impute = "start_conc0")) }) - + it("throws an error for unknown target_params", { expect_error(interval_add_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param")) }) - + it("handles impute column with FALSE values correctly", { o_data_with_na_impute <- o_data o_data_with_na_impute$intervals$impute <- NA_character_ @@ -71,14 +71,14 @@ describe("interval_add_impute", { result <- interval_add_impute(o_data_with_na_impute, target_impute = "new_impute") expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("reports an error when the impute column is not a character", { o_data_not_character_impute <- o_data o_data_not_character_impute$intervals$impute <- 1 expect_error(interval_add_impute(o_data_not_character_impute, target_impute = "new_impute"), "The 'impute' column in the intervals data.frame must be a character column.") }) - + it("warns and makes no changes when target_impute is NA or empty", { expect_warning({ result <- interval_add_impute(o_data, target_impute = NA_character_) @@ -86,7 +86,7 @@ describe("interval_add_impute", { }, "No impute method specified. No changes made." ) - + expect_warning({ result <- interval_add_impute(o_data, target_impute = "") expect_equal(result, o_data) @@ -94,7 +94,7 @@ describe("interval_add_impute", { "No impute method specified. No changes made." ) }) - + it("creates missing impute col as NA_char & adds impute", { d_no_imp <- o_data d_no_imp$intervals$impute <- NULL @@ -103,7 +103,7 @@ describe("interval_add_impute", { res <- interval_add_impute(d_no_imp$intervals, target_impute = "new_impute") expect_equal(res, transform(d_no_imp$intervals, impute = "new_impute")) }) - + it("with no optional parameters uses all, with new intervals below", { expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), @@ -114,7 +114,7 @@ describe("interval_add_impute", { result <- interval_add_impute(o_data, target_impute = "new_impute") expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("handles specified target_params correctly", { expected_result_half_life <- data.frame( analyte = c("Analyte1", "Analyte2", "Analyte1"), @@ -134,7 +134,7 @@ describe("interval_add_impute", { c("analyte", "cmax", "impute")] |> `rownames<-`(NULL), expected_result_cmax) }) - + it("handles target_groups correctly", { expected_result_analyte1 <- data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), @@ -153,7 +153,7 @@ describe("interval_add_impute", { c("analyte", "half.life", "cmax", "impute")] |> `rownames<-`(NULL), expected_result_analyte2) }) - + it("handles multiple target_params correctly", { expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), @@ -166,7 +166,7 @@ describe("interval_add_impute", { target_params = c("half.life", "cmax")) expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("makes no changes and warns when no matching intervals are found", { expect_warning({ res <- interval_remove_impute(o_data, @@ -178,7 +178,7 @@ describe("interval_add_impute", { " groups and/or impute method. No changes made.") ) }) - + it("handles mixed TRUE/FALSE for cmax and half.life correctly", { intervals_mixed <- data.frame( start = c(0, 0, 0, 0), @@ -189,7 +189,7 @@ describe("interval_add_impute", { analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), ID = c(1, 2, 1, 2) ) - + o_data_mixed <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), half.life = c(TRUE, FALSE, TRUE, FALSE), @@ -201,7 +201,7 @@ describe("interval_add_impute", { result <- interval_add_impute(o_data_mixed, target_impute = "new_impute") expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("does not create duplicates but removes the originals & adds impute method based on after", { result <- interval_add_impute(o_data, target_impute = "start_conc0", after = Inf) expected_result <- data.frame( @@ -215,7 +215,7 @@ describe("interval_add_impute", { expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("adds new rows with added imputations after the original ones", { result <- interval_add_impute(o_data, target_impute = "new_impute", target_param = "cmax") expected_result <- data.frame( @@ -233,7 +233,7 @@ describe("interval_add_impute", { expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("does not add new interval if non-target & target params share target impute", { intervals_mixed <- data.frame( start = c(0, 0), @@ -244,7 +244,7 @@ describe("interval_add_impute", { analyte = c("Analyte1", "Analyte2"), ID = 1 ) - + o_data_mixed <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) result <- suppressWarnings(interval_add_impute(o_data_mixed, target_impute = "start_predose", @@ -274,28 +274,28 @@ describe("interval_remove_impute", { res <- interval_remove_impute(simple_df, target_impute = "m0") expect_equal(res, expected_res) }) - + it("throws an error if either data or target_impute is missing", { expect_error(interval_remove_impute(o_data), "Both 'data' and 'target_impute' must be provided.") }) - + it("throws an error for non-character target_impute", { expect_error(interval_remove_impute(o_data, target_impute = 123), "'target_impute' must be a character string.") }) - + it("throws an error when input data is not in correct format", { expect_error(interval_remove_impute(data = o_conc, target_impute = "start_conc0")) expect_no_error(interval_remove_impute(data = o_data, target_impute = "start_conc0")) }) - + it("throws an error for unknown target_params", { expect_error(interval_remove_impute(o_data, target_impute = "start_conc0", target_params = "unknown_param")) }) - + it("handles impute column with FALSE values correctly", { o_data_with_na_impute <- o_data o_data_with_na_impute$intervals$impute <- NA_character_ @@ -308,14 +308,14 @@ describe("interval_remove_impute", { ) expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("reports an error when impute column is not a character", { o_data_not_character_impute <- o_data o_data_not_character_impute$intervals$impute <- 1 expect_error(interval_remove_impute(o_data_not_character_impute, target_impute = "start_conc0"), "The 'impute' column in the intervals data.frame must be a character column.") }) - + it("warns and makes no changes when target_impute is NA or empty", { expect_warning({ result <- interval_remove_impute(o_data, target_impute = NA_character_) @@ -323,7 +323,7 @@ describe("interval_remove_impute", { }, "No impute method specified. No changes made." ) - + expect_warning({ result <- interval_remove_impute(o_data, target_impute = "") expect_equal(result, o_data) @@ -331,7 +331,7 @@ describe("interval_remove_impute", { "No impute method specified. No changes made." ) }) - + it("does not modify data if global impute & column are missing", { d_no_imp <- o_data d_no_imp$intervals <- d_no_imp$intervals[, !names(d_no_imp$intervals) %in% "impute"] @@ -343,22 +343,22 @@ describe("interval_remove_impute", { paste0("No default impute column or global method identified.", " No impute methods to remove") ) - + expect_warning({ res <- interval_remove_impute(d_no_imp$intervals, target_impute = "start_conc0") expect_equal(res, d_no_imp$intervals) }, "No default impute column identified. No impute methods to remove") }) - + it("if impute col is missing uses global impute", { o_d_no_imp <- o_data o_d_no_imp$intervals <- o_d_no_imp$intervals[, !names(o_d_no_imp$intervals) %in% "impute"] o_d_no_imp$impute <- "start_conc0, start_predose" - + # When targets are all intervals, global method is changed res_no_target <- interval_remove_impute(o_d_no_imp, target_impute = "start_conc0") expect_equal(res_no_target$impute, "start_predose") - + # When targets are specific intervals, then a new column is created and the action handled res_target <- interval_remove_impute(o_d_no_imp, target_impute = "start_conc0", target_groups = data.frame(analyte = "Analyte1")) @@ -367,7 +367,7 @@ describe("interval_remove_impute", { expect_equal(res_target$intervals[res_target$intervals$analyte == "Analyte2", "impute"], "start_conc0, start_predose") }) - + it("with no optional parameters uses all relevant cases", { expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), @@ -376,7 +376,7 @@ describe("interval_remove_impute", { result <- interval_remove_impute(o_data, target_impute = "start_conc0") expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("handles specified target_params correctly", { expected_result_half_life <- data.frame( analyte = c("Analyte1", "Analyte2", "Analyte1"), @@ -396,7 +396,7 @@ describe("interval_remove_impute", { c("analyte", "cmax", "impute")] |> `rownames<-`(NULL), expected_result_cmax) }) - + it("handles target_groups correctly", { expected_result_analyte1 <- data.frame(analyte = c("Analyte1", "Analyte1"), half.life = c(TRUE, TRUE), @@ -413,7 +413,7 @@ describe("interval_remove_impute", { c("analyte", "half.life", "cmax", "impute")], expected_result_analyte2) }) - + it("handles multiple target_params correctly", { expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1"), half.life = c(TRUE, TRUE, TRUE), @@ -426,7 +426,7 @@ describe("interval_remove_impute", { ) expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("makes no changes and warns when no matching intervals found", { expect_warning({ res <- interval_remove_impute(o_data, @@ -437,7 +437,7 @@ describe("interval_remove_impute", { " groups and/or impute method. No changes made.") }) }) - + it("handles properly impute character method with multiple imputes", { o_data_multiple_imputes <- o_data o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose" @@ -451,7 +451,7 @@ describe("interval_remove_impute", { expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("handles mixed TRUE/FALSE for cmax and half.life correctly", { intervals_mixed <- data.frame( start = c(0, 0, 0, 0), @@ -462,9 +462,9 @@ describe("interval_remove_impute", { analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), ID = c(1, 2, 1, 2) ) - + o_data_mixed <- PKNCA::PKNCAdata(o_conc, o_dose, intervals = intervals_mixed) - + expected_result <- data.frame(analyte = c("Analyte1", "Analyte2", "Analyte1", "Analyte2"), half.life = c(TRUE, FALSE, TRUE, FALSE), cmax = c(FALSE, TRUE, FALSE, TRUE), @@ -477,7 +477,7 @@ describe("interval_remove_impute", { ) expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("removes all target_impute even if is several times", { o_data_multiple_imputes <- o_data o_data_multiple_imputes$intervals$impute <- "start_conc0,start_predose,start_conc0" @@ -491,7 +491,7 @@ describe("interval_remove_impute", { expect_equal(result$intervals[, c("analyte", "half.life", "cmax", "impute")], expected_result) }) - + it("includes new rows right after the original ones", { result <- interval_remove_impute(o_data, target_impute = "start_conc0", target_param = "cmax") expected_result <- data.frame( From 6174adf9175bfb2a3b0c1d4c3975ce4813f624d2 Mon Sep 17 00:00:00 2001 From: Gero1999 Date: Sat, 29 Mar 2025 12:01:08 +0100 Subject: [PATCH 49/49] rename: intervals_support_funs > intervals_support --- R/{intervals_support_funs.R => intervals_support.R} | 0 man/add_impute_method.Rd | 2 +- man/identify_target_rows.Rd | 2 +- man/interval_add_impute.Rd | 2 +- man/interval_remove_impute.Rd | 2 +- man/remove_impute_method.Rd | 2 +- .../{test-intervals_support_funs.R => test-intervals_support.R} | 0 7 files changed, 5 insertions(+), 5 deletions(-) rename R/{intervals_support_funs.R => intervals_support.R} (100%) rename tests/testthat/{test-intervals_support_funs.R => test-intervals_support.R} (100%) diff --git a/R/intervals_support_funs.R b/R/intervals_support.R similarity index 100% rename from R/intervals_support_funs.R rename to R/intervals_support.R diff --git a/man/add_impute_method.Rd b/man/add_impute_method.Rd index 3c1b0fda..39d35321 100644 --- a/man/add_impute_method.Rd +++ b/man/add_impute_method.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/intervals_support_funs.R +% Please edit documentation in R/intervals_support.R \name{add_impute_method} \alias{add_impute_method} \title{Add impute method to the impute column} diff --git a/man/identify_target_rows.Rd b/man/identify_target_rows.Rd index 94ba5607..0f0dc239 100644 --- a/man/identify_target_rows.Rd +++ b/man/identify_target_rows.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/intervals_support_funs.R +% Please edit documentation in R/intervals_support.R \name{identify_target_rows} \alias{identify_target_rows} \title{Identify target rows based on groups, parameters, and impute method} diff --git a/man/interval_add_impute.Rd b/man/interval_add_impute.Rd index e99ffcda..bb4ecad1 100644 --- a/man/interval_add_impute.Rd +++ b/man/interval_add_impute.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/intervals_support_funs.R +% Please edit documentation in R/intervals_support.R \name{interval_add_impute} \alias{interval_add_impute} \title{Add specified imputation methods to the intervals in a PKNCAdata or data.frame object.} diff --git a/man/interval_remove_impute.Rd b/man/interval_remove_impute.Rd index a6dabc6c..180b5123 100644 --- a/man/interval_remove_impute.Rd +++ b/man/interval_remove_impute.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/intervals_support_funs.R +% Please edit documentation in R/intervals_support.R \name{interval_remove_impute} \alias{interval_remove_impute} \title{Remove specified imputation from the intervals in a PKNCAdata or data.frame (intervals) object.} diff --git a/man/remove_impute_method.Rd b/man/remove_impute_method.Rd index b4796174..6273767f 100644 --- a/man/remove_impute_method.Rd +++ b/man/remove_impute_method.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/intervals_support_funs.R +% Please edit documentation in R/intervals_support.R \name{remove_impute_method} \alias{remove_impute_method} \title{Remove impute method from the impute column} diff --git a/tests/testthat/test-intervals_support_funs.R b/tests/testthat/test-intervals_support.R similarity index 100% rename from tests/testthat/test-intervals_support_funs.R rename to tests/testthat/test-intervals_support.R