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

@@ -494,6 +494,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

@@ -1,6 +1,6 @@
 #' Interface for running `NM-TRAN` on model objects
 #'
-#' Function to run `NM-TRAN` on a model object to validate its control stream
+#' Functions to run `NM-TRAN` on a model object to validate its control stream
 #'  for correct coding before submission. The `NM-TRAN` dataset (`FDATA`) and
 #'  other `NONMEM` artifacts can be further inspected by keeping the run directory
 #'  around.
@@ -36,6 +36,12 @@
 #' }
 #'
 #' @return An S3 object of class `nmtran_process`
+#' @name nmtran
+NULL
+
+
+#' @describeIn nmtran Function to run `NM-TRAN` on a model object to validate
+#' its control stream for correct coding before submission.
 #' @export
 run_nmtran <- function(
     .mod,
@@ -389,3 +395,54 @@ parse_nmtran_args <- function(
 
   return(.nmtran_args)
 }
+
+
+#' @describeIn nmtran Executes `run_nmtran` on a `bbi_nonmem_model` and returns
+#' the `NM-TRAN` dataset (`FDATA`)
+#' @export
+nm_fdata <- function(
+    .mod,
+    .bbi_args = NULL,
+    .config_path = NULL
+){
+  nmtran_p <- run_nmtran(.mod, .bbi_args, .config_path, clean = 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))
+  }
+}

_pkgdown.yml

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