Skip to content

Commit

Permalink
Fixed Issues with Interpolation/Extrapolation and FLGNOCMAX
Browse files Browse the repository at this point in the history 
- Fixed Issue where Partial AUC returned an error when it shouldnt
- Fixed Issue where Partail AUC didnt account for a specific scenario for Interpolation/Extrapolation
- Fixed Potential Issue for reading OPTIMIZEKEL value from map dataset
- Fixed Issue where FLGNOCMAX was not being read properly
- Fixed Minor Issue with Optimize Kel function
  • Loading branch information
@opennca
opennca committed Nov 19, 2019
1 parent b2bf9b3 commit 066fa5d
Show file tree
Hide file tree
Showing 11 changed files with 80 additions and 62 deletions.
8 changes: 6 additions & 2 deletions openNCA/R/auc_lin.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -90,7 +90,7 @@ auc_lin <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
conc <- conc[exflag]
}

if(!isTRUE(interpolate)){
if(!isTRUE(interpolate) && !isTRUE(extrapolate)){
time <- time[!is.na(conc)]
conc <- conc[!is.na(conc)]
}
Expand All @@ -117,7 +117,11 @@ auc_lin <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
tmp <- data.frame(time, conc)
}
for(i in 1:(nrow(tmp)-1)){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
if(!is.na(tmp$time[i]) && !is.na(tmp$time[i+1]) && !is.na(tmp$conc[i]) && !is.na(tmp$conc[i+1])){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
} else {
auc_df[i] <- NA
}
}
auc_df <- as.numeric(auc_df)
auc <- sum(auc_df, na.rm = TRUE)
Expand Down
14 changes: 9 additions & 5 deletions openNCA/R/auc_lin_log.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ auc_lin_log <- function(conc = NULL, time = NULL, exflag = NULL, t_max = NULL, i
conc <- conc[exflag]
}

if(!isTRUE(interpolate)){
if(!isTRUE(interpolate) && !isTRUE(extrapolate)){
time <- time[!is.na(conc)]
conc <- conc[!is.na(conc)]
}
Expand Down Expand Up @@ -124,11 +124,15 @@ auc_lin_log <- function(conc = NULL, time = NULL, exflag = NULL, t_max = NULL, i
tmp <- data.frame(time, conc)
}
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])
if(!is.na(tmp$time[i]) && !is.na(tmp$time[i+1]) && !is.na(tmp$conc[i]) && !is.na(tmp$conc[i+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 {
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])
}
} else {
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])
auc_df[i] <- NA
}
}
} else {
Expand Down
22 changes: 13 additions & 9 deletions openNCA/R/auc_lin_up_log_down.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ auc_lin_up_log_down <- function(conc = NULL, time = NULL, exflag = NULL, interpo
conc <- conc[exflag]
}

if(!isTRUE(interpolate)){
if(!isTRUE(interpolate) && !isTRUE(extrapolate)){
time <- time[!is.na(conc)]
conc <- conc[!is.na(conc)]
}
Expand All @@ -120,17 +120,21 @@ auc_lin_up_log_down <- function(conc = NULL, time = NULL, exflag = NULL, interpo
tmp <- data.frame(time, conc)
}
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){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
} else {
if(conc[i] == 0 || conc[i+1] == 0){
if(!is.na(tmp$time[i]) && !is.na(tmp$time[i+1]) && !is.na(tmp$conc[i]) && !is.na(tmp$conc[i+1])){
curr_c <- as.numeric(conc[i])
next_c <- as.numeric(conc[i+1])
if(next_c >= curr_c){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
} else {
tmp_ln <- conc[i]/conc[i+1]
auc_df[i] <- ((conc[i] - conc[i+1])/log(tmp_ln))*(time[i+1]-time[i])
if(conc[i] == 0 || conc[i+1] == 0){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
} else {
tmp_ln <- conc[i]/conc[i+1]
auc_df[i] <- ((conc[i] - conc[i+1])/log(tmp_ln))*(time[i+1]-time[i])
}
}
} else {
auc_df[i] <- NA
}
}
auc_df <- as.numeric(auc_df)
Expand Down
14 changes: 9 additions & 5 deletions openNCA/R/auc_log.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -91,7 +91,7 @@ auc_log <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
conc <- conc[exflag]
}

if(!isTRUE(interpolate)){
if(!isTRUE(interpolate) && !isTRUE(extrapolate)){
time <- time[!is.na(conc)]
conc <- conc[!is.na(conc)]
}
Expand Down Expand Up @@ -120,11 +120,15 @@ auc_log <- function(conc = NULL, time = NULL, exflag = NULL, interpolate = NULL,
}
if(!is.na(t_max)){
for(i in 1:(nrow(tmp)-1)){
if(conc[i] == 0 || conc[i+1] == 0){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
if(!is.na(tmp$time[i]) && !is.na(tmp$time[i+1]) && !is.na(tmp$conc[i]) && !is.na(tmp$conc[i+1])){
if(conc[i] == 0 || conc[i+1] == 0){
auc_df[i] <- ((conc[i] + conc[i+1])/2)*(time[i+1]-time[i])
} else {
tmp_ln <- conc[i]/conc[i+1]
auc_df[i] <- ((conc[i] - conc[i+1])/log(tmp_ln))*(time[i+1]-time[i])
}
} else {
tmp_ln <- conc[i]/conc[i+1]
auc_df[i] <- ((conc[i] - conc[i+1])/log(tmp_ln))*(time[i+1]-time[i])
auc_df[i] <- NA
}
}
} else {
Expand Down
2 changes: 2 additions & 0 deletions openNCA/R/estimate_missing_concentration.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -67,6 +67,7 @@ estimate_missing_concentration <- function(conc = NULL, time = NULL, auc_method
tmp$INT_EXT[1] <- "EXT"
} else {
conc[1] <- NA
tmp$INT_EXT[1] <- "EXT"
}
}
## 2019-11-08/RD Added for Interpolation for AUC End time has no data
Expand Down Expand Up @@ -94,6 +95,7 @@ estimate_missing_concentration <- function(conc = NULL, time = NULL, auc_method
tmp$INT_EXT[nrow(tmp)] <- "EXT"
} else {
conc[nrow(tmp)] <- NA
tmp$INT_EXT[nrow(tmp)] <- "EXT"
}
}
}
Expand Down
14 changes: 7 additions & 7 deletions openNCA/R/run_M1_SD_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -806,12 +806,12 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
# }
#}

if(optimize_kel && (!"TMAX" %in% parameter_list || !"TLAST" %in% parameter_list || !"CMAX" %in% parameter_list || !"CLAST" %in% parameter_list || !"AUCLAST" %in% parameter_list ||
if(isTRUE(optimize_kel) && (!"TMAX" %in% parameter_list || !"TLAST" %in% parameter_list || !"CMAX" %in% parameter_list || !"CLAST" %in% parameter_list || !"AUCLAST" %in% parameter_list ||
!"FLGACCEPTKELCRIT" %in% names(map_data) || !"FLGEXKEL" %in% names(map_data) || !map_data$FLGEXKEL %in% names(data_data))){
warning("Kel optimization cannot be performed because 'TMAX', 'TLAST', 'CMAX', 'CLAST', 'AUCLAST' are not part of the calulcated parameters AND Flag 'FLGACCEPTKELCRIT' and Flag 'FLGEXKEL' are not present in the dataset")
}

if(optimize_kel && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
kel_flag_optimized <- integer()
}
Expand Down Expand Up @@ -900,16 +900,16 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
if(comp_required[["AUCLAST"]]) {
auclast <- auc_last(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME], method = method, exflag = auc_flag)
}
if(optimize_kel && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
orig_time <- tmp_df[,map_data$TIME]
orig_conc <- tmp_df[,map_data$CONC]
tmp_time <- orig_time
tmp_conc <- orig_conc

if("FLGNOCMAX" %in% names(map_data) && (map_data$FLGNOCMAX == 1 || map_data$FLGNOCMAX == 0)){
flg_no_cmax <- as.logical(map_data$FLGNOCMAX)
if(flg_no_cmax){
flg_no_cmax <- as.logical(as.numeric(map_data$FLGNOCMAX))
if(isTRUE(flg_no_cmax)){
if(!is.null(t_max) && !is.na(t_max) && !is.null(t_last) && !is.na(t_last)){
s_time <- match(t_max, orig_time)+1
e_time <- match(t_last, orig_time)
Expand Down Expand Up @@ -997,7 +997,7 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kelr_opt
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
Expand Down Expand Up @@ -1777,7 +1777,7 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
results_list$data_out <- computation_df
results_list$est_data <- est_data

if(optimize_kel && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
### if("KEL" %in% parameter_list){
### results_list <- list()
Expand Down
18 changes: 9 additions & 9 deletions openNCA/R/run_M1_SS_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1006,12 +1006,12 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
# }
# }
#}
if(optimize_kel && (!"TMAX" %in% parameter_list || !"TLAST" %in% parameter_list || !"CMAX" %in% parameter_list || !"CLAST" %in% parameter_list || !"AUCLAST" %in% parameter_list ||
if(isTRUE(optimize_kel) && (!"TMAX" %in% parameter_list || !"TLAST" %in% parameter_list || !"CMAX" %in% parameter_list || !"CLAST" %in% parameter_list || !"AUCLAST" %in% parameter_list ||
!"FLGACCEPTKELCRIT" %in% names(map_data) || !"FLGEXKEL" %in% names(map_data) || !map_data$FLGEXKEL %in% names(data_data))){
warning("Kel optimization cannot be performed because 'TMAX', 'TLAST', 'CMAX', 'CLAST', 'AUCLAST' are not part of the calulcated parameters AND Flag 'FLGACCEPTKELCRIT' and Flag 'FLGXKEL' are not present in the dataset")
}

if(optimize_kel && "TMAXi" %in% parameter_list && "TLAST" %in% parameter_list && "CMAXi" %in% parameter_list && "CLASTi" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAXi" %in% parameter_list && "TLAST" %in% parameter_list && "CMAXi" %in% parameter_list && "CLASTi" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
kel_flag_optimized <- integer()
}
Expand Down Expand Up @@ -1219,7 +1219,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
if(comp_required[["VZFTAUWi"]]){
vzf_tauw <- list()
}

tmp_df <- data_data[data_data[,map_data$SDEID] == unique(data_data[,map_data$SDEID])[i],]
tmp_df <- tmp_df[order(tmp_df[,map_data$TIME]),]
tmp_df[,map_data$CONC] <- as.numeric(tmp_df[,map_data$CONC])
Expand Down Expand Up @@ -1299,7 +1299,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
if(comp_required[["AUCLAST"]]){
auclast <- auc_last(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME], method = method, exflag = auc_flag, t_last = t_last, t_max = t_max)
}
if(optimize_kel && "TMAXi" %in% parameter_list && "TLAST" %in% parameter_list && "CMAXi" %in% parameter_list && "CLASTi" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAXi" %in% parameter_list && "TLAST" %in% parameter_list && "CMAXi" %in% parameter_list && "CLASTi" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
### 2019-09-04/TGT/
### orig_time <- tmp_df[,map_data$TIME]
Expand All @@ -1308,8 +1308,8 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
tmp_conc <- orig_conc

if("FLGNOCMAX" %in% names(map_data) && (map_data$FLGNOCMAX == 1 || map_data$FLGNOCMAX == 0)){
flg_no_cmax <- as.logical(map_data$FLGNOCMAX)
if(flg_no_cmax){
flg_no_cmax <- as.logical(as.numeric(map_data$FLGNOCMAX))
if(isTRUE(flg_no_cmax)){
if(!is.null(t_max) && !is.na(t_max) && !is.null(t_last) && !is.na(t_last)){
s_time <- match(t_max, orig_time)+1
e_time <- match(t_last, orig_time)
Expand Down Expand Up @@ -1370,7 +1370,6 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
stop("Error in optimize kel")
}

#print("for loop")
selected_idx <- NA
saved_kel_opt <- -1
for(k in 1:length(ulist)){
Expand Down Expand Up @@ -1398,11 +1397,12 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kelr_opt
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}

tmp_kel_flag <- rep(1, length(kel_flag))
tmp_kel_flag[selected_idx] <- 0
kel_flag <- tmp_kel_flag
Expand Down Expand Up @@ -2683,7 +2683,7 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
results_list$data_out <- computation_df
results_list$est_data <- est_data

if(optimize_kel && "TMAXi" %in% parameter_list && "TLAST" %in% parameter_list && "CMAXi" %in% parameter_list && "CLASTi" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAXi" %in% parameter_list && "TLAST" %in% parameter_list && "CMAXi" %in% parameter_list && "CLASTi" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
### if("KEL" %in% parameter_list){
### if("KEL" %in% parameter_list){
Expand Down
12 changes: 6 additions & 6 deletions openNCA/R/run_M2_SD_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -789,13 +789,13 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
# }
# }
#}
if(optimize_kel && (!"TMAX" %in% parameter_list || !"TLAST" %in% parameter_list || !"CMAX" %in% parameter_list || !"CLAST" %in% parameter_list || !"AUCLAST" %in% parameter_list ||
if(isTRUE(optimize_kel) && (!"TMAX" %in% parameter_list || !"TLAST" %in% parameter_list || !"CMAX" %in% parameter_list || !"CLAST" %in% parameter_list || !"AUCLAST" %in% parameter_list ||
!"FLGACCEPTKELCRIT" %in% names(map_data) || !"FLGEXKEL" %in% names(map_data) || !map_data$FLGEXKEL %in% names(data_data))){
### 2019-09-05/TGT/ fixed spelling
### warning("Kel optimization cannot be performed because 'TMAX', 'TLAST', 'CMAX', 'CLAST', 'AUCLAST' are not part of the calulcated parameters AND Flag 'FLGACCEPTKELCRIT' and Flag 'FLGXKEL' are not present in the dataset")
warning("Kel optimization cannot be performed because 'TMAX', 'TLAST', 'CMAX', 'CLAST', 'AUCLAST' are not part of the calculated parameters AND Flag 'FLGACCEPTKELCRIT' and Flag 'FLGXKEL' are not present in the dataset")
}
if(optimize_kel && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
kel_flag_optimized <- integer()
}
Expand Down Expand Up @@ -878,16 +878,16 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
if(comp_required[["AUCLAST"]]) {
auclast <- auc_last(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME], method = method, exflag = auc_flag)
}
if(optimize_kel && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
orig_time <- tmp_df[,map_data$TIME]
orig_conc <- tmp_df[,map_data$CONC]
tmp_time <- orig_time
tmp_conc <- orig_conc

if("FLGNOCMAX" %in% names(map_data) && (map_data$FLGNOCMAX == 1 || map_data$FLGNOCMAX == 0)){
flg_no_cmax <- as.logical(map_data$FLGNOCMAX)
if(flg_no_cmax){
flg_no_cmax <- as.logical(as.numeric(map_data$FLGNOCMAX))
if(isTRUE(flg_no_cmax)){
if(!is.null(t_max) && !is.na(t_max) && !is.null(t_last) && !is.na(t_last)){
s_time <- match(t_max, orig_time)+1
e_time <- match(t_last, orig_time)
Expand Down Expand Up @@ -1734,7 +1734,7 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
results_list$data_out <- computation_df
results_list$est_data <- est_data

if(optimize_kel && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
if(isTRUE(optimize_kel) && "TMAX" %in% parameter_list && "TLAST" %in% parameter_list && "CMAX" %in% parameter_list && "CLAST" %in% parameter_list && "AUCLAST" %in% parameter_list &&
"FLGACCEPTKELCRIT" %in% names(map_data) && "FLGEXKEL" %in% names(map_data) && map_data$FLGEXKEL %in% names(data_data)){
### if("KEL" %in% parameter_list){
### results_list <- list()
Expand Down

0 comments on commit 066fa5d

Please sign in to comment.