R/pmx_manual_import.R

In ggPMX: 'ggplot2' Based Tool to Facilitate Diagnostic Plots for NLME Models

# The ggPMX NONMEM reader (pmx_nm) is strongly based on NONMEM reading functions of the xpose package (v.0.4.11) (Thanks to Benjamin Guiastrennec)
#
#' Manually define nonmem tables to be imported
#' 
#' @description Manually provide names of the table files to be imported.
#'
#' @param tab_names Provide the name of the tables to import e.g. 'sdtab', 'patab', 'cotab', 
#' 'catab' for NONMEM.
#' @param tab_suffix Default is '', but can be changed to any character string to be used as 
#' suffix in the table names.
#' @param sim_suffix Default is 'sim', but can be changed to any character string to be used as 
#' suffix in the simulation table names e.g. sdtab001sim.
#' 
pmx_manual_nm_import <- function(tab_names = c('sdtab', 'mutab', 'patab', 'catab', 'cotab', 
                                           'mytab', 'extra', 'xptab', 'cwtab'),
                             tab_suffix = '', sim_suffix = 'sim') {
  
  list(tab_suffix = tab_suffix, sim_suffix = sim_suffix, tab_names = tab_names)
}


#' Creates an nm_table_list from manually defined table name patterns
#' 
#' @param runno Run number to be used to generate model file name.
#' @param file Model file name containing the file extension.
#' @param dir Location of the model files.
#' @param tab_list A list of table definition generated by `pmx_manual_nm_import`.
#' 
#' @return A `nm_table_list`
#' 
#' @keywords internal
pmx_list_nm_tables_manual <- function(runno = NULL, file = NULL, dir = NULL, tab_list) {
  . <- NULL
  if (is.null(runno)) {
    # Attempt to guess runno if file has been used
    runno <- stringr::str_match(string = pmx_update_extension(file, ''), 
                                pattern = '\\d.+$')[1,]
    if (is.na(runno)) {
      stop('Failed to guess `runno` from `file` argument. Check ?pmx_manual_nm_import for help.',
           call. = FALSE)
    }
  }
  pmx_file_path(dir, stringr::str_c(tab_list$tab_names, runno)) %>% 
    dplyr::tibble(problem = 1, file = ., firstonly = FALSE, simtab = NA) %>% 
    tidyr::expand(problem = .$problem, file = .$file, firstonly = .$firstonly, simtab = c(FALSE, TRUE)) %>% 
    dplyr::mutate(file = dplyr::if_else(.$simtab, stringr::str_c(.$file, tab_list$sim_suffix),
                                        stringr::str_c(.$file, tab_list$tab_suffix))) %>% 
    dplyr::filter(file.exists(.$file)) %>% 
    pmx_as.nm.table.list()
}