Skip to content

Commit

Permalink
Fixed Various Issues
Browse files Browse the repository at this point in the history 
- Fixed Issue with error occuring with ACTUAL time with respect to AET
- Fixed unit conversion for AETAUPT
- Account for additional error case for estimating missing concentration
- Added estimated output to be returned as computation result in certain cases
- Accounted for KEL in FLGACCEPTKEL for OPTIMIZEKEL
- Fixed other minor issues
  • Loading branch information
@opennca
opennca committed Feb 6, 2020
1 parent 6fd6d56 commit a1fb2f9
Show file tree
Hide file tree
Showing 12 changed files with 165 additions and 64 deletions.
4 changes: 2 additions & 2 deletions openNCA/R/aet.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -129,7 +129,7 @@ aet <- function(amt = NULL, time = NULL, t = NULL, orig_time=NULL, all_time=NULL
a_e <- NA
} else {
if(t %in% time) {
if(is.null(all_time) || is.null(end_time)){
if(is.null(all_time) && is.null(end_time)){
tmp_time <- time[time <= t]
if(length(tmp_time) > 0) {
tmp_amt <- amt[1:length(tmp_time)]
Expand All @@ -143,7 +143,7 @@ aet <- function(amt = NULL, time = NULL, t = NULL, orig_time=NULL, all_time=NULL
a_e <- ifelse(a_e == 0, NA, a_e)
}
} else {
tmp_rows <- unlist(sapply(all_time, function(x){ all(x %in% orig_time) }))
tmp_rows <- apply(all_time, 1, function(x) { any(apply(orig_time, 1, function(y){ x %in% y })) })
tmp_end_time <- all_time[tmp_rows,][,2]
tmp_time <- end_time %in% tmp_end_time
tmp_lim <- seq(1:length(tmp_time))[tmp_time]
Expand Down
37 changes: 29 additions & 8 deletions openNCA/R/estimate_missing_concentration.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -85,10 +85,17 @@ estimate_missing_concentration <- function(conc = NULL, time = NULL, interpolate
}
}
} else if(time[1] >= orig_time[length(orig_time)]){
if(!is.na(kel[["KEL"]])){
if(isTRUE(extrapolate)){
conc[1] <- cest(conc = conc, time = time, t_last = time[1], kel = kel[["KEL"]], kelc0 = kel[["KELC0"]])
tmp$INT_EXT[1] <- "EXT"
if(!is.na(kel) && !is.null(kel)){
if(!is.na(kel[["KEL"]])){
if(isTRUE(extrapolate)){
conc[1] <- cest(conc = conc, time = time, t_last = time[1], kel = kel[["KEL"]], kelc0 = kel[["KELC0"]])
tmp$INT_EXT[1] <- "EXT"
}
} else {
if(isTRUE(extrapolate)){
conc[1] <- NA
tmp$INT_EXT[1] <- "EXT"
}
}
} else {
if(isTRUE(extrapolate)){
Expand Down Expand Up @@ -116,10 +123,24 @@ estimate_missing_concentration <- function(conc = NULL, time = NULL, interpolate
}
}
} else {
if(!is.na(kel[["KEL"]])){
if(isTRUE(extrapolate)){
conc[nrow(tmp)] <- cest(conc = conc, time = time, t_last = time[length(time)], kel = kel[["KEL"]], kelc0 = kel[["KELC0"]])
tmp$INT_EXT[nrow(tmp)] <- "EXT"
if(!is.na(kel) && !is.null(kel)){
if(!is.na(kel[["KEL"]])){
if(isTRUE(extrapolate)){
conc[nrow(tmp)] <- cest(conc = conc, time = time, t_last = time[length(time)], kel = kel[["KEL"]], kelc0 = kel[["KELC0"]])
tmp$INT_EXT[nrow(tmp)] <- "EXT"
}
} else {
if(isTRUE(extrapolate)){
min_lim <- orig_time[length(orig_time)] - (orig_time[length(orig_time)] * 0.05)
max_lim <- (orig_time[length(orig_time)] * 0.05) + orig_time[length(orig_time)]
if(min_lim < time[nrow(tmp)] && time[nrow(tmp)] < max_lim){
conc[nrow(tmp)] <- orig_conc[length(orig_conc)]
tmp$INT_EXT[nrow(tmp)] <- "EXT"
} else {
conc[nrow(tmp)] <- NA
tmp$INT_EXT[nrow(tmp)] <- "EXT"
}
}
}
} else {
if(isTRUE(extrapolate)){
Expand Down
19 changes: 14 additions & 5 deletions openNCA/R/run_M1_SD_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1081,7 +1081,9 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1111,15 +1113,22 @@ run_M1_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
17 changes: 13 additions & 4 deletions openNCA/R/run_M1_SS_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1541,7 +1541,9 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1571,15 +1573,22 @@ run_M1_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
21 changes: 15 additions & 6 deletions openNCA/R/run_M2_SD_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -964,10 +964,10 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
obs_c_0 <- c0(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME])

if(comp_required[["DOSEC"]]) {
dose_c <- dosec(data = tmp_df, map = map_data)
dose_c <- dosec(data = tmp_df, map = map_data)
}
if(comp_required[["C0"]]) {
est_c_0 <- est_c0(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME], npts=2, returnall=TRUE)
est_c_0 <- est_c0(conc = tmp_df[,map_data$CONC], time = tmp_df[,map_data$TIME], npts=2, returnall=TRUE)
}
if(comp_required[["V0"]]) {
### v_0 <- v0(c0 = est_c_0$est_c0, dose = unique(tmp_df[,map_data$DOSE1])[1])
Expand Down Expand Up @@ -1070,7 +1070,9 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1100,15 +1102,22 @@ run_M2_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
17 changes: 13 additions & 4 deletions openNCA/R/run_M2_SS_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1457,7 +1457,9 @@ run_M2_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1487,15 +1489,22 @@ run_M2_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
17 changes: 13 additions & 4 deletions openNCA/R/run_M3_SD_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1096,7 +1096,9 @@ run_M3_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1126,15 +1128,22 @@ run_M3_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
17 changes: 13 additions & 4 deletions openNCA/R/run_M3_SS_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1443,7 +1443,9 @@ run_M3_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1473,15 +1475,22 @@ run_M3_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
17 changes: 13 additions & 4 deletions openNCA/R/run_M4_SD_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1121,7 +1121,9 @@ run_M4_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1151,15 +1153,22 @@ run_M4_SD_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down
21 changes: 15 additions & 6 deletions openNCA/R/run_M4_SS_computation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1076,9 +1076,9 @@ run_M4_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
tmp_map <- map_data
tmp_dosevar <- dosevar[!duplicated(dosevar)]
tmp_res <- tmp_df[,c(map_data$SDEID, tmp_dosevar)]
tmp_res$AETAU <- aetau_i[[d]]
tmp_res$AETAU1 <- aetau_i[[d]]
aetau_pt_dose <- unique(unit_conversion(tmp_df, tmp_map, tmp_res, unit_class = "DOSEU", verbose = FALSE)[,tmp_dosevar])[1]
aetau_pt_aetau <- unique(unit_conversion(tmp_df, tmp_map, tmp_res, unit_class = "AMOUNTU", verbose = FALSE)[,"AETAU"])[1]
aetau_pt_aetau <- unique(unit_conversion(tmp_df, tmp_map, tmp_res, unit_class = "AMOUNTU", verbose = FALSE)[,"AETAU1"])[1]
aetau_pt_i[[d]] <- aepct(ae = aetau_pt_aetau, dose = aetau_pt_dose)
}
if(comp_required[["AURCT"]] && (row_len) >= 2) {
Expand Down Expand Up @@ -1310,7 +1310,9 @@ run_M4_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
## } else {
## stop("Error in optimize kel")
## }
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
if(isTRUE("KEL" %in% flag_df$VAR)){
kel_val <- as.numeric(flag_df$CRIT[match("KEL", flag_df$VAR)])
}
kelr_val <- as.numeric(flag_df$CRIT[match("KELRSQ", flag_df$VAR)])
if("AUCXPCTO" %in% flag_df$VAR){
aucxpct <- as.numeric(flag_df$CRIT[match("AUCXPCTO", flag_df$VAR)])
Expand Down Expand Up @@ -1340,15 +1342,22 @@ run_M4_SS_computation <- function(data = NULL, map = NULL, method = 1, model_reg
}

if(!is.na(kelr_opt) && !is.na(aucxpct_opt)){
kel_opt <- ((kel_tmp - kel_val)/(1 - kel_val)) + ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
kel_opt <- ((kelr_opt - kelr_val)/(1 - kelr_val)) + (length(sel_time)/length(tmp_time)) + ((aucxpct - aucxpct_opt)/aucxpct)
} else {
kel_opt <- -1
}

if(!is.na(kel_opt)){
if(kel_opt > saved_kel_opt){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
if(isTRUE("KEL" %in% flag_df$VAR)){
if(kel_tmp > kel_val){
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
} else {
saved_kel_opt <- kel_opt
selected_idx <- match(sel_time, orig_time)
}
}
}
}
Expand Down

0 comments on commit a1fb2f9

Please sign in to comment.