openNCA Release 2.0

Previous commit changes: - Fixed Issues with AUMCINFO not returning NA when all concentrations were 0 - Fixed Issues with create dosing interval routine when TAUi is 0 for multiple dosing intervals - Fixed Issue where NAs in concentration would cause computation failure for SS models - Corrected the implementation of OPTIMIZEKEL routine to account for correct pre-req parameters - Fixed the order of execution which was cauing OPTIMIZEKEL to fail - Correct issues with AUMCTAUi where the TAU value passed to the function was not normalized to 0 (with respect to TOLDi) - Fixed Issues with failure in computation when all concentration are missing with respect to C0 - Fixed other minor issues This commit changes: - Fixed Issues with negative time points checking routine for all models - Fixed Issues with BLQ/LLOQ check which was introduced due to the negative time points checking routine issue - Fixed issues with LASTTIMEi which were introduced due to BLQ/LLOQ checking routine issue - Fixed issue where index of 21 was hard-coded as NA unit value which actually represented UL unit value - Added warnings for invalid TIME and CONC value with respect to SDEID - Fixed other minor issues with logical checking
tensfeldt · May 27, 2020 · e7df513 · e7df513
1 parent 786bf37
commit e7df513
Show file tree

Hide file tree

Showing 13 changed files with 258 additions and 115 deletions.
diff --git a/openNCA/R/auc_tau.R b/openNCA/R/auc_tau.R
@@ -139,7 +139,7 @@
 #'  \item email: \url{support@rudraya.com}
 #' }
 #' @export
-auc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau = NULL, t_max = NULL, orig_conc = NULL, orig_time = NULL, last_crit_factor = NULL, kel = NULL, auclast = NULL){
+auc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau = NULL, t_max = NULL, orig_conc = NULL, orig_time = NULL, last_crit_factor = NULL, kel = NULL, auclast = NULL, lasttime = NULL){
   if(is.null(conc) && is.null(time)){
     stop("Error in auc_tau: 'conc' and 'time' vectors are NULL")
   } else if(is.null(conc)) {
@@ -172,7 +172,7 @@ auc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau = N
 ###
 ###cat('auc_tau.R: tau: ', tau, ' time: ', time, ' conc: ', conc, ' method: ', method, ' exflag: ', exflag, ' tau: ', tau, ' t_max: ', t_max, ' orig_conc: ', orig_conc, ' orig_time: ', orig_time, '\n')
 
-  if(tau %in% time && time[length(time)] == tau){
+  if(isTRUE(tau %in% time && time[length(time)] == tau)){
     if(method == 1){
       return(auc_lin_log(conc = conc, time = time, exflag = exflag, t_max = t_max))
     } else if(method == 2){
@@ -202,7 +202,7 @@ auc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau = N
     }
 
 ### 2019-08-28/TGT/ There doesn't appear to be any implement extrapolation method for auc_tau.R if tau>max(time)
-    if(tau < orig_time[length(orig_time)]){
+    if(isTRUE(tau < orig_time[length(orig_time)])){
       idx <- which(orig_time < tau)
       idx <- idx[length(idx)]
       time_1 <- orig_time[idx]
@@ -279,10 +279,10 @@ auc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau = N
             auctau <- auclast
           }
         }
-        if(time_min_range <= orig_time[length(orig_time)]){
+        if(isTRUE(time_min_range <= lastttime)){
           return(auctau)
         } else {
-          auctau <- ifelse(!is.null(auclast), ifelse((auctau <= (as.numeric(auclast) * 1.20)), auctau, NA), NA)
+          auctau <- ifelse(!is.null(auclast), ifelse(isTRUE(auctau <= (as.numeric(auclast) * 1.20)), auctau, NA), NA)
         }
       }
       return(auctau)

diff --git a/openNCA/R/aumc_tau.R b/openNCA/R/aumc_tau.R
@@ -166,7 +166,7 @@ aumc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau =
     return(NA)
   }
 
-  if(tau %in% time && time[length(time)] == tau){
+  if(isTRUE(tau %in% time && time[length(time)] == tau)){
     if(method == 1){
       return(aumc_lin_log(conc = conc, time = time, exflag = exflag, t_max = t_max))
     } else if(method == 2){
@@ -195,7 +195,7 @@ aumc_tau <- function(conc = NULL, time = NULL, method = 1, exflag = NULL, tau =
       stop("Error in aumc_tau: length of 'orig_time' and 'orig_conc' vectors are not equal")
     }
 
-    if(orig_time[1] < tau && tau < orig_time[length(orig_time)]){
+    if(isTRUE(orig_time[1] < tau && tau < orig_time[length(orig_time)])){
       idx <- which(orig_time < tau)
       idx <- idx[length(idx)]
       time_1 <- orig_time[idx]

diff --git a/openNCA/R/run_M1_SD_computation.R b/openNCA/R/run_M1_SD_computation.R
@@ -661,8 +661,7 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
     tryCatch({
       tmp_df <- data_data[data_data[,map_data$SDEID] == unique(data_data[,map_data$SDEID])[i],]
       default_df <- tmp_df
-      default_df[,map_data$TIME] <- as.numeric(default_df[,map_data$TIME])
-      default_df <- default_df[order(default_df[,map_data$TIME]),]
+      suppressWarnings(default_df <- default_df[order(as.numeric(default_df[,map_data$TIME])),])
       tmp_df[,map_data$CONC] <- as.numeric(tmp_df[,map_data$CONC])
       tmp_df[,map_data$TIME] <- as.numeric(tmp_df[,map_data$TIME])
       tmp_df <- tmp_df[order(tmp_df[,map_data$TIME]),]
@@ -772,8 +771,22 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
       }
 
       dof <- ifelse("DOF1" %in% names(map_data), ifelse(map_data$DOF1 %in% names(data_data), unique(tmp_df[,map_data$DOF1])[1], NA), ifelse("DOF" %in% names(map_data), ifelse(map_data$DOF %in% names(data_data), unique(tmp_df[,map_data$DOF])[1], NA), NA))
+      conc_check <- TRUE
+      time_check <- TRUE
+      suppressWarnings(blq_lloq_check <- default_df[,map_data$CONC][is.na(default_df[,map_data$CONC])])
+      if(isTRUE(length(blq_lloq_check) > 0)){
+        if(!isTRUE(all(toupper(blq_lloq_check) %in% c("BLQ", "LLOQ", NA)))){
+          warning(paste0("Parameters not generated due to invalid concentration values for SDEID: '", unique(data_data[,map_data$SDEID])[i], "'"))
+          conc_check <- FALSE
+        }
+      }
+      suppressWarnings(na_time_check <- default_df[,map_data$TIME][is.na(default_df[,map_data$TIME])])
+      if(isTRUE(length(na_time_check) > 0)){
+        warning(paste0("Parameters not generated due to invalid time values for SDEID: '", unique(data_data[,map_data$SDEID])[i], "'"))
+        time_check <- FALSE
+      }
 
-      if(isTRUE(nrow(tmp_df) > 0 & all(tmp_df[,map_data$TIME][!is.na(tmp_df[,map_data$TIME])] >= 0))){
+      if(isTRUE(nrow(tmp_df) > 0 & all(tmp_df[,map_data$TIME][!is.na(tmp_df[,map_data$TIME])] >= 0)) & isTRUE(time_check) & isTRUE(conc_check)){
         orig_time <- tmp_df[,map_data$TIME]
         orig_conc <- tmp_df[,map_data$CONC]
 

diff --git a/openNCA/R/run_M1_SS_computation.R b/openNCA/R/run_M1_SS_computation.R
@@ -949,8 +949,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
 
       tmp_df <- data_data[data_data[,map_data$SDEID] == unique(data_data[,map_data$SDEID])[i],]
       default_df <- tmp_df
-      default_df[,map_data$TIME] <- as.numeric(default_df[,map_data$TIME])
-      default_df <- default_df[order(default_df[,map_data$TIME]),]
+      suppressWarnings(default_df <- default_df[order(as.numeric(default_df[,map_data$TIME])),])
       tmp_df[,map_data$CONC] <- as.numeric(tmp_df[,map_data$CONC])
       tmp_df[,map_data$TIME] <- as.numeric(tmp_df[,map_data$TIME])
       tmp_df <- tmp_df[order(tmp_df[,map_data$TIME]),]
@@ -1058,7 +1057,22 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
         extrapolation <- FALSE
       }
 
-      if(isTRUE(nrow(tmp_df) > 0 & all(tmp_df[,map_data$TIME][!is.na(tmp_df[,map_data$TIME])] >= 0))){
+      conc_check <- TRUE
+      time_check <- TRUE
+      suppressWarnings(blq_lloq_check <- default_df[,map_data$CONC][is.na(as.numeric(default_df[,map_data$CONC]))])
+      if(isTRUE(length(blq_lloq_check) > 0)){
+        if(!isTRUE(all(toupper(blq_lloq_check) %in% c("BLQ", "LLOQ", NA)))){
+          warning(paste0("Parameters not generated due to invalid concentration values for SDEID: '", unique(data_data[,map_data$SDEID])[i], "'"))
+          conc_check <- FALSE
+        }
+      }
+      suppressWarnings(na_time_check <- default_df[,map_data$TIME][is.na(default_df[,map_data$TIME])])
+      if(isTRUE(length(na_time_check) > 0)){
+        warning(paste0("Parameters not generated due to invalid time values for SDEID: '", unique(data_data[,map_data$SDEID])[i], "'"))
+        time_check <- FALSE
+      }
+
+      if(isTRUE(nrow(tmp_df) > 0 & all(tmp_df[,map_data$TIME][!is.na(tmp_df[,map_data$TIME])] >= 0)) & isTRUE(time_check) & isTRUE(conc_check)){
         orig_time <- tmp_df[,map_data$TIME]
         orig_conc <- tmp_df[,map_data$CONC]
 
@@ -1082,7 +1096,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
         }
         for(d in 1:di_col){
           default_di_df <- default_df[default_df[c(paste0("DI", d, "F"))] == 1,]
-          default_di_df <- default_di_df[order(default_di_df[,map_data$TIME]),]
+          suppressWarnings(default_di_df <- default_di_df[order(as.numeric(default_di_df[,map_data$TIME])),])
           tmp_di_df <- tmp_df[tmp_df[c(paste0("DI", d, "F"))] == 1,]
           tmp_di_df <- tmp_di_df[order(tmp_di_df[,map_data$TIME]),]
           norm_bs <- ifelse("NORMBS" %in% names(map_data), ifelse(map_data$NORMBS %in% names(tmp_di_df), tmp_di_df[,map_data$NORMBS][1], NA), NA)
@@ -1109,7 +1123,11 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
           }
           if(!isTRUE(ctold_exists) && !is.na(tmp_told)){
             tmp_conc_di <- c(NA, tmp_di_df[,map_data$CONC])
-            tmp_time_di <- c(tmp_told, tmp_di_df[,map_data$TIME])
+            if(tmp_told %in% tmp_di_df[,map_data$NOMTIME]){
+              tmp_time_di <- c(tmp_di_df[,map_data$TIME])
+            } else {
+              tmp_time_di <- c(tmp_told, tmp_di_df[,map_data$TIME])
+            }
             est_tmp <- estimate_told_concentration(conc = tmp_conc_di, time = tmp_time_di, interpolate = TRUE, extrapolate = TRUE, auc_method = "LIN", model = "M3", dosing_type = "SS", told = tmp_told, orig_conc = orig_conc, orig_time = orig_time)
             tmp_conc_di <- est_tmp[[1]]
             ctold_est[[d]] <- tmp_conc_di[1]
@@ -1149,7 +1167,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
             told[[d]] <- as.numeric(told[[d]])
           }
           if(comp_required[["TMAXi"]]){
-            if(toupper(map_data$TIME) == "ACTUAL"){
+            if(toupper(map_data$ORGTIME) == "ACTUAL"){
               t_maxi[[d]] <- tmax(conc = tmp_conc_di, time = tmp_time_di, told = told[[d]])
             } else {
               t_maxi[[d]] <- tmax(conc = tmp_conc_di, time = tmp_time_di)
@@ -1403,7 +1421,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
           kelr_v <- kel_r(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME], exflag = kel_flag)
         }
         if(comp_required[["LASTTIME"]]){
-          last_time <- lasttime(conc = default_df[,map_data$CONC], time = default_df[,map_data$TIME])
+          last_time <- lasttime(conc = default_df[,map_data$CONC], time = as.numeric(default_df[,map_data$TIME]))
         }
         if(comp_required[["CEST"]] || parameter_required("KEL", names(kel_v)) || parameter_required("KELC0", names(kel_v))) {
           span_ratio <- ifelse("SPANRATIOCRIT" %in% names(map_data), suppressWarnings(as.numeric(map_data$SPANRATIOCRIT)), NA)
@@ -1431,7 +1449,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
 
         for(d in 1:di_col){
           default_di_df <- default_df[default_df[c(paste0("DI", d, "F"))] == 1,]
-          default_di_df <- default_di_df[order(default_di_df[,map_data$TIME]),]
+          suppressWarnings(default_di_df <- default_di_df[order(as.numeric(default_di_df[,map_data$TIME])),])
           tmp_di_df  <- tmp_df[tmp_df[c(paste0("DI", d, "F"))] == 1,]
           tmp_di_df <- tmp_di_df[order(tmp_di_df[,map_data$TIME]),]
           norm_bs <- ifelse("NORMBS" %in% names(map_data), ifelse(map_data$NORMBS %in% names(tmp_di_df), tmp_di_df[,map_data$NORMBS][1], NA), NA)
@@ -1464,7 +1482,11 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
 
           if(!isTRUE(ctold_exists) && !is.na(tmp_told)){
             tmp_conc_di <- c(NA, tmp_di_df[,map_data$CONC])
-            tmp_time_di <- c(tmp_told, tmp_di_df[,map_data$TIME])
+            if(tmp_told %in% tmp_di_df[,map_data$NOMTIME]){
+              tmp_time_di <- c(tmp_di_df[,map_data$TIME])
+            } else {
+              tmp_time_di <- c(tmp_told, tmp_di_df[,map_data$TIME])
+            }
             est_tmp <- estimate_told_concentration(conc = tmp_conc_di, time = tmp_time_di, interpolate = TRUE, extrapolate = TRUE, auc_method = "LIN", model = "M1", dosing_type = "SS", told = tmp_told, orig_conc = orig_conc, orig_time = orig_time)
             tmp_conc_di <- est_tmp[[1]]
             ctold_est[[d]] <- tmp_conc_di[1]
@@ -1520,21 +1542,21 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
             c_mindni[[d]] <- cmin_dn(cmin = c_mini[[d]], dose = tmp_dose)
           }
           if(comp_required[["TMAXi"]]){
-            if(toupper(map_data$TIME) == "ACTUAL"){
+            if(toupper(map_data$ORGTIME) == "ACTUAL"){
               t_maxi[[d]] <- tmax(conc = tmp_conc_di, time = tmp_time_di, told = told[[d]])
             } else {
               t_maxi[[d]] <- tmax(conc = tmp_conc_di, time = tmp_time_di)
             }
           }
           if(comp_required[["TMINi"]]){
-            if(toupper(map_data$TIME) == "ACTUAL"){
+            if(toupper(map_data$ORGTIME) == "ACTUAL"){
               t_mini[[d]] <- tmin(conc = tmp_conc_di, time = tmp_time_di, told = told[[d]]) 
             } else {
               t_mini[[d]] <- tmin(conc = tmp_conc_di, time = tmp_time_di)
             }
           }
           if(comp_required[["LASTTIMEi"]]){
-            last_timei[[d]] <- lasttime(conc = default_di_df[,map_data$CONC], time = default_di_df[,map_data$TIME])
+            last_timei[[d]] <- lasttime(conc = default_di_df[,map_data$CONC], time = as.numeric(default_di_df[,map_data$TIME]))
           }
           if(comp_required[["CMAXCi"]]) {
             c_maxci[[d]] <- cmaxc(kel = kel_v[["KEL"]], cmax = c_maxi[[d]], c0 = obs_c_0, tmax = t_maxi[[d]])
@@ -1579,7 +1601,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
             aumcinfpi[[d]] <- aumc_inf_p(conc = tmp_conc_di, time = aumc_time, method = method, kelflag = kel_flag, aucflag = auc_flag, aumclast = aumclasti[[d]], t_last = t_lasti[[d]], kel = kel_v)
           }
           if(comp_required[["AUCTAUi"]]){
-            auctau[[d]] <- auc_tau(conc = tmp_conc_di, time = tmp_time_di, method = method, exflag = auc_flag, tau = told[[d]]+tau[[d]], t_max = t_maxi[[d]], orig_conc = orig_conc, orig_time = orig_time, last_crit_factor = last_crit_factor, kel = kel_v, auclast = auclasti[[d]])
+            auctau[[d]] <- auc_tau(conc = tmp_conc_di, time = tmp_time_di, method = method, exflag = auc_flag, tau = told[[d]]+tau[[d]], t_max = t_maxi[[d]], orig_conc = orig_conc, orig_time = orig_time, last_crit_factor = last_crit_factor, kel = kel_v, auclast = auclasti[[d]], lasttime = last_timei[[d]])
           }
           if(comp_required[["AUCTAUDNi"]]){
             auctaudn[[d]] <- auc_dn(auc = auctau[[d]], dose = tmp_dose)

diff --git a/openNCA/R/run_M2_SD_computation.R b/openNCA/R/run_M2_SD_computation.R
@@ -707,8 +707,7 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
     tryCatch({
       tmp_df <- data_data[data_data[,map_data$SDEID] == unique(data_data[,map_data$SDEID])[i],]
       default_df <- tmp_df
-      default_df[,map_data$TIME] <- as.numeric(default_df[,map_data$TIME])
-      default_df <- default_df[order(default_df[,map_data$TIME]),]
+      suppressWarnings(default_df <- default_df[order(as.numeric(default_df[,map_data$TIME])),])
       tmp_df[,map_data$CONC] <- as.numeric(tmp_df[,map_data$CONC])
       tmp_df[,map_data$TIME] <- as.numeric(tmp_df[,map_data$TIME])
       tmp_df <- tmp_df[order(tmp_df[,map_data$TIME]),]
@@ -818,8 +817,22 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
       }
 
       dof <- ifelse("DOF1" %in% names(map_data), ifelse(map_data$DOF1 %in% names(data_data), unique(tmp_df[,map_data$DOF1])[1], NA), ifelse("DOF" %in% names(map_data), ifelse(map_data$DOF %in% names(data_data), unique(tmp_df[,map_data$DOF])[1], NA), NA))
+      conc_check <- TRUE
+      time_check <- TRUE
+      suppressWarnings(blq_lloq_check <- default_df[,map_data$CONC][is.na(default_df[,map_data$CONC])])
+      if(isTRUE(length(blq_lloq_check) > 0)){
+        if(!isTRUE(all(toupper(blq_lloq_check) %in% c("BLQ", "LLOQ", NA)))){
+          warning(paste0("Parameters not generated due to invalid concentration values for SDEID: '", unique(data_data[,map_data$SDEID])[i], "'"))
+          conc_check <- FALSE
+        }
+      }
+      suppressWarnings(na_time_check <- default_df[,map_data$TIME][is.na(default_df[,map_data$TIME])])
+      if(isTRUE(length(na_time_check) > 0)){
+        warning(paste0("Parameters not generated due to invalid time values for SDEID: '", unique(data_data[,map_data$SDEID])[i], "'"))
+        time_check <- FALSE
+      }
 
-      if(isTRUE(nrow(tmp_df) > 0 & all(tmp_df[,map_data$TIME][!is.na(tmp_df[,map_data$TIME])] >= 0))){
+      if(isTRUE(nrow(tmp_df) > 0 & all(tmp_df[,map_data$TIME][!is.na(tmp_df[,map_data$TIME])] >= 0)) & isTRUE(time_check) & isTRUE(conc_check)){
         orig_time <- tmp_df[,map_data$TIME]
         orig_conc <- tmp_df[,map_data$CONC]
         auc_time <- tmp_df[,map_data$TIME]
@@ -841,13 +854,13 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
             a_auc_flag <- a_auc_flag[auc_time != 0]
             auc_conc <- c(as.numeric(est_c_0$est_c0), auc_conc)
             auc_time <- c(0, auc_time)
-            if(!any(auc_time == 0)){
+            if(!isTRUE(any(auc_time == 0))){
               remove_extra_AUC <- FALSE
               a_kel_flag <- c(0, a_kel_flag)
               a_auc_flag <- c(0, a_auc_flag)
             }
           } else {
-            if(!any(auc_time == 0)){
+            if(!isTRUE(any(auc_time == 0))){
               remove_extra_AUC <- FALSE
             }
           }