Skip to content

Commit

Permalink
run_nmtran refactor
Browse files Browse the repository at this point in the history
 - use processx instead of `system()`
 - add print options for NMTRAN run
 - improved `compare_nmtran` function
  • Loading branch information
barrettk committed Feb 8, 2024
1 parent 7f61077 commit 7c3d849
Show file tree
Hide file tree
Showing 7 changed files with 153 additions and 44 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -51,6 +51,7 @@ S3method(param_labels,character)
S3method(print,bbi_model)
S3method(print,bbi_nonmem_summary)
S3method(print,bbi_process)
S3method(print,nmtran_process)
S3method(print_model_files,default)
S3method(submit_model,bbi_nonmem_model)
S3method(submit_models,bbi_nonmem_models)
Expand Down
1 change: 1 addition & 0 deletions R/aaa.R
Original file line number Diff line number Diff line change
Expand Up @@ -206,6 +206,7 @@ RUN_LOG_CLASS <- "bbi_run_log_df"
CONF_LOG_CLASS <- "bbi_config_log_df"
SUM_LOG_CLASS <- "bbi_summary_log_df"
LOG_DF_CLASS <- "bbi_log_df"
NMTRAN_PROCESS_CLASS <- "nmtran_process"

# YAML keys that are hard-coded
YAML_YAML_MD5 <- "yaml_md5"
Expand Down
58 changes: 58 additions & 0 deletions R/print.R
Original file line number Diff line number Diff line change
Expand Up @@ -281,6 +281,64 @@ print.bbi_nonmem_summary <- function(x, .digits = 3, .fixed = FALSE, .off_diag =
if (!is.null(.nrow)) cat_line(glue("... {orig_rows - .nrow} more rows"), col = "grey")
}


#' @describeIn print_bbi Prints the `NMTRAN` evaluation of a `bbi_model` model
#' @export
print.nmtran_process <- function(x){

is_valid_print <- function(.x) {
if (!is.null(.x)) {
length(.x) != 0
} else {
FALSE
}
}

heading <- cli_h1
subheading <- cli_h2
bullet_list <- cat_bullet

status <- x[["status"]]
if (x[["status_val"]] == 0) {
status <- col_green(status)
} else {
status <- col_red(status)
}

nm_version <- x[["nonmem_version"]]
if(is.null(nm_version)) nm_version <- "unknown"

heading('Status')
subheading(status)

heading("Absolute Model Path")
bullet_list(x[[ABS_MOD_PATH]])

heading("NMTRAN Specifications")
cli::cli_bullets(
c(
"*" = paste0("NMTRAN Executable: {.path ", x[["nmtran_exe"]], "}"),
"*" = paste0("NONMEM Version: {.val ", nm_version, "}"),
"*" = paste0("Run Directory: {.path ", x[["run_dir"]], "}")
)
)

if (is_valid_print(x[["output_lines"]])) {
heading('Output')
cat_line(style_italic(x[["output_lines"]]))
}

if (is_valid_print(x[["error_lines"]])) {
heading('Additional Errors')
cat_line(style_italic(x[["error_lines"]]))
}

# format and print status string
if (is_valid_print(x[["output_lines"]])) {
cat_line("Process finished.", col = "green")
}

}
#####################
# INTERNAL HELPERS
#####################
Expand Down
103 changes: 68 additions & 35 deletions R/run-nmtran.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,6 @@
#' `bbi.yaml` file in the same directory as the model.
#' @param delete_on_exit Logical. If `FALSE`, don't delete the temporary folder
#' containing the `NMTRAN` run.
#' @param ... additional arguments passed to `system()`
#'
#' @examples
#' \dontrun{
Expand All @@ -25,8 +24,7 @@ run_nmtran <- function(
.mod,
.config_path = NULL,
nmtran_exe = NULL,
delete_on_exit = TRUE,
...
delete_on_exit = TRUE
){
check_model_object(.mod, "bbi_nonmem_model")
nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe)
Expand All @@ -44,7 +42,7 @@ run_nmtran <- function(
}

# copy model and dataset
file.copy(mod_path, temp_folder)
file.copy(mod_path, temp_folder, overwrite = TRUE)
file.copy(data_path, temp_folder)

# overwrite $DATA of new model
Expand All @@ -53,16 +51,19 @@ run_nmtran <- function(
data_path = basename(data_path)
)

# Get command & append the control file name
cmd_args <- paste("<", basename(mod_path))
cmd <- paste(nmtran_exe, cmd_args)

# Run NMTRAN
message(glue("Running NMTRAN with executable: `{nmtran_exe}`"))
if(!is.null(nm_ver)) message(glue("NONMEM version: `{nm_ver}`"))
system_with_dir(cmd, dir = temp_folder, wait = TRUE, ...)
nmtran_results <- c(
list(
nmtran_exe = as.character(nmtran_exe),
nonmem_version = nm_ver,
absolute_model_path = mod_path
),
execute_nmtran(nmtran_exe, mod_path = basename(mod_path), dir = temp_folder)
)

if(isFALSE(delete_on_exit)) return(temp_folder)
# assign class and return
class(nmtran_results) <- c(NMTRAN_PROCESS_CLASS, class(nmtran_results))
return(nmtran_results)
}


Expand Down Expand Up @@ -124,22 +125,46 @@ locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){
}


#' Run a system command in a given directory
#' Execute NMTRAN in a given directory
#'
#' @param cmd System command
#' @param dir Directory in which to execute the command
#' @param ... additional arguments passed to `system()`
#' @param nmtran_exe Path to `NMTRAN` executable.
#' @param mod_path Path of a model to evaluate. Should be relative to `dir`.
#' @param dir Directory in which to execute the command.
#'
#' @noRd
system_with_dir <- function(cmd, args = character(), dir = NULL, ...) {
#' @keywords internal
execute_nmtran <- function(nmtran_exe, mod_path, dir = NULL) {
if(is.null(dir) || !file.exists(dir)) dir <- "."
checkmate::assert_directory_exists(dir)

wd <- getwd()
setwd(dir)
on.exit(setwd(wd))
nmtran.p <- processx::process$new(
command = nmtran_exe, args = mod_path, wd = dir,
stdout = "|", stderr="|", stdin = file.path(dir, mod_path)
)

# Wait till finished for status to be reflective of result
nmtran.p$wait()

system(cmd, ...)
# Assign status
status <- "Not Run"
status_val <- nmtran.p$get_exit_status()
if(status_val == 0){
status <- "NMTRAN successful"
}else if(status_val == 4){
status <- "NMTRAN failed. See errors."
}else{
dev_error("NMTRAN exit status other than 0 or 4")
}

# Tabulate NMTRAN results
nmtran_results <- list(
nmtran_model = nmtran.p$get_input_file(),
run_dir = as.character(fs::path_real(dir)),
status = status, status_val = status_val,
output_lines = nmtran.p$read_all_output_lines(),
error_lines = nmtran.p$read_all_error_lines()
)

return(nmtran_results)
}

#' Get the specified data path from a control stream file
Expand Down Expand Up @@ -290,7 +315,9 @@ compare_nmtran <- function(
return(mod_new)
}

# Run NMTRAN on each model (only message once)
# Remove problem statements from both models to ensure a fair comparison
# If update_model_id was called, this would also change the evaluation,
# though we can't really prevent that.
mod_no_prob <- empty_prob_statement(.mod)
compare_no_prob <- empty_prob_statement(.mod_compare)
on.exit(
Expand All @@ -303,30 +330,36 @@ compare_nmtran <- function(
# Run NMTRAN on each model
nmtran_mod <- run_nmtran(
mod_no_prob, nmtran_exe = nmtran_exe,
delete_on_exit = FALSE, intern = TRUE
delete_on_exit = FALSE
)
nmtran_compare <- run_nmtran(
compare_no_prob, nmtran_exe = nmtran_exe,
delete_on_exit = FALSE, intern = TRUE
) %>% suppressMessages()
delete_on_exit = FALSE
)

# Force delete folders at the end
on.exit(unlink(nmtran_mod, recursive = TRUE, force = TRUE), add = TRUE)
on.exit(unlink(nmtran_compare, recursive = TRUE, force = TRUE), add = TRUE)
on.exit(unlink(nmtran_mod$run_dir, recursive = TRUE, force = TRUE), add = TRUE)
on.exit(unlink(nmtran_compare$run_dir, recursive = TRUE, force = TRUE), add = TRUE)

# Compare FCON files
nmtran_mod_fcon <- file.path(nmtran_mod, "FCON")
nmtran_compare_fcon <- file.path(nmtran_compare, "FCON")
nmtran_mod_fcon <- file.path(nmtran_mod$run_dir, "FCON")
nmtran_compare_fcon <- file.path(nmtran_compare$run_dir, "FCON")
cmd <- paste("cmp", nmtran_mod_fcon, nmtran_compare_fcon)

# Warnings occur when files are different
output <- system_with_dir(cmd, intern = TRUE, input = tempdir()) %>%
suppressWarnings()
# Compare FCON files from each NMTRAN run
.p <- processx::process$new(
command = "cmp", args = c(nmtran_mod_fcon, nmtran_compare_fcon),
stdout = "|", stderr = "|"
)

# Format output
output <- .p$read_all_output_lines()
if(length(output) == 0){
message("\nNo differences found")
cat_line("No differences found", col = "green")
}else{
message("\nModels are not equivalent")
cat_line("Models are not equivalent", col = "red")
output <- gsub(paste0(nmtran_mod_fcon, "|", nmtran_compare_fcon), "", output) %>%
stringr::str_trim()
}

return(output)
Expand Down
19 changes: 19 additions & 0 deletions man/execute_nmtran.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

5 changes: 5 additions & 0 deletions man/print_bbi.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

10 changes: 1 addition & 9 deletions man/run_nmtran.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 7c3d849

Please sign in to comment.