Implemented CEST Interpolation/Extrapolation as an output

- Added CEST Interpolate/Extrapolate as a result for computation - Added INCLUDEINTERPOLATION and INCLUDEEXTRAPOLATION Flags logic
tensfeldt · Nov 11, 2019 · 1fc479c · 1fc479c
1 parent 051805c
commit 1fc479c
Show file tree

Hide file tree

Showing 12 changed files with 410 additions and 134 deletions.
diff --git a/openNCA/R/auc_lin.R b/openNCA/R/auc_lin.R
@@ -6,14 +6,15 @@
 #' @param time The time data (given in a vector form)
 #' @param exflag The exclude flag data (given in a numeric vector)
 #' @param interpolate The value to determine whether to interpolate data points (given in a logical form)
+#' @param extrapolate The value to determine whether to extrapolate data points (given in a logical form)
 #' @param model The model specification (either 'M1', 'M2', 'M3', or 'M4')
 #' @param dosing_type The dosing type specification (either 'SD' or 'SS')
 #' @param told The time of last dose (given in a numeric value)
 #' @param orig_conc The original (full) concentration data (given in a numeric vector)
 #' @param orig_time The original (full) time data (given in a numeric vector)
 #' 
 #! @export
-auc_lin <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
+auc_lin <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL, extrapolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
   if(is.null(conc) && is.null(time)){
     stop("Error in auc_lin: 'conc' and 'time' vectors are NULL")
   } else if(is.null(conc)) {
@@ -106,20 +107,28 @@ auc_lin <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
   } else {
     auc_df <- ""
 
-    for(i in 1:(nrow(tmp)-1)){
-##      2019-11-07/RD Added for Interpolation to check for triggers for interpolation
+##    2019-11-07/RD Added for Interpolation to check for triggers for interpolation
 ##
-      if(isTRUE(interpolate)){
+    if(isTRUE(interpolate)){
 ##      2019-11-08/RD Added helper function for Interpolation
 ##
-        conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-      }
+      est_tmp <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
+      conc <- est_tmp[[1]]
+    }
+    for(i in 1:(nrow(tmp)-1)){
       auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
     }
     auc_df <- as.numeric(auc_df)
     auc <- sum(auc_df, na.rm = TRUE)
   }
-##  2019-11-07/RD Returning interpolated data that will be used as an output
+##  2019-11-08/RD Returning interpolated data that will be used as an output
+##
+  if(isTRUE(interpolate)){
+    return(list(auc, est_tmp[[2]]))
+  } else {
+    return(auc)
+  }
+##  2019-11-08/RD Commenting this as interpolation return call will replace it 
 ##
-return(auc)
+##  return(auc)
 }
diff --git a/openNCA/R/auc_lin_log.R b/openNCA/R/auc_lin_log.R
@@ -9,14 +9,15 @@
 #' @param exflag The exclude flag data (given in a numeric vector)
 #' @param t_max The first time at which CMAXi is observed within the dosing interval (numeric value)
 #' @param interpolate The value to determine whether to interpolate data points (given in a logical form)
+#' @param extrapolate The value to determine whether to extrapolate data points (given in a logical form)
 #' @param model The model specification (either 'M1', 'M2', 'M3', or 'M4')
 #' @param dosing_type The dosing type specification (either 'SD' or 'SS')
 #' @param told The time of last dose (given in a numeric value)
 #' @param orig_conc The original (full) concentration data (given in a numeric vector)
 #' @param orig_time The original (full) time data (given in a numeric vector)
 #' 
 #! @export
-auc_lin_log <- function(conc = NULL, time = NULL, exflag = NULL, t_max = NULL, interpolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
+auc_lin_log <- function(conc = NULL, time = NULL, exflag = NULL, t_max = NULL, interpolate = NULL, extrapolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
   if(is.null(conc) && is.null(time)){
     stop("Error in auc_lin_log: 'conc' and 'time' vectors are NULL")
   } else if(is.null(conc)) {
@@ -113,24 +114,18 @@ auc_lin_log <- function(conc = NULL, time = NULL, exflag = NULL, t_max = NULL, i
     auc_df <- ""
 
     if(!is.na(t_max)){
-      for(i in 1:(nrow(tmp)-1)){
-        if(tmp$time[i+1] <= t_max || tmp$conc[i] == 0 || tmp$conc[i+1] == 0 || tmp$conc[i] == tmp$conc[i+1]){
-##          2019-11-07/RD Added for Interpolation to check for triggers for interpolation
+##      2019-11-07/RD Added for Interpolation to check for triggers for interpolation
 ##
-          if(isTRUE(interpolate)){
-##            2019-11-08/RD Added helper function for Interpolation
+      if(isTRUE(interpolate)){
+##        2019-11-08/RD Added helper function for Interpolation
 ##
-            conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-          }
+        est_tmp <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
+        conc <- est_tmp[[1]]
+      }
+      for(i in 1:(nrow(tmp)-1)){
+        if(tmp$time[i+1] <= t_max || tmp$conc[i] == 0 || tmp$conc[i+1] == 0 || tmp$conc[i] == tmp$conc[i+1]){
           auc_df[i] <- ((tmp$conc[i] + tmp$conc[i+1])/2)*(tmp$time[i+1]-tmp$time[i])
         } else {
-##          2019-11-07/RD Added for Interpolation to check for triggers for interpolation
-##
-          if(isTRUE(interpolate)){
-##            2019-11-08/RD Added helper function for Interpolation
-##
-            conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LOG", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-          }
           tmp_ln <- tmp$conc[i]/tmp$conc[i+1]
           auc_df[i] <- ((tmp$conc[i] - tmp$conc[i+1])/log(tmp_ln))*(tmp$time[i+1]-tmp$time[i])
         }
@@ -141,6 +136,14 @@ auc_lin_log <- function(conc = NULL, time = NULL, exflag = NULL, t_max = NULL, i
     auc_df <- as.numeric(auc_df)
     auc <- sum(auc_df, na.rm = TRUE)
   }
-
-  return(auc)
+##  2019-11-08/RD Returning interpolated data that will be used as an output
+##
+  if(isTRUE(interpolate)){
+    return(list(auc, est_tmp[[2]]))
+  } else {
+    return(auc)
+  }
+##  2019-11-08/RD Commenting this as interpolation return call will replace it 
+##
+##  return(auc)
 }
diff --git a/openNCA/R/auc_lin_up_log_down.R b/openNCA/R/auc_lin_up_log_down.R
@@ -9,14 +9,15 @@
 #' @param time The time data (given in a vector form)
 #' @param exflag The exclude flag data (given in a numeric vector)
 #' @param interpolate The value to determine whether to interpolate data points (given in a logical form)
+#' @param extrapolate The value to determine whether to extrapolate data points (given in a logical form)
 #' @param model The model specification (either 'M1', 'M2', 'M3', or 'M4')
 #' @param dosing_type The dosing type specification (either 'SD' or 'SS')
 #' @param told The time of last dose (given in a numeric value)
 #' @param orig_conc The original (full) concentration data (given in a numeric vector)
 #' @param orig_time The original (full) time data (given in a numeric vector)
 #' 
 #! @export
-auc_lin_up_log_down <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
+auc_lin_up_log_down <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL, extrapolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
   if(is.null(conc) && is.null(time)){
     stop("Error in auc_lin_up_log_down: 'conc' and 'time' vectors are NULL")
   } else if(is.null(conc)) {
@@ -109,36 +110,23 @@ auc_lin_up_log_down <- function(conc = NULL, time = NULL, exflag = NULL, interpo
   } else {
     auc_df <- ""
 
+##    2019-11-07/RD Added for Interpolation to check for triggers for interpolation
+##
+    if(isTRUE(interpolate)){
+##      2019-11-08/RD Added helper function for Interpolation
+##
+      est_tmp <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
+      conc <- est_tmp[[1]]
+    }
     for(i in 1:(nrow(tmp)-1)){
       curr_c <- as.numeric(conc[i])
       next_c <- as.numeric(conc[i+1])
       if(next_c >= curr_c){
-##        2019-11-07/RD Added for Interpolation to check for triggers for interpolation
-##
-        if(isTRUE(interpolate)){
-##          2019-11-08/RD Added helper function for Interpolation
-##
-          conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-        }
         auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
       } else {
         if(conc[i] == 0 || conc[i+1] == 0){
-##          2019-11-07/RD Added for Interpolation to check for triggers for interpolation
-##
-          if(isTRUE(interpolate)){
-##            2019-11-08/RD Added helper function for Interpolation
-##
-            conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-          }
           auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
         } else {
-##          2019-11-07/RD Added for Interpolation to check for triggers for interpolation
-##
-          if(isTRUE(interpolate)){
-##      2019-11-08/RD Added helper function for Interpolation
-##
-            conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LOG", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-          }
           tmp_ln <- conc[i]/conc[i+1]
           auc_df[i] <- ((conc[i] - conc[i+1])/log(tmp_ln))*(time[i+1]-time[i])
         }
@@ -147,6 +135,14 @@ auc_lin_up_log_down <- function(conc = NULL, time = NULL, exflag = NULL, interpo
     auc_df <- as.numeric(auc_df)
     auc <- sum(auc_df, na.rm = TRUE)
   }
-
-  return(auc)
+##  2019-11-08/RD Returning interpolated data that will be used as an output
+##
+  if(isTRUE(interpolate)){
+    return(list(auc, est_tmp[[2]]))
+  } else {
+    return(auc)
+  }
+##  2019-11-08/RD Commenting this as interpolation return call will replace it 
+##
+##  return(auc)
 }
diff --git a/openNCA/R/auc_log.R b/openNCA/R/auc_log.R
@@ -7,14 +7,15 @@
 #' @param time The time data (given in a vector form)
 #' @param exflag The exclude flag data (given in a numeric vector)
 #' @param interpolate The value to determine whether to interpolate data points (given in a logical form)
+#' @param extrapolate The value to determine whether to extrapolate data points (given in a logical form)
 #' @param model The model specification (either 'M1', 'M2', 'M3', or 'M4')
 #' @param dosing_type The dosing type specification (either 'SD' or 'SS')
 #' @param told The time of last dose (given in a numeric value)
 #' @param orig_conc The original (full) concentration data (given in a numeric vector)
 #' @param orig_time The original (full) time data (given in a numeric vector)
 #' 
 #! @export
-auc_log <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
+auc_log <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL, extrapolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
   if(is.null(conc) && is.null(time)){
     stop("Error in auc_log: 'conc' and 'time' vectors are NULL")
   } else if(is.null(conc)) {
@@ -108,25 +109,19 @@ auc_log <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
     t_max <- tmax(conc = conc, time = time)
     auc_df <- ""
 
+##    2019-11-07/RD Added for Interpolation to check for triggers for interpolation
+##
+    if(isTRUE(interpolate)){
+##      2019-11-08/RD Added helper function for Interpolation
+##
+      est_tmp <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
+      conc <- est_tmp[[1]]
+    }
     if(!is.na(t_max)){
       for(i in 1:(nrow(tmp)-1)){
         if(conc[i] == 0 || conc[i+1] == 0){
-##            2019-11-07/RD Added for Interpolation to check for triggers for interpolation
-##
-          if(isTRUE(interpolate)){
-##            2019-11-08/RD Added helper function for Interpolation
-##
-            conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LIN", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-          }
           auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
         } else {
-##            2019-11-07/RD Added for Interpolation to check for triggers for interpolation
-##
-          if(isTRUE(interpolate)){
-##            2019-11-08/RD Added helper function for Interpolation
-##
-            conc <- estimate_missing_concentration(conc = conc, time = time, auc_method = "LOG", model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time)
-          }
           tmp_ln <- conc[i]/conc[i+1]
           auc_df[i] <- ((conc[i] - conc[i+1])/log(tmp_ln))*(time[i+1]-time[i])
         }
@@ -137,6 +132,14 @@ auc_log <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
     auc_df <- as.numeric(auc_df)
     auc <- sum(auc_df, na.rm = TRUE)
   }
-
-  return(auc)
+##  2019-11-08/RD Returning interpolated data that will be used as an output
+##
+  if(isTRUE(interpolate)){
+    return(list(auc, est_tmp[[2]]))
+  } else {
+    return(auc)
+  }
+##  2019-11-08/RD Commenting this as interpolation return call will replace it 
+##
+##  return(auc)
 }
diff --git a/openNCA/R/auc_t1_t2.R b/openNCA/R/auc_t1_t2.R
@@ -48,6 +48,7 @@
 #' @param exflag The exclude flag data (given in a numeric vector)
 #' @param t_max The first time at which CMAXi is observed within the dosing interval (numeric value)
 #' @param interpolate The value to determine whether to interpolate data points (given in a logical form)
+#' @param extrapolate The value to determine whether to extrapolate data points (given in a logical form)
 #' @param model The model specification (either 'M1', 'M2', 'M3', or 'M4')
 #' @param dosing_type The dosing type specification (either 'SD' or 'SS')
 #' @param told The time of last dose (given in a numeric value)
@@ -135,7 +136,7 @@
 #'  \item email: \url{support@rudraya.com}
 #' }
 #' @export
-auc_t1_t2 <- function(conc = NULL, time = NULL, t1 = NULL, t2 = NULL, method = 1, exflag = NULL, t_max = NULL, dose_time = NULL, interpolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
+auc_t1_t2 <- function(conc = NULL, time = NULL, t1 = NULL, t2 = NULL, method = 1, exflag = NULL, t_max = NULL, dose_time = NULL, interpolate = NULL, extrapolate = NULL, model = NULL, dosing_type = NULL, told = NULL, orig_conc = NULL, orig_time = NULL){
   if(is.null(conc) && is.null(time)){
     stop("Error in auc_t1_t2: 'conc' and 'time' vectors are NULL")
   } else if(is.null(conc)) {
@@ -199,14 +200,14 @@ auc_t1_t2 <- function(conc = NULL, time = NULL, t1 = NULL, t2 = NULL, method = 1
   if(sum(conc, na.rm = T) == 0){
     return(0)
   }
-
+  
   if(method == 1){
-    return(auc_lin_log(conc = conc, time = time, exflag = exflag, t_max = t_max, interpolate = interpolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
+    return(auc_lin_log(conc = conc, time = time, exflag = exflag, t_max = t_max, interpolate = interpolate, extrapolate = extrapolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
   } else if(method == 2){
-    return(auc_lin(conc = conc, time = time, exflag = exflag, interpolate = interpolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
+    return(auc_lin(conc = conc, time = time, exflag = exflag, interpolate = interpolate, extrapolate = extrapolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
   } else if(method == 3){
-    return(auc_log(conc = conc, time = time, exflag = exflag, interpolate = interpolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
+    return(auc_log(conc = conc, time = time, exflag = exflag, interpolate = interpolate, extrapolate = extrapolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
   } else if(method == 4){
-    return(auc_lin_up_log_down(conc = conc, time = time, exflag = exflag, interpolate = interpolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
+    return(auc_lin_up_log_down(conc = conc, time = time, exflag = exflag, interpolate = interpolate, extrapolate = extrapolate, model = model, dosing_type = dosing_type, told = told, orig_conc = orig_conc, orig_time = orig_time))
   }
 }