nm_fdata prototype

 - taken from #705 (some additional changes)

 - known issues:
   - Need to remove column "C" from columns retrieved from the control stream file. FDATA seems to always start with 'ID'. Will include additional details in a later commit when this behavior is more understood

   - Need to support alternate formats (WIDE, etc)
   - Need to check for additional $INPUT options and add handling for them (unclear which ones at the moment)

NAMESPACE

@@ -76,6 +76,7 @@ S3method(print,bbi_nmboot_summary)
 S3method(print,bbi_nonmem_summary)
 S3method(print,bbi_process)
 S3method(print,model_tree_static)
+S3method(print,nmtran_fdata)
 S3method(print,nmtran_process)
 S3method(print_model_files,default)
 S3method(submit_model,bbi_base_model)
@@ -160,6 +161,7 @@ export(new_bootstrap_run)
 export(new_ext)
 export(new_model)
 export(nm_data)
+export(nm_fdata)
 export(nm_file)
 export(nm_file_multi_tab)
 export(nm_grd)

R/aaa.R

@@ -210,6 +210,7 @@ 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"
+NMTRAN_FDATA_CLASS <- "nmtran_fdata"
 
 # YAML keys that are hard-coded
 YAML_YAML_MD5 <- "yaml_md5"

R/modify-records.R

@@ -274,8 +274,15 @@ modify_prob_statement <- function(.mod, prob_text = NULL){
 #'  from the first line of the referenced dataset (input data or table file). If
 #'  `FALSE`, parse the control stream and retrieve from the relevant record type
 #'  (`$INPUT` or `$TABLE`).
+#' @param filter_drop Logical (T/F). If `TRUE`, remove columns set to `DROP`
+#'  or `SKIP` in the control stream's `$INPUT` record. Only used if
+#'  `from_data = FALSE`.
 #' @keywords internal
-get_input_columns <- function(.mod, from_data = TRUE){
+get_input_columns <- function(
+    .mod,
+    from_data = TRUE,
+    filter_drop = FALSE
+){
   if(isTRUE(from_data)){
     data_path <- get_data_path(.mod)
     input_data <- fread(data_path, na.strings = ".", verbose = FALSE, nrows = 1)
@@ -294,6 +301,11 @@ get_input_columns <- function(.mod, from_data = TRUE){
       ifelse(inherits(val, "nmrec_option_flag"), val$name, as.character(val$value))
     }) %>% stats::setNames(input_col_names)
   }
+
+  if(isTRUE(filter_drop)){
+    # Filter out columns that are marked as DROP or SKIP
+    input_cols <- input_cols[!grepl("^(?i)drop$|^(?i)skip$", input_cols)]
+  }
   return(input_cols)
 }
 

R/nm-file.R

@@ -113,8 +113,9 @@ nm_data <- function(.mod) {
 #' @importFrom data.table fread
 #' @importFrom stringr str_detect
 #' @param .path a path to a table file.
+#' @param skip number of rows to skip when reading in table file. Defaults to `1`
 #' @keywords internal
-nm_file_impl <- function(.path) {
+nm_file_impl <- function(.path, skip = 1) {
   # read file and find top of table
   verbose_msg(glue("Reading {basename(.path)}"))
 
@@ -128,7 +129,7 @@ nm_file_impl <- function(.path) {
       data <- fread(
         .path,
         na.strings = ".",
-        skip = 1,
+        skip = skip,
         verbose = FALSE
       )
     })

R/print.R

@@ -502,6 +502,19 @@ print.nmtran_process <- function(x, ...){
 }
 
 
+#' @describeIn print_bbi Prints the `FDATA`, showing key changes from `nm_data`
+#' @export
+print.nmtran_fdata <- function(x, ...){
+  recs_dropped <- attributes(x)$n_records_dropped
+  cli::cat_bullet(
+    paste("Number of records dropped:", col_blue(recs_dropped)),
+    bullet = "en_dash"
+  )
+  cat("\n")
+  NextMethod()
+}
+
+
 #' @describeIn print_bbi Draw model tree as a static plot
 #' @param x plot to display
 #' @param newpage Logical (T/F). If `TRUE`, draw new (empty) page first.

R/run-nmtran.R

@@ -8,7 +8,8 @@
 #' control stream data and instructions into a form executable by `NONMEM`.
 #'
 #' `run_nmtran()` allows users to test their models ahead of submission to ensure
-#' correct coding.
+#' correct coding, whereas `nm_fdata()` generates and returns the `NM-TRAN`
+#' dataset (`FDATA`) for further analysis and verification.
 #'
 #' @param .mod A `bbr` model object.
 #' @param .config_path Path to a bbi configuration file. If `NULL`, the default,
@@ -27,6 +28,9 @@
 #' # Set the path to an NM-TRAN executable
 #' run_nmtran(mod, nmtran_exe = "/opt/NONMEM/nm75/tr/NMTRAN.exe")
 #'
+#' # Generate and return `FDATA`
+#' fdata <- nm_fdata(mod)
+#'
 #' }
 #' @name nmtran
 NULL
@@ -87,6 +91,57 @@ run_nmtran <- function(
 }
 
 
+#' @describeIn nmtran Executes `run_nmtran` on a `bbi_nonmem_model` and
+#'  returns the `NM-TRAN` dataset (`FDATA`)
+#' @export
+nm_fdata <- function(
+    .mod,
+    .config_path = NULL,
+    nmtran_exe = NULL
+){
+  nmtran_p <- run_nmtran(.mod, .config_path, nmtran_exe, delete_on_exit = FALSE)
+  on.exit(fs::dir_delete(nmtran_p$run_dir))
+
+  if(nmtran_p$status_val != 0){
+    # trim output
+    output_lines <- nmtran_p$output_lines[!grepl("^\\s+$", nmtran_p$output_lines)]
+    rlang::warn(
+      c(
+        "NM-TRAN was unsuccessful and returned the following messages:",
+        paste(output_lines, collapse = "\n")
+      )
+    )
+  }
+
+  # Attempt to read in FDATA (even if status_val is not 0)
+  #  - FDATA can still be read in in _some scenarios_ where NM-TRAN fails
+  fdata_path <- file.path(nmtran_p$run_dir, "FDATA")
+  if(fs::file_exists(fdata_path)){
+    input_cols <- get_input_columns(.mod, from_data = FALSE, filter_drop = TRUE)
+
+    fdata <- tryCatch({
+      nm_file_impl(fdata_path, skip = 0) %>%
+        stats::setNames(input_cols)
+    }, error = function(cond){
+      rlang::inform(
+        c("FDATA could not be read in:", cond$parent$message)
+      )
+      return(NULL)
+    })
+
+    if(!is.null(fdata)){
+      attr(fdata, "n_records_dropped") <- nrow(input_data) - nrow(fdata)
+    }
+
+    # assign class and return
+    class(fdata) <- c(NMTRAN_FDATA_CLASS, class(fdata))
+    return(fdata)
+  }else{
+    return(invisible(NULL))
+  }
+}
+
+
 #' Search for and validate existence of an `NM-TRAN` executable
 #'
 #' If `nmtran_exe = NULL`, this will look for a `bbi.yaml` file in the same

_pkgdown.yml

@@ -39,6 +39,7 @@ reference:
   - nm_tables
   - nm_file
   - nm_file_multi_tab
+  - nm_fdata
   - get_omega
   - cov_cor
   - check_cor_threshold

tests/testthat/test-workflow-bbi.R

@@ -402,6 +402,20 @@ withr::with_options(list(
       expect_equal(nmtran_results$status, "NMTRAN successful")
     })
 
+    it("nm_fdata: integration", {
+      mod1 <- read_model(file.path(MODEL_DIR_BBI, "1"))
+      fdata <- nm_fdata(mod1)
+
+      expect_equal(names(fdata), names(nm_data(mod1)))
+
+      # Test dropped/renamed columns
+
+      # Test failure: incorrect data path
+      data_path <- "test/this/path/data.csv"
+      modify_data_path_ctl(mod1, data_path)
+
+      # Test alternate formats
+    })
   })
 
 }) # closing withr::with_options