From 74f5aa8c79795aa8e7db72078a5ee0e5f9450255 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 6 Feb 2024 12:44:20 -0500 Subject: [PATCH 01/13] run_nmtran prototype - Searches for NMTRAN executable using `bbi.yaml`, though allows for passing the path directly. - also includes `compare_nmtran` developer tool, which can be useful for comparing different NONMEM control stream configurations (see details of function for an example) --- NAMESPACE | 1 + R/run-nmtran.R | 328 ++++++++++++++++++++++++++++++++++++++++++ man/compare_nmtran.Rd | 41 ++++++ man/run_nmtran.Rd | 32 +++++ 4 files changed, 402 insertions(+) create mode 100644 R/run-nmtran.R create mode 100644 man/compare_nmtran.Rd create mode 100644 man/run_nmtran.Rd diff --git a/NAMESPACE b/NAMESPACE index de5d6fced..e6a1b1c1c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -161,6 +161,7 @@ export(replace_model_field) export(replace_note) export(replace_tag) export(run_log) +export(run_nmtran) export(submit_model) export(submit_models) export(summary_log) diff --git a/R/run-nmtran.R b/R/run-nmtran.R new file mode 100644 index 000000000..84af5111a --- /dev/null +++ b/R/run-nmtran.R @@ -0,0 +1,328 @@ + +#' Run NMTRAN on a model object +#' +#' @param .mod a `bbr` model object +#' @param .config_path Path to a bbi configuration file. If `NULL`, the +#' default, will attempt to use a `bbi.yaml` in the same directory as the +#' model. +#' @param nmtran_exe Path to an `NMTRAN` executable. If `NULL`, will look for a +#' `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()` +#' +#' @export +run_nmtran <- function( + .mod, + .config_path = NULL, + nmtran_exe = NULL, + delete_on_exit = TRUE, + ... +){ + nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe) + nm_ver <- attr(nmtran_exe, "nonmem_version") + + mod_path <- get_model_path(.mod) + data_path <- get_data_path_from_ctl(.mod) + + # make temporary directory in current directory + mod_name <- fs::path_ext_remove(basename(mod_path)) + tempdir0 <- paste0("nmtran_", mod_name, "_", basename(tempdir())) + dir.create(tempdir0) + if(isTRUE(delete_on_exit)){ + on.exit(unlink(tempdir0, recursive = TRUE, force = TRUE)) + } + + # copy model and dataset + file.copy(mod_path, tempdir0) + file.copy(data_path, tempdir0) + + # overwrite $DATA of new model + modify_data_path_ctl( + mod_path = file.path(tempdir0, basename(mod_path)), + data_path = basename(data_path) + ) + + # Get command & append the control file name + cmd <- stringr::str_glue(nmtran_exe, .envir = list(ctl_name = basename(mod_path)), .na = NULL) + cmd <- paste(cmd, "<", basename(mod_path)) + + # Run NMTRAN + if(!is.null(nm_ver)){ + message(glue("Running NMTRAN with NONMEM version `{nm_ver}`")) + } + system_nm(cmd, dir = tempdir0, wait = TRUE, ...) + + if(isFALSE(delete_on_exit)){ + return(tempdir0) + } +} + + +#' Search for and validate existence of an `NMTRAN` executable +#' +#' If `nmtran_exe = NULL`, this will look for a `bbi.yaml` file in the same +#' directory as the model. +#' +#' @inheritParams run_nmtran +#' +#' @noRd +locate_nmtran <- function(.mod, .config_path = NULL, nmtran_exe = NULL){ + + if(is.null(nmtran_exe)){ + model_dir <- get_model_working_directory(.mod) + config_path <- .config_path %||% file.path(model_dir, "bbi.yaml") + + if(!file_exists(config_path)){ + stop(paste("No bbi configuration was found in the execution directory.", + "Please run `bbi_init()` with the appropriate directory to continue.")) + } + + if (!is.null(.config_path)) { + config_path <- normalizePath(.config_path) + } + + bbi_config <- yaml::read_yaml(config_path) + nm_config <- bbi_config$nonmem + + # look for default nonmem installation + default_nm <- purrr::keep(nm_config, function(nm_ver){ + !is.null(nm_ver$default) + }) + + # Set nonmem path + if(length(default_nm) > 0){ + default_nm <- default_nm[[1]] + }else{ + # If no default, use the last one (likely higher version) + default_nm <- nm_config[[length(nm_config)]] + } + + # Set NMTRAN executable path + nm_path <- default_nm$home + nmtran_exe <- file.path(nm_path, "tr", "NMTRAN.exe") + + # If executable found via bbi.yaml, append NONMEM version as attribute + attr(nmtran_exe, "nonmem_version") <- basename(default_nm$home) + } + + if(!file_exists(nmtran_exe)){ + stop(glue("Could not find an NMTRAN executable at `{nmtran_exe}`")) + } + + return(nmtran_exe) +} + + +#' Wrapper for `system()`, meant to allow windows operating systems +#' +#' @param cmd System command +#' @param ... additional arguments passed to `system()` or `shell()` +#' +#' @noRd +system_nm_default <- function(cmd, ...) { + if (.Platform$OS.type == "windows") { + local_env_vars <- Sys.getenv() + stdout_unit_vars <- local_env_vars[grepl("STDOUT_UNIT|STDERR_UNIT", names(local_env_vars))] + for (i in seq_along(stdout_unit_vars)) { + Sys.unsetenv(names(stdout_unit_vars)[i]) + } + on.exit({ + if (length(stdout_unit_vars) > 0) { + do.call(Sys.setenv, as.list(stdout_unit_vars)) + } + }) + args <- list(...) + if (!"wait" %in% names(args)) wait <- FALSE else wait <- args$wait + if (wait == FALSE) { + shell(paste("START CMD /C", cmd), ...) + } else { + shell(cmd, ...) + } + } else { + system(cmd, ...) + } +} + +#' Run a system command in a given directory +#' +#' @inheritParams system_nm_default +#' @param dir Directory in which to execute the command +#' +#' @noRd +system_nm <- function(cmd, dir = NULL, ...) { + if (is.null(dir) || !file.exists(dir)) dir <- "." + if (file.exists(dir)) { + currentwd <- getwd() + setwd(dir) + on.exit(setwd(currentwd)) + } else { + stop(paste0("Directory \"", dir, "\" doesn't exist.")) + } + + system_nm_default(cmd, ...) +} + +#' Get the specified data path from a control stream file +#' +#' @param .mod a `bbr` model object +#' +#' @noRd +get_data_path_from_ctl <- function(.mod){ + mod_path <- get_model_path(.mod) + ctl <- nmrec::read_ctl(mod_path) + data_rec <- nmrec::select_records(ctl, "data")[[1]] + data_path <- nmrec::get_record_option(data_rec, "filename")$value + + data_path_norm <- fs::path_norm(file.path(mod_path, data_path)) + + if(!fs::file_exists(data_path_norm)){ + stop(glue("Could not find data at {data_path_norm}")) + } + + return(data_path_norm) +} + +#' Modify the specified data path in a control stream file +#' @param mod_path Path to a control stream file +#' @param data_path Data path to set in a `$DATA` record. +#' +#' @noRd +modify_data_path_ctl <- function(mod_path, data_path){ + # Get data record + ctl <- nmrec::read_ctl(mod_path) + data_rec <- nmrec::select_records(ctl, "data")[[1]] + data_rec$parse() + + # Overwrite 'filename' option + # TODO: confirm this works with .mod extensions + data_rec$values <- purrr::map(data_rec$values, function(data_opt){ + if(inherits(data_opt, "nmrec_option_pos") && data_opt$name == "filename"){ + data_opt$value <- data_path + } + data_opt + }) + + # Write out modified ctl + nmrec::write_ctl(ctl, mod_path) +} + + + +#' Runs `run_nmtran` on two models, and compares the output +#' +#' Developer tool for comparing different NONMEM control stream configurations. +#' +#' @details +#' Say you wanted to test whether diagonal matrices could specify standard +#' deviation for one value, and variance for another +#' +#' The **reference model** would have this block: +#' ```r +#' $OMEGA +#' 0.05 STANDARD ; iiv CL +#' 0.2 ; iiv V2 +#' ``` +#' +#' The **new model** would have this block: +#' ```r +#' $OMEGA +#' 0.05 STANDARD ; iiv CL +#' 0.2 VAR ; iiv V2 +#' ``` +#' +#' Comparing the two (see below), we find no differences. This means that adding +#' `VAR` to the second ETA value had no impact, and the two models would evaluate +#' the same. +#' ```r +#' > compare_nmtran(MOD1, MOD_COMPARE) +#' Running NMTRAN with NONMEM version `nm75` +#' +#' No differences found +#' character(0) +#' ``` +#' +#' @keywords internal +compare_nmtran <- function( + .mod, + .mod_compare, + .config_path = NULL, + nmtran_exe = NULL +){ + nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe) + nmtran_exe2 <- locate_nmtran(.mod_compare, .config_path, nmtran_exe) + if(nmtran_exe != nmtran_exe2){ + rlang::warn( + c( + "!" = "Found two separate NMTRAN executables:", + " " = paste("-", nmtran_exe), + " " = paste("-", nmtran_exe2), + "i" = "Defaulting to the first one" + ) + ) + } + + # This function is used to remove problem statement differences introduced + # via `copy_model_from()` + empty_prob_statement <- function(.mod){ + mod_new <- copy_model_from(.mod, paste0(get_model_id(.mod), "_no_prob")) + mod_path <- get_model_path(mod_new) + ctl <- nmrec::read_ctl(mod_path) + prob_rec <- nmrec::select_records(ctl, "prob")[[1]] + prob_rec$parse() + + # Overwrite 'text' option + prob_rec$values <- purrr::map(prob_rec$values, function(prob_rec){ + if(inherits(prob_rec, "nmrec_option_pos") && prob_rec$name == "text"){ + prob_rec$value <- "" + } + prob_rec + }) + + # Write out modified ctl + nmrec::write_ctl(ctl, mod_path) + return(mod_new) + } + + # Run NMTRAN on each model (only message once) + mod_no_prob <- empty_prob_statement(.mod) + compare_no_prob <- empty_prob_statement(.mod_compare) + on.exit( + delete_models( + list(mod_no_prob, compare_no_prob), .tags = NULL, .force = TRUE + ) %>% suppressMessages(), + add = TRUE + ) + + # Run NMTRAN on each model + nmtran_mod <- run_nmtran( + mod_no_prob, + delete_on_exit = FALSE, intern = TRUE + ) + nmtran_compare <- run_nmtran( + compare_no_prob, + delete_on_exit = FALSE, intern = TRUE + ) %>% suppressMessages() + + # 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) + + # Compare FCON files + nmtran_mod_fcon <- file.path(nmtran_mod, "FCON") + nmtran_compare_fcon <- file.path(nmtran_compare, "FCON") + cmd <- paste("cmp", nmtran_mod_fcon, nmtran_compare_fcon) + + # Warnings occur when files are different + output <- system_nm(cmd, intern = TRUE, input = tempdir()) %>% + suppressWarnings() + + if(length(output) == 0){ + message("\nNo differences found") + }else{ + message("\nModels are not equivalent") + } + + return(output) +} + diff --git a/man/compare_nmtran.Rd b/man/compare_nmtran.Rd new file mode 100644 index 000000000..e2485ee75 --- /dev/null +++ b/man/compare_nmtran.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run-nmtran.R +\name{compare_nmtran} +\alias{compare_nmtran} +\title{Runs \code{run_nmtran} on two models, and compares the output} +\usage{ +compare_nmtran(.mod, .mod_compare, .config_path = NULL, nmtran_exe = NULL) +} +\description{ +Developer tool for comparing different NONMEM control stream configurations. +} +\details{ +Say you wanted to test whether diagonal matrices could specify standard +deviation for one value, and variance for another + +The \strong{reference model} would have this block: + +\if{html}{\out{
}}\preformatted{$OMEGA +0.05 STANDARD ; iiv CL +0.2 ; iiv V2 +}\if{html}{\out{
}} + +The \strong{new model} would have this block: + +\if{html}{\out{
}}\preformatted{$OMEGA +0.05 STANDARD ; iiv CL +0.2 VAR ; iiv V2 +}\if{html}{\out{
}} + +Comparing the two (see below), we find no differences. This means that adding +\code{VAR} to the second ETA value had no impact, and the two models would evaluate +the same. + +\if{html}{\out{
}}\preformatted{> compare_nmtran(MOD1, MOD_COMPARE) +Running NMTRAN with NONMEM version `nm75` + +No differences found +character(0) +}\if{html}{\out{
}} +} +\keyword{internal} diff --git a/man/run_nmtran.Rd b/man/run_nmtran.Rd new file mode 100644 index 000000000..7f9b47d38 --- /dev/null +++ b/man/run_nmtran.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run-nmtran.R +\name{run_nmtran} +\alias{run_nmtran} +\title{Run NMTRAN on a model object} +\usage{ +run_nmtran( + .mod, + .config_path = NULL, + nmtran_exe = NULL, + delete_on_exit = TRUE, + ... +) +} +\arguments{ +\item{.mod}{a \code{bbr} model object} + +\item{.config_path}{Path to a bbi configuration file. If \code{NULL}, the +default, will attempt to use a \code{bbi.yaml} in the same directory as the +model.} + +\item{nmtran_exe}{Path to an \code{NMTRAN} executable. If \code{NULL}, will look for a +\code{bbi.yaml} file in the same directory as the model.} + +\item{delete_on_exit}{Logical. If \code{FALSE}, don't delete the temporary folder +containing the \code{NMTRAN} run.} + +\item{...}{additional arguments passed to \code{system()}} +} +\description{ +Run NMTRAN on a model object +} From 59571f5d0a84eaaefed52d7e614ce0c2ee38bce6 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 6 Feb 2024 13:03:20 -0500 Subject: [PATCH 02/13] add notes to helper functions taken from NMproject --- R/run-nmtran.R | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 84af5111a..3f8e605bd 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -119,6 +119,9 @@ locate_nmtran <- function(.mod, .config_path = NULL, nmtran_exe = NULL){ #' @param cmd System command #' @param ... additional arguments passed to `system()` or `shell()` #' +#' @details +#' Taken from `NMproject` +#' #' @noRd system_nm_default <- function(cmd, ...) { if (.Platform$OS.type == "windows") { @@ -146,6 +149,9 @@ system_nm_default <- function(cmd, ...) { #' Run a system command in a given directory #' +#' @details +#' Taken from `NMproject` +#' #' @inheritParams system_nm_default #' @param dir Directory in which to execute the command #' From 969b896cc71bc8706bd59dc0a8efcf862bb38aef Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 6 Feb 2024 13:09:13 -0500 Subject: [PATCH 03/13] fix: simplify NMTRAN command - dont need to evaluate it within a different environment --- R/run-nmtran.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 3f8e605bd..bd407f83c 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -44,8 +44,7 @@ run_nmtran <- function( ) # Get command & append the control file name - cmd <- stringr::str_glue(nmtran_exe, .envir = list(ctl_name = basename(mod_path)), .na = NULL) - cmd <- paste(cmd, "<", basename(mod_path)) + cmd <- paste(nmtran_exe, "<", basename(mod_path)) # Run NMTRAN if(!is.null(nm_ver)){ From ac5de3f04bb12762d10fe669e59b41bb67cb71d1 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 6 Feb 2024 13:32:16 -0500 Subject: [PATCH 04/13] bug fix and add examples --- R/run-nmtran.R | 63 +++++++++++++++++++++++++++++++++---------- man/compare_nmtran.Rd | 24 +++++++++++++++-- man/run_nmtran.Rd | 12 ++++++++- 3 files changed, 82 insertions(+), 17 deletions(-) diff --git a/R/run-nmtran.R b/R/run-nmtran.R index bd407f83c..222de1a97 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -9,7 +9,16 @@ #' `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()` +#' @param ... additional arguments passed to `system()` (`shell()` for windows). +#' +#' @examples +#' \dontrun{ +#' mod <- read_model(file.path(MODEL_DIR, 1)) +#' run_nmtran(mod) +#' +#' # Set the path to an NMTRAN executable +#' run_nmtran(mod, nmtran_exe = "/opt/NONMEM/nm75/tr/NMTRAN.exe") +#' } #' #' @export run_nmtran <- function( @@ -19,6 +28,7 @@ run_nmtran <- function( delete_on_exit = TRUE, ... ){ + check_model_object(.mod, "bbi_nonmem_model") nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe) nm_ver <- attr(nmtran_exe, "nonmem_version") @@ -47,14 +57,11 @@ run_nmtran <- function( cmd <- paste(nmtran_exe, "<", basename(mod_path)) # Run NMTRAN - if(!is.null(nm_ver)){ - message(glue("Running NMTRAN with NONMEM version `{nm_ver}`")) - } + message(glue("Running NMTRAN with executable: `{nmtran_exe}`")) + if(!is.null(nm_ver)) message(glue("NONMEM version: `{nm_ver}`")) system_nm(cmd, dir = tempdir0, wait = TRUE, ...) - if(isFALSE(delete_on_exit)){ - return(tempdir0) - } + if(isFALSE(delete_on_exit)) return(tempdir0) } @@ -66,9 +73,10 @@ run_nmtran <- function( #' @inheritParams run_nmtran #' #' @noRd -locate_nmtran <- function(.mod, .config_path = NULL, nmtran_exe = NULL){ +locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ if(is.null(nmtran_exe)){ + check_model_object(.mod, "bbi_nonmem_model") model_dir <- get_model_working_directory(.mod) config_path <- .config_path %||% file.path(model_dir, "bbi.yaml") @@ -174,11 +182,13 @@ system_nm <- function(cmd, dir = NULL, ...) { #' #' @noRd get_data_path_from_ctl <- function(.mod){ + check_model_object(.mod, "bbi_nonmem_model") mod_path <- get_model_path(.mod) ctl <- nmrec::read_ctl(mod_path) + + # Get data record data_rec <- nmrec::select_records(ctl, "data")[[1]] data_path <- nmrec::get_record_option(data_rec, "filename")$value - data_path_norm <- fs::path_norm(file.path(mod_path, data_path)) if(!fs::file_exists(data_path_norm)){ @@ -189,11 +199,14 @@ get_data_path_from_ctl <- function(.mod){ } #' Modify the specified data path in a control stream file + #' @param mod_path Path to a control stream file #' @param data_path Data path to set in a `$DATA` record. #' #' @noRd modify_data_path_ctl <- function(mod_path, data_path){ + checkmate::assert_file_exists(mod_path) + # Get data record ctl <- nmrec::read_ctl(mod_path) data_rec <- nmrec::select_records(ctl, "data")[[1]] @@ -213,10 +226,10 @@ modify_data_path_ctl <- function(mod_path, data_path){ } - -#' Runs `run_nmtran` on two models, and compares the output +#' Compare different NONMEM control stream configurations. #' -#' Developer tool for comparing different NONMEM control stream configurations. +#' Runs `run_nmtran()` on two models and compares the output, denoting whether +#' they evaluate to the same model via `NMTRAN`. #' #' @details #' Say you wanted to test whether diagonal matrices could specify standard @@ -247,6 +260,24 @@ modify_data_path_ctl <- function(mod_path, data_path){ #' character(0) #' ``` #' +#' @examples +#' \dontrun{ +#' # Starting model - set a reference +#' open_model_file(MOD1) +#' +#' # Make new model +#' MOD_COMPARE <- copy_model_from(MOD1) +#' +#' # Make a change +#' open_model_file(MOD_COMPARE) +#' +#' # Compare NMTRAN evaluation +#' compare_nmtran(MOD1, MOD_COMPARE) +#' +#' # delete new model at the end +#' delete_models(MOD_COMPARE, .tags = NULL, .force = TRUE) +#' } +#' #' @keywords internal compare_nmtran <- function( .mod, @@ -254,8 +285,12 @@ compare_nmtran <- function( .config_path = NULL, nmtran_exe = NULL ){ + # Set NMTRAN executable nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe) nmtran_exe2 <- locate_nmtran(.mod_compare, .config_path, nmtran_exe) + + # This would only happen when comparing two models in different working + # directories, where the `bbi.yaml` defaults differ. if(nmtran_exe != nmtran_exe2){ rlang::warn( c( @@ -301,11 +336,11 @@ compare_nmtran <- function( # Run NMTRAN on each model nmtran_mod <- run_nmtran( - mod_no_prob, + mod_no_prob, nmtran_exe = nmtran_exe, delete_on_exit = FALSE, intern = TRUE ) nmtran_compare <- run_nmtran( - compare_no_prob, + compare_no_prob, nmtran_exe = nmtran_exe, delete_on_exit = FALSE, intern = TRUE ) %>% suppressMessages() diff --git a/man/compare_nmtran.Rd b/man/compare_nmtran.Rd index e2485ee75..03dbd3354 100644 --- a/man/compare_nmtran.Rd +++ b/man/compare_nmtran.Rd @@ -2,12 +2,13 @@ % Please edit documentation in R/run-nmtran.R \name{compare_nmtran} \alias{compare_nmtran} -\title{Runs \code{run_nmtran} on two models, and compares the output} +\title{Compare different NONMEM control stream configurations.} \usage{ compare_nmtran(.mod, .mod_compare, .config_path = NULL, nmtran_exe = NULL) } \description{ -Developer tool for comparing different NONMEM control stream configurations. +Runs \code{run_nmtran()} on two models and compares the output, denoting whether +they evaluate to the same model via \code{NMTRAN}. } \details{ Say you wanted to test whether diagonal matrices could specify standard @@ -37,5 +38,24 @@ Running NMTRAN with NONMEM version `nm75` No differences found character(0) }\if{html}{\out{}} +} +\examples{ +\dontrun{ +# Starting model - set a reference +open_model_file(MOD1) + +# Make new model +MOD_COMPARE <- copy_model_from(MOD1) + +# Make a change +open_model_file(MOD_COMPARE) + +# Compare NMTRAN evaluation +compare_nmtran(MOD1, MOD_COMPARE) + +# delete new model at the end +delete_models(MOD_COMPARE, .tags = NULL, .force = TRUE) +} + } \keyword{internal} diff --git a/man/run_nmtran.Rd b/man/run_nmtran.Rd index 7f9b47d38..84f7c50a4 100644 --- a/man/run_nmtran.Rd +++ b/man/run_nmtran.Rd @@ -25,8 +25,18 @@ model.} \item{delete_on_exit}{Logical. If \code{FALSE}, don't delete the temporary folder containing the \code{NMTRAN} run.} -\item{...}{additional arguments passed to \code{system()}} +\item{...}{additional arguments passed to \code{system()} (\code{shell()} for windows).} } \description{ Run NMTRAN on a model object } +\examples{ +\dontrun{ +mod <- read_model(file.path(MODEL_DIR, 1)) +run_nmtran(mod) + +# Set the path to an NMTRAN executable +run_nmtran(mod, nmtran_exe = "/opt/NONMEM/nm75/tr/NMTRAN.exe") +} + +} From 74e0ae0271bf86aa30980245d4e7af9c3f95af9e Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 6 Feb 2024 13:45:16 -0500 Subject: [PATCH 05/13] Simplify system commands - this likely makes windows unsupported --- R/run-nmtran.R | 56 ++++++++++------------------------------------- man/run_nmtran.Rd | 2 +- 2 files changed, 12 insertions(+), 46 deletions(-) diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 222de1a97..d6263e1ac 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -9,7 +9,7 @@ #' `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()` (`shell()` for windows). +#' @param ... additional arguments passed to `system()` #' #' @examples #' \dontrun{ @@ -59,7 +59,7 @@ run_nmtran <- function( # Run NMTRAN message(glue("Running NMTRAN with executable: `{nmtran_exe}`")) if(!is.null(nm_ver)) message(glue("NONMEM version: `{nm_ver}`")) - system_nm(cmd, dir = tempdir0, wait = TRUE, ...) + system_with_dir(cmd, dir = tempdir0, wait = TRUE, ...) if(isFALSE(delete_on_exit)) return(tempdir0) } @@ -121,59 +121,25 @@ locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ } -#' Wrapper for `system()`, meant to allow windows operating systems -#' -#' @param cmd System command -#' @param ... additional arguments passed to `system()` or `shell()` -#' -#' @details -#' Taken from `NMproject` -#' -#' @noRd -system_nm_default <- function(cmd, ...) { - if (.Platform$OS.type == "windows") { - local_env_vars <- Sys.getenv() - stdout_unit_vars <- local_env_vars[grepl("STDOUT_UNIT|STDERR_UNIT", names(local_env_vars))] - for (i in seq_along(stdout_unit_vars)) { - Sys.unsetenv(names(stdout_unit_vars)[i]) - } - on.exit({ - if (length(stdout_unit_vars) > 0) { - do.call(Sys.setenv, as.list(stdout_unit_vars)) - } - }) - args <- list(...) - if (!"wait" %in% names(args)) wait <- FALSE else wait <- args$wait - if (wait == FALSE) { - shell(paste("START CMD /C", cmd), ...) - } else { - shell(cmd, ...) - } - } else { - system(cmd, ...) - } -} - #' Run a system command in a given directory #' -#' @details -#' Taken from `NMproject` -#' -#' @inheritParams system_nm_default +#' @param cmd System command #' @param dir Directory in which to execute the command +#' @param ... additional arguments passed to `system()` #' #' @noRd -system_nm <- function(cmd, dir = NULL, ...) { +system_with_dir <- function(cmd, dir = NULL, ...) { if (is.null(dir) || !file.exists(dir)) dir <- "." + if (file.exists(dir)) { - currentwd <- getwd() + wd <- getwd() setwd(dir) - on.exit(setwd(currentwd)) + on.exit(setwd(wd)) } else { - stop(paste0("Directory \"", dir, "\" doesn't exist.")) + stop(glue("Directory `{dir}` doesn't exist.")) } - system_nm_default(cmd, ...) + system(cmd, ...) } #' Get the specified data path from a control stream file @@ -354,7 +320,7 @@ compare_nmtran <- function( cmd <- paste("cmp", nmtran_mod_fcon, nmtran_compare_fcon) # Warnings occur when files are different - output <- system_nm(cmd, intern = TRUE, input = tempdir()) %>% + output <- system_with_dir(cmd, intern = TRUE, input = tempdir()) %>% suppressWarnings() if(length(output) == 0){ diff --git a/man/run_nmtran.Rd b/man/run_nmtran.Rd index 84f7c50a4..9e2d48453 100644 --- a/man/run_nmtran.Rd +++ b/man/run_nmtran.Rd @@ -25,7 +25,7 @@ model.} \item{delete_on_exit}{Logical. If \code{FALSE}, don't delete the temporary folder containing the \code{NMTRAN} run.} -\item{...}{additional arguments passed to \code{system()} (\code{shell()} for windows).} +\item{...}{additional arguments passed to \code{system()}} } \description{ Run NMTRAN on a model object From f51124bd06985e0b63d41f24f274caaeedbf4da1 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 6 Feb 2024 15:43:46 -0500 Subject: [PATCH 06/13] slight refactor of system process - did a lot of testing with processx, but wasnt able to get the command to work due to the function's insistence on quoting the arguements. --- R/run-nmtran.R | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) diff --git a/R/run-nmtran.R b/R/run-nmtran.R index d6263e1ac..aa0f95ef4 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -37,31 +37,32 @@ run_nmtran <- function( # make temporary directory in current directory mod_name <- fs::path_ext_remove(basename(mod_path)) - tempdir0 <- paste0("nmtran_", mod_name, "_", basename(tempdir())) - dir.create(tempdir0) + temp_folder <- paste0("nmtran_", mod_name, "_", basename(tempdir())) + dir.create(temp_folder) if(isTRUE(delete_on_exit)){ - on.exit(unlink(tempdir0, recursive = TRUE, force = TRUE)) + on.exit(unlink(temp_folder, recursive = TRUE, force = TRUE)) } # copy model and dataset - file.copy(mod_path, tempdir0) - file.copy(data_path, tempdir0) + file.copy(mod_path, temp_folder) + file.copy(data_path, temp_folder) # overwrite $DATA of new model modify_data_path_ctl( - mod_path = file.path(tempdir0, basename(mod_path)), + mod_path = file.path(temp_folder, basename(mod_path)), data_path = basename(data_path) ) # Get command & append the control file name - cmd <- paste(nmtran_exe, "<", basename(mod_path)) + 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 = tempdir0, wait = TRUE, ...) + system_with_dir(cmd, dir = temp_folder, wait = TRUE, ...) - if(isFALSE(delete_on_exit)) return(tempdir0) + if(isFALSE(delete_on_exit)) return(temp_folder) } @@ -85,7 +86,7 @@ locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ "Please run `bbi_init()` with the appropriate directory to continue.")) } - if (!is.null(.config_path)) { + if(!is.null(.config_path)){ config_path <- normalizePath(.config_path) } @@ -107,6 +108,8 @@ locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ # Set NMTRAN executable path nm_path <- default_nm$home + # TODO: should we recursively look for this executable, or assume Metworx? + # i.e. can we assume NMTRAN is in a `tr` folder, and is called `NMTRAN.exe`? nmtran_exe <- file.path(nm_path, "tr", "NMTRAN.exe") # If executable found via bbi.yaml, append NONMEM version as attribute @@ -128,16 +131,13 @@ locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ #' @param ... additional arguments passed to `system()` #' #' @noRd -system_with_dir <- function(cmd, dir = NULL, ...) { - if (is.null(dir) || !file.exists(dir)) dir <- "." - - if (file.exists(dir)) { - wd <- getwd() - setwd(dir) - on.exit(setwd(wd)) - } else { - stop(glue("Directory `{dir}` doesn't exist.")) - } +system_with_dir <- function(cmd, args = character(), dir = NULL, ...) { + if(is.null(dir) || !file.exists(dir)) dir <- "." + checkmate::assert_directory_exists(dir) + + wd <- getwd() + setwd(dir) + on.exit(setwd(wd)) system(cmd, ...) } From ed641fecf47b9d239dd8b85bcaba1944ad3c06db Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Wed, 7 Feb 2024 15:00:26 -0500 Subject: [PATCH 07/13] run_nmtran refactor - use processx instead of `system()` - add print options for NMTRAN run - improved `compare_nmtran` function --- NAMESPACE | 1 + R/aaa.R | 1 + R/print.R | 58 ++++++++++++++++++++++++ R/run-nmtran.R | 103 ++++++++++++++++++++++++++++-------------- man/execute_nmtran.Rd | 19 ++++++++ man/print_bbi.Rd | 5 ++ man/run_nmtran.Rd | 10 +--- 7 files changed, 153 insertions(+), 44 deletions(-) create mode 100644 man/execute_nmtran.Rd diff --git a/NAMESPACE b/NAMESPACE index e6a1b1c1c..5455d96dd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -55,6 +55,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) diff --git a/R/aaa.R b/R/aaa.R index f1ed08a11..ebbf280f0 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -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" diff --git a/R/print.R b/R/print.R index 9027462e3..439e4a93d 100644 --- a/R/print.R +++ b/R/print.R @@ -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 ##################### diff --git a/R/run-nmtran.R b/R/run-nmtran.R index aa0f95ef4..4d4e85e66 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -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{ @@ -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) @@ -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 @@ -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) } @@ -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 @@ -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( @@ -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) diff --git a/man/execute_nmtran.Rd b/man/execute_nmtran.Rd new file mode 100644 index 000000000..50d578dfb --- /dev/null +++ b/man/execute_nmtran.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run-nmtran.R +\name{execute_nmtran} +\alias{execute_nmtran} +\title{Execute NMTRAN in a given directory} +\usage{ +execute_nmtran(nmtran_exe, mod_path, dir = NULL) +} +\arguments{ +\item{nmtran_exe}{Path to \code{NMTRAN} executable.} + +\item{mod_path}{Path of a model to evaluate. Should be relative to \code{dir}.} + +\item{dir}{Directory in which to execute the command.} +} +\description{ +Execute NMTRAN in a given directory +} +\keyword{internal} diff --git a/man/print_bbi.Rd b/man/print_bbi.Rd index 53843ccf7..614c56d23 100644 --- a/man/print_bbi.Rd +++ b/man/print_bbi.Rd @@ -5,6 +5,7 @@ \alias{print.bbi_process} \alias{print.bbi_model} \alias{print.bbi_nonmem_summary} +\alias{print.nmtran_process} \title{Print methods for bbr objects} \usage{ \method{print}{bbi_process}(x, ..., .call_limit = 250) @@ -12,6 +13,8 @@ \method{print}{bbi_model}(x, ...) \method{print}{bbi_nonmem_summary}(x, .digits = 3, .fixed = FALSE, .off_diag = FALSE, .nrow = NULL, ...) + +\method{print}{nmtran_process}(x) } \arguments{ \item{x}{Object to format or print.} @@ -47,4 +50,6 @@ will make for prettier formatting, especially of table outputs. \item \code{print(bbi_nonmem_summary)}: Prints a high level summary of a model from a bbi_nonmem_summary object +\item \code{print(nmtran_process)}: Prints the \code{NMTRAN} evaluation of a \code{bbi_model} model + }} diff --git a/man/run_nmtran.Rd b/man/run_nmtran.Rd index 9e2d48453..f6e71ea73 100644 --- a/man/run_nmtran.Rd +++ b/man/run_nmtran.Rd @@ -4,13 +4,7 @@ \alias{run_nmtran} \title{Run NMTRAN on a model object} \usage{ -run_nmtran( - .mod, - .config_path = NULL, - nmtran_exe = NULL, - delete_on_exit = TRUE, - ... -) +run_nmtran(.mod, .config_path = NULL, nmtran_exe = NULL, delete_on_exit = TRUE) } \arguments{ \item{.mod}{a \code{bbr} model object} @@ -24,8 +18,6 @@ model.} \item{delete_on_exit}{Logical. If \code{FALSE}, don't delete the temporary folder containing the \code{NMTRAN} run.} - -\item{...}{additional arguments passed to \code{system()}} } \description{ Run NMTRAN on a model object From 5c02bdb5c43f68528f08305b51dba3dbed7489fc Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Thu, 8 Feb 2024 15:37:42 -0500 Subject: [PATCH 08/13] fix print method and add handling for .mod extensions --- R/print.R | 2 +- R/run-nmtran.R | 6 ++++++ man/print_bbi.Rd | 2 +- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/print.R b/R/print.R index 439e4a93d..8fa05e204 100644 --- a/R/print.R +++ b/R/print.R @@ -284,7 +284,7 @@ print.bbi_nonmem_summary <- function(x, .digits = 3, .fixed = FALSE, .off_diag = #' @describeIn print_bbi Prints the `NMTRAN` evaluation of a `bbi_model` model #' @export -print.nmtran_process <- function(x){ +print.nmtran_process <- function(x, ...){ is_valid_print <- function(.x) { if (!is.null(.x)) { diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 4d4e85e66..34013bf21 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -180,6 +180,12 @@ get_data_path_from_ctl <- function(.mod){ # Get data record data_rec <- nmrec::select_records(ctl, "data")[[1]] data_path <- nmrec::get_record_option(data_rec, "filename")$value + + # Handling for `.mod` extensions + if(grepl("(?i)mod", fs::path_ext(mod_path))){ + data_path <- file.path("..", data_path) + } + data_path_norm <- fs::path_norm(file.path(mod_path, data_path)) if(!fs::file_exists(data_path_norm)){ diff --git a/man/print_bbi.Rd b/man/print_bbi.Rd index 614c56d23..3fb2753c1 100644 --- a/man/print_bbi.Rd +++ b/man/print_bbi.Rd @@ -14,7 +14,7 @@ \method{print}{bbi_nonmem_summary}(x, .digits = 3, .fixed = FALSE, .off_diag = FALSE, .nrow = NULL, ...) -\method{print}{nmtran_process}(x) +\method{print}{nmtran_process}(x, ...) } \arguments{ \item{x}{Object to format or print.} From 5837fd2c7823d6a8cafb7df2181b431a3476a8a6 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 13 Feb 2024 11:37:43 -0500 Subject: [PATCH 09/13] update handling of data paths processes from control stream files --- R/run-nmtran.R | 44 ++++++++++++++++++++++++++++++-------------- man/locate_nmtran.Rd | 23 +++++++++++++++++++++++ 2 files changed, 53 insertions(+), 14 deletions(-) create mode 100644 man/locate_nmtran.Rd diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 34013bf21..317b006b4 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -41,15 +41,19 @@ run_nmtran <- function( on.exit(unlink(temp_folder, recursive = TRUE, force = TRUE)) } - # copy model and dataset + # Copy model file.copy(mod_path, temp_folder, overwrite = TRUE) - file.copy(data_path, temp_folder) - # overwrite $DATA of new model - modify_data_path_ctl( - mod_path = file.path(temp_folder, basename(mod_path)), - data_path = basename(data_path) - ) + # Copy dataset & overwrite $DATA record of new model + # NMTRAN will error if data cannot be found + if(fs::file_exists(data_path)){ + file.copy(data_path, temp_folder, overwrite = TRUE) + # overwrite $DATA record of new model + modify_data_path_ctl( + mod_path = file.path(temp_folder, basename(mod_path)), + data_path = basename(data_path) + ) + } # Run NMTRAN nmtran_results <- c( @@ -74,17 +78,23 @@ run_nmtran <- function( #' #' @inheritParams run_nmtran #' -#' @noRd +#' @keywords internal locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ if(is.null(nmtran_exe)){ - check_model_object(.mod, "bbi_nonmem_model") - model_dir <- get_model_working_directory(.mod) + if(!is.null(.mod)){ + check_model_object(.mod, "bbi_nonmem_model") + model_dir <- get_model_working_directory(.mod) + } config_path <- .config_path %||% file.path(model_dir, "bbi.yaml") if(!file_exists(config_path)){ - stop(paste("No bbi configuration was found in the execution directory.", - "Please run `bbi_init()` with the appropriate directory to continue.")) + rlang::abort( + c( + "x" = "No bbi configuration was found in the execution directory.", + "i" = "Please run `bbi_init()` with the appropriate directory to continue." + ) + ) } if(!is.null(.config_path)){ @@ -189,10 +199,16 @@ get_data_path_from_ctl <- function(.mod){ data_path_norm <- fs::path_norm(file.path(mod_path, data_path)) if(!fs::file_exists(data_path_norm)){ - stop(glue("Could not find data at {data_path_norm}")) + # The first error message line is what NMTRAN would return in this situation + rlang::warn( + c( + "x" = "Input data file does not exist or cannot be opened", + "i" = glue("Referenced input data path: {data_path_norm}") + ) + ) } - return(data_path_norm) + return(as.character(data_path_norm)) } #' Modify the specified data path in a control stream file diff --git a/man/locate_nmtran.Rd b/man/locate_nmtran.Rd new file mode 100644 index 000000000..a1aeb3571 --- /dev/null +++ b/man/locate_nmtran.Rd @@ -0,0 +1,23 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/run-nmtran.R +\name{locate_nmtran} +\alias{locate_nmtran} +\title{Search for and validate existence of an \code{NMTRAN} executable} +\usage{ +locate_nmtran(.mod = NULL, .config_path = NULL, nmtran_exe = NULL) +} +\arguments{ +\item{.mod}{a \code{bbr} model object} + +\item{.config_path}{Path to a bbi configuration file. If \code{NULL}, the +default, will attempt to use a \code{bbi.yaml} in the same directory as the +model.} + +\item{nmtran_exe}{Path to an \code{NMTRAN} executable. If \code{NULL}, will look for a +\code{bbi.yaml} file in the same directory as the model.} +} +\description{ +If \code{nmtran_exe = NULL}, this will look for a \code{bbi.yaml} file in the same +directory as the model. +} +\keyword{internal} From 65cb5c0c69cb1dda3cc07efd3e53fbcd8a1b9a87 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Wed, 14 Feb 2024 09:55:39 -0500 Subject: [PATCH 10/13] add nmtran tests --- tests/testthat/test-workflow-bbi.R | 57 ++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) diff --git a/tests/testthat/test-workflow-bbi.R b/tests/testthat/test-workflow-bbi.R index fd14f0343..03345157a 100644 --- a/tests/testthat/test-workflow-bbi.R +++ b/tests/testthat/test-workflow-bbi.R @@ -306,5 +306,62 @@ withr::with_options(list( run_times <- model_summaries(mods) %>% check_run_times(.wait = FALSE) %>% suppressWarnings() expect_equal(dim(run_times), c(3, 3)) }) + + + describe("run_nmtran", { + + it("locate_nmtran", { + # Using model object, looks for bbi.yaml + nmtran_exe <- locate_nmtran(mod1) + # Confirm executable + expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm NONMEM version + expect_equal(attr(nmtran_exe, "nonmem_version"), "nm74gf") + + # Passed executable + nmtran_exe <- locate_nmtran(mod1, nmtran_exe = "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm executable + expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm NONMEM version + expect_true(is.null(attr(nmtran_exe, "nonmem_version"))) + + # Passed config_path + nmtran_exe <- locate_nmtran(.config_path = file.path(MODEL_DIR_BBI, "bbi.yaml")) + # Confirm executable + expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm NONMEM version + expect_equal(attr(nmtran_exe, "nonmem_version"), "nm74gf") + + # Wrong nmtran_exe path passed + expect_error( + locate_nmtran(mod1, nmtran_exe = "/opt/NONMEM/nm74gf/tr/NMTRAN2.exe"), + "Could not find an NMTRAN executable" + ) + + # no configuration file found + expect_error( + locate_nmtran(.config_path = file.path(tempdir(), "bbi.yaml")), + "No bbi configuration was found" + ) + }) + + + it("base case", { + # create model + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + + nmtran_results <- run_nmtran(mod1, delete_on_exit = FALSE) + on.exit(fs::dir_delete(nmtran_results$run_dir)) + + # Check attributes + expect_equal(get_model_path(mod1), nmtran_results$absolute_model_path) + expect_equal( + file.path(nmtran_results$run_dir, basename(get_model_path(mod1))), + nmtran_results$nmtran_model + ) + expect_equal(nmtran_results$nonmem_version, "nm74gf") + expect_equal(nmtran_results$status_val, 0) + expect_equal(nmtran_results$status, "NMTRAN successful") + }) }) # closing withr::with_options From 9e1f4a201804c16ec7b37368d57b8cf61f2a79d5 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Thu, 29 Feb 2024 16:49:37 -0500 Subject: [PATCH 11/13] add tests and refactor on top of main - utilize get_data_path refactor --- R/get-path-from-object.R | 25 + R/run-nmtran.R | 72 +- tests/testthat/helpers-create-example-model.R | 27 - tests/testthat/test-get-path-from-object.R | 10 + tests/testthat/test-workflow-bbi.R | 640 ++++++++++-------- 5 files changed, 381 insertions(+), 393 deletions(-) diff --git a/R/get-path-from-object.R b/R/get-path-from-object.R index b4b41ed49..28f486af9 100644 --- a/R/get-path-from-object.R +++ b/R/get-path-from-object.R @@ -389,6 +389,31 @@ adjust_data_path_ext <- function(data_path, mod_path){ return(as.character(data_path_adj)) } +#' Modify the specified data path in a control stream file +#' +#' @param mod a bbr model object +#' @param data_path Data path to set in a `$DATA` record. +#' +#' @noRd +modify_data_path_ctl <- function(mod, data_path){ + mod_path <- get_model_path(mod) + + # Get data record + ctl <- nmrec::read_ctl(mod_path) + data_rec <- nmrec::select_records(ctl, "data")[[1]] + data_rec$parse() + + # Overwrite 'filename' option + data_rec$values <- purrr::map(data_rec$values, function(data_opt){ + if(inherits(data_opt, "nmrec_option_pos") && data_opt$name == "filename"){ + data_opt$value <- data_path + } + data_opt + }) + + # Write out modified ctl + nmrec::write_ctl(ctl, mod_path) +} #' Build path to output file #' diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 317b006b4..161a38d75 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -26,7 +26,10 @@ run_nmtran <- function( nmtran_exe = NULL, delete_on_exit = TRUE ){ + test_nmrec_version(.min_version = "0.3.0") check_model_object(.mod, "bbi_nonmem_model") + + # Capture NONMEM and NMTRAN options nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe) nm_ver <- attr(nmtran_exe, "nonmem_version") @@ -43,16 +46,14 @@ run_nmtran <- function( # Copy model file.copy(mod_path, temp_folder, overwrite = TRUE) + nmtran_mod <- new_model(file.path(temp_folder, basename(mod_path)), .overwrite = TRUE) # Copy dataset & overwrite $DATA record of new model # NMTRAN will error if data cannot be found if(fs::file_exists(data_path)){ file.copy(data_path, temp_folder, overwrite = TRUE) # overwrite $DATA record of new model - modify_data_path_ctl( - mod_path = file.path(temp_folder, basename(mod_path)), - data_path = basename(data_path) - ) + modify_data_path_ctl(nmtran_mod, data_path = basename(data_path)) } # Run NMTRAN @@ -143,7 +144,7 @@ locate_nmtran <- function(.mod = NULL, .config_path = NULL, nmtran_exe = NULL){ #' #' @keywords internal execute_nmtran <- function(nmtran_exe, mod_path, dir = NULL) { - if(is.null(dir) || !file.exists(dir)) dir <- "." + if(is.null(dir)) dir <- "." checkmate::assert_directory_exists(dir) nmtran.p <- processx::process$new( @@ -177,67 +178,6 @@ execute_nmtran <- function(nmtran_exe, mod_path, dir = NULL) { return(nmtran_results) } -#' Get the specified data path from a control stream file -#' -#' @param .mod a `bbr` model object -#' -#' @noRd -get_data_path_from_ctl <- function(.mod){ - check_model_object(.mod, "bbi_nonmem_model") - mod_path <- get_model_path(.mod) - ctl <- nmrec::read_ctl(mod_path) - - # Get data record - data_rec <- nmrec::select_records(ctl, "data")[[1]] - data_path <- nmrec::get_record_option(data_rec, "filename")$value - - # Handling for `.mod` extensions - if(grepl("(?i)mod", fs::path_ext(mod_path))){ - data_path <- file.path("..", data_path) - } - - data_path_norm <- fs::path_norm(file.path(mod_path, data_path)) - - if(!fs::file_exists(data_path_norm)){ - # The first error message line is what NMTRAN would return in this situation - rlang::warn( - c( - "x" = "Input data file does not exist or cannot be opened", - "i" = glue("Referenced input data path: {data_path_norm}") - ) - ) - } - - return(as.character(data_path_norm)) -} - -#' Modify the specified data path in a control stream file - -#' @param mod_path Path to a control stream file -#' @param data_path Data path to set in a `$DATA` record. -#' -#' @noRd -modify_data_path_ctl <- function(mod_path, data_path){ - checkmate::assert_file_exists(mod_path) - - # Get data record - ctl <- nmrec::read_ctl(mod_path) - data_rec <- nmrec::select_records(ctl, "data")[[1]] - data_rec$parse() - - # Overwrite 'filename' option - # TODO: confirm this works with .mod extensions - data_rec$values <- purrr::map(data_rec$values, function(data_opt){ - if(inherits(data_opt, "nmrec_option_pos") && data_opt$name == "filename"){ - data_opt$value <- data_path - } - data_opt - }) - - # Write out modified ctl - nmrec::write_ctl(ctl, mod_path) -} - #' Compare different NONMEM control stream configurations. #' diff --git a/tests/testthat/helpers-create-example-model.R b/tests/testthat/helpers-create-example-model.R index c62403759..ec8122bba 100644 --- a/tests/testthat/helpers-create-example-model.R +++ b/tests/testthat/helpers-create-example-model.R @@ -24,33 +24,6 @@ make_fake_mod <- function(case = NULL, input_ctl = NULL){ } -#' Modify the specified data path in a control stream file - -#' @param mod a bbr model object -#' @param data_path Data path to set in a `$DATA` record. -#' -#' @keywords internal -modify_data_path_ctl <- function(mod, data_path){ - mod_path <- get_model_path(mod) - - # Get data record - ctl <- nmrec::read_ctl(mod_path) - data_rec <- nmrec::select_records(ctl, "data")[[1]] - data_rec$parse() - - # Overwrite 'filename' option - data_rec$values <- purrr::map(data_rec$values, function(data_opt){ - if(inherits(data_opt, "nmrec_option_pos") && data_opt$name == "filename"){ - data_opt$value <- data_path - } - data_opt - }) - - # Write out modified ctl - nmrec::write_ctl(ctl, mod_path) -} - - modify_data_path_json <- function(mod, data_path){ cfg_path <- get_config_path(mod) diff --git a/tests/testthat/test-get-path-from-object.R b/tests/testthat/test-get-path-from-object.R index dfd93be4e..d19293b21 100644 --- a/tests/testthat/test-get-path-from-object.R +++ b/tests/testthat/test-get-path-from-object.R @@ -198,6 +198,16 @@ test_that("get_data_path_from_ctl works with absolute paths", { ) }) +test_that("modify_data_path_ctl works", { + clean_test_enviroment(create_rlg_models) + mod <- read_model(NEW_MOD3) + + data_path <- "test/this/path/data.csv" + modify_data_path_ctl(mod, data_path) + + expect_equal(data_path, get_data_path_from_ctl(mod, normalize = FALSE)) +}) + test_that("get_data_path parses errors informatively", { clean_test_enviroment(create_rlg_models) mod <- read_model(NEW_MOD3) diff --git a/tests/testthat/test-workflow-bbi.R b/tests/testthat/test-workflow-bbi.R index 03345157a..2952a439e 100644 --- a/tests/testthat/test-workflow-bbi.R +++ b/tests/testthat/test-workflow-bbi.R @@ -31,337 +31,377 @@ withr::with_options(list( bbr.bbi_exe_path = read_bbi_path(), bbr.verbose = FALSE), { - # cleanup when done - on.exit({ - Sys.sleep(3) # wait for some NONMEM mess to delete itself - cleanup_bbi() - }) - - # clear old bbi.yaml - if (fs::file_exists(file.path(MODEL_DIR_BBI, "bbi.yaml"))) fs::file_delete(file.path(MODEL_DIR_BBI, "bbi.yaml")) - - # create new bbi.yaml - bbi_init( - MODEL_DIR_BBI, - .nonmem_dir = Sys.getenv("BBR_TESTS_NONMEM_DIR", "/opt/NONMEM"), - .nonmem_version = Sys.getenv("BBR_TESTS_NONMEM_VERSION", "nm74gf"), - .bbi_args = list(mpi_exec_path = get_mpiexec_path()) - ) - - # copy model file into new model dir - fs::file_copy(CTL_TEST_FILE, MODEL_DIR_BBI) - - ####################### - # create model from R - ####################### - - test_that("step by step create_model to submit_model to model_summary works [BBR-WRKF-001]", { - # create model - mod1 <- new_model( - file.path(MODEL_DIR_BBI, "1"), - .description = "original test-workflow-bbi model", - .tags = ORIG_TAGS, - .bbi_args = list(threads = 4, parallel = TRUE) - ) - expect_identical(class(mod1), NM_MOD_CLASS_LIST) - - # submit model - proc1 <- submit_model(mod1, .mode = "local", .wait = TRUE) - expect_identical(class(proc1), PROC_CLASS_LIST) - - # get summary from model object - sum1 <- mod1 %>% model_summary() + # cleanup when done + on.exit({ + Sys.sleep(3) # wait for some NONMEM mess to delete itself + cleanup_bbi() + }) - # can't check against SUMMARY_REF_FILE because run time, etc. will be different - # so we just check the structure - expect_identical(class(sum1), NM_SUM_CLASS_LIST) - expect_identical(names(sum1), SUM_NAMES_REF) + # clear old bbi.yaml + if (fs::file_exists(file.path(MODEL_DIR_BBI, "bbi.yaml"))) fs::file_delete(file.path(MODEL_DIR_BBI, "bbi.yaml")) - # As a quick check that the model run was successful, verify that THETA - # values are in ballpark of reference values. - ref_theta <- dplyr::filter( - dget(PARAM_REF_FILE), - stringr::str_detect(parameter_names, "^THETA") - ) - expect_equal( - unname(get_theta(sum1)), ref_theta[["estimate"]], - tolerance = 1 + # create new bbi.yaml + bbi_init( + MODEL_DIR_BBI, + .nonmem_dir = Sys.getenv("BBR_TESTS_NONMEM_DIR", "/opt/NONMEM"), + .nonmem_version = Sys.getenv("BBR_TESTS_NONMEM_VERSION", "nm74gf"), + .bbi_args = list(mpi_exec_path = get_mpiexec_path()) ) - }) - test_that("copying model works and new models run correctly [BBR-WRKF-002]", { - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - mod2 <- copy_model_from(mod1) # should auto-increment to 2.ctl - mod3 <- copy_model_from(mod1, 3, .inherit_tags = TRUE) %>% add_bbi_args(list(clean_lvl=2)) + # copy model file into new model dir + fs::file_copy(CTL_TEST_FILE, MODEL_DIR_BBI) - # run new models - list(mod2, mod3) %>% submit_models(.mode = "local", .wait = TRUE) + ####################### + # create model from R + ####################### - # get summary from model object - sum2 <- mod2 %>% model_summary() - expect_identical(class(sum2), NM_SUM_CLASS_LIST) - expect_identical(names(sum2), SUM_NAMES_REF) + test_that("step by step create_model to submit_model to model_summary works [BBR-WRKF-001]", { + # create model + mod1 <- new_model( + file.path(MODEL_DIR_BBI, "1"), + .description = "original test-workflow-bbi model", + .tags = ORIG_TAGS, + .bbi_args = list(threads = 4, parallel = TRUE) + ) + expect_identical(class(mod1), NM_MOD_CLASS_LIST) - # Quick check that model run was successful (see comment above). - ref_theta <- dplyr::filter( - dget(PARAM_REF_FILE), - stringr::str_detect(parameter_names, "^THETA") - ) - expect_equal( - unname(get_theta(sum2)), ref_theta[["estimate"]], - tolerance = 1 - ) + # submit model + proc1 <- submit_model(mod1, .mode = "local", .wait = TRUE) + expect_identical(class(proc1), PROC_CLASS_LIST) - # Run of same model on same system gives same result. - expect_equal( - param_estimates(sum2), - param_estimates(model_summary(mod3)) - ) + # get summary from model object + sum1 <- mod1 %>% model_summary() - # add some tags to new model - mod2 <- mod2 %>% add_tags(NEW_TAGS) - }) + # can't check against SUMMARY_REF_FILE because run time, etc. will be different + # so we just check the structure + expect_identical(class(sum1), NM_SUM_CLASS_LIST) + expect_identical(names(sum1), SUM_NAMES_REF) - test_that(".overwrite argument works for submitting models [BBR-WRKF-008]", { - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - mod2 <- read_model(file.path(MODEL_DIR_BBI, "2")) - mod3 <- read_model(file.path(MODEL_DIR_BBI, "3")) + # As a quick check that the model run was successful, verify that THETA + # values are in ballpark of reference values. + ref_theta <- dplyr::filter( + dget(PARAM_REF_FILE), + stringr::str_detect(parameter_names, "^THETA") + ) + expect_equal( + unname(get_theta(sum1)), ref_theta[["estimate"]], + tolerance = 1 + ) + }) - # check that overwrite error parses correctly - expect_error( - submit_model(mod1, .mode = "local", .wait = TRUE), - regexp = "The target output directory already exists" - ) - expect_error( - submit_models(list(mod2, mod3), .mode = "local", .wait = TRUE), - regexp = "The target output directory already exists" - ) + test_that("copying model works and new models run correctly [BBR-WRKF-002]", { + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + mod2 <- copy_model_from(mod1) # should auto-increment to 2.ctl + mod3 <- copy_model_from(mod1, 3, .inherit_tags = TRUE) %>% add_bbi_args(list(clean_lvl=2)) - # check that .overwrite works - submit_model(mod1, .mode = "local", .wait = TRUE, .overwrite = TRUE) - submit_models(list(mod2, mod3), .mode = "local", .wait = TRUE, .overwrite = TRUE) - log_df <- summary_log(MODEL_DIR_BBI) - - # check that models finished successfully - expect_equal(nrow(log_df), 3) - expect_true(all(is.na(log_df$error_msg))) - }) - - test_that("config_log() works correctly [BBR-WRKF-003]", { - # check config log for all models so far - log_df <- config_log(MODEL_DIR_BBI) - expect_equal(nrow(log_df), 3) - expect_equal(ncol(log_df), CONFIG_COLS) - expect_false(any(is.na(log_df$model_md5))) - expect_false(any(is.na(log_df$data_md5))) - expect_false(any(is.na(log_df$data_path))) - }) - - test_that(".wait = FALSE returns correctly [BBR-WRKF-004]", { - # launch a model but don't wait for it to finish - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - proc <- copy_model_from(mod1, 4, .inherit_tags = TRUE) %>% submit_model(.mode = "local", .wait = FALSE) - expect_true(stringr::str_detect(proc[[PROC_STDOUT]], ".wait = FALSE")) - }) - - test_that("run_log() captures runs correctly [BBR-WRKF-005]", { - # check run log for all models - log_df <- run_log(MODEL_DIR_BBI) - expect_equal(nrow(log_df), 4) - expect_equal(ncol(log_df), RUN_LOG_COLS) - expect_identical(basename(log_df[[ABS_MOD_PATH]]), as.character(seq(1:4))) - expect_identical(log_df$description, c("original test-workflow-bbi model", rep(NA_character_, 3))) - expect_identical(log_df$tags, list(ORIG_TAGS, NEW_TAGS, ORIG_TAGS, ORIG_TAGS)) - }) - - test_that("add_config() works with in progress model run [BBR-WRKF-006]", { - # add config log to run log - log_df <- expect_warning( - run_log(MODEL_DIR_BBI) %>% add_config(), - regexp = "in progress" - ) - expect_equal(nrow(log_df), 4) - expect_equal(ncol(log_df), RUN_LOG_COLS + CONFIG_COLS-2) - - # check that the running model has NA for config fields - expect_equal(sum(is.na(log_df$model_md5)), 1L) - }) - - - test_that("submit_model() works with non-NULL .config_path [BBR-WRKF-007]", { - if (requireNamespace("withr", quietly = TRUE) && - utils::packageVersion("withr") < "2.2.0") { - skip("must have withr >= 2.2.0 to run this test") - } - - test_dir <- getwd() - withr::with_tempdir({ - # copy model, YAML, and data files to the same location - files_to_copy <- file.path( - ABS_MODEL_DIR, - c("1.ctl", "1.yaml", "../../../extdata/acop.csv") - ) + # run new models + list(mod2, mod3) %>% submit_models(.mode = "local", .wait = TRUE) - purrr::walk(files_to_copy, fs::file_copy, ".") + # get summary from model object + sum2 <- mod2 %>% model_summary() + expect_identical(class(sum2), NM_SUM_CLASS_LIST) + expect_identical(names(sum2), SUM_NAMES_REF) - # modify DATA to reflect location in temp dir - ctl <- readr::read_file("1.ctl") - ctl_mod <- stringr::str_replace( - ctl, "\\$DATA\\s+[^\\s]+", "$DATA ../acop.csv" + # Quick check that model run was successful (see comment above). + ref_theta <- dplyr::filter( + dget(PARAM_REF_FILE), + stringr::str_detect(parameter_names, "^THETA") + ) + expect_equal( + unname(get_theta(sum2)), ref_theta[["estimate"]], + tolerance = 1 ) - readr::write_file(ctl_mod, "1.ctl") - - mod <- read_model("1") - res <- submit_model( - mod, - .mode = "local", - .config_path = file.path(MODEL_DIR_BBI, "bbi.yaml"), - .wait = TRUE + + # Run of same model on same system gives same result. + expect_equal( + param_estimates(sum2), + param_estimates(model_summary(mod3)) ) - expect_true(any(grepl("--config", res[["cmd_args"]], fixed = TRUE))) - expect_true(any(grepl("models completed", res[["stdout"]], fixed = TRUE))) + # add some tags to new model + mod2 <- mod2 %>% add_tags(NEW_TAGS) }) - }) - - - test_that("wait_for_nonmem() correctly reads in stop time [BBR-UTL-012]", { - # create model - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - submit_model(mod1, .mode = "local", .wait = FALSE) - wait_for_nonmem(mod1, 100, .interval = 5) - expect_true(suppressMessages(nrow(nm_tab(mod1)) > 1)) - }) - - test_that("wait_for_nonmem() doesn't error out if no stop time found [BBR-UTL-013]", { - # model setup - mod_fail <- copy_model_from( - read_model(file.path(MODEL_DIR_BBI, "1")), - "failure" - ) - # run model - .p <- submit_model(mod_fail, .mode = "local", .wait = FALSE) - Sys.sleep(0.5) - .p$process$kill() + test_that(".overwrite argument works for submitting models [BBR-WRKF-008]", { + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + mod2 <- read_model(file.path(MODEL_DIR_BBI, "2")) + mod3 <- read_model(file.path(MODEL_DIR_BBI, "3")) - # dont need high wait time since we know it failed - expect_warning( - wait_for_nonmem(mod_fail, 2, .interval = 1), - "Expiration was reached" - ) - }) - - test_that("check_run_times() works with one model [BBR-CRT-001]", { - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - # warnings will trigger for bbi <= 3.1.1, but we still want to test this - run_times <- check_run_times(mod1, .wait = FALSE) %>% suppressWarnings() - expected_cols <- c("run", "threads", "estimation_time") - expect_true(all(expected_cols %in% names(run_times))) - expect_equal(dim(run_times), c(1, 3)) - }) - - test_that("check_run_times() works with multiple models [BBR-CRT-002]", { - - mods <- purrr::map(file.path(MODEL_DIR_BBI, 1:3), ~ read_model(.x)) - run_times <- check_run_times(mods, .wait = FALSE) %>% suppressWarnings() - - expected_cols <- c("run", "threads", "estimation_time") - expect_true(all(expected_cols %in% names(run_times))) - expect_equal(dim(run_times), c(3, 3)) - }) - - test_that("check_run_times() .return_times arg [BBR-CRT-003]", { - skip_if_old_bbi("3.2.0") - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - run_times <- check_run_times(mod1, .wait = FALSE, .return_times = "all") - expected_cols <- c("run", "threads", "estimation_time", "covariance_time", "postprocess_time", "cpu_time") - expect_true(all(expected_cols %in% names(run_times))) - expect_equal(dim(run_times), c(1, 6)) - - mods <- purrr::map(file.path(MODEL_DIR_BBI, 1:2), ~ read_model(.x)) - run_times <- check_run_times(mods, .wait = FALSE, - .return_times = c("estimation_time", "covariance_time")) - expected_cols <- c("run", "threads", "estimation_time", "covariance_time") - expect_true(all(expected_cols %in% names(run_times))) - expect_equal(dim(run_times), c(2, 4)) - }) - - test_that("check_run_times() waits for models to complete [BBR-CRT-004]", { - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - mod_threads <- test_threads(mod1, .threads = c(2, 4), .cap_iterations = 100, .mode = "local") - run_times <- check_run_times(mod_threads, .wait = TRUE, .time_limit = 100) %>% suppressWarnings() - # This will error if .wait didnt work - expect_equal(dim(run_times), c(2, 3)) - }) - - test_that("check_run_times() works with a bbi_nonmem_summary object [BBR-CRT-005]", { - mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) - run_times <- model_summary(mod1) %>% check_run_times(.wait = FALSE) %>% suppressWarnings() - expect_equal(dim(run_times), c(1, 3)) - }) - - test_that("check_run_times() works with a bbi_summary_list object [BBR-CRT-006]", { - mods <- purrr::map(file.path(MODEL_DIR_BBI, 1:3), ~ read_model(.x)) - run_times <- model_summaries(mods) %>% check_run_times(.wait = FALSE) %>% suppressWarnings() - expect_equal(dim(run_times), c(3, 3)) - }) - - - describe("run_nmtran", { - - it("locate_nmtran", { - # Using model object, looks for bbi.yaml - nmtran_exe <- locate_nmtran(mod1) - # Confirm executable - expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") - # Confirm NONMEM version - expect_equal(attr(nmtran_exe, "nonmem_version"), "nm74gf") - - # Passed executable - nmtran_exe <- locate_nmtran(mod1, nmtran_exe = "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") - # Confirm executable - expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") - # Confirm NONMEM version - expect_true(is.null(attr(nmtran_exe, "nonmem_version"))) - - # Passed config_path - nmtran_exe <- locate_nmtran(.config_path = file.path(MODEL_DIR_BBI, "bbi.yaml")) - # Confirm executable - expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") - # Confirm NONMEM version - expect_equal(attr(nmtran_exe, "nonmem_version"), "nm74gf") - - # Wrong nmtran_exe path passed + # check that overwrite error parses correctly expect_error( - locate_nmtran(mod1, nmtran_exe = "/opt/NONMEM/nm74gf/tr/NMTRAN2.exe"), - "Could not find an NMTRAN executable" + submit_model(mod1, .mode = "local", .wait = TRUE), + regexp = "The target output directory already exists" ) - - # no configuration file found expect_error( - locate_nmtran(.config_path = file.path(tempdir(), "bbi.yaml")), - "No bbi configuration was found" + submit_models(list(mod2, mod3), .mode = "local", .wait = TRUE), + regexp = "The target output directory already exists" ) + + # check that .overwrite works + submit_model(mod1, .mode = "local", .wait = TRUE, .overwrite = TRUE) + submit_models(list(mod2, mod3), .mode = "local", .wait = TRUE, .overwrite = TRUE) + log_df <- summary_log(MODEL_DIR_BBI) + + # check that models finished successfully + expect_equal(nrow(log_df), 3) + expect_true(all(is.na(log_df$error_msg))) + }) + + test_that("config_log() works correctly [BBR-WRKF-003]", { + # check config log for all models so far + log_df <- config_log(MODEL_DIR_BBI) + expect_equal(nrow(log_df), 3) + expect_equal(ncol(log_df), CONFIG_COLS) + expect_false(any(is.na(log_df$model_md5))) + expect_false(any(is.na(log_df$data_md5))) + expect_false(any(is.na(log_df$data_path))) }) + test_that(".wait = FALSE returns correctly [BBR-WRKF-004]", { + # launch a model but don't wait for it to finish + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + proc <- copy_model_from(mod1, 4, .inherit_tags = TRUE) %>% submit_model(.mode = "local", .wait = FALSE) + expect_true(stringr::str_detect(proc[[PROC_STDOUT]], ".wait = FALSE")) + }) - it("base case", { + test_that("run_log() captures runs correctly [BBR-WRKF-005]", { + # check run log for all models + log_df <- run_log(MODEL_DIR_BBI) + expect_equal(nrow(log_df), 4) + expect_equal(ncol(log_df), RUN_LOG_COLS) + expect_identical(basename(log_df[[ABS_MOD_PATH]]), as.character(seq(1:4))) + expect_identical(log_df$description, c("original test-workflow-bbi model", rep(NA_character_, 3))) + expect_identical(log_df$tags, list(ORIG_TAGS, NEW_TAGS, ORIG_TAGS, ORIG_TAGS)) + }) + + test_that("add_config() works with in progress model run [BBR-WRKF-006]", { + # add config log to run log + log_df <- expect_warning( + run_log(MODEL_DIR_BBI) %>% add_config(), + regexp = "in progress" + ) + expect_equal(nrow(log_df), 4) + expect_equal(ncol(log_df), RUN_LOG_COLS + CONFIG_COLS-2) + + # check that the running model has NA for config fields + expect_equal(sum(is.na(log_df$model_md5)), 1L) + }) + + + test_that("submit_model() works with non-NULL .config_path [BBR-WRKF-007]", { + if (requireNamespace("withr", quietly = TRUE) && + utils::packageVersion("withr") < "2.2.0") { + skip("must have withr >= 2.2.0 to run this test") + } + + test_dir <- getwd() + withr::with_tempdir({ + # copy model, YAML, and data files to the same location + files_to_copy <- file.path( + ABS_MODEL_DIR, + c("1.ctl", "1.yaml", "../../../extdata/acop.csv") + ) + + purrr::walk(files_to_copy, fs::file_copy, ".") + + # modify DATA to reflect location in temp dir + ctl <- readr::read_file("1.ctl") + ctl_mod <- stringr::str_replace( + ctl, "\\$DATA\\s+[^\\s]+", "$DATA ../acop.csv" + ) + readr::write_file(ctl_mod, "1.ctl") + + mod <- read_model("1") + res <- submit_model( + mod, + .mode = "local", + .config_path = file.path(MODEL_DIR_BBI, "bbi.yaml"), + .wait = TRUE + ) + + expect_true(any(grepl("--config", res[["cmd_args"]], fixed = TRUE))) + expect_true(any(grepl("models completed", res[["stdout"]], fixed = TRUE))) + }) + }) + + + test_that("wait_for_nonmem() correctly reads in stop time [BBR-UTL-012]", { # create model mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + submit_model(mod1, .mode = "local", .wait = FALSE) + wait_for_nonmem(mod1, 100, .interval = 5) + expect_true(suppressMessages(nrow(nm_tab(mod1)) > 1)) + }) + + test_that("wait_for_nonmem() doesn't error out if no stop time found [BBR-UTL-013]", { + # model setup + mod_fail <- copy_model_from( + read_model(file.path(MODEL_DIR_BBI, "1")), + "failure" + ) - nmtran_results <- run_nmtran(mod1, delete_on_exit = FALSE) - on.exit(fs::dir_delete(nmtran_results$run_dir)) + # run model + .p <- submit_model(mod_fail, .mode = "local", .wait = FALSE) + Sys.sleep(0.5) + .p$process$kill() - # Check attributes - expect_equal(get_model_path(mod1), nmtran_results$absolute_model_path) - expect_equal( - file.path(nmtran_results$run_dir, basename(get_model_path(mod1))), - nmtran_results$nmtran_model + # dont need high wait time since we know it failed + expect_warning( + wait_for_nonmem(mod_fail, 2, .interval = 1), + "Expiration was reached" ) - expect_equal(nmtran_results$nonmem_version, "nm74gf") - expect_equal(nmtran_results$status_val, 0) - expect_equal(nmtran_results$status, "NMTRAN successful") }) -}) # closing withr::with_options + + test_that("check_run_times() works with one model [BBR-CRT-001]", { + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + # warnings will trigger for bbi <= 3.1.1, but we still want to test this + run_times <- check_run_times(mod1, .wait = FALSE) %>% suppressWarnings() + expected_cols <- c("run", "threads", "estimation_time") + expect_true(all(expected_cols %in% names(run_times))) + expect_equal(dim(run_times), c(1, 3)) + }) + + test_that("check_run_times() works with multiple models [BBR-CRT-002]", { + + mods <- purrr::map(file.path(MODEL_DIR_BBI, 1:3), ~ read_model(.x)) + run_times <- check_run_times(mods, .wait = FALSE) %>% suppressWarnings() + + expected_cols <- c("run", "threads", "estimation_time") + expect_true(all(expected_cols %in% names(run_times))) + expect_equal(dim(run_times), c(3, 3)) + }) + + test_that("check_run_times() .return_times arg [BBR-CRT-003]", { + skip_if_old_bbi("3.2.0") + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + run_times <- check_run_times(mod1, .wait = FALSE, .return_times = "all") + expected_cols <- c("run", "threads", "estimation_time", "covariance_time", "postprocess_time", "cpu_time") + expect_true(all(expected_cols %in% names(run_times))) + expect_equal(dim(run_times), c(1, 6)) + + mods <- purrr::map(file.path(MODEL_DIR_BBI, 1:2), ~ read_model(.x)) + run_times <- check_run_times(mods, .wait = FALSE, + .return_times = c("estimation_time", "covariance_time")) + expected_cols <- c("run", "threads", "estimation_time", "covariance_time") + expect_true(all(expected_cols %in% names(run_times))) + expect_equal(dim(run_times), c(2, 4)) + }) + + test_that("check_run_times() waits for models to complete [BBR-CRT-004]", { + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + mod_threads <- test_threads(mod1, .threads = c(2, 4), .cap_iterations = 100, .mode = "local") + run_times <- check_run_times(mod_threads, .wait = TRUE, .time_limit = 100) %>% suppressWarnings() + # This will error if .wait didnt work + expect_equal(dim(run_times), c(2, 3)) + }) + + test_that("check_run_times() works with a bbi_nonmem_summary object [BBR-CRT-005]", { + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + run_times <- model_summary(mod1) %>% check_run_times(.wait = FALSE) %>% suppressWarnings() + expect_equal(dim(run_times), c(1, 3)) + }) + + test_that("check_run_times() works with a bbi_summary_list object [BBR-CRT-006]", { + mods <- purrr::map(file.path(MODEL_DIR_BBI, 1:3), ~ read_model(.x)) + run_times <- model_summaries(mods) %>% check_run_times(.wait = FALSE) %>% suppressWarnings() + expect_equal(dim(run_times), c(3, 3)) + }) + + describe("run_nmtran", { + it("locate_nmtran", { + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + # Using model object, looks for bbi.yaml + nmtran_exe <- locate_nmtran(mod1) + # Confirm executable + expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm NONMEM version + expect_equal(attr(nmtran_exe, "nonmem_version"), "nm74gf") + + # Passed executable + nmtran_exe <- locate_nmtran(mod1, nmtran_exe = "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm executable + expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm NONMEM version + expect_true(is.null(attr(nmtran_exe, "nonmem_version"))) + + # Passed config_path + nmtran_exe <- locate_nmtran(.config_path = file.path(MODEL_DIR_BBI, "bbi.yaml")) + # Confirm executable + expect_equal(as.character(nmtran_exe), "/opt/NONMEM/nm74gf/tr/NMTRAN.exe") + # Confirm NONMEM version + expect_equal(attr(nmtran_exe, "nonmem_version"), "nm74gf") + + # Wrong nmtran_exe path passed + expect_error( + locate_nmtran(mod1, nmtran_exe = "/opt/NONMEM/nm74gf/tr/NMTRAN2.exe"), + "Could not find an NMTRAN executable" + ) + + # no configuration file found + expect_error( + locate_nmtran(.config_path = file.path(tempdir(), "bbi.yaml")), + "No bbi configuration was found" + ) + }) + + it("execute_nmtran", { + # Execute in subdirectory to avoid messing with other tests + nmtran_dir <- file.path(MODEL_DIR_BBI, "nmtran") + fs::dir_create(nmtran_dir) + on.exit(fs::dir_delete(nmtran_dir), add = TRUE) + + # Copy model file into new model dir + fs::file_copy(CTL_TEST_FILE, nmtran_dir, overwrite = TRUE) + mod1 <- new_model(file.path(nmtran_dir, "1"), .overwrite = TRUE) + + # create new bbi.yaml + bbi_init( + nmtran_dir, + .nonmem_dir = Sys.getenv("BBR_TESTS_NONMEM_DIR", "/opt/NONMEM"), + .nonmem_version = Sys.getenv("BBR_TESTS_NONMEM_VERSION", "nm74gf"), + .bbi_args = list(mpi_exec_path = get_mpiexec_path()) + ) + + nmtran_exe <- locate_nmtran(mod1) + nmtran_results <- execute_nmtran( + nmtran_exe, mod_path = basename(get_model_path(mod1)), dir = nmtran_dir + ) + + # Check attributes + expect_equal(nmtran_dir, nmtran_results$run_dir) + expect_equal(nmtran_results$status_val, 0) + expect_equal(nmtran_results$status, "NMTRAN successful") + + # Test failure + data_path <- "test/this/path/data.csv" + modify_data_path_ctl(mod1, data_path) + + nmtran_results <- execute_nmtran( + nmtran_exe, mod_path = basename(get_model_path(mod1)), dir = nmtran_dir + ) + + # Check attributes + expect_equal(nmtran_results$status_val, 4) + expect_equal(nmtran_results$status, "NMTRAN failed. See errors.") + }) + + it("run_nmtran", { + # create model + mod1 <- read_model(file.path(MODEL_DIR_BBI, "1")) + + nmtran_results <- run_nmtran(mod1, delete_on_exit = FALSE) + on.exit(fs::dir_delete(nmtran_results$run_dir)) + + # Check attributes + expect_equal(get_model_path(mod1), nmtran_results$absolute_model_path) + expect_equal( + file.path(nmtran_results$run_dir, basename(get_model_path(mod1))), + nmtran_results$nmtran_model + ) + expect_equal(nmtran_results$nonmem_version, "nm74gf") + expect_equal(nmtran_results$status_val, 0) + expect_equal(nmtran_results$status, "NMTRAN successful") + }) + }) + }) # closing withr::with_options From 8d4a98f0ad6e3824dd619a42cdb778aedc81562c Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 1 Mar 2024 10:12:47 -0500 Subject: [PATCH 12/13] remove internal compare_nmtran function --- R/run-nmtran.R | 149 ------------------------------------------ man/compare_nmtran.Rd | 61 ----------------- 2 files changed, 210 deletions(-) delete mode 100644 man/compare_nmtran.Rd diff --git a/R/run-nmtran.R b/R/run-nmtran.R index 161a38d75..78966a4c3 100644 --- a/R/run-nmtran.R +++ b/R/run-nmtran.R @@ -178,152 +178,3 @@ execute_nmtran <- function(nmtran_exe, mod_path, dir = NULL) { return(nmtran_results) } - -#' Compare different NONMEM control stream configurations. -#' -#' Runs `run_nmtran()` on two models and compares the output, denoting whether -#' they evaluate to the same model via `NMTRAN`. -#' -#' @details -#' Say you wanted to test whether diagonal matrices could specify standard -#' deviation for one value, and variance for another -#' -#' The **reference model** would have this block: -#' ```r -#' $OMEGA -#' 0.05 STANDARD ; iiv CL -#' 0.2 ; iiv V2 -#' ``` -#' -#' The **new model** would have this block: -#' ```r -#' $OMEGA -#' 0.05 STANDARD ; iiv CL -#' 0.2 VAR ; iiv V2 -#' ``` -#' -#' Comparing the two (see below), we find no differences. This means that adding -#' `VAR` to the second ETA value had no impact, and the two models would evaluate -#' the same. -#' ```r -#' > compare_nmtran(MOD1, MOD_COMPARE) -#' Running NMTRAN with NONMEM version `nm75` -#' -#' No differences found -#' character(0) -#' ``` -#' -#' @examples -#' \dontrun{ -#' # Starting model - set a reference -#' open_model_file(MOD1) -#' -#' # Make new model -#' MOD_COMPARE <- copy_model_from(MOD1) -#' -#' # Make a change -#' open_model_file(MOD_COMPARE) -#' -#' # Compare NMTRAN evaluation -#' compare_nmtran(MOD1, MOD_COMPARE) -#' -#' # delete new model at the end -#' delete_models(MOD_COMPARE, .tags = NULL, .force = TRUE) -#' } -#' -#' @keywords internal -compare_nmtran <- function( - .mod, - .mod_compare, - .config_path = NULL, - nmtran_exe = NULL -){ - # Set NMTRAN executable - nmtran_exe <- locate_nmtran(.mod, .config_path, nmtran_exe) - nmtran_exe2 <- locate_nmtran(.mod_compare, .config_path, nmtran_exe) - - # This would only happen when comparing two models in different working - # directories, where the `bbi.yaml` defaults differ. - if(nmtran_exe != nmtran_exe2){ - rlang::warn( - c( - "!" = "Found two separate NMTRAN executables:", - " " = paste("-", nmtran_exe), - " " = paste("-", nmtran_exe2), - "i" = "Defaulting to the first one" - ) - ) - } - - # This function is used to remove problem statement differences introduced - # via `copy_model_from()` - empty_prob_statement <- function(.mod){ - mod_new <- copy_model_from(.mod, paste0(get_model_id(.mod), "_no_prob")) - mod_path <- get_model_path(mod_new) - ctl <- nmrec::read_ctl(mod_path) - prob_rec <- nmrec::select_records(ctl, "prob")[[1]] - prob_rec$parse() - - # Overwrite 'text' option - prob_rec$values <- purrr::map(prob_rec$values, function(prob_rec){ - if(inherits(prob_rec, "nmrec_option_pos") && prob_rec$name == "text"){ - prob_rec$value <- "" - } - prob_rec - }) - - # Write out modified ctl - nmrec::write_ctl(ctl, mod_path) - return(mod_new) - } - - # 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( - delete_models( - list(mod_no_prob, compare_no_prob), .tags = NULL, .force = TRUE - ) %>% suppressMessages(), - add = TRUE - ) - - # Run NMTRAN on each model - nmtran_mod <- run_nmtran( - mod_no_prob, nmtran_exe = nmtran_exe, - delete_on_exit = FALSE - ) - nmtran_compare <- run_nmtran( - compare_no_prob, nmtran_exe = nmtran_exe, - delete_on_exit = FALSE - ) - - # Force delete folders at the end - 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$run_dir, "FCON") - nmtran_compare_fcon <- file.path(nmtran_compare$run_dir, "FCON") - cmd <- paste("cmp", nmtran_mod_fcon, nmtran_compare_fcon) - - # 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){ - cat_line("No differences found", col = "green") - }else{ - cat_line("Models are not equivalent", col = "red") - output <- gsub(paste0(nmtran_mod_fcon, "|", nmtran_compare_fcon), "", output) %>% - stringr::str_trim() - } - - return(output) -} - diff --git a/man/compare_nmtran.Rd b/man/compare_nmtran.Rd deleted file mode 100644 index 03dbd3354..000000000 --- a/man/compare_nmtran.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run-nmtran.R -\name{compare_nmtran} -\alias{compare_nmtran} -\title{Compare different NONMEM control stream configurations.} -\usage{ -compare_nmtran(.mod, .mod_compare, .config_path = NULL, nmtran_exe = NULL) -} -\description{ -Runs \code{run_nmtran()} on two models and compares the output, denoting whether -they evaluate to the same model via \code{NMTRAN}. -} -\details{ -Say you wanted to test whether diagonal matrices could specify standard -deviation for one value, and variance for another - -The \strong{reference model} would have this block: - -\if{html}{\out{
}}\preformatted{$OMEGA -0.05 STANDARD ; iiv CL -0.2 ; iiv V2 -}\if{html}{\out{
}} - -The \strong{new model} would have this block: - -\if{html}{\out{
}}\preformatted{$OMEGA -0.05 STANDARD ; iiv CL -0.2 VAR ; iiv V2 -}\if{html}{\out{
}} - -Comparing the two (see below), we find no differences. This means that adding -\code{VAR} to the second ETA value had no impact, and the two models would evaluate -the same. - -\if{html}{\out{
}}\preformatted{> compare_nmtran(MOD1, MOD_COMPARE) -Running NMTRAN with NONMEM version `nm75` - -No differences found -character(0) -}\if{html}{\out{
}} -} -\examples{ -\dontrun{ -# Starting model - set a reference -open_model_file(MOD1) - -# Make new model -MOD_COMPARE <- copy_model_from(MOD1) - -# Make a change -open_model_file(MOD_COMPARE) - -# Compare NMTRAN evaluation -compare_nmtran(MOD1, MOD_COMPARE) - -# delete new model at the end -delete_models(MOD_COMPARE, .tags = NULL, .force = TRUE) -} - -} -\keyword{internal} From ff70aa7f6e27dbb0ff2f0e19be05853a7411320a Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 25 Jun 2024 13:34:14 -0400 Subject: [PATCH 13/13] remove modify_data_path_ctl ahead of rebase - a better version will be available after rebasing (I had redone this for the bootstrap PR), and deleting it ahead of time helps avoid some conflicts with the rebase --- R/get-path-from-object.R | 24 ------------------------ 1 file changed, 24 deletions(-) diff --git a/R/get-path-from-object.R b/R/get-path-from-object.R index 28f486af9..54074d33f 100644 --- a/R/get-path-from-object.R +++ b/R/get-path-from-object.R @@ -389,31 +389,7 @@ adjust_data_path_ext <- function(data_path, mod_path){ return(as.character(data_path_adj)) } -#' Modify the specified data path in a control stream file -#' -#' @param mod a bbr model object -#' @param data_path Data path to set in a `$DATA` record. -#' -#' @noRd -modify_data_path_ctl <- function(mod, data_path){ - mod_path <- get_model_path(mod) - - # Get data record - ctl <- nmrec::read_ctl(mod_path) - data_rec <- nmrec::select_records(ctl, "data")[[1]] - data_rec$parse() - # Overwrite 'filename' option - data_rec$values <- purrr::map(data_rec$values, function(data_opt){ - if(inherits(data_opt, "nmrec_option_pos") && data_opt$name == "filename"){ - data_opt$value <- data_path - } - data_opt - }) - - # Write out modified ctl - nmrec::write_ctl(ctl, mod_path) -} #' Build path to output file #'