R/manual_import.R

In guiastrennec/xpose: Diagnostics for Pharmacometric Models

#' Manually define nonmem tables to be imported
#' 
#' @description Manually provide names of the table files to be imported by \code{xpose_data}.
#'
#' @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.
#'
#' @details 
#' In order to be imported manually, table names must follow the following convention: 
#' \code{<tab_names><runno><tab/sim_suffix>} e.g. sdtab001sim. When the argument `file` is used in 
#' \code{xpose_data}, the \code{<runno>} part is guessed by taking the portion of the string starting 
#' by any digit and ending at the file extension e.g. \code{file = run001a.mod} will guess <runno> as
#' `001a`. If no valid <runno> can be guessed, xpose will return an error. In this case it is advised 
#' to use the \code{xpose_data} argument `runno` directly rather than `file` hence preventing xpose 
#' from having to guess <runno>.
#' 
#' Note that with manual table import xpose still reads in the NONMEM model file in order to generate
#' the run summary.
#' 
#' @seealso \code{\link{xpose_data}}
#' @examples 
#' \dontrun{
#' # Import all names specified by default as in xpose4
#' xpose_data(runno = '001', manual_import = manual_nm_import())
#' 
#' # Import a specific table name
#' xpose_data(runno = '001', manual_import = manual_nm_import(tab_names = 'mytab'))
#' }
#' @export
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 `manual_nm_import`.
#' 
#' @return A `nm_table_list`
#' 
#' @keywords internal
#' @export
list_nm_tables_manual <- function(runno = NULL, file = NULL, dir = NULL, tab_list) {
  if (is.null(runno)) {
    # Attempt to guess runno if file has been used
    runno <- stringr::str_match(string = update_extension(file, ''), 
                                pattern = '\\d.+$')[1,]
    if (is.na(runno)) {
      stop('Failed to guess `runno` from `file` argument. Check ?manual_nm_import for help.',
           call. = FALSE)
    }
  }
  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)) %>% 
    as.nm.table.list()
}