diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 55a6957..c97f696 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -50,18 +50,13 @@ jobs: pak-version: devel extra-packages: | any::rcmdcheck - cran/lotri - cran/rxode2 - cran/nlmixr2est - cran/nlmixr2extra - cran/nlmixr2plot pharmpy/pharmr needs: check - name: Install pharmpy run: pharmr::install_pharmpy() shell: Rscript {0} - + - uses: r-lib/actions/check-r-package@v2 with: args: 'c("--no-manual", "--as-cran")' diff --git a/DESCRIPTION b/DESCRIPTION index 7fbca04..548e4e9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,31 +13,35 @@ Imports: purrr, glue, rlang, - withr, lubridate, - pharmr, + pharmr, + pharmr.extra, + irxutils, yaml, stringr, cli, cachem, - vpc, stats, job, - diffr, - rstudioapi, - altair + diffr Suggests: httr, ellmer, nlmixr2, ggplot2, xpose, + vpc, patchwork, testthat (>= 3.0.0), mockery, knitr, rmarkdown, - Rapp + Rapp, + withr, + rstudioapi +Remotes: + InsightRX/irxutils, + InsightRX/pharmr.extra License: MIT + file LICENSE URL: https://github.com/InsightRX/uno, https://insightrx.github.io/uno/, https://insightrx.github.io/luna/ LazyData: TRUE diff --git a/NAMESPACE b/NAMESPACE index fb75161..da77ccd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,43 +1,8 @@ # Generated by roxygen2: do not edit by hand S3method(print,luna.run_table) -S3method(print,pharmpy.workflows.results.ModelfitResults) -export(add_covariates_to_model) -export(add_default_output_tables) -export(add_table_to_model) -export(attach_fit_info) -export(call_nmfe) -export(call_pharmpy_fit) -export(call_pharmpy_tool) -export(call_psn) -export(clean_modelfit_data) -export(clean_nonmem_folder) -export(clean_pharmpy_runfolders) -export(combine_regimens) -export(compare_nlme_fit) -export(create_covariate_search_space) -export(create_model) -export(create_model_nlmixr) -export(create_pkmodel_search_space) -export(create_regimen) -export(create_vpc_data) -export(find_pk_parameter) -export(fit_model) -export(get_advan) -export(get_condition_number_for_fit) -export(get_final_results_from_search) -export(get_fit_info) -export(get_initial_estimates_from_data) -export(get_obs_compartment) -export(get_ode_size) -export(get_pharmpy_conf) export(get_table_for_plots) -export(get_tables_from_fit) -export(get_tables_in_model_code) -export(get_tool_from_model) export(ifelse0) -export(is_ltbs_model) -export(is_maxeval_zero) export(luna_check) export(luna_clone) export(luna_compare) @@ -61,20 +26,9 @@ export(luna_tables) export(luna_tag) export(luna_tool) export(luna_xpose) -export(nm_read_model) -export(nm_save_model) -export(nm_update_dataset) -export(read_table_nm) -export(remove_table_from_model) -export(remove_tables_from_model) export(replace_list_elements) -export(run_nlme) -export(run_sim) -export(save_model_code) -export(scale_initial_estimates_pk) -export(set_compartment_scale) -export(set_covariance) -export(stack_encounters) export(update_cache) -export(update_parameters) -export(update_pk_tables) +importFrom(stats,setNames) +importFrom(utils,file.edit) +importFrom(utils,tail) +importFrom(utils,write.csv) diff --git a/R/add_covariates_to_model.R b/R/add_covariates_to_model.R deleted file mode 100644 index 4345383..0000000 --- a/R/add_covariates_to_model.R +++ /dev/null @@ -1,32 +0,0 @@ -#' Wrapper function to add covariates to a pharmpy model -#' -#' @inheritParams create_model -#' -#' @export -add_covariates_to_model <- function( - model, - covariates, - data = NULL -) { - allowed_effects <- c("lin", "pow", "exp", "piece_lin", "cat", "cat2") - for(par in names(covariates)) { - for(covt in names(covariates[[par]])) { - effect <- covariates[[par]][[covt]] - if(!is.null(data) && !covt %in% names(data)) { - warning("Covariate `", covt, "` not found in data, skipping.") - } else { - if(!effect %in% allowed_effects) { - warning("Requested covariate effect type `", effect, "` not recognized, skipping.") - } else { - model <- pharmr::add_covariate_effect( - model = model, - parameter = par, - covariate = covt, - effect = effect - ) - } - } - } - } - model -} diff --git a/R/add_default_output_tables.R b/R/add_default_output_tables.R deleted file mode 100644 index fd5de21..0000000 --- a/R/add_default_output_tables.R +++ /dev/null @@ -1,80 +0,0 @@ -## for individual parameter estimates -#' Add one or more default output tables to a model, -#' if they don't already exist in the model. -#' -#' @param model Pharmpy model object -#' @param iiv vector of parameters with iiv. Optional, if not specified -#' will use pharmpy function to retrieve it. Shortcut strings "basic" and "all" -#' are also treated as NULL and will auto-detect parameters. -#' @param tables character vector of which default tables -#' to add, options are `fit` and `parameters`. -#' @param full_tables For the default tables, should all input columns from be -#' included in the output tables? Default `FALSE`. -#' @param verbose verbose output? -#' -#' @export -#' -add_default_output_tables <- function( - model, - iiv = NULL, - tables = c("fit", "parameters"), - full_tables = FALSE, - remove_existing = TRUE, - verbose = TRUE -) { - default_table_names <- list( - "parameters" = "patab", - "fit" = "sdtab" - ) - - existing_tables <- get_tables_in_model_code(model$code) - ## by default will remove existing tables - ## If these are not removed, and patab and sdtab are already present, - ## will not override them - if(remove_existing & length(existing_tables) > 0) { - model <- remove_tables_from_model(model) - existing_tables <- c() - } - - ## individual parameters, first row only - if("parameters" %in% tables && !(default_table_names[["parameters"]] %in% existing_tables)) { - if(verbose) cli::cli_alert_info("Adding output table for individual parameters") - if(is.null(iiv) || (is.character(iiv) && length(iiv) == 1 && iiv %in% c("basic", "all"))) { - ## Pharmpy bug, cannot retrieve IIV if only one parameter has IIV - ## Also ignore shortcut strings like "basic" or "all" - cols <- pharmr::get_individual_parameters(model) - } else { - rm_corr <- grep("\\~", names(iiv)) - if(length(rm_corr) > 0) { - iiv <- iiv[-rm_corr] - } - cols <- names(iiv) - } - if(full_tables) { - cols <- unique(c(cols, model$datainfo$names)) - } - model <- add_table_to_model( - model = model, - variables = c("ID", cols), - firstonly = FALSE, # currently not supported by Pharmpy - file = "patab" - ) - } - - ## goodness of fit, all rows - if("fit" %in% tables && !(default_table_names[["fit"]] %in% existing_tables)) { - if(verbose) cli::cli_alert_info("Adding output table for goodness of fit") - cols <- c("DV", "EVID", "MDV", "PRED", "IPRED", "CWRES", "NPDE") - if(full_tables) { - cols <- unique(c(cols, model$datainfo$names)) - } - model <- add_table_to_model( - model = model, - variables = c("ID", "TIME", cols), - firstonly = FALSE, - file = "sdtab" - ) - } - - model -} diff --git a/R/add_table_to_model.R b/R/add_table_to_model.R deleted file mode 100644 index f8ab390..0000000 --- a/R/add_table_to_model.R +++ /dev/null @@ -1,46 +0,0 @@ -#' Add new $TABLE record to output variables -#' -#' @param model pharmpy model object -#' @param variables character vector with variable names -#' @param firstonly add `FIRSTONLY` parameter to $TABLE record -#' @param file path to file, e.g. `sdtab` -#' -#' @export -#' -add_table_to_model <- function( - model, - variables, - firstonly = FALSE, - file -) { - tool <- get_tool_from_model(model) - if(tool == "nonmem") { - existing_tables <- get_tables_in_model_code(model$code) - data <- model$dataset - if(file %in% existing_tables) { - warning("Table file already in a $TABLE record in model.") - return(model) - } - if(is.null(variables) || length(variables) == 0) { - warning("No variables to add to $TABLE, skipping.") - return(model) - } - table_code <- paste0( - "\n$TABLE\n", - paste0(c(" ", variables), collapse = " "), - ifelse(firstonly, "\n FIRSTONLY", ""), - "\n NOAPPEND NOPRINT", - "\n FILE=", file, - "\n\n" - ) - model <- pharmr::read_model_from_string( - code = paste0(model$code, table_code) - ) - if(!is.null(data)) { - model <- pharmr::set_dataset(model, data) - } - } else { - ## Adding tables can only be done for NONMEM datasets - } - return(model) -} diff --git a/R/attach_fit_info.R b/R/attach_fit_info.R deleted file mode 100644 index 6448320..0000000 --- a/R/attach_fit_info.R +++ /dev/null @@ -1,43 +0,0 @@ -#' Attach fit info and tables to a fit object, e.g. from model fit or -#' Pharmpy grid search final results -#' -#' @inheritParams run_nlme -#' @inheritParams get_fit_info -#' -#' @export -#' -attach_fit_info <- function( - fit, - model, - fit_folder, - output_file = file.path(fit_folder, "model.lst"), - is_sim_model = FALSE, - verbose = TRUE -) { - ## Attach model object (with dataset) to fit, for traceability or use in post-processing - attr(fit, "model") <- model - - ## Attach tables to model fit - if(verbose) cli::cli_process_start("Importing generated tables") - tables <- get_tables_from_fit( - model, - fit_folder - ) - attr(fit, "tables") <- tables - if(verbose) cli::cli_process_done() - - if(!is_sim_model) { - ## Generate a summary of fit info - if(verbose) cli::cli_process_start("Summarizing fit results") - fit_info <- get_fit_info( - fit, - path = fit_folder, - output_file = output_file - ) - attr(fit, "info") <- fit_info - } - - if(verbose) cli::cli_process_done() - - fit -} diff --git a/R/call_pharmpy_fit.R b/R/call_pharmpy_fit.R deleted file mode 100644 index a856813..0000000 --- a/R/call_pharmpy_fit.R +++ /dev/null @@ -1,61 +0,0 @@ -#' Run model with pharmpy -#' -#' @inheritParams call_nmfe -#' -#' @export -#' -call_pharmpy_fit <- function( - model_file, - path, - clean = TRUE, - console = TRUE, - verbose = TRUE -) { - - if(verbose) { - cli::cli_alert_info( - paste0("Starting Pharmpy modelfit in ", path) - ) - } - - ## Clean run folders, if requested - clean_pharmpy_runfolders( - id = NULL, - folder = path, - tool = "modelfit", - remove = clean - ) - - ## Read model - model_paths <- file.path(path, model_file) - models <- list() - if(length(model_paths) == 1) { - models <- pharmr::read_model(model_paths[1]) - } else { - for(model_path in model_paths) { - models <- c(models, pharmr::read_model(model_path)) - } - } - - ## Run model - withr::with_dir(path, { - tmp <- pharmr::fit( - models - ) - }) - - ## Copy all results from modelfit folder back into main folder - for(p in model_paths) { - last_pharmpy_runfolder <- tail(get_pharmpy_runfolders(id = NULL, folder = path, tool = "modelfit"), 1) - run_folder <- file.path(path, last_pharmpy_runfolder, "models", "run") - files <- dir(run_folder) - for(f in files) { - f_new <- stringr::str_replace(f, "model\\.", "run.") - file.copy( - file.path(run_folder, f), - file.path(path, f_new) - ) - } - } - -} diff --git a/R/call_pharmpy_tool.R b/R/call_pharmpy_tool.R deleted file mode 100644 index 06ff970..0000000 --- a/R/call_pharmpy_tool.R +++ /dev/null @@ -1,141 +0,0 @@ -#' Generic function for running a pharmpy tool, like bootstrap, -#' or modelsearch. A separate function is available for `fit()` -#' -#' @param model Pharmpy model object, preferably created using -#' `luna::create_model()`. -#' @param id model id. Optional. If not specified, will generate random modelfit -#' id. The `id` will be used to create the run folder. -#' @param verbose verbose output? -#' @param clear if one or more run folders exists for the tool, -#' do we want to remove them first? -#' @param options list of arguments pass on to `tool` as argument. Documentation -#' for available arguments for each Pharmpy tool can be found here: -#' https://pharmpy.github.io/latest/mfl.html. -#' -#' @return fit object -#' -#' @export -#' -call_pharmpy_tool <- function( - id, - model = NULL, - results = NULL, - tool = NULL, - folder = NULL, - clean = TRUE, - verbose = TRUE, - force = FALSE, - options = list() -) { - - if(is.null(tool)) { - cli::cli_abort("Please provide Pharmpy `tool` to run.") - } - if(is.null(model) && is.null(results)) { - cli::cli_abort("Please provide `model` and/or `results` to start Pharmpy tool.") - } - if(is.null(model)) { - if(!is.null(attr(results, "model"))) { - if(verbose) - cli::cli_alert_info("No `model` provided, taking from `results` object") - model <- attr(results, "model") - } else { - cli::cli_abort("Please provide `model` to start Pharmpy tool.") - } - } - - ## Check results, if needed - req_results <- c("modelsearch", "covsearch", "iivsearch", "ruvsearch", "amd") - if(is.null(results) && tool %in% req_results) { - if(verbose) - cli::cli_alert_info("No `results` provided, running the model first to generate `results` object.") - results <- run_nlme( - id = id, - model = model, - force = force - ) - } - - ## Prepare run folder - if(is.null(folder)) { - folder <- getwd() - } - run_folder <- file.path(getwd(), id) - if(!dir.exists(run_folder)) - run_folder <- create_run_folder(id, folder, force, verbose) - - ## Clean Pharmpy run folders, if requested - clean_pharmpy_runfolders(id, folder, tool, remove = clean) - - ## Run tool - if(verbose) { - cli::cli_alert_info( - paste0("Starting {tool} in ", run_folder) - ) - } - - ## Tool-specific modifications / checks - ## - ## - simulation: ensure it is a simulation - if(tool == "simulation") { - if(verbose) - cli::cli_alert_info("Making sure model is a simulation model") - model <- model |> - pharmr::set_simulation(n = ifelse0(options$n, 1)) |> - pharmr::set_name("sim") - options$n <- NULL - } - - ## prepare arguments for call - args <- c( - list(model = model), - options - ) - if(tool %in% req_results) { - args$results <- results - } - - ## make the call to the Pharmpy tool - withr::with_dir(run_folder, { - res <- do.call( - paste0("run_", tool), - envir = asNamespace("pharmr"), - args = args - ) - }) - - ## Post-processing, tool-specific - ## Save final model to file, and attach to output object - if(stringr::str_detect(tool, "(.*search|amd)")) { - final_model <- update_parameters(res$final_model, res$final_results) - final_model_code <- final_model$code - writeLines( - final_model_code, - file.path(run_folder, glue::glue("final_{tool}.mod")) - ) - attr(res, "final_model") <- final_model - } - if(tool == "simulation") { - pharmpy_runfolders <- get_pharmpy_runfolders( - id = id, - folder = folder, - tool = tool - ) - full_table_path <- file.path(run_folder, tail(pharmpy_runfolders, 1), "models", "sim") - tables <- get_tables_from_fit( - model, - path = full_table_path - ) - if(verbose) { - if(length(tables) > 0) { - cli::cli_alert_info(paste0("Attaching {length(tables)} table", ifelse(length(tables) > 1, "s", ""), " from {tool} to output")) - } else { - cli::cli_alert_info("No tables found from {tool} at {full_run_path}") - } - attr(res, "tables") <- tables - } - } - - res - -} diff --git a/R/call_psn.R b/R/call_psn.R deleted file mode 100644 index 6accc89..0000000 --- a/R/call_psn.R +++ /dev/null @@ -1,66 +0,0 @@ -#' Call PsN -#' -#' @inheritParams call_nmfe -#' @param options a vector of arguments to pass to the PsN tool, e.g. -#' `c("--samples=100", "--dir="test")` -#' -#' @export -#' -call_psn <- function( - model_file, - output_file, - path, - options = c(), - tool = c( - "execute", "vpc", "bootstrap", "sir", "proseval", "update_inits", - "cdd" - ), - console = TRUE, - verbose = TRUE -) { - - tool <- match.arg(tool) - - # Transform folder path to absolute path - path <- normalizePath(path, mustWork = TRUE) - - if(verbose) - cli::cli_alert_info(paste0("Starting PsN {tool} run in ", path)) - - ## Output to console or to file? - if(console) { - stdout <- "" - stderr <- "" - } else { - stdout <- file.path(path, "stdout") - stderr <- file.path(path, "stderr") - } - - psn_args <- parse_psn_args(options) - if(verbose) { - cli::cli_alert_info("Running: {tool} {model_file} {psn_args}") - } - withr::with_dir(path, { - suppressWarnings( - res <- system2( - command = tool, - args = paste(basename(model_file), psn_args), - wait = TRUE, - stdout = stdout, - stderr = stderr - ) - ) - }) - cli::cli_process_done() - if(length(res) == 1 && is.numeric(res)) { - if(res == 127) { - cli::cli_abort("PsN {tool} was not found. Make sure PsN is installed in your environment and on the path.") - } else { - if(res != 0) { - cli::cli_abort("A unknown error occurred running PsN {tool}. Error code: {res}.") - } else { - cli::cli_alert_success("PsN {tool} done.") - } - } - } -} diff --git a/R/clean_modelfit_data.R b/R/clean_modelfit_data.R deleted file mode 100644 index 5f42878..0000000 --- a/R/clean_modelfit_data.R +++ /dev/null @@ -1,96 +0,0 @@ -#' Clean / check the dataset before passing to model fitting tool -#' -#' @inheritParams luna_run -#' @param try_make_numeric should function try to turn character columns -#' into numeric columns? If `FALSE` will just set all values to 0 (but -#' retain column to avoid issues). -#' -#' @export -#' -clean_modelfit_data <- function( - model, - try_make_numeric = TRUE, - data = NULL, - verbose = TRUE -) { - - tool <- ifelse(inherits(model, "pharmpy.model.external.nonmem.model.Model"), "nonmem", "nlmixr") - - if(is.null(data)) { - data <- model$dataset - } - if(any(lapply(data, class) != "character")) { - for(key in names(data)) { - if(inherits(data[[key]], "character")) { - if(key %in% c("TIME", "DATE") && all(c("TIME", "DATE") %in% names(data))) { - ## exception for TIME and DATE columns if they appear together, - ## don't convert to numeric - - } else { - if(try_make_numeric) { - if (key == "DV") { - ## special handling, if DV includes BLQ values such as "<0.01" - ## then try to convert to numeric - idx <- stringr::str_detect(data$DV, "\\<") - if(any(idx)) { ## add an LLOQ column - if(verbose) - cli::cli_alert_warning("Detected `<` in DV column, adding LLOQ column to handle BLOQ data.") - data <- data |> - dplyr::mutate(DV = as.numeric(stringr::str_replace_all(DV, "\\<", ""))) |> - dplyr::mutate(LLOQ = dplyr::if_else(idx, DV, 0)) |> - dplyr::mutate(DV = dplyr::if_else(idx, 0, DV)) - } - tmp_dv <- as.numeric(data$DV) - } else { - if(verbose) - cli::cli_alert_warning("Detected character column ({key}), trying to convert to numeric.") - suppressWarnings({ - data[[key]] <- as.numeric(data[[key]]) - }) - } - } else { - if(verbose) - cli::cli_alert_warning("Detected character column ({key}), setting to 0.") - data[[key]] <- NULL - } - } - } - # make sure all NAs are set to 0 - if(any(is.na(data[[key]]))) { - data[[key]][is.na(data[[key]])] <- 0 - } - } - - ## Check if model is using log-transform-both-sides - ## If so, check if we need to use LNDV instead of DV - ltbs <- is_ltbs_model(model) - if(ltbs) { - if("LNDV" %in% names(data)) { - cli::cli_alert_info("Log-transform both sides error model, and detected LNDV column in dataset. Setting LNDV column as dependent variable instead of current `DV` column (will be retained as `ODV`).") - data <- data |> - dplyr::mutate(ODV = DV) |> - dplyr::mutate(DV = LNDV) - } else { - cli::cli_alert_warning("Log-transform both sides error model, but no `LNDV` column. Assuming `DV` is log-transformed.") - } - } - - if(tool != "nonmem") { ## nlmixr2 requires lower-case `cmt` - data <- data |> - dplyr::rename(cmt = CMT) - } - - ## Save dataset - dataset_file <- tempfile(pattern = "data", fileext = ".csv") - write.csv(data, dataset_file, quote = F, row.names = F) - - ## Update dataset in model - model <- pharmr::set_dataset( - model, - path_or_df = dataset_file, - datatype = "nonmem" - ) |> - pharmr::load_dataset() - } - model -} diff --git a/R/clean_nonmem_folder.R b/R/clean_nonmem_folder.R deleted file mode 100644 index 673ed80..0000000 --- a/R/clean_nonmem_folder.R +++ /dev/null @@ -1,34 +0,0 @@ -#' Remove temporary files from NONMEM run -#' -#' @param path path to NONMEM run folder -#' -#' @export -clean_nonmem_folder <- function(path) { - files <- dir(path) - blacklist <- c( - "compile.lnk", - "FCON", - "FDATA", - "FDATA.csv", - "FMSG", - "FORIG", - "FREPL", - "FREPORT", - "FSIZES", - "FSTREAM", - "FSUBS", - "FSUBS2", - "FSUBS.f90", - "gfortran.txt", - "INTER", - "LINKC.LNK", - "LINK.LNK", - "nmpathlist.txt", - "nmprd4p.mod", - "nonmem", - "PRDERR", - "PRSIZES.f90" - ) - rm_files <- file.path(path, intersect(blacklist, files)) - unlink(rm_files) -} diff --git a/R/clean_pharmpy_runfolders.R b/R/clean_pharmpy_runfolders.R deleted file mode 100644 index 56a08f1..0000000 --- a/R/clean_pharmpy_runfolders.R +++ /dev/null @@ -1,33 +0,0 @@ -#' Clean pharmpy run folders like modelfit1 etc -#' -#' @inheritParams run_nlme -#' @param clean should folders really be removed (`TRUE`), or just show a warning (`FALSE`) -#' -#' @export -#' -clean_pharmpy_runfolders <- function( - id = NULL, - folder, - tool, - remove = TRUE, - verbose = TRUE -) { - tool_runfolders <- get_pharmpy_runfolders(id = id, folder = folder, tool = tool) - if(length(tool_runfolders) > 0) { - if(remove) { - cli::cli_alert_info("Cleaning {length(tool_runfolders)} existing {tool} folders") - for(f in tool_runfolders) { - if(!is.null(id)) { - full_folder_path <- file.path(folder, id, f) - } else { - full_folder_path <- file.path(folder, f) - } - if(f != "") { - unlink(full_folder_path, recursive = TRUE, force = TRUE) - } - } - } else { - cli::cli_alert_info("Leaving {length(tool_runfolders)} existing {tool} folders. Use `clean=TRUE` to remove.") - } - } -} diff --git a/R/compare_nlme_fit.R b/R/compare_nlme_fit.R deleted file mode 100644 index 30bdccd..0000000 --- a/R/compare_nlme_fit.R +++ /dev/null @@ -1,77 +0,0 @@ -#' Compare fit of two or more NLME fits -#' -#' @param ... fit objects -#' @param return_object logical, if TRUE, return a list of the combined info and parameter tables -#' @export -#' -compare_nlme_fit <- function(..., return_object = FALSE) { - fits <- list(...) - if(length(fits) == 1) { - if(length(fits[[1]]) >= 1) { - fits <- fits[[1]] - } - } - ## First, combine into a list of parsed info - fit_info <- purrr::map(fits, function(x) { - list( - info_tab = create_modelfit_info_table(x), - par_tab = create_modelfit_parameter_table(x), - name = attr(x, "model")$name - ) - }) - ## Then grab the right info and combine columns from different runs - info_comb <- combine_info_columns( - fit_info, - "info_tab", - label = "Detail" - ) - par_comb <- combine_info_columns( - fit_info, - "par_tab", - label = "Parameter" - ) - if(return_object) { - return(list( - info_comb = info_comb, - par_comb = par_comb - )) - } else { - print( - knitr::kable(info_comb) - ) - print( - knitr::kable(par_comb) - ) - } -} - -#' Combine columns with run info into a data.frame -#' and make sure that rows match (e.g. parameters) -#' -#' data.frames in list should have the same column names but can have different -#' row names (e.g. parameter names). -#' -combine_info_columns <- function( - fit_info, - table = "info_tab", - label = "Detail" -) { - comb <- dplyr::bind_rows( - purrr::map(fit_info, function(x) { - run_name <- ifelse0(x$name, "n/a") - res <- data.frame(x[[table]][,-1]) - first_label <- names(res)[1] - res[,1] <- as.character(res[,1]) - cols <- dplyr::bind_rows( - data.frame(run_name) |> setNames(first_label), - res - ) - rownames(cols) <- c("Run id", x[[table]][,1]) - t(cols) |> - data.frame() # leverage bind_rows to match parameter names and insert NAs. bind_cols cannot do that. - }) - ) |> - t() |> - data.frame() # pivot back again - comb -} diff --git a/R/create_covariate_search_space.R b/R/create_covariate_search_space.R deleted file mode 100644 index 2d2f69c..0000000 --- a/R/create_covariate_search_space.R +++ /dev/null @@ -1,57 +0,0 @@ -#' Create covariate search space definition for pharmpy `covsearch` -#' -#' See Pharmpy MFL documentation for more info: -#' https://pharmpy.github.io/latest/covsearch.html -#' -#' @param parameters vector of parameter names -#' @param covariates vector of covariate names -#' @param operation parameter-covariate model type (operation) -#' @param explore should the specified `parameters` and `covariates` -#' be used as structural model elements, or as exploration space? -#' @param struct_parameters vector of parameter names for structural model -#' @param struct_covariates vector of covariate names for structural model -#' @param struct_operation parameter-covariate model type (operation) -#' for structural model -#' -#' @export -#' -create_covariate_search_space <- function( - parameters, - covariates, - operation = c("LIN", "POW"), # options: c("POW", "*", "+", "LIN", "EXP", "PIECE_LIN") - explore = TRUE, - struct_parameters = NULL, - struct_covariates = NULL, - struct_operation = "POW" -) { - struct_space <- NULL - if(!is.null(struct_parameters)) { - if(is.null(struct_covariates)) { - cli::cli_abort("Please also specify structural covariates to include.") - } - struct_space <- create_covariate_search_space( - parameters = struct_parameters, - covariates = struct_covariates, - operation = struct_operation, - explore = FALSE - ) - } - if("*" %in% operation) { - operation_string <- "*" - } else { - operation_string <- paste0("[", paste0(operation, collapse=","), "]") - } - search_space <- paste0( - "COVARIATE", ifelse(explore, "?", ""), "([", - paste0(parameters, collapse=","), - "], [", - paste0(covariates, collapse=","), - "], ", - operation_string, - ")" - ) - paste0( - c(struct_space, search_space), - collapse = "; " - ) -} diff --git a/R/create_model.R b/R/create_model.R deleted file mode 100644 index 58cce4a..0000000 --- a/R/create_model.R +++ /dev/null @@ -1,419 +0,0 @@ -#' Create model -#' -#' This is essentially a wrapper around the model-creation and -modification -#' functionality in pharmr/Pharmpy. -#' -#' @param data data.frame as input to NONMEM / nlmixr. -#' @param route route of administration, either `oral` or `iv` -#' @param lag_time add a lag time, default is `FALSE` -#' @param n_transit_compartments number of transit-compartments for absorption -#' model. Default is `0`. -#' @param bioavailability Add a bioavailability parameter? Default is `FALSE`. -#' Will add using a logit function. -#' @param n_cmt number of elimination and distribution compartments. Default is -#' 1, i.e. no peripheral distributions. -#' @param elimination elimination type, either `linear` or `michaelis-menten`. -#' @param iiv either `character` or a `list` object. If `character`, should be -#' either "basic" (only CL and V parameters) or "all" (IIV on all parameters). -#' If specified as a list object, it should contain the IIV magnitude (on SD -#' scale) for parameters and potential correlations specified using a tilde, -#' e.g. `list("CL" = 0.2, "V" = 0.3, "CL~V" = 0.1)`. -#' @param iiv_effect either `character` or `list`. If character, one of -#' `c("exp", "add", "prop", "log", "re_log")`. If `list`, should specify for -#' each parameter the effect type, e.g. `list(CL = "add", V = "exp")`. Default -#' is `"exp"` for all. -#' @param ruv one of `proportional`, `additive`, or `combined`. -#' @param covariates list of parameter-covariate effects, e.g. -#' `list(CL = list(WT = "pow", CRCL = "lin"), V = list(WT = "pow")` -#' Values in list need to match one of the effects allowed by pharmpy. -#' @param scale_observations scale observations by factor, e.g. due to unit -#' differences between dose and concentration. E.g. `scale_observations = 1000` -#' will add `S1 = V/1000` (for a 1-compartment model) to NONMEM code. -#' @param estimation_method estimation method. -#' @param estimation_options options for estimation method, specified as list, -#' e.g. `NITER` or `ISAMPLE`. -#' @param uncertainty_method Compute uncertainty for parameter estimations. -#' One of `sandwich` (default), `smat`, `fmat`, `efim`. -#' @param blq_method method for handling data below the limit of quantification. -#' Available options are `m1`, `m3`, `m4`, `m5`, `m6`, `m7`, as described -#' by Beal et al. Default is no handling of BLQ data (`NULL`). -#' @param lloq (optional) a numeric value specifying the limit of -#' quantification for observations. Will be disregarded if an `LLOQ` column is -#' in the dataset. -#' @param auto_init automatically update initial estimates to reasonable values -#' based on a crude assessment of the PK data. Default is `TRUE`. -#' @param auto_stack_encounters detects if TIME within an individual is -#' decreasing from one record to another, which NONMEM cannot handle. -#' If this happens, it will add a reset event (EVID=3) at that time, and -#' increase the TIME for subsequent events so that NONMEM does not throw an -#' error. It will increase the time for the next encounter to the maximum -#' encounter length across all subjects in the dataset (rounded up to 100). -#' If no decreasing TIME is detected, nothing will be done (most common case). -#' This feature is useful e.g. for crossover trials when data on the same -#' individual ispresent but is included in the dataset as time-after-dose and -#' not actual time since first overall dose. -#' @param auto_stack_encounters detects if TIME within an individual is -#' decreasing from one record to another, which NONMEM cannot handle. -#' If this happens, it will add a reset event (EVID=3) at that time, and -#' increase the TIME for subsequent events so that NONMEM does not throw an -#' error. It will increase the time for the next encounter to the maximum -#' encounter length across all subjects in the dataset (rounded up to 100). -#' If no decreasing TIME is detected, nothing will be done (most common case). -#' This feature is useful e.g. for crossover trials when data on the same -#' individual ispresent but is included in the dataset as time-after-dose and -#' not actual time since first overall dose. -#' @param mu_reference MU-reference the model, useful for SAEM estimation -#' method. -#' @param settings additional settings for model creation and model estimation. -#' TBD -#' @param tables which pre-specified tables to add, defaults to `parameters` -#' and `fit` tables. -#' @param full_tables For the default tables, should all input columns from be -#' included in the output tables? Default `FALSE`. -#' @param name name of model -#' @param tool output model type, either `nonmem` or `nlmixr` -#' @param verbose verbose output? -#' -#' @export -#' -create_model <- function( - route = c("auto", "oral", "iv"), - lag_time = FALSE, - n_transit_compartments = 0, - bioavailability = FALSE, - n_cmt = 1, - elimination = c("linear", "michaelis-menten"), - iiv = "all", - iiv_type = "exp", - ruv = c("additive", "proportional", "combined", "ltbs"), - covariates = NULL, - scale_observations = NULL, - data = NULL, - name = NULL, - estimation_method = c("foce", "saem"), - estimation_options = list(), - uncertainty_method = c("sandwich", "smat", "rmat", "efim", "none"), - blq_method = NULL, - lloq = NULL, - tool = c("nonmem", "nlmixr", "nlmixr2"), - tables = c("fit"), - full_tables = FALSE, - auto_init = TRUE, - auto_stack_encounters = TRUE, - mu_reference = FALSE, - settings = list(), # TBD - verbose = FALSE -) { - - ## Parse arguments - route <- match.arg(route) - elimination <- match.arg(elimination) - ruv <- match.arg(ruv) - tool <- match.arg(tool) - estimation_method <- match.arg(estimation_method) - uncertainty_method <- match.arg(uncertainty_method) - if(uncertainty_method == "none") - uncertainty_method <- NULL - - ## identify tool - if(tool == "nlmixr2") { # pharmpy identifies "nlmixr2" as "nlmixr" - tool <- "nlmixr" - } - if(verbose) cli::cli_alert_info(paste0("Writing model in ", tool, " format")) - - ## Pick route - if(route == "auto") { - route <- get_route_from_data(data) - } - - ## Read base model - if(verbose) cli::cli_alert_info("Reading base model") - mod <- pharmr::read_model( - path = system.file( - paste0("models/nonmem/base_", route, ".mod"), - package = "luna" - ) - ) - - ## Absorption - if(verbose) cli::cli_alert_info("Parsing absorption model") - if(lag_time) { - if(route == "iv") { - cli::cli_alert_warning("IV administration selected, ignoring `lag_time`") - } else { - mod <- pharmr::add_lag_time(mod) - } - } - if(isTRUE(bioavailability)) { - mod <- mod |> - pharmr::add_bioavailability( - add_parameter = TRUE, - logit_transform = TRUE - ) |> - pharmr::set_initial_estimates(list(POP_BIO = 0.5)) - } - if(n_transit_compartments > 0) { - mod <- pharmr::set_transit_compartments(mod, n = n_transit_compartments) - } - - ## Distribution: add peripheral compartments - if(n_cmt > 1) { - if(verbose) cli::cli_alert_info("Adding peripheral compartments") - for(i in 1:(n_cmt-1)) { - mod <- pharmr::add_peripheral_compartment(mod) - } - } - - ## Elimination - if(elimination == "michaelis-menten") { - if(verbose) cli::cli_alert_info("Adding Michaelis-Menten elimination") - mod <- mod |> - pharmr::set_michaelis_menten_elimination() - } - - ## Add individual variability - if(verbose) cli::cli_alert_info("Setting IIV") - mod <- set_iiv(mod, iiv, iiv_type) - - ## Residual error - if(verbose) cli::cli_alert_info(paste0("Setting error model to: ", ruv)) - mod <- set_residual_error(mod, ruv) - - ## Covariates - if(!is.null(covariates)) { - if(verbose) cli::cli_alert_info("Adding covariates to model") - mod <- add_covariates_to_model( - model = mod, - covariates = covariates, - data = data - ) - } else { - if(verbose) cli::cli_alert_warning("Skipping covariates") - } - - ## Set scaling - if(!is.null(scale_observations)) { - obs_compartment <- get_obs_compartment(mod) - volume_par <- pharmr::get_central_volume_and_clearance(mod)[[1]] - mod <- mod |> - set_compartment_scale( - compartment = obs_compartment, - expression = list( - variable = volume_par, - scale = scale_observations - ) - ) - } - - ## set parameter estimates to reasonable values based on data - if(!is.null(data) && auto_init) { - if(verbose) cli::cli_alert_info("Setting initial estimates") - inits <- get_initial_estimates_from_data( - data, - n_cmt = n_cmt, - scale_observations = scale_observations - ) - if(length(inits) == 0 || any(is.na(inits)) || any(inits == Inf)) { - cli::cli_alert_warning("Could not compute initial estimates automatically, please check manually.") - } else { - inits <- stats::setNames(inits, paste0("POP_", names(inits))) - mod <- pharmr::set_initial_estimates( - model = mod, - inits = inits - ) - } - } - - ## Convert to nlmixr2? - if(tool == "nlmixr") { - if(verbose) cli::cli_alert_info("Converting model to nlmixr.") - mod <- pharmr::convert_model( - model = mod, - to_format = "nlmixr" - ) - } - - ## Estimation method - steps <- mod$execution_steps$to_dataframe() - n_steps <- nrow(steps) - if(! estimation_method %in% steps$method) { - ## add requested estimation method, with options - if(tool == "nonmem") { - if(verbose) cli::cli_alert_info("Setting estimation options") - tool_options <- get_estimation_options( - tool, - estimation_method, - estimation_options - ) - } else { - tool_options <- list() - cli::cli_alert_warning(paste0("Skipping estimation options for ", tool, ", since not supported by Pharmpy. Please set manually")) - } - if(verbose) cli::cli_alert_info(paste0("Updating estimation step: ", estimation_method)) - mod <- pharmr::set_estimation_step( - mod, - method = estimation_method, - idx = n_steps - 1, - interaction = TRUE, - tool_options = tool_options, - parameter_uncertainty_method = uncertainty_method - ) - } - - ## MU referencing? - if(mu_reference) { - mod <- pharmr::mu_reference_model(mod) - } - - ## Parameter uncertainty? - if(!is.null(uncertainty_method)) { - if(verbose) cli::cli_alert_info(paste0("Adding parameter uncertainty step: ", uncertainty_method)) - mod <- pharmr::add_parameter_uncertainty_step( - mod, - parameter_uncertainty_method = toupper(uncertainty_method) - ) - } - - ## Add $TABLEs - if(tool == "nonmem") { - if(!is.null(tables)) { - mod <- add_default_output_tables( - model = mod, - iiv = iiv, - tables = tables, - full_tables = full_tables - ) - } - } - - ## Add dataset (needed if we want to add covariates to the model) - if(!is.null(data)) { - if(isTRUE(auto_stack_encounters)) { - data <- stack_encounters( - data = data, - verbose = verbose - ) - } - if(verbose) cli::cli_alert_info("Updating model dataset with provided dataset.") - mod <- mod |> - pharmr::unload_dataset() |> - pharmr::set_dataset( - path_or_df = data, - datatype = "nonmem" - ) - if(verbose) cli::cli_alert_info("Checking and cleaning dataset.") - mod <- clean_modelfit_data( - model = mod, - try_make_numeric = TRUE - ) - } - - ## Handle BLQ - if(!is.null(blq_method)) { - blq_method <- tolower(blq_method) - allowed_blq <- paste0("m", 1:7) - if(! blq_method %in% allowed_blq) { - cli::cli_abort("`blq_method` should be one of {allowed_blq}, or `NULL`.") - } - if(!is.null(lloq) && "LLOQ" %in% names(mod$dataset)) { - lloq <- NULL - cli::cli_alert_info("`lloq` argument cannot be used when `LLOQ` column exists in dataset. Ignoring argument.") - } - if(is.null(lloq) && ! "LLOQ" %in% names(mod$dataset) && blq_method %in% c("m2", "m3", "m4", "m5", "m6")) { - cli::cli_abort("For {blq_method}-method, need either `lloq` argument or a LLOQ column in the dataset.") - } - mod <- pharmr::transform_blq(mod, method = blq_method, lloq = lloq) - } - - ## Set name? - if(!is.null(name)) { - mod <- pharmr::set_name(mod, new_name = name) - } - - if(verbose) cli::cli_alert_success("Done") - - return(mod) -} - -#' Helper function to combine default estimation options with user-specified, -#' and ensure correct format. -#' -get_estimation_options <- function(tool, estimation_method, estimation_options) { - tool_options <- estimation_options_defaults[[tool]][[estimation_method]] - if(!is.null(estimation_options)) { - tool_options[names(estimation_options)] <- estimation_options - } - for(key in names(tool_options)) { # to avoid e.g. `ITER=500.0` - tool_options[[key]] <- as.character(tool_options[[key]]) - } - tool_options -} - - -#' List of default options for estimation method. -#' -estimation_options_defaults <- list( - "nonmem" = list( - "foce" = list( - MAXEVAL = 2000, - PRINT = 5, - POSTHOC = "", - NOABORT = "" - ), - "saem" = list( - NBURN = 500, - NITER = 1000, - ISAMPLE = 2 - ) - ), - "nlmixr" = list( ## leave empty for now, pharmpy does not support nlmixr options yet. - "foce" = list( # https://nlmixr2.org/reference/foceiControl.html - ), - "saem" = list( - ) - ) -) - -#' Logic to set the residual error model structure for the model -#' -set_residual_error <- function(mod, ruv) { - if(ruv == "proportional") { - mod <- pharmr::set_proportional_error_model(mod) - } else if (ruv == "additive") { - mod <- pharmr::set_additive_error_model(mod) - } else if (ruv == "combined") { - mod <- pharmr::set_combined_error_model(mod) - } else if (ruv == "ltbs") { - # Pharmpy: first need to make additive, then set to proportional + log-transf. - mod <- mod |> - pharmr::set_additive_error_model() |> - pharmr::set_proportional_error_model(data_trans="log(Y)") - } else { - cli::cli_abort("Requested error model structure not recognized.") - } - mod -} - -#' Get route from data. -#' If dose and observation events all happen in the same compartment, -#' then assume IV administration, else oral absorption (or sc, im, etc). -#' -get_route_from_data <- function(data, default = "iv") { - if(is.null(data)) { - return(default) - } - dose_cmt <- data |> - dplyr::filter(EVID == 1) |> - dplyr::pull(CMT) |> - unique() - obs_cmt <- data |> - dplyr::filter(EVID == 0) |> - dplyr::pull(CMT) |> - unique() - if(length(setdiff(dose_cmt, obs_cmt)) > 0) { - route <- "oral" - } else { - route <- "iv" - } - route -} diff --git a/R/create_model_nlmixr.R b/R/create_model_nlmixr.R deleted file mode 100644 index c1b7b94..0000000 --- a/R/create_model_nlmixr.R +++ /dev/null @@ -1,51 +0,0 @@ -#' Temporary function that returns a hardcoded nlmixr2 model -#' -#' Any arguments to the function are just ignored, this is just for demo -#' purposes -#' -#' @export -#' -create_model_nlmixr <- function(...) { - mod <- function() { - ini({ - # --- THETAS --- - POP_KA <- c(0.0, 0.5, Inf) - POP_CL <- c(0.0, 5, Inf) - POP_V <- c(0.0, 150, Inf) - POP_BIO <- c(0.0, 0.5, 1.0) - - # --- ETAS --- - ETA_1 ~ 0.3 - ETA_2 ~ 0.3 - ETA_3 ~ 0.3 - - # --- EPSILONS --- - RUV_ADD <- c(0.0, 0.5, Inf) - }) - model({ - BIO <- log(POP_BIO/(1 - POP_BIO)) - TVKA <- POP_KA - TVCL <- POP_CL - TVV <- POP_V - KA <- TVKA*exp(ETA_1) - CL <- TVCL*exp(ETA_2) - V <- TVV*exp(ETA_3) - S2 <- V/1000 - F_BIO <- 1/(1 + exp(-BIO)) - - # --- DIFF EQUATIONS --- - d/dt(A_DEPOT) = -KA*A_DEPOT - d/dt(A_CENTRAL) = -CL*A_CENTRAL/V + KA*A_DEPOT - - f(A_DEPOT) <- F_BIO - F <- A_CENTRAL/S2 - W <- 1 - IPRED <- F - Y <- IPRED - add_error <- RUV_ADD*W - prop_error <- 0 - Y ~ add(add_error) + prop(prop_error) - }) - } - mod -} diff --git a/R/create_pharmpy_model_from_list.R b/R/create_pharmpy_model_from_list.R deleted file mode 100644 index 7baec06..0000000 --- a/R/create_pharmpy_model_from_list.R +++ /dev/null @@ -1,18 +0,0 @@ -#' Create a model object from the model code and dataset stored as a list -#' object. -#' -#' @param model_obj list object with entries `code` and `dataset` -#' -create_pharmpy_model_from_list <- function(model_obj) { - ## Pharmpy bug: datainfo not updated when using pharmar::set_dataset() - ## So need to make sure the dataset is on file when loading the model - code <- model_obj$code - tmpfile <- tempfile() - write.csv(model_obj$dataset, tmpfile, quote=F, row.names=F) - code <- stringr::str_replace( - code, - "\\$DATA ([\\/a-zA-Z0-9\\.]*)", - paste0("$DATA ", tmpfile) - ) - model <- pharmr::read_model_from_string(code) -} diff --git a/R/create_pkmodel_search_space.R b/R/create_pkmodel_search_space.R deleted file mode 100644 index f767f4f..0000000 --- a/R/create_pkmodel_search_space.R +++ /dev/null @@ -1,49 +0,0 @@ -#' Create PK mmodel search space definition for pharmpy `modelsearch` -#' -#' See Pharmpy MFL documentation for more info: -#' https://pharmpy.github.io/latest/modelsearch.html -#' -#' @param absorption absorption model options -#' @param elimination elimination model options -#' @param peripherals peripheral compartment options -#' @param transits transit model options -#' @param lagtime lagtime options -#' -#' @export -#' -create_pkmodel_search_space <- function( - absorption = c("FO", "ZO"), - elimination = c("FO", "MM"), - peripherals = c(0, 1), - transits = c(0, 1, 3), - lagtime = c("OFF", "ON") -) { - - ## Confirm all requested options are allowed - all_options <- list( - ABSORPTION = c("INST", "FO", "ZO", "SEQ-ZO-FO"), - ELIMINATION = c("FO", "ZO", "MM", "MIX-FO-MM"), - PERIPHERALS = c("number", "DRUG", "MET"), - TRANSITS = c("number", "DEPOT", "NODEPOT"), - LAGTIME = c("OFF", "ON") - ) - args <- c("absorption", "transits", "lagtime", "elimination", "peripherals") - out <- c() - for(key in args) { - value <- get(key) - if(!is.null(value) & length(value) > 0) { - tmp <- value - tmp[is.numeric(tmp)] <- rep("number", sum(is.numeric(tmp))) - if (! all(tmp %in% all_options[[toupper(key)]])) { - cli::cli_abort("Some options not recongized: {}") - } - out <- c( - out, - paste0(toupper(key), "([", paste0(value, collapse=","), "])") - ) - } - } - - paste(out, collapse = "; ") - -} diff --git a/R/create_regimen.R b/R/create_regimen.R deleted file mode 100644 index 0d26591..0000000 --- a/R/create_regimen.R +++ /dev/null @@ -1,111 +0,0 @@ -#' Create a single regimen -#' -#' The resulting data.frame can be passed to `luna::run_sim()` as the `regimen` -#' argument. -#' -#' @examples -#' -#' \dontrun{ -#' reg1 <- create_regimen( -#' dose = 500, -#' interval = 12, -#' n = 10, -#' route = "oral" -#' ) -#' luna::run_sim(..., regimen = reg1) -#' } -#' -#' @export -create_regimen <- function( - dose, - interval = 24, - n, - t_inf = NULL, - route = c("oral", "iv", "sc", "im") -) { - route <- match.arg(route) - if(route %in% c("iv", "im", "sc")) { - if(is.null(t_inf)) { - cli::cli_alert_info("`t_inf` not specified, assuming bolus dose.") - t_inf <- 0 - } - } else { - t_inf <- 0 - } - out <- data.frame( - dose = rep(dose, n), - time = seq(0, to = interval * (n - 1), by = interval), - route = rep(route, n), - t_inf = rep(t_inf, n), - interval = rep(interval, n) - ) - class(out) <- c("dosing_regimen", "data.frame") - out -} - -#' Combine several regimens into a single data.frame, which can be passed into -#' `luna::run_sim()` as `regimen` argument. -#' -#' @details -#' This allows both for combination of two or more phases, e.g. loading doses -#' and maintenance phase in a single regimen. It also allows for specification -#' of multiple separate regimens to simulate, e.g. a high-dose regimen and a -#' low-dose regimen. -#' -#' @param ... each argument is a named regimen, that in itself is specified as -#' a list containing multiple regimens, each created using `create_regimen()`. -#' See examples. -#' -#' @examples -#' \dontrun{ -#' regimens <- combine_regimens( -#' "without_load" = list( -#' create_regimen( -#' dose = 500, -#' interval = 12, -#' n = 10, -#' route = "oral" -#' ) -#' ), -#' "with_load" = list( -#' create_regimen( -#' dose = 2000, -#' n = 1, -#' interval = 12, -#' route = "iv", -#' t_inf = 1 -#' ), -#' create_regimen( -#' dose = 500, -#' n = 5, -#' interval = 24, -#' route = "oral" -#' ) -#' ) -#' ) -#' } -#' -#' @export -combine_regimens <- function(...) { - regs <- list(...) - regimen_names <- names(regs) - if(is.null(regimen_names)) { - cli::cli_abort("Please use named arguments to `combine_regimen()` to define the regimen names.") - } - comb <- data.frame() - for(key in names(regs)) { - t_last <- 0 - for(idx in seq(regs[[key]])) { - tmp <- regs[[key]][[idx]] - if(!inherits(tmp, "dosing_regimen")) { - cli::cli_abort("Please create dosing regimens using the `create_regimen()` function.") - } - tmp <- tmp |> - dplyr::mutate(time = time + t_last) |> - dplyr::mutate(regimen = key) - comb <- dplyr::bind_rows(comb, tmp) - t_last <- max(tmp$time) + tail(tmp$interval, 1) - } - } - comb -} diff --git a/R/create_run_folder.R b/R/create_run_folder.R deleted file mode 100644 index cd50263..0000000 --- a/R/create_run_folder.R +++ /dev/null @@ -1,31 +0,0 @@ -#' Create a folder for a run -#' -#' @inheritParams run_nlme -#' -create_run_folder <- function( - id, - path, - force = FALSE, - verbose = TRUE -) { - if(is.null(id)) { - id <- paste0("run", get_new_run_number(path)) - } - fit_folder <- file.path(path, id) - if(dir.exists(fit_folder)) { - if(force) { - if(verbose) cli::cli_alert_warning("Existing results found, removing") - files <- dir(fit_folder, all.files = TRUE) - for(f in files) { - if(!stringr::str_detect(f, "^\\.")) { - unlink(file.path(fit_folder, f)) - } - } - } else { - cli::cli_abort(paste0("Run folder (", fit_folder, ") exists. Use `force` to overwrite.")) - } - } else { - dir.create(fit_folder) - } - fit_folder -} diff --git a/R/create_vpc_data.R b/R/create_vpc_data.R deleted file mode 100644 index ad766c6..0000000 --- a/R/create_vpc_data.R +++ /dev/null @@ -1,160 +0,0 @@ -#' Run a simulation based on supplied parameters estimates, -#' and combine into proper format for VPC -#' -#' @param fit fit object from `pharmr::run_modelfit()`. Optional, can supply a -#' `model` and `parameters` argument -#' @param model pharmpy model object. Optional, can also only supply just a -#' `fit` object -#' @param parameters list of parameter estimates, e.g. `list(CL = 5, V = 50)`. -#' Optional, can also supply a `fit` object. -#' @param n number of simulation iterations to generate -#' @param keep_columns character vector of column names in original dataset -#' to keep in the output dataset -#' @param verbose verbose output? -#' -#' @export -#' -create_vpc_data <- function( - fit = NULL, - model = NULL, - parameters = NULL, - keep_columns = c(), - n = 100, - verbose = FALSE, - id = NULL, - use_pharmpy = TRUE -) { - - ## Make a copy of the model for simulations, and update initial estimates - tool <- get_tool_from_model(model) - if(is.null(model)) { - model <- attr(fit, "model") - if(is.null(model)) { - cli::cli_abort("Either a `fit` object with a model attached, or a `model` argument is required.") - } - } - data <- model$dataset - if(tool != "nonmem") { - warning("Currently, simulation is not supported by pharmpy for nlmixr-type models. Trying to convert to NONMEM model.") - ## dataset sometimes gets altered by pharmpy (CMT), make sure this doesn't happen - model <- pharmr::convert_model( - model, - to_format = "nonmem" - ) - if(!is.null(data)) { - model <- pharmr::set_dataset(model, data) - } - } - if(!is.null(parameters)) { - if(verbose) message("Using supplied `parameters` object") - } else { # try to grab from fit object - if(!is.null(fit) && !is.null(fit$parameter_estimates)) { - if(verbose) message("Using parameters from `fit` object") - parameters <- as.list(fit$parameter_estimates) - } else { - warning("No parameter estimates available, will use initial estimates for VPC!") - } - } - - if(is.null(model)) { - if(verbose) message("Using model from fit object") - model <- attr(fit, "model") - if(is.null(model) || !inherits(model, "pharmpy.model.model.Model")) { - cli::cli_abort("Model is not a pharmpy Model object.") - } - } - if(verbose) message("Updating estimates for simulation model") - sim_model <- pharmr::set_initial_estimates( - model, - inits = parameters - ) - - ## Remove tables and covariance step, add back table with stuff that the VPC needs (ID TIME DV EVID MDV) - keep <- unique(c("ENC_TIME", keep_columns)) - keep <- keep[keep %in% names(data)] - sim_model <- sim_model |> - pharmr::remove_parameter_uncertainty_step() |> - remove_tables_from_model() |> - add_table_to_model( - variables = c("ID", "TIME", "PRED", "DV", "EVID", "MDV", keep), - firstonly = FALSE, - file = "sdtab" - ) - - ## Make sure data is clean for modelfit - sim_model <- clean_modelfit_data(sim_model) - - tmp_path <- file.path( - tempdir(), - paste0("simulation_", random_string(5)) - ) - dir.create(tmp_path) - if(is.null(id)) { - id <- "tmp" - } - - ## Run maxeval=0 run to get obs dataset - if(verbose) cli::cli_alert_info("Running input model evaluation for VPC") - eval_model <- sim_model |> - pharmr::set_evaluation_step(idx = 0) - eval_res <- run_nlme( - model = eval_model, - path = tmp_path, - force = TRUE, - id = id, - save_final = FALSE - ) - obs <- attr(eval_res, "tables")[[1]] - - ## Run the simulation - if(verbose) cli::cli_alert_info("Running simulation for VPC") - sim_model <- pharmr::set_simulation( - sim_model, - n = n - ) - - sim_data <- run_nlme( - model = sim_model, - path = tmp_path, - force = TRUE, - id = id, - save_final = FALSE - ) - sim <- attr(sim_data, "tables")[[1]] - - ## Parse the output and make ready for vpc::vpc() - if(verbose) cli::cli_alert_info("Preparing simulated output data for plotting") - - ## Generate a TAD colunmn - if(is.null(obs$TAD)) { - obs <- obs |> - dplyr::group_by(ID) |> - dplyr::mutate(last_dose_time = if_else(EVID == 1, TIME, NA)) |> - tidyr::fill(last_dose_time, .direction = "downup") |> - dplyr::mutate(TAD = TIME - last_dose_time) |> - dplyr::select(-last_dose_time) - } - - ## Check if obs and sim match up, and make sure sim has the columns it needs - len_obs <- nrow(obs) - len_sim <- nrow(sim) - if((len_sim %% len_obs) != 0) { - cli::cli_abort("The simulated dataset length is not a multiple of the length of the original dataset. Please check model and simulation settings.") - } - if(use_pharmpy) { - transfer <- c("ID", "TIME", "PRED", "TAD", "ENC_TIME") - for(col in transfer) { - if(!is.null(obs[[col]])) { - sim[[col]] <- obs[[col]] - } else { - cli::cli_alert_warning("Column {col} not found in original dataset.") - } - } - } - for(col in keep_columns) { - sim[[col]] <- obs[[col]] - } - - ## Return - list(obs = obs, sim = sim) -} diff --git a/R/find_pk_parameter.R b/R/find_pk_parameter.R deleted file mode 100644 index 03b8f64..0000000 --- a/R/find_pk_parameter.R +++ /dev/null @@ -1,36 +0,0 @@ -#' Find / match PK parameter based on generic name. -#' -#' E.g. a user may request `pharmr::remove_iiv("V")`, to remove -#' IIV on the central volume. But if in the model the central volume is actually -#' parametrized as `V1` or `V2`, then it will error. When wrapped in -#' `find_pk_parameter` this adds more safety. It will first look if the -#' parameter is used in the model as such. If not found directly, it will -#' attempt other common names for the parameter, depending on the ADVAN number -#' of the model. -#' -#' @param parameter name of the parameter to find -#' @inheritParams run_nlme -#' -#' @export -#' -find_pk_parameter <- function(parameter, model) { - ## first try if parameter exist as-is - model_params <- pharmr::get_pk_parameters(model) - if(as.character(parameter) %in% model_params) { - return(parameter) - } - ## then, try to find depending on advan - advan <- get_advan(model) - if(advan %in% c(1, 3, 11)) { - map <- list("V" = "V1", "Q" = "QP1", "V2" = "VP1", "V3" = "VP2") - } else { - map <- list("V" = "V2", "Q" = "QP1", "V3" = "VP1", "V4" = "VP2") - } - if(is.null(map[[parameter]])) { - cli::cli_warn("Could not find parameter {parameter} in model as {parameter}, nor under different name.") - return(parameter) - } else { - cli::cli_alert_info("Found parameter {parameter} in model as {map[[parameter]]}.") - return(map[[parameter]]) - } -} diff --git a/R/fit_model.R b/R/fit_model.R deleted file mode 100644 index f14a64b..0000000 --- a/R/fit_model.R +++ /dev/null @@ -1,101 +0,0 @@ -#' Fit model using NONMEM or nlmixr2 -#' -#' Takes a pharmpy-loaded NONMEM model as input, and returns a pharmpy model -#' results object. So essentially this function is a drop-in replacement for the -#' run_modelfit() function in pharmr/pharmpy. -#' -#' @param model pharmpy model object -#' @param data data.frame with data to fit -#' @param tool either `nonmem` or `nlmixr` -#' @param path path to .rds file to save fit results to -#' @param ... passed onto `run_nmfe()` function -#' -#' @export -#' -fit_model <- function(model, data, tool = "nonmem", path, ...) { - if(! "pharmpy.model.external.nonmem.model.Model" %in% class(model)) { - cli::cli_abort("Needs a pharmpy model object to run.") - } - - if(tool == "nonmem") { - fit <- fit_model_nonmem(model, data, ...) - } else if (tool == "nlmixr") { - fit <- fit_model_nlmixr(model, data, ...) - } else { - cli::cli_abort(paste("Sorry, fit tool", tool, "not supported")) - } - - ## save fit object to file - saveRDS(fit$to_dict(), path) - - ## save model to markdown file - md_path <- stringr::str_replace(path, "\\.rds", ".md") - save_model_code(model$model_code, md_path) - - return(fit) -} - -#' Fit model using nlmixr2 -#' -#' @inheritParams fit_model -#' -fit_model_nlmixr <- function(model, data = NULL, ...) { - - if(is.null(data)) { # get from model reference - data <- model$dataset - } - - ## Fit - fit <- pharmr::run_modelfit( - model, - tool = "nlmixr" - ) - - return(fit) -} - -#' Fit model using NONMEM -#' -#' @inheritParams fit_model -#' -fit_model_nonmem <- function(model, data = NULL, ...) { - - ## Create temp folder - folder <- file.path(tempdir(), paste0(model$name, "_", get_datetime_string(), "_", random_string(6))) - dir.create(folder) - dataset_filename <- file.path(folder, "nm_data.csv") - model_filename <- file.path(folder, "run1.mod") - - ## Save dataset to folder - if(is.null(data)) { # get from model reference - data <- model$dataset - } - nm_save_dataset(data, dataset_filename) - - ## save model to folder - writeLines(model$model_code, model_filename) - - ## TODO: use Pharmpy to do update datset - ## rewrite model with updated dataset - nm_update_dataset( - model_filename, - basename(dataset_filename), - overwrite = TRUE - ) - - ## Run model - output <- run_nmfe( - model_filename, - folder = folder, - verbose = FALSE - ) - - ## Check for model errors reported from NONMEM - check_errors_nm_output(output) - - ## Return pharmpy results object, attach output data as well - res <- pharmr::read_modelfit_results(model_filename) - attr(res, "sdtab") <- read_table_nm(file.path(folder, "sdtab1")) - - res -} diff --git a/R/get_advan.R b/R/get_advan.R deleted file mode 100644 index 1107816..0000000 --- a/R/get_advan.R +++ /dev/null @@ -1,86 +0,0 @@ -#' Get ADVAN number for model -#' -#' @inheritParams run_nlme -#' -#' @returns integer (advan number) -#' -#' @export -#' -get_advan <- function(model) { - tmp <- model$internals$control_stream$records - idx <- lapply(seq_along(tmp), function(i) { - if(inherits(tmp[[i]], "pharmpy.model.external.nonmem.records.subroutine_record.SubroutineRecord")) { - return(i) - } - }) |> - unlist() - if(length(idx) >= 1) { - subroutine <- tmp[[idx[1]]] - } else { - return(invisible()) - } - as.integer(gsub("ADVAN", "", subroutine$advan)) -} - -#' Get observation compartment number from model -#' -#' @details For ADVAN1-4/11-12 this is easy, for other ADVANs we have to make some -#' assumptions based on whether scaling parameters have already been defined -#' for the model. Logic is as follows: -#' -#' - if S1 is defined and not S2, assume it's 1. -#' - if S2 is defined and not S1, assume it's 2 -#' - if both are defined, assume it's 2 but show a warning -#' - if none are defined, assume it's 2 but show a warning -#' -#' @inheritParams get_advan -#' -#' @returns single integer value -#' -#' @export -#' -get_obs_compartment <- function(model) { - advan <- get_advan(model) - if(advan %in% c(1, 3, 11)) { # iv - return(1) - } else if(advan %in% c(2, 4, 12)) { # with absorption - return(2) - } else { - s1 <- model$statements$find_assignment("S1") - s2 <- model$statements$find_assignment("S2") - ode_size <- get_ode_size(model) - if(!is.null(s1)) { - if(is.null(s2)) { - return(1) - } else { - comp <- ifelse(ode_size <= 1, 1, 2) - cli::cli_warn("Scaling parameters S1 and S2 are both defined, and could not determine observation compartment from ADVAN: assuming observation compartment is {ode_size}.") - return(comp) - } - } else { - if(!is.null(s2)) { - return(2) - } else { - comp <- ifelse(ode_size <= 1, 1, 2) - cli::cli_warn("No scaling parameters defined yet in model and could not determine observation compartment from ADVAN: assuming observation compartment is {comp}.") - return(comp) - } - } - } -} - -#' Get size of ODE system in $DES -#' -#' @inheritParams get_advan -#' -#' @returns single integer value -#' -#' @export -#' -get_ode_size <- function(model) { - advan <- get_advan(model) - if(advan %in% c(1,2,3,4,5,11,12)) { - return(0) - } - length(model$statements$ode_system$compartment_names) -} diff --git a/R/get_condition_number_for_fit.R b/R/get_condition_number_for_fit.R deleted file mode 100644 index 9de4ff5..0000000 --- a/R/get_condition_number_for_fit.R +++ /dev/null @@ -1,33 +0,0 @@ -#' Calculate the condition number for a model fit object -#' Performs some safety checks -#' -#' @param fit pharmpy fit object -#' -#' @export -get_condition_number_for_fit <- function( - fit -) { - if(is.null(fit$correlation_matrix)) { - cli::cli_alert_warning("Correlation matrix not available, cannot calculate condition number for fit.") - return(NA) - } - mat <- as.matrix(fit$correlation_matrix) - if(!inherits(mat, "matrix") || diff(dim(mat)) != 0) { - cli::cli_alert_warning("Needs a square matrix to calculate condition number.") - return(NA) - } - tryCatch({ - cond <- calc_condition_number(mat) - }, error = function(e) { - cli::cli_alert_warning("Failed to calculate condition number: {e}") - cond <- NA - }) - cond -} - -#' Calculate the condition number given a matrix -#' -calc_condition_number <- function(mat) { - e <- eigen(mat)$values - max(e) / min(e) -} diff --git a/R/get_cov_matrix.R b/R/get_cov_matrix.R deleted file mode 100644 index 10928da..0000000 --- a/R/get_cov_matrix.R +++ /dev/null @@ -1,95 +0,0 @@ -#' Create a covariance block matrix -#' -#' @param params parameters, a vector of standard deviations and correlations, -#' e.g. `list("CL" = 0.1, "V" = 0.2, "KA" = 0.3, "CL~V" = 0.3)`. -#' @param keep_all Should all parameters be kept in the covariance matrix, -#' even if they do not have a correlation with other parameters? -#' @param triangle return the lower triangle as a vector instead of a -#' matrix object? -#' @param limit lower limit, to avoid becoming zero, which is not allowed by -#' NONMEM (`A COVARIANCE IS ZERO, BUT THE BLOCK IS NOT A BAND MATRIX.`) -#' -#' @examples -#' \dontrun{ -#' make_cov_matrix(list("CL" = 0.1, "V" = 0.2, "KA" = 0.3, "CL~V" = 0.3)) -#' } -#' -get_cov_matrix <- function( - params, - keep_all = FALSE, - triangle = FALSE, - nonmem = TRUE, - limit = 0.001 -) { - # Separate SDs and correlations - sds <- params[!grepl("~", names(params))] - cors <- params[grepl("~", names(params))] - - vars <- names(sds) - n <- length(vars) - cov_mat <- matrix(0, n, n, dimnames = list(vars, vars)) - - # Fill diagonal with variances - for (v in vars) { - cov_mat[v, v] <- sds[[v]]^2 - } - - # Fill off-diagonal with covariances - corr_params <- c() - for (nm in names(cors)) { - parts <- strsplit(nm, "~")[[1]] - v1 <- parts[1] - v2 <- parts[2] - corr_params <- c(corr_params, v1, v2) - rho <- cors[[nm]] - cov_val <- rho * sds[[v1]] * sds[[v2]] - cov_mat[v1, v2] <- cov_val - cov_mat[v2, v1] <- cov_val - } - - # Lower limit for covariance, also make sure there are no 0s in the block. - if(!is.null(limit)) { - for(i in 2:(nrow(cov_mat))) { - for(j in 1:(i-1)) { - cov_mat[i, j] <- max(c(limit, cov_mat[i, j])) - cov_mat[j, i] <- max(c(limit, cov_mat[j, i])) - } - } - } - - ## make sure the param names are unique, and in right order - corr_params <- intersect(names(params), unique(corr_params)) - - ## Keep only parameters that have corrs - if(!keep_all) { - idx <- match(corr_params, rownames(cov_mat)) - cov_mat <- cov_mat[idx, idx] - } - - if(nonmem) { - return(format_lower_triangle(cov_mat)) - } - - ## Lower triangle output? - if(triangle) { - cov_mat <- cov_mat[lower.tri(cov_mat, diag = TRUE)] - } - - cov_mat -} - -format_lower_triangle <- function(cov_mat, digits = 3, na_str = ".", ...) { - vars <- colnames(cov_mat) - n <- length(vars) - - # format numbers - fmt <- function(x) ifelse(is.na(x), na_str, formatC(x, format = "f", digits = digits)) - - lines <- character(n) - for (i in seq_len(n)) { - row_vals <- sapply(seq_len(i), function(j) fmt(cov_mat[i, j])) - lines[i] <- paste(row_vals, collapse = " ") - } - - lines -} diff --git a/R/get_final_results_from_search.R b/R/get_final_results_from_search.R deleted file mode 100644 index bd25889..0000000 --- a/R/get_final_results_from_search.R +++ /dev/null @@ -1,45 +0,0 @@ -#' For a Pharmpy grid search, fetch the fit info and attach to object -#' -#' @param id run id -#' @param results Pharmpy results object from grid search -#' @param tool Pharmpy search tool. If `NULL`, will try to infer from class of -#' results object -#' -#' @export -#' -get_final_results_from_search <- function( - id, - results, - tool = NULL, - verbose = TRUE -) { - - if(is.null(tool)) { - type <- class(results)[1] - tool <- stringr::str_extract(type, "pharmpy\\.tools\\.([a-z]*)\\.", group = 1) - } - if(is.null(tool) || is.na(tool)) { - cli::cli_abort("Sorry, don't recognize this object as results from a Pharmpy grid search tool.") - } - if(is.null(results$final_results)) { - cli::cli_abort("Sorry, it seems that no final results are available for this grid search.") - } - - ## Get folder name and last fit folder - folders <- stringr::str_replace_all( - dir(id, include.dirs = TRUE, pattern = paste0("^", tool, "[0-9].?$")), - tool, - "" - ) - numbers <- as.numeric(folders) - last_run <- paste0(tool, max(numbers)) - - ## Try to grab fit info and tables etc. - fit <- luna::attach_fit_info( - results$final_results, - results$final_model, - fit_folder = file.path(id, last_run, "models", "final") - ) - - fit -} \ No newline at end of file diff --git a/R/get_fit_info.R b/R/get_fit_info.R deleted file mode 100644 index 7ab6d13..0000000 --- a/R/get_fit_info.R +++ /dev/null @@ -1,148 +0,0 @@ -#' Get fit info from NONMEM run -#' -#' @param fit pharmpy fit object -#' @param path path to run folder -#' @param output_file NONMEM output file, default is `run.lst` -#' -#' @export -get_fit_info <- function(fit, path = NULL, output_file = "run.lst") { - lst_file <- file.path(path, output_file) - fit_info <- list( - ofv = fit$ofv, - condition_number = get_condition_number_for_fit(fit), - shrinkage = get_shrinkage_summary(path = lst_file, fit = fit), - eta_bar = "TODO", - iterations = length(fit$ofv_iterations), - function_evaluations = fit$function_evaluations, - parameter_estimates = fit$parameter_estimates, - standard_errors = fit$standard_errors, - relative_standard_errors = fit$relative_standard_errors, - runtime = list( - estimation = fit$estimation_runtime, - total = fit$runtime_total - ), - run_info = list( - minimization_successful = ifelse(fit$minimization_successful, "yes", "no"), - covstep_successful = ifelse(fit$covstep_successful, "yes", "no"), - termination_cause = fit$termination_cause, - warnings = as.character(fit$warnings), - significant_digits = fit$significant_digits - ) - ) - class(fit_info) <- c("list", "pharmpy_fit_info") - fit_info -} - -#' Print function that provides basic run information for a pharmpy modelfit -#' -#' @param x pharmpy fit object -#' -#' @export -print.pharmpy.workflows.results.ModelfitResults <- function(x, ...) { - - ## Run description, notes, etc - run <- attr(x, "run") - if(!is.null(run)) { - data.frame( - "Run log" = c("Description", "Notes", "Tags"), - "Value" = c( - run$description, - ifelse0(run$notes, ""), - paste0(ifelse0(run$tags, ""), collapse = ", ") - ) - ) |> - dplyr::filter(Value != "") |> - knitr::kable(row.names = FALSE, format = "simple") |> - print() - } - - ## General run info - info_tab <- create_modelfit_info_table(x) - print(knitr::kable(info_tab, row.names = FALSE, format = "simple")) - - ## Parameter estimates + uncertainty - par_tab <- create_modelfit_parameter_table(x) - print(knitr::kable(par_tab, row.names = FALSE)) - -} - -#' Create a data.frame with basic model fit info -#' -#' @param fit pharmpy fit object -#' -create_modelfit_info_table <- function(fit) { - x <- attr(fit, "info") - eta_shrinkage <- data.frame() - etas <- gsub("ETA_", "", names(x$shrinkage$eta)) - for(i in seq(etas)) { - eta_shrinkage <- dplyr::bind_rows( - eta_shrinkage, - data.frame(ETA = etas[i], value = signif(x$shrinkage$eta[i], 3)) - ) - } - ofv <- ifelse(!is.null(x$ofv), round(x$ofv, 3), NA) - if(!is.na(ofv) && !is.null(x$dofv)) { - sign <- ifelse(x$dofv < 0, "-", ifelse(x$dofv > 0, "+",)) - dofv <- abs(round(x$dofv, 3)) - ref_run <- paste0(" vs ", x$reference_run) - } else { - dofv <- "" - sign <- "" - ref_run <- "" - } - condition_number <- ifelse(!is.null(x$condition_number), signif(x$condition_number, 3), NA) - tools <- attr(fit, "tools") - model <- attr(fit, "model") - est_steps <- model$execution_steps$to_dataframe() - info_tab <- data.frame( - c("OFV:", paste0(ofv, " (", sign, dofv, ref_run, ")")), - c("Condition number:", condition_number), - c("ETA Shrinkage: ", paste0(paste0(eta_shrinkage$ETA, ": ", eta_shrinkage$value, " %"), collapse=", ")), - c("Run info:", ""), - c("- Estimation step(s): ", ifelse0(paste0(est_steps$method, collapse = ", "), "NA")), - c("- Minimization success:", x$run_info$minimization_successful), - c("- Covariance step success:", x$run_info$covstep_successful), - c("- Evaluations: ", x$function_evaluations), - c("- Termination cause:", ifelse0(x$run_info$termination_cause, "")), - c("- Warnings:", paste(x$run_info$warnings, collapse = " / ")), - c("- Sign. digits:", x$run_info$significant_digits), - c("- Run time:", paste0(x$runtime$estimation, " sec (estimation), ", x$runtime$total, " sec (total)")), - c("Tool folders:", ifelse0(paste0(tools, collapse = ", "), "None")) - ) |> - t() - colnames(info_tab) <- c("Result", "Value") - rownames(info_tab) <- NULL - - info_tab -} - -#' Create a data.frame with parameter estimates -#' -create_modelfit_parameter_table <- function(fit) { - x <- attr(fit, "info") - if(is.null(x$standard_errors)) { - stdevs <- rep(NA, length(x$parameter_estimates)) - } else { - stdevs <- as.numeric(x$standard_errors) - } - data.frame( - Parameter = names(x$parameter_estimates), - Estimate = as.numeric( - x$parameter_estimates - ), - SD = stdevs - ) |> - dplyr::mutate(`RSE %` = dplyr::if_else( - Estimate != 0, - round(100 * SD / Estimate, 1), - NA - ) - ) |> - dplyr::select(-SD) |> - dplyr::mutate( - Estimate = format( - signif(Estimate, 5), - trim = FALSE, drop0trailing = TRUE, scientific = FALSE - ) - ) -} diff --git a/R/get_initial_estimates_from_data.R b/R/get_initial_estimates_from_data.R deleted file mode 100644 index 9f02d79..0000000 --- a/R/get_initial_estimates_from_data.R +++ /dev/null @@ -1,113 +0,0 @@ -#' Get a very crude estimate for V to serve as initial estimate -#' for CL and V, without performing an NCA. The calculation is based on -#' the assumption that often in clinical trial data, there is at least a -#' peak and a trough (and likely other samples) taken, hence it's -#' possible to get a crude estimate for CL and V from that. -#' For 2-compartment models we just set Q and V to half and -#' twice the size of CL and V, which is often a good starting point. -#' In most scenarios this is sufficiently close to the final estimates that -#' estimation methods will be able to find the global minimum. -#' -#' @param data NONMEM-style dataset -#' @param n_cmt number of distribution / elimination compartments. -#' -#' @export -get_initial_estimates_from_data <- function( - data, - n_cmt = 1, - scale_observations = NULL -) { - - ## TODO: an extension could be to automatically add - ## observed value scaling, e.g. when V < 1.0. - pars <- data.frame() - ids <- unique(data$ID) - for(id in ids) { - tmp <- get_initial_estimates_from_individual_data( - data[data$ID == id,] - ) - if(length(tmp) > 0) { - pars <- dplyr::bind_rows(pars, tmp) - } - } - est <- pars |> - dplyr::summarise_all(function(x) signif(mean(x, na.rm=TRUE), 3)) |> - as.list() - if(n_cmt >= 2) { - est$QP1 <- est$CL - est$VP1 <- est$V * 2 - } - if(n_cmt == 3) { - est$QP2 <- est$CL - est$VP2 <- est$V * 3 - } - if(is.null(scale_observations)) { - scale_observations <- 1 - } - for(i in seq_along(est)) { - est[[i]] <- signif(est[[i]] * scale_observations, 3) - } - - est -} - -#' Core function to get parameter estimates from individual data -#' -get_initial_estimates_from_individual_data <- function(data, ...) { - - suppressWarnings( - dat <- data |> - dplyr::mutate( - dosenr = cumsum(EVID), - DV = as.numeric(DV), - TIME = as.numeric(TIME) - ) - ) - - ## Get first dose number for which more than two samples are available. - dose_nr <- dat |> - dplyr::filter(EVID == 0) |> - dplyr::group_by(dosenr) |> - dplyr::summarise(n_obs = length(TIME)) |> - dplyr::filter(n_obs >= 2) |> - dplyr::slice(1) |> - dplyr::pull(dosenr) - - if(length(dose_nr) == 0) { - ## take first observation for which at least one obs is available - dose_nr <- dat |> - dplyr::filter(EVID == 0) |> - dplyr::group_by(dosenr) |> - dplyr::summarise(n_obs = length(TIME)) |> - dplyr::filter(n_obs == 1) |> - dplyr::slice(1) |> - dplyr::pull(dosenr) - } - if(length(dose_nr) == 0) { # no observations in data - return() - } - - ## get peak value. This leads to estimate for V - tmp <- dat |> - dplyr::filter(dosenr == dose_nr & EVID == 0 & !is.na(DV) & DV != 0) |> - dplyr::slice(unique(c(which.max(DV), which.min(DV)))) - dose <- dat |> - dplyr::filter(dosenr == dose_nr & EVID == 1) |> - dplyr::pull(AMT) - est <- c() - if(inherits(tmp$TIME, "numeric") && nrow(tmp) > 1) { # two datapoints at least - KEL <- (log(max(tmp$DV)) - log(min(tmp$DV))) / abs(diff(tmp$TIME)) - est$V <- dose / max(tmp$DV, na.rm=TRUE) - est$CL <- KEL * est$V - } else { # more crude estimation - if(length(tmp$DV) > 0) { - est$V <- dose / (max(tmp$DV, na.rm=TRUE) * 5) - est$CL <- est$V / 10 - } else { # for placebo patients, DV may all be zero or NA so we should not attempt to ballpark V or CL - est$V <- NA - est$CL <- NA - } - } - - unlist(est) -} diff --git a/R/get_pharmpy_conf.R b/R/get_pharmpy_conf.R deleted file mode 100644 index a5acf3f..0000000 --- a/R/get_pharmpy_conf.R +++ /dev/null @@ -1,55 +0,0 @@ -#' Get pharmpy configuration, as an R object (list) -#' -#' @export -#' -#' @returns a list object -#' -get_pharmpy_conf <- function() { - - ## Get path to config file - pharmpy_conf <- pharmr::get_config_path() - pharmpy_stop_msg <- "Cannot find Pharmpy configuration file. Please check your Pharmpy / pharmr installation." - if(is.null(pharmpy_conf)) { - cli::cli_abort(pharmpy_stop_msg) - } - if(!file.exists(pharmpy_conf)) { - cli::cli_abort(pharmpy_stop_msg) - } - - ## Read / check config file - suppressWarnings({ # may throw warning about incomplete final line - ini <- read_ini(pharmpy_conf) - }) - if(!inherits(ini, "list")) { - cli::cli_abort("Pharmpy configuration could not be interpreted. Please check your configuration file at {pharmpy_conf}") - } - - ini -} - -#' Helper function for read_ini -extract <- function(regexp, x) { - regmatches(x, regexec(regexp, x))[[1]][2] -} - -#' Read ini file core function -#' -read_ini <- function(fn) { - blank = "^\\s*$" - header = "^\\[(.*)\\]$" - key_value = "^.*=.*$" - lines = readLines(fn) - ini <- list() - for (l in lines) { - if (grepl(blank, l)) next - if (grepl(header, l)) { - section = extract(header, l) - ini[[section]] = list() - } - if (grepl(key_value, l)) { - kv = strsplit(l, "\\s*=\\s*")[[1]] - ini[[section]][[kv[1]]] = kv[2] - } - } - ini -} diff --git a/R/get_pharmpy_runfolders.R b/R/get_pharmpy_runfolders.R deleted file mode 100644 index 23eaab8..0000000 --- a/R/get_pharmpy_runfolders.R +++ /dev/null @@ -1,27 +0,0 @@ -#' Find last pharmpy run folder -#' -#' @inheritParams call_pharmpy_tool -#' -get_pharmpy_runfolders <- function( - id = NULL, - folder = NULL, - tool -) { - if(is.null(folder)) { - folder <- getwd() - } - if(!is.null(id)) { - fit_folder <- file.path(folder, id) - } else { - fit_folder <- folder - } - tool_dirs <- list.dirs( - path = fit_folder, - recursive = FALSE, - full.names = FALSE - ) - pattern <- paste0("^", tool, "[0-9]+?$") - tool_dirs <- tool_dirs[stringr::str_detect(tool_dirs, pattern)] - last_dir <- tool_dirs[order(stringr::str_rank(tool_dirs, numeric = TRUE))] - last_dir -} diff --git a/R/get_shrinkage_summary.R b/R/get_shrinkage_summary.R deleted file mode 100644 index 6676ccf..0000000 --- a/R/get_shrinkage_summary.R +++ /dev/null @@ -1,70 +0,0 @@ -#' Parses a NONMEM output file and extracts shrinkage -#' -#' @param fit pharmpy model object -#' @param path path to nonmem output file (.lst) -#' -get_shrinkage_summary <- function(path = NULL, fit = NULL) { - if(is.null(path) || !file.exists(path)) { - return(list()) - } - txt <- readLines(path) - eta <- get_shrinkage_values(txt, "ETASHRINKSD") - ebv <- get_shrinkage_values(txt, "EBVSHRINKSD") # based on first order approximation of the posterior variance around the mode (see intro to NM7 pdf, p231) - eps <- get_shrinkage_values(txt, "EPSSHRINKSD") - if(!is.null(fit$individual_estimates)) { - eta_names <- names(fit$individual_estimates) - } else { - eta_names <- paste0("ETA_", seq(length(eta))) - } - if(is.null(eta)) { - cli::cli_alert_info("Cannot compute shrinkage.") - return(list()) - } - names(eta) <- eta_names[1:length(eta)] - names(ebv) <- eta_names[1:length(eta)] - list( - eta = eta, - ebv = ebv, - eps = eps - ) -} - -#' Get shrinkage values from a single line in NONMEM output -#' -get_shrinkage_values <- function( - txt, - type = "ETASHRINKSD" -) { - idx <- grep(type, txt) - if(length(idx) == 0) { - return(NA) - } else { - if(length(idx) > 1) { - idx <- idx[1] - } - } - line <- txt[idx] - ## Also check in next 2 lines for more values - line1 <- gsub(" ", "", substr(txt[idx + 1], 1, 16)) - line2 <- gsub(" ", "", substr(txt[idx + 2], 1, 16)) - if(!is.na(line1) && line1 == "") { - line <- paste0(line, txt[idx+1]) - } - if(!is.na(line2) && line2 == "") { - line <- paste0(line, txt[idx+2]) - } - spl <- line |> - stringr::str_replace_all(type, "") |> - stringr::str_replace_all("\\(%\\)", "") |> - stringr::str_split("\\s") - if(length(spl) == 0) { - return(NA) - } - shr <- as.numeric(spl[[1]]) - shr <- shr[!is.na(shr)] - if(length(shr) > 0) { - return(shr) - } else { - return(NA) - } -} diff --git a/R/get_tables_from_fit.R b/R/get_tables_from_fit.R deleted file mode 100644 index eeb60b3..0000000 --- a/R/get_tables_from_fit.R +++ /dev/null @@ -1,45 +0,0 @@ -#' Read tables created in model run and return as a list of data.frames -#' -#' @param model pharmpy model object -#' @param path path to model execution folder -#' -#' @export -#' -get_tables_from_fit <- function(model, path) { - table_names <- get_tables_in_model_code(model$code) - tables <- get_tables_from_folder( - table_names, - path - ) - tables -} - -#' Get tables from a folder, by table_names -#' -#' @inheritParams get_tables_from_fit -#' @param table_names file names of tables -#' -get_tables_from_folder <- function( - table_names, - path -) { - tables <- list() - if(length(table_names) > 0) { - for(tabnam in table_names) { - file_name <- file.path(path, tabnam) - if(file.exists(file_name)) { - suppressWarnings( - suppressMessages( - tables[[tabnam]] <- read_table_nm(file = file.path(path, tabnam)) - ) - ) - if(stringr::str_detect(tabnam, "^patab") && "ID" %in% names(tables[[tabnam]])) { - tables[[tabnam]] <- tables[[tabnam]] |> # apply FIRSTONLY on patab files - dplyr::group_by(.data$ID) |> - dplyr::slice(1) - } - } - } - } - tables -} diff --git a/R/get_tables_in_model_code.R b/R/get_tables_in_model_code.R deleted file mode 100644 index 4b16d0f..0000000 --- a/R/get_tables_in_model_code.R +++ /dev/null @@ -1,14 +0,0 @@ -#' extract FILE names from $TABLE using simple regex. -#' For some reason the tables are not (yet?) available in pharmpy -#' -#' @param code a character string with NONMEM model code -#' -#' @export -get_tables_in_model_code <- function(code) { - txt <- stringr::str_replace_all(code, "\\n", " ") - tables <- stringr::str_match_all( - txt, - "\\$TABLE\\s+(?:(?!\\$).)*?FILE=([^\\s]+)" - )[[1]][,2] - tables -} \ No newline at end of file diff --git a/R/get_tool_from_model.R b/R/get_tool_from_model.R deleted file mode 100644 index 03273a8..0000000 --- a/R/get_tool_from_model.R +++ /dev/null @@ -1,12 +0,0 @@ -#' Get estimation/simulation engine from pharmpy model -#' -#' @param model pharmpy model -#' -#' @export -get_tool_from_model <- function(model) { - tool <- "nonmem" - if(inherits(model, "pharmpy.model.external.nlmixr.model.Model")) { - tool <- "nlmixr" - } - tool -} diff --git a/R/is_ltbs_model.R b/R/is_ltbs_model.R deleted file mode 100644 index 979fc06..0000000 --- a/R/is_ltbs_model.R +++ /dev/null @@ -1,26 +0,0 @@ -#' Is the residual error model "log-transform both-sides"? -#' -#' @inheritParams create_model -#' -#' @export -#' -is_ltbs_model <- function(model) { - if(! "control_stream" %in% names(model$internals)) { - ## TODO: not yet implemented for nlmixr2! - cli::cli_alert_warning("Check for LTBS not yet implemented for nlmixr2.") - return(FALSE) - } - res <- model$internals$control_stream$get_error_record() - if(!is.null(res) && inherits(res, "pharmpy.model.external.nonmem.records.code_record.CodeRecord")) { - y <- res$statements$find_assignment("Y") - if(!is.null(y) && inherits(y, "pharmpy.model.statements.Assignment")) { - return( - stringr::str_detect( - y$to_dict()$expression, - "log\\(.*?\\)" - ) - ) - } - } - FALSE -} diff --git a/R/luna-package.R b/R/luna-package.R new file mode 100644 index 0000000..30d8841 --- /dev/null +++ b/R/luna-package.R @@ -0,0 +1,9 @@ +#' luna package +#' +#' Pharmacometrics workflow manager +#' +#' @name luna +#' +#' @importFrom stats setNames +#' @importFrom utils file.edit tail write.csv +NULL diff --git a/R/luna_check.R b/R/luna_check.R index 8b25cac..6cd035e 100644 --- a/R/luna_check.R +++ b/R/luna_check.R @@ -1,6 +1,6 @@ #' Syntax-check a NONMEM model #' -#' @inheritParams run_nlme +#' @inheritParams luna_run #' #' @export luna_check <- function( @@ -49,7 +49,7 @@ luna_check <- function( } cli::cli_alert_success("Model loaded successfully.") - model_ok <- run_nlme( + model_ok <- pharmr.extra::run_nlme( model = model, id = id, path = folder, diff --git a/R/luna_compare.R b/R/luna_compare.R index 796a19b..3a1780c 100644 --- a/R/luna_compare.R +++ b/R/luna_compare.R @@ -23,7 +23,7 @@ luna_compare <- function( return(results) }) names(model_results) <- runs - results <- compare_nlme_fit( + results <- pharmr.extra::compare_nlme_fit( model_results, return_object = return_object ) diff --git a/R/luna_diff.R b/R/luna_diff.R index b70a377..85c0073 100644 --- a/R/luna_diff.R +++ b/R/luna_diff.R @@ -21,7 +21,7 @@ luna_diff <- function( if(is.null(folder)) { folder <- .luna_cache$get("project")$metadata$folder } - + ## Figure out which files to look at if(!is.null(reference)) { new_id <- validate_id(id) @@ -29,7 +29,7 @@ luna_diff <- function( } else { # get reference from YAML, if available new_id <- validate_id(id) runs <- .luna_cache$get("project")$yaml$runs - log_entry <- luna:::pluck_entry(runs, new_id) + log_entry <- pluck_entry(runs, new_id) if(is.null(log_entry)) { cli::cli_abort("Cannot find run in YAML.") } @@ -42,7 +42,7 @@ luna_diff <- function( } } } - + ## Load files model_file_new <- find_file_with_fallback( folder, @@ -56,11 +56,11 @@ luna_diff <- function( fallback = paste0(ref_id, ".mod"), verbose = FALSE ) - + ## Generate diff diffr::diffr( - model_file_new, + model_file_new, model_file_ref ) - + } diff --git a/R/luna_list.R b/R/luna_list.R index 6f8f219..a36987e 100644 --- a/R/luna_list.R +++ b/R/luna_list.R @@ -34,14 +34,14 @@ luna_list <- function( sel_cols <- names(cols)[unlist(cols)] check_unknown <- setdiff(sel_cols, names(out)) if(length(check_unknown) > 0) { - cli::cli_alert_warning("Columns {check_unknown} not available, please check configuration.") + cli::cli_warn("Columns {check_unknown} not available, please check configuration.") sel_cols <- intersect(sel_cols, names(out)) } if(length(sel_cols) > 0) { out <- out |> dplyr::select(!!sel_cols) } else { - cli::cli_warning("No columns selected, please check luna configuration.") + cli::cli_warn("No columns selected, please check luna configuration.") } } } diff --git a/R/luna_run.R b/R/luna_run.R index 09337c6..7e947bf 100644 --- a/R/luna_run.R +++ b/R/luna_run.R @@ -68,7 +68,7 @@ luna_run <- function( } method <- ifelse0(config$tools$modelfit$method, "pharmpy") console <- ifelse0(config$tools$modelfit$console, TRUE) - run_nlme( + pharmr.extra::run_nlme( model = model, id = id, path = folder, @@ -78,47 +78,4 @@ luna_run <- function( console = console, ... ) -} - -#' Helper function to determine nmfe location from various sources -#' The order is as follows: -#' -#' 1. argument specified by user -#' 2. check project settings (not implemented for now, will add later) -#' 3. check pharmpy config -#' 4. throw error, force user to specify -#' -get_nmfe_location_for_run <- function( - nmfe = NULL, - verbose = FALSE -) { - if(!is.null(nmfe)) { - if(verbose) cli::cli_alert_info("Using user-specified NONMEM version at {nmfe}") - } else { - pharmpy_conf <- get_pharmpy_conf() - nm_path <- pharmpy_conf$pharmpy.plugins.nonmem$default_nonmem_path - if(is.null(nm_path)) { - cli::cli_abort("Pharmpy is not configured to run NONMEM.") - } - if(!file.exists(nm_path)) { - cli::cli_abort("NONMEM path configured in Pharmpy is not a valid folder. Please reconfigure Pharmpy") - } - nmfe_file <- detect_nmfe_version(nm_path) - nmfe <- file.path(nm_path, "run", nmfe_file) - if(verbose) cli::cli_alert_info("Using Pharmpy-configured NONMEM version at {nmfe}") - } - if(is.null(nmfe) || !file.exists(nmfe)) { - cli::cli_abort("Could not determine path to NONMEM nmfe file, please specify manually with `nmfe` argument or reconfigure Pharmpy.") - } - nmfe -} - -#' get nmfe file name from a NONMEM installation folder -#' -detect_nmfe_version <- function(nm_path) { - files <- dir( - file.path(nm_path, "run"), - pattern = "nmfe\\d\\d" - ) - files[1] -} +} \ No newline at end of file diff --git a/R/luna_tool.R b/R/luna_tool.R index 79f8b3a..02485a2 100644 --- a/R/luna_tool.R +++ b/R/luna_tool.R @@ -92,7 +92,7 @@ luna_tool <- function( options <- tool_obj$options[[1]] ## create run folder, if needed - model <- prepare_run_folder( + model <- pharmr.extra::prepare_run_folder( id = id, model = model, path = folder, @@ -115,7 +115,7 @@ luna_tool <- function( } else if(method == "psn") { ## Parse options into args - args <- parse_psn_args(tool_obj) + args <- pharmr.extra::parse_psn_args(tool_obj) tool_clean <- gsub("^(.*?)::", "", tool) ## call PsN tool @@ -132,30 +132,4 @@ luna_tool <- function( ) ) } -} - -#' Parse tool options specified in YAML into PsN commandline args -#' -#' @param options list of options. Logical arguments should be specified -#' as TRUE/FALSE. -#' -parse_psn_args <- function(options) { - options$id <- NULL - options$tool <- NULL - if(is.null(options) || length(options) == 0) { - return(NULL) - } - ## split in logical and epxlicit options - logical_options <- list() - for(key in names(options)) { - if(class(options[[key]]) == "logical") { - logical_options[[key]] <- options[[key]] - options[[key]] <- NULL - } - } - args <- c(paste0("--", names(options), "=", options)) - if(length(logical_options) > 0) { - args <- c(args, paste0("--", names(logical_options))) - } - args -} +} \ No newline at end of file diff --git a/R/misc.R b/R/misc.R index fa4c9d7..ee0a0c1 100644 --- a/R/misc.R +++ b/R/misc.R @@ -148,20 +148,6 @@ is_run_as_job <- function(config, as_job = NULL) { as_job } -#' Does the last estimation method in a model have maxeval=0? -#' -#' @export -#' -is_maxeval_zero <- function(model) { - last_step <- model$execution_steps$to_dataframe() |> - tail(1) - options <- list() - if(!is.null(last_step$tool_options) && length(last_step$tool_options) > 0) { - options <- last_step$tool_options[[1]] - } - (is.na(last_step$maximum_evaluations) || last_step$maximum_evaluations == 0) && (is.null(options$MAXEVAL) || isTRUE(options$MAXEVAL == "0")) -} - #' Get a binary value from config, based on path #' #' @param flag character vector indicating path to flag @@ -202,19 +188,4 @@ replace_list_elements <- function (x, y) { } ) x -} - -#' Get a random sequence of letters and numbers of size `n` -#' -#' @param prefix optional prefix -#' -#' @returns character -get_random_id <- function(prefix = NULL, n = 6) { - paste0( - prefix, - paste0( - sample(c(letters, LETTERS, 0:9), n, replace = TRUE), - collapse = "" - ) - ) -} +} \ No newline at end of file diff --git a/R/nm_read_model.R b/R/nm_read_model.R deleted file mode 100644 index a2265eb..0000000 --- a/R/nm_read_model.R +++ /dev/null @@ -1,56 +0,0 @@ -#' Parse NONMEM model file into a list containing blocks of code -#' -#' @param modelfile NONMEM model filename -#' @param as_block import code blocks as block of text (`TRUE`, default) or as -#' separate lines (`FALSE`) -#' @param code NONMEM code (alternative to specifying file name) -#' -#' @export -nm_read_model <- function( - modelfile = NULL, - as_block = FALSE, - code = NULL) { - if(is.null(modelfile)) { - if(is.null(code)) { - cli::cli_abort("Please specify a NONMEM modelfile or NONMEM code.") - } - } - if(!is.null(code)) { - nm_txt <- code - } else { - if(file.exists(modelfile)) { - nm_txt <- readChar(modelfile, file.info(modelfile)$size) - } else { - cli::cli_abort(paste0("NONMEM modelfile (", modelfile,") not found.")) - } - } - nm_lines <- stringr::str_split(nm_txt, "\\n")[[1]] - # remove any spaces before start of line - for(i in seq(nm_lines)) { - nm_lines[i] <- stringr::str_replace_all(nm_lines[i], "^[\\s\\t]*", "")[[1]] - } - # get block indices: - block_idx <- c(1:length(nm_lines))[stringr::str_detect(nm_lines, "^\\$")] - if(length(block_idx) == 0) { - print(nm_lines) - cli::cli_abort("Sorry, no code blocks detected in NONMEM file.") - } - block_idx <- c(block_idx, length(nm_lines)+1) - obj <- list() - for(i in 1:(length(block_idx)-1)) { - block_id <- stringr::str_replace( - stringr::str_split(nm_lines[block_idx[i]], "\\s")[[1]][1], - "^\\$", "") - block_tmp <- nm_lines[block_idx[i]:(block_idx[i+1]-1)] - if(as_block) { - block_tmp <- stringr::str_c(block_tmp, collapse="\n") - } - if(is.null(obj[[block_id]])) { - obj[[block_id]] <- block_tmp - } else { - obj[[block_id]] <- c(obj[[block_id]], block_tmp) - } - } - class(obj) <- c("NONMEM", "list") - return(obj) -} diff --git a/R/nm_save_dataset.R b/R/nm_save_dataset.R deleted file mode 100644 index 0476281..0000000 --- a/R/nm_save_dataset.R +++ /dev/null @@ -1,19 +0,0 @@ -#' Save an R data.frame to a NONMEM-style dataset as CSV -#' -#' @param data data.frame -#' @param filename filename to save to. -#' @param tool type of dataset, either `nonmem` or `nlmixr` -nm_save_dataset <- function( - data, - filename, - tool = c("nonmem", "nlmixr") -) { - tool <- match.arg(tool) - if(tool == "nonmem") { ## Remove NAs for NONMEM, and replace with ".". Not for nlmixr - for(key in names(dat)) { - data[[key]] <- as.character(data[[key]]) - data[[key]][is.na(data[[key]])] <- "." - } - } - write.csv(data, filename, quote=F, row.names=F) -} \ No newline at end of file diff --git a/R/nm_save_model.R b/R/nm_save_model.R deleted file mode 100644 index 9f0fe52..0000000 --- a/R/nm_save_model.R +++ /dev/null @@ -1,25 +0,0 @@ -#' Write a NONMEM model object to file -#' -#' @param model NONMEM model object (imported with `read_nm()`) -#' @param modelfile NONMEM model filename -#' @param overwrite overwrite model file if exists? -#' -#' @export -nm_save_model <- function( - model = NULL, - modelfile = NULL, - overwrite = FALSE) { - if(is.null(modelfile)) cli::cli_abort("Please specify an output NONMEM modelfile.") - if(is.null(model)) cli::cli_abort("Please specify an imported NONMEM model (imported with `read_nm`).") - if(file.exists(modelfile) && !overwrite) { - cli::cli_abort("Sorry, the output NONMEM file already exists and `overwrite` is set to FALSE.") - } - if(! "NONMEM" %in% class(model)) { - cli::cli_abort("Sorry, this object does not seem to be a valid NONMEM model object. Please import NONMEM files using `nm_read()`") - } - # rearrange to make sure record order is correct - header <- c("PROBLEM", "INPUT", "DATA", "ABBR") - model <- model[c(header, names(model)[!names(model) %in% header])] - # write to file - writeLines(unlist(model), con = modelfile) -} diff --git a/R/nm_update_dataset.R b/R/nm_update_dataset.R deleted file mode 100644 index b887e9d..0000000 --- a/R/nm_update_dataset.R +++ /dev/null @@ -1,31 +0,0 @@ -#' Update $DATA in NONMEM model with new dataset -#' -#' @param model_filename model filename -#' @param dataset_filename dataset filename -#' @param ... parameters passed to `nm_save_model()` -#' -#' @export -#' -nm_update_dataset <- function(model_filename, dataset_filename, ...) { - mod <- nm_read_model(model_filename) - data <- mod$DATA - # Assume that the first block of text that does not have $DATA, IGNORE=, - # or ACCEPT= is the dataset. - for(i in seq(data)) { - line <- data[i] - line_vec <- unlist(stringr::str_split(line, " ")) - idx_not_dataset <- grep("(\\$DAT)|(IGNORE=)|(ACCEPT=)", line_vec) - idx_dataset <- seq(line_vec)[-idx_not_dataset][1] - if(length(idx_dataset) > 0) { - line_vec[idx_dataset] <- dataset_filename - data[i] <- paste(line_vec, collapse = " ") - mod$DATA <- data - nm_save_model( - mod, - modelfile = model_filename, - ... - ) - break - } - } -} \ No newline at end of file diff --git a/R/prepare_model_folder.R b/R/prepare_model_folder.R deleted file mode 100644 index 3e79c01..0000000 --- a/R/prepare_model_folder.R +++ /dev/null @@ -1,63 +0,0 @@ -#' Create a folder for running model, with the model and dataset -#' -prepare_run_folder <- function( - id, - model, - path, - force = FALSE, - data = NULL, - auto_stack_encounters = FALSE, - verbose = TRUE -) { - - ## Create the folder - fit_folder <- create_run_folder( - id = id, - path, - force = force, - verbose - ) - - ## Set up other files - dataset_path <- file.path(fit_folder, "data.csv") - model_file <- "run.mod" - output_file <- "run.lst" - model_path <- file.path(fit_folder, model_file) - - if(verbose) cli::cli_process_start("Checking dataset and copying") - if(!is.null(data)) { - if(isTRUE(auto_stack_encounters)) { - data <- stack_encounters( - data = data, - verbose = verbose - ) - } - if(verbose) cli::cli_alert_info("Updating model dataset with provided dataset") - model <- model |> - pharmr::unload_dataset() |> - pharmr::set_dataset( - path_or_df = data, - datatype = "nonmem" - ) - } - model <- clean_modelfit_data(model) - data <- model$dataset - - ## Copy modelfile + dataset - write.csv(data, file = dataset_path, quote=F, row.names=F) - model_code <- model$code - model_code <- change_nonmem_dataset( - model_code, - dataset_path - ) - writeLines(model_code, model_path) - if(verbose) cli::cli_process_done() - - list( - model = model, - model_file = model_file, - output_file = output_file, - fit_folder = fit_folder, - dataset_path = dataset_path - ) -} diff --git a/R/read_table_nm.R b/R/read_table_nm.R deleted file mode 100644 index 919a563..0000000 --- a/R/read_table_nm.R +++ /dev/null @@ -1,85 +0,0 @@ -#' NONMEM output table import function -#' -#' @description Quickly import NONMEM output tables into R. -#' Function taken from `modelviz` package by Benjamin Guiastrennec. -#' When both \code{skip} and \code{header} are \code{NULL}, -#' \code{read_nmtab} will automatically detect the optimal -#' settings to import the tables. When more than one files are -#' provided for a same NONMEM run, they will be combined into -#' a single \code{data.frame}. -#' -#' @param file full file name -#' @param skip number of lines to skip before reading data -#' @param header logical value indicating whether the file contains the names -#' of the variables as its first line -#' @param rm_duplicates logical value indicating whether duplicated columns should be removed -#' @param nonmem_tab logical value indicating to the function whether the file is a -#' table or a nonmem additional output file. -#' -#' @return A \code{data.frame} -#' @examples -#' \dontrun{ -#' data <- read_table_nm(file = '../models/pk/sdtab101') -#' } -#' -#' @export -#' -read_table_nm <- function( - file = NULL, - skip = NULL, - header = NULL, - rm_duplicates = FALSE, - nonmem_tab = TRUE -) { - - # Check inputs - if(is.null(file)) { - stop('Argument \"file\" required.') - } - - if(!any(file.exists(file))) { - stop('No file not found.') - } else { - file <- file[file.exists(file)] - } - - if(nonmem_tab) { - # If auto mode required - if(is.null(skip) & is.null(header)) { - test <- readLines(file[1], n = 3) - skip <- ifelse(grepl('TABLE NO', test[1]), 1, 0) - header <- ifelse(grepl('[a-zA-Z]', test[2]), TRUE, FALSE) - } - - # Import data - tab_file <- do.call('cbind', lapply(file, readr::read_table, - skip = skip, col_names = header)) - - tab_file <- as.data.frame(apply(tab_file, MARGIN = 2, FUN = as.numeric)) - - # Drop rows with NA (in simtab) - tab_file <- na.omit(tab_file) - - # Correct bug in the headers - if(header) { - colnames(tab_file)[grepl('\n',colnames(tab_file))] <- - gsub('\n.+', '', colnames(tab_file)[grepl('\n', colnames(tab_file))]) - } - - } else { - # Search for final results only - skip <- max(grep('TABLE NO', readLines(file[1]))) - - # Import all files - tab_file <- do.call('cbind', lapply(file, read.table, skip = skip, - header = FALSE, fill = TRUE, as.is = TRUE)) - colnames(tab_file) <- tab_file[1, ] - tab_file <- suppressWarnings(as.data.frame(apply(tab_file[-1, ], 2, as.numeric))) - } - - if(rm_duplicates) { - tab_file <- tab_file[, !duplicated(colnames(tab_file))] - } - - tab_file -} diff --git a/R/remove_table_from_model.R b/R/remove_table_from_model.R deleted file mode 100644 index 304afce..0000000 --- a/R/remove_table_from_model.R +++ /dev/null @@ -1,42 +0,0 @@ -#' Remove all $TABLE records from a model -#' -#' @param model pharmpy model object -#' @param variables character vector with variable names -#' @param firstonly add `FIRSTONLY` parameter to $TABLE record -#' @param file path to file, e.g. `sdtab` -#' -#' @export -#' -remove_table_from_model <- function( - model, - variables, - firstonly = FALSE, - file -) { - tool <- get_tool_from_model(model) - if(tool == "nonmem") { - existing_tables <- get_tables_in_model_code(model$code) - if(file %in% existing_tables) { - warning("Table file already in a $TABLE record in model.") - return(model) - } - if(is.null(variables) || length(variables) == 0) { - warning("No variables to add to $TABLE, skipping.") - return(model) - } - table_code <- paste0( - "\n$TABLE\n", - paste0(c(" ", variables), collapse = " "), - ifelse(firstonly, "\n FIRSTONLY", ""), - "\n NOAPPEND NOPRINT", - "\n FILE=", file, - "\n\n" - ) - model <- pharmr::read_model_from_string( - code = paste0(model$code, table_code) - ) - } else { - ## Adding tables can only be done for NONMEM datasets - } - return(model) -} \ No newline at end of file diff --git a/R/remove_tables_from_model.R b/R/remove_tables_from_model.R deleted file mode 100644 index cb737d6..0000000 --- a/R/remove_tables_from_model.R +++ /dev/null @@ -1,78 +0,0 @@ -#' Remove all $TABLE records from a model -#' -#' @param model pharmpy model object -#' @param file remove only a specific table defined as FILE=. `file` can -#' also specify only the start of a filename, e.g. `patab` -#' -#' @export -#' -remove_tables_from_model <- function( - model, - file = NULL -) { - tool <- get_tool_from_model(model) - if(tool == "nonmem") { - - ## if there's no tables to begin with, then just return unchanged - existing_tables <- get_tables_in_model_code(model$code) - if(length(existing_tables) == 0) { - return(model) - } - - ## workaround for dataset needed to circumvent issues re-reading the model file - data <- model$dataset - temp_csv <- paste0(tempfile(), ".csv") - write.csv(data, temp_csv, quote=F, row.names=F) - model <- pharmr::set_dataset(model, temp_csv) - code_without_tables <- remove_table_sections(model$code, file = file) - model <- pharmr::read_model_from_string( - code = code_without_tables - ) - - ## read_model_from_string() will strip the dataset, need to re-add: - if(!is.null(data)) { - model <- pharmr::set_dataset(model, path_or_df = data) - } - } else { - ## Removing tables can only be done for NONMEM datasets - } - return(model) -} - -#' Remove $DATA from a NONMEM model -#' -#' @param text model code -#' @returns character string -remove_data_section <- function(text) { - pattern <- "\\$DATA[^$]+" - result <- gsub(pattern, "", text, perl = TRUE) - result -} - -#' Function to remove all $TABLE sections -#' -remove_table_sections <- function(text, file = NULL) { - if(!is.null(file)) { - if(length(file) != 1) { - cli::cli_abort("`file` should be of length 1") - } - pattern <- paste0("\\$TABLE[^$]+FILE=", file) - } else { - pattern <- "\\$TABLE[^$]+" - } - result <- gsub(pattern, "", text, perl = TRUE) - - # Handle case where $TABLE is the last section - if(!is.null(file)) { - result <- gsub("\\$TABLE.*FILE=.*$", "", result, perl = TRUE) - } else { - result <- gsub("\\$TABLE.*$", "", result, perl = TRUE) - } - - # Clean up any extra newlines that might be left - result <- gsub("\n{3,}", "\n\n", result) - - # Trim any trailing whitespace - result <- trimws(result, which = "right") - return(result) -} diff --git a/R/run_nlme.R b/R/run_nlme.R deleted file mode 100644 index d77c87a..0000000 --- a/R/run_nlme.R +++ /dev/null @@ -1,503 +0,0 @@ -#' Run model in NONMEM -#' -#' Run the model directly using nmfe (not through pharmpy). -#' This is a more reliable way of running NONMEM, and it is now possible to -#' stream stdout and stderr to file or to console, which is useful for -#' inspection of intermediate model fit. -#' -#' The function does take a pharmpy model as input (optionally), and uses -#' pharmpy to read the results from the model fit, and returns a pharmpy -#' `modelfit` object. -#' -#' @param model pharmpy model object or NONMEM model code (character) or path -#' to NONMEM model file. -#' @param data dataset (data.frame). Optional, can also be included in `model` -#' object (if specified as pharmpy model object). -#' @param tables acharacter vector of which default tables -#' to add, options are `fit` and `parameters`. Default is NULL, -#' i.e. don't add any new tables (but will keep existing). -#' @param full_tables For the default tables, should all input columns from be -#' included in the output tables? Default `FALSE`. -#' @param id run id, e.g. `run1`. This will be the folder in which the NONMEM -#' model is run. If no folder is specified, it will create a folder `run1` in -#' the current working directory, and will increment the run number for each -#' subsequent run. -#' @param path path to nonmem model. If not specified, will assume current -#' working directory. -#' @param method run method, either `pharmpy` dispatch, `nmfe` or `psn` -#' (psn::execute). -#' @param nmfe full path to nmfe file to run NONMEM with, if `method=="nmfe"`. -#' @param console show stderr and stdout in R console? If FALSE, will stream -#' to files `stdout` and `stderr` in fit folder. -#' @param force if run folder (`id`) exists, should existing results be -#' removed before rerunning NONMEM? Default `FALSE`. -#' @param save_fit save fit object. If `TRUE`, will save as . Can -#' also specify filename (rds) to save to. -#' @param save_summary save fit summary and parameter estimates to file? -#' Default is `TRUE`. Will use current folder, and save as -#' `fit_summary_.txt` and `fit_parameters_.csv`. -#' @param estimation_method Optional. Character vector of estimation method(s) -#' to apply to model. Will remove all existing estimation steps in the model -#' and update with methods specified in argument. -#' @param auto_stack_encounters only invoked if `data` argument supplied, not if -#' a pharmpy model object is supplied without `data`. -#' Detects if TIME within an individual is -#' decreasing from one record to another, which NONMEM cannot handle. -#' If this happens, it will add a reset event (EVID=3) at that time, and -#' increase the TIME for subsequent events so that NONMEM does not throw an -#' error. It will increase the time for the next encounter to the maximum -#' encounter length across all subjects in the dataset (rounded up to 100). -#' If no decreasing TIME is detected, nothing will be done (most common case). -#' This feature is useful e.g. for crossover trials when data on the same -#' individual ispresent but is included in the dataset as time-after-dose and -#' not actual time since first overall dose. -#' @param clean clean up run folder after NONMEM execution? -#' @param as_job run as RStudio job? -#' @param save_final after running the model, should a file `final.mod` be created -#' with the final estimates from the run. -#' @param check_only if `TRUE`, will only check the model code (NM-TRAN in the case -#' of NONMEM), but not run the model. Will return `TRUE` if model syntax is -#' correct, and `FALSE` if not. Will also attach stdout as `message` attribute. -#' @param verbose verbose output? -#' -#' @export -#' -run_nlme <- function( - model, - data = NULL, - tables = NULL, - full_tables = FALSE, - id, - path = getwd(), - method = c("nmfe", "pharmpy", "psn"), - nmfe = get_nmfe_location_for_run(), - force = NULL, - console = FALSE, - save_fit = TRUE, - save_summary = TRUE, - estimation_method = NULL, - auto_stack_encounters = TRUE, - clean = TRUE, - as_job = FALSE, - save_final = TRUE, - check_only = FALSE, - verbose = TRUE -) { - - time_start <- Sys.time() - model <- validate_model(model) - method <- match.arg(method) - if(is.null(force)) { - force <- get_flag_from_config( - flag = c("tools", "modelfit", "force"), - FALSE - ) - } - - ## Set model name - model <- pharmr::set_name( - model = model, - new_name = id - ) - - ## Change estimation method, if requested - if(!is.null(estimation_method)) { - model <- update_estimation_method( - model, - estimation_method, - verbose = verbose - ) - } - - ## Add default tables, if requested - if(!is.null(tables)) { - model <- add_default_output_tables( - model = model, - tables = tables, - full_tables = full_tables - ) - } - - ## Make sure data is clean for modelfit - obj <- prepare_run_folder( - id = id, - model = model, - path = path, - data = data, - force = force, - auto_stack_encounters = auto_stack_encounters, - verbose = verbose - ) - - ## If only `check` requested: - if(check_only) { - model_ok <- call_nmfe( - model_file = obj$model_file, - output_file = obj$output_file, - path = obj$fit_folder, - nmfe = nmfe, - check_only = TRUE, - console = console, - verbose = verbose - ) - return(model_ok) - } - - ## Run NONMEM and direct stdout/stderr - if(method == "pharmpy") { - if(as_job) { - if(! rstudioapi::isAvailable()) { - cli::cli_abort("RStudio API not available, cannot start job.") - } - suppressMessages({ - jobid <- job::job( - title = paste0(id, "-", "modelfit"), - { - call_pharmpy_fit( - model_file = obj$model_file, - path = obj$fit_folder, - verbose = verbose, - console = console - ) - } - ) - }) - cli::cli_alert_info("Job with id {jobid} started") - return(invisible(jobid)) - } else { - call_pharmpy_fit( - model_file = obj$model_file, - path = obj$fit_folder, - verbose = verbose, - console = console - ) - } - } else if(method == "nmfe") { - if(as_job) { - cli::cli_alert_warning("Sorry, running as job not implemented yet for nmfe runs.") - } - call_nmfe( - model_file = obj$model_file, - output_file = obj$output_file, - path = obj$fit_folder, - nmfe = nmfe, - console = console, - verbose = verbose - ) - } else if(method == "psn") { - if(as_job) { - cli::cli_alert_warning("Sorry, running as job not implemented yet for PsN runs.") - } - call_psn( - model_file = obj$model_file, - output_file = obj$output_file, - path = obj$fit_folder, - tool = "execute", - console = console, - verbose = verbose - ) - } else{ - cli::cli_abort("Model run method {method} not recognized.") - } - - if(clean) { - if(verbose) cli::cli_alert_info("Cleaning up run folder") - clean_nonmem_folder(obj$fit_folder) - } - - ## Check if sim / eval model only - is_sim_model <- pharmr::is_simulation_model(model) - is_eval_model <- is_maxeval_zero(model) - if(is_sim_model || is_eval_model) { - fit <- list( - ## just return empty list for now - ) - } else { - ## Read results using Pharmpy and return - if(verbose) cli::cli_process_start("Parsing results from run") - fit <- pharmr::read_modelfit_results( - file.path(obj$fit_folder, obj$model_file) - ) - if(verbose) cli::cli_process_done() - if(is.null(fit)) { - if(verbose) { - if(!console) { - cli::cli_alert_danger("Something went wrong with fit. Output shown below.") - nmfe_output <- get_nmfe_output( - path = obj$fit_folder, - obj$output_file - ) - log_add( - event = "error", - action = "modelfit", - id = id, - context = nmfe_output - ) - print_nmfe_output(nmfe_output) - } - } - cli::cli_abort("No results from modelfit, please check run output.") - } - } - - ## Attach fit info / tables as attributes, also for simulation - fit <- attach_fit_info( - fit, - model = obj$model, - obj$fit_folder, - obj$output_file, - is_sim_model = is_sim_model, - verbose = verbose - ) - - if(!is_sim_model) { - ## Create final.mod with updated estimates? - if(save_final) { - final_model <- update_parameters(obj$model, fit) - if(!is.null(final_model)) { - if(verbose) { - cli::cli_alert_info("Saving model with updated estimates to final.mod") - } - attr(fit, "final_model") <- final_model - final_model_code <- final_model$code - final_model_code <- change_nonmem_dataset(final_model_code, obj$dataset_path) - writeLines(final_model_code, file.path(obj$fit_folder, "final.mod")) - } else { - if(verbose) { - cli::cli_alert_warning("Final parameter estimates not available, not saving final.mod") - } - } - } - - ## save fit object to file - if(!is.null(save_fit)){ - if(inherits(save_fit, "character")) { - saveRDS(fit, save_fit) - } else if(inherits(save_fit, "logical")) { - if(save_fit) { - saveRDS(fit, paste0(id, ".rds")) - } - } - } - - ## save fit summary (fit info and parameter estimates) as JSON - if(save_summary) { - if(verbose) cli::cli_process_start("Saving fit results to file") - fit_summ <- create_modelfit_info_table(fit) - txt_summ <- knitr::kable(fit_summ, row.names = FALSE, format = "simple") - writeLines( - txt_summ, - paste0(id, "_fit_summary.txt") - ) - par_est <- create_modelfit_parameter_table(fit) - write.csv( - par_est, - paste0(id, "_fit_parameters.csv"), - quote=F, row.names=F - ) - if(verbose) cli::cli_process_done() - } - } - - time_end <- Sys.time() - time_all <- round(as.numeric(time_end - time_start), 1) - if(verbose) cli::cli_alert_success(paste0("Run done (", time_all,"s).")) - - fit - -} - -#' Get new run number for model fit -#' -#' @param path path to folder in which to create subfolder for run -#' -get_new_run_number <- function(path = getwd()) { - folders <- stringr::str_replace_all( - dir(path, include.dirs = TRUE, pattern = "^run[0-9].?$"), - "run", - "" - ) - numbers <- as.numeric(folders) - if(length(numbers) == 0) { - new_number <- 1 - } else { - new_number <- max(numbers) + 1 - } - new_number -} - -#' Change $DATA in NONMEM model code -#' -#' @param code model code, either as single line string, or vector of lines -#' @param path path of new dataset -#' -change_nonmem_dataset <- function( - code, - path -) { - - ## TODO: this implementation is not foolproof, but works in cases - ## where the dataset path immediately follows $DATA - - # Find the $DATA line - if(length(code) == 1) { - lines <- stringr::str_split(code, pattern = "\\n")[[1]] - } else { - lines <- code - } - data_line_idx <- grep("^\\$DATA", lines) - - if (length(data_line_idx) == 0) { - cli::cli_abort("No $DATA line found in the model file") - } - - # Replace the dataset path while preserving any options after it - current_line <- lines[data_line_idx] - parts <- strsplit(current_line, "\\s+")[[1]] - parts[2] <- path - lines[data_line_idx] <- paste(parts, collapse = " ") - - code <- paste0(lines, collapse = "\n") - code -} - -#' Call nmfe -#' -#' @param model_file model file, e.g. "run.mod" -#' @param output_file output file, e.g. "run.lst" -#' @param path run folder path, e.g. "run1" -#' @param nmfe path to nmfe batch file to run NONMEM -#' @param console show output from nmfe in console? Default `FALSE` -#' @param check_only only run NM-TRAN, to check the model syntax -#' @param verbose verbose output? -#' -#' @export -#' -call_nmfe <- function( - model_file, - output_file, - path, - nmfe = "/opt/NONMEM/nm_cxurrent/run/nmfe75", - console = FALSE, - check_only = FALSE, - verbose = FALSE -) { - - if(! file.exists(nmfe)) { - cli::cli_abort("NONMEM (nmfe) not found at {nmfe}") - } else { - if(verbose) { - cli::cli_alert_success("NONMEM found at {nmfe}") - } - } - - # Transform folder path to absolute path - path <- normalizePath(path, mustWork = TRUE) - - if(verbose) { - cli::cli_process_start( - paste0("Starting NONMEM (nmfe) run in ", path), - on_exit = "failed" - ) - } - - ## Output to console or to file? - if(console) { - stdout <- "" - stderr <- "" - } else { - stdout <- file.path(path, "stdout") - stderr <- file.path(path, "stderr") - } - curr_dir <- getwd() - on.exit({ - setwd(curr_dir) - }) - setwd(path) - if(check_only) { - nmtran <- get_nmtran_from_nmfe(nmfe) - if(!file.exists(nmtran)) { - cli::cli_abort("NM-TRAN executable could not be found, can't perform syntax check.") - } - system2( - command = nmtran, - args = c("<", model_file), - wait = TRUE, - stdout = stdout, - stderr = stderr - ) - cons <- c( - readLines(stderr), - readLines(stdout) - ) - has_no_error <- !any(stringr::str_detect(cons, "AN ERROR WAS FOUND")) - attr(has_no_error, "message") <- cons - return(has_no_error) - } else { - system2( - command = nmfe, - args = c(model_file, output_file), - wait = TRUE, - stdout = stdout, - stderr = stderr, - ) - } - cli::cli_process_done() -} - -#' Get the location of NM-TRAN based on the location of nmfe -#' It's usually up one folder from nmfe, then in tr/NMTRAN.exe -get_nmtran_from_nmfe <- function(nmfe) { - nm_folder <- dirname(dirname(nmfe)) - nmtran <- file.path(nm_folder, "tr", "NMTRAN.exe") - nmtran -} - -#' Get output from NMFE -#' -#' @param path path to folder with NMFE run -#' @param results_file name of output file -#' -get_nmfe_output <- function(path, results_file = "run.lst") { - out <- list( - stderr = NULL, - stdout = NULL - ) - if(file.exists(file.path(path, "stderr"))) { - out$stderr <- readLines(file.path(path, "stderr")) - } - if(file.exists(file.path(path, "stdout"))) { - out$stdout <- readLines(file.path(path, "stdout")) - } - if(file.exists(file.path(path, results_file))) { - out$results_file <- readLines(file.path(path, results_file)) - } - out -} - -#' Print nmfe output (stdout and stderr) from a run folder -#' -#' @param nmfe_output output from nmfe command, as list -#' -print_nmfe_output <- function( - nmfe_output -) { - if(length(nmfe_output$stderr) > 0) { - cli::cli_alert_warning("stderr: ") - cat(paste0(nmfe_output$stderr, collapse = "\n"), "\n\n") - } else { - cli::cli_alert_warning("stderr: ") - } - if(length(nmfe_output$stdout) > 0) { - cli::cli_alert_warning("stdout (last 10 lines): ") - cat(paste0(tail(nmfe_output$stdout, 10), collapse = "\n"), "\n\n") - } else { - cli::cli_alert_warning("stdout: ") - } - if(length(nmfe_output$results_file) > 0) { - cli::cli_alert_warning("results file (last 10 lines): ") - cat(paste0(tail(nmfe_output$results_file, 10), collapse = "\n"), "\n\n") - } else { - cli::cli_alert_warning("results_file: ") - } -} diff --git a/R/run_psn.R b/R/run_psn.R deleted file mode 100644 index 1523be3..0000000 --- a/R/run_psn.R +++ /dev/null @@ -1,8 +0,0 @@ -#' Run a PsN tool -#' -run_psn <- function( - model -) { - - # cmd <- paste0(cmd, "execute ", model_file, " --dir=", fit_dir) -} diff --git a/R/run_sim.R b/R/run_sim.R deleted file mode 100644 index 7ab5e8c..0000000 --- a/R/run_sim.R +++ /dev/null @@ -1,440 +0,0 @@ -#' Run simulations -#' -#' @inheritParams run_nlme -#' -#' @param regimen if specified, will replace the regimens for each subject with -#' a custom regimen. Can be specified in two ways. The simplest way is to just -#' specify a list with elements `dose`, `interval`, `n`, and -#' `route` (and `t_inf` / `rate` for infusions). -#' E.g. `regimen = list(dose = 500, interval = 12, n = 5, route = "oral")`. -#' Alternatively, regimens can be specified as a data.frame. The data.frame -#' specified all dosing times (`dose`, `time` columns) and `route` and `t_inf` / -#' `rate`. The data.frame may also optionally contain a `regimen` column that -#' specifies a name for the regimen. This can be used to simulate multiple -#' regimens. -#' @param covariates if specified, will replace subjects with subjects specified -#' in a data.frame. In the data.frame, the column names should correspond -#' exactly to any covariates included in the model. An `ID` column is required, -#' and for time-varying covariates, a `TIME` column is also required (otherwise -#' it will be assumed covariates are not changing over time). -#' @param t_obs a vector of observations times. If specified, will override -#' the observations in each subject in the input dataset. -#' @param n_subjects number of subjects to simulate, when using sampled data -#' (i.e. requires `covariates` argument) -#' @param n_iterations number of iterations of the entire simulation to -#' perform. The dataset for the simulation will stay the same between each -#' iterations. -#' @param add_pk_variables calculate basic PK variables that can be extracted -#' in post-processing, such as CMAX_OBS, TMAX_OBS, AUC_SS. -#' @param update_table should any existing $TABLE records be removed, and a new -#' `simtab` be created? This is default. If `FALSE`, it will leave $TABLEs as -#' specifed in the model. However, in the return object, only the first table -#' is returned back. If `FALSE`, the `add_pk_variables` argument will be ignored. -#' -#' @returns data.frame with simulation results -#' -#' @export -run_sim <- function( - fit = NULL, - data = NULL, - model = NULL, - id = get_random_id("sim_"), - force = FALSE, - t_obs = NULL, - dictionary = list( - ID = "ID", - DV = "DV", - EVID = "EVID", - AMT = "AMT", - CMT = "CMT", - MDV = "MDV" - ), - regimen = NULL, - covariates = NULL, - tool = c("auto", "nonmem", "nlmixr2"), - n_subjects = NULL, - n_iterations = 1, - variables = c("ID", "TIME", "DV", "EVID", "IPRED", "PRED"), - add_pk_variables = TRUE, - output_file = "simtab", - update_table = TRUE, - seed = 12345, - verbose = TRUE -) { - - ## parse arguments - if(is.null(fit) && is.null(model)) { - cli::cli_abort("For simulations we need either a `fit` object, or a `model` file (with updated estimates)") - } - if(is.null(model)) { - if(!is.null(attr(fit, "final_model"))) { - model <- attr(fit, "final_model") - } else { - cli::cli_abort("No proper model object available. Need either a `model` object or a `fit` object with a model attached.") - } - } - tool <- match.arg(tool) - if(tool == "auto") { - if(inherits(model, "pharmpy.model.external.nonmem.model.Model")) { - tool <- "nonmem" - } - } - if(tool != "nonmem") { - cli::cli_abort("Sorry, currently only supporting NONMEM simulations.") - } - ## make sure we have regimen as a data.frame - regimen_df <- NULL - if(!is.null(regimen)) { - if(inherits(regimen, "data.frame")) { - regimen_df <- regimen - } else if (inherits(regimen, "list")) { - regimen_df <- do.call(create_regimen, args = regimen) |> - dplyr::mutate(regimen = "regimen 1") - } else { - cli::cli_abort("`regimen` needs to be either a data.frame or a list, or NULL.") - } - } - - ## Prepare data - if(is.null(data)) { - input_data <- model$dataset - } else { - input_data <- data - } - ## Set CMT to NA if not in dataset - if(is.null(input_data[[dictionary$CMT]])) { - input_data[[dictionary$CMT]] <- NA - } - if(is.null(covariates)) { # use original dataset - if(verbose) cli::cli_alert_info("Using input dataset for simulation") - sim_data <- input_data - if(!is.null(dictionary)) { - sim_data <- sim_data |> - dplyr::rename( - !!!rlang::set_names( - dictionary, - names(dictionary) - ) - ) - } - if(!is.null(n_subjects)) { - cli::cli_warn("`n_subjects` argument can only be used when sampling `covariates`, and will ignored for this simulation.") - } - n_subjects <- length(unique(sim_data[[dictionary$ID]])) - } else { ## use provided sampled covariates in `data` - if(is.null(n_subjects)) { - cli::cli_abort("For sampling new datasets, need `n_subjects` argument.") - } - if(verbose) cli::cli_alert_info("Preparing sampled dataset for simulation") - ids <- unique(input_data[[dictionary$ID]]) - random_sample <- sample(ids, n_subjects, replace = TRUE) - sim_data <- lapply(seq_along(random_sample), function(i) { - input_data |> - dplyr::filter(ID == random_sample[i]) |> - dplyr::mutate(ID = i) - }) %>% - dplyr::bind_rows() - if(!is.null(covariates)) { - if(verbose) cli::cli_alert_info("Updating covariates for subjects in simulation") - covs_reqd <- unlist(lapply( - pharmr::get_model_covariates(model), - function(x) { x$name } - )) - if(! all(covs_reqd %in% names(covariates))) { - missing <- covs_reqd[! covs_reqd %in% names(covariates)] - cli::cli_abort("Not all required covariates supplied in `covariates` data, missing: {missing}") - } - if(! "ID" %in% names(covariates)) { - covariates$ID <- 1:nrow(covariates) - } - if(! "TIME" %in% names(covariates)) { - covariates$TIME <- 0 - } - new_covariates <- names(covariates) - new_covariates <- new_covariates[(! new_covariates %in% c("ID", "TIME")) & new_covariates %in% names(sim_data)] - sim_data <- sim_data |> - dplyr::select(- new_covariates) |> ## remove existing covariates - dplyr::left_join( - covariates, - by = join_by(ID == ID, TIME == TIME) - ) |> - tidyr::fill(new_covariates, .direction = "downup") - } - } - if(!is.null(regimen_df)) { - if(verbose) cli::cli_alert_info("Creating new regimens for subjects in simulation") - advan <- get_advan(model) - doses <- create_dosing_records( - regimen_df, - sim_data, - n_subjects, - dictionary, - advan - ) - ## remove old doses and add new - sim_data <- sim_data |> - dplyr::filter(EVID != 1) |> - dplyr::bind_rows(doses) |> - dplyr::arrange(.regimen, ID, TIME, EVID) |> - dplyr::group_by(ID) |> - tidyr::fill( - tidyselect::everything(), - -CMT, - .direction = "downup" - ) - if(is.null(t_obs)) { - ## TODO: could be made somewhat smarter, based on e.g. original dataset or - t_max <- max(sim_data$TIME) + round(diff(tail(sim_data$TIME, 2))) - t_obs <- seq(0, t_max, 4) - } - } else { - sim_data[[".regimen"]] <- "original regimens" - } - if(!is.null(t_obs)) { - if(verbose) cli::cli_alert_info("Creating new observation records for subjects in simulation") - obs <- create_obs_records( - sim_data, - t_obs, - n_subjects, - dictionary, - model - ) - ## remove old obs and add new - sim_data <- sim_data |> - dplyr::filter(EVID != 0) |> - dplyr::bind_rows(obs) |> - dplyr::arrange(.regimen, ID, TIME, EVID) |> - dplyr::group_by(ID) |> - tidyr::fill( - dplyr::everything(), - .direction = "downup" - ) - } - - ## get unique regimens / datasets to simulate - unique_regimens <- unique(sim_data[[".regimen"]]) - comb <- list() - - ## Loop over regimens to simulate - for(reg_label in unique_regimens) { - - ## grab data for regimen - sim_data_regimen <- sim_data |> - dplyr::filter(.regimen == reg_label) |> - dplyr::select(-.regimen) - - ## Set simulation, and set sim dataset: - if(verbose) cli::cli_alert_info("Changing model to simulation model") - sim_model <- model |> - pharmr::set_simulation(seed = 12345) |> - pharmr::set_dataset(sim_data_regimen) - - ## Add tables - if(update_table) { - if(verbose) cli::cli_alert_info("Updating table record(s)") - parameter_names <- get_defined_pk_parameters(sim_model) - variables <- unique(c(variables, parameter_names, names(covariates))) - sim_model <- sim_model |> - remove_tables_from_model() |> - add_table_to_model(variables, file = output_file) - } else { - if(verbose) cli::cli_alert_info("Using existing table record(s)") - } - - ## Run simulation - if(verbose) cli::cli_alert_info("Running simulation ({reg_label})") - results <- run_nlme( - model = sim_model, - id = id, - force = TRUE, - verbose = FALSE - ) - - ## post-processing - if(update_table) { - if(add_pk_variables) { - if(!is.null(regimen_df)) { # regimen needed for calculation of AUCss - attr(results, "tables")[[output_file]] <- calc_pk_variables( - data = attr(results, "tables")[[output_file]], - regimen = regimen_df |> - dplyr::filter(regimen == reg_label) - ) - } else { - attr(results, "tables")[[output_file]] <- calc_pk_variables( - data = attr(results, "tables")[[output_file]], - regimen = NULL - ) - } - } - } - - ## grab table, return - if(verbose) cli::cli_alert_info("Exporting simulation results ({reg_label})") - comb[[reg_label]] <- attr(results, "tables") - - } - - ## combine back down to single data.frame again - out <- lapply(unique_regimens, function(reg_label) { - table_names <- names(comb[[reg_label]]) - simtab <- table_names[1] - if(!is.null(simtab) && !is.null(comb[[reg_label]][[simtab]])) { - return( - comb[[reg_label]][[simtab]] |> - dplyr::mutate(regimen_label = reg_label) - ) - } else { - cli::cli_warn("Simulation for {reg_label} did not output any results.") - return(data.frame()) - } - }) |> - dplyr::bind_rows() - - if(verbose) cli::cli_alert_success("Done") - out -} - -#' Calculate some basic PK variables from simulated or observed data -#' -#' @param data data.frame in NONMEM format -#' @inheritParams run_sim -#' -#' @returns data.frame -calc_pk_variables <- function( - data, - regimen = NULL, - dictionary = NULL -) { - - if(!is.null(data)) { - ## Find cmax/tmax for each ID - data <- data |> - dplyr::group_by(.data$ID) |> - dplyr::mutate(CMAX_OBS = max(.data$DV)) |> - dplyr::mutate(TMAX_OBS = TIME[match(CMAX_OBS[1], DV)][1]) - - ## Find Cmin for each ID, for last interval - tmp_data <- data |> - dplyr::group_by(.data$ID) |> - dplyr::mutate(.dose_id = cumsum(EVID == 1)) - last_obs_dose_id <- tmp_data |> - dplyr::filter(EVID == 0) |> - dplyr::pull(.dose_id) |> - tail(1) - cmin_data <- tmp_data |> - dplyr::mutate(.dose_cmin = max(c(1, last_obs_dose_id))) |> # last full interval (before last dose) - dplyr::filter(.dose_id == .dose_cmin & EVID == 0) |> - dplyr::summarise(CMIN_OBS = min(DV)) - data <- dplyr::left_join( - data, - cmin_data, - by = "ID" - ) - - ## Add AUC_SS as CL/dose, if we're simulating a specific regimen - if(!is.null(regimen) && "CL" %in% names(data)) { - data <- data |> - dplyr::mutate(AUC_SS = tail(regimen$dose, 1) / .data$CL) - } - } - - data -} - -#' Create dosing records, given a specified regimen as a data frame with -#' potentially multiple regimens and varying dosing times / doses -#' -create_dosing_records <- function( - regimen, - data, - n_subjects, - dictionary, - advan = NULL -) { - if(!is.null(regimen$regimen)) { - unq_reg <- unique(regimen$regimen) - } else { - regimen$regimen <- "regimen 1" - unq_reg <- "regimen 1" - } - ## logic for picking dosing compartments - cmt_oral <- 1 - cmt_iv <- 2 - if(!is.null(advan)) { - if(advan %in% c(1, 3, 11)) { - cmt_iv <- 1 - if(any(regimen$route) %in% c("oral", "im", "sc")) { - cli::cli_abort("The model structure does not support oral, im, or sc dosing, only iv.") - } - } - } - dose <- data.frame( - ID = 1, - TIME = regimen$time, - AMT = regimen$dose, - EVID = 1, - MDV = 1, - DV = 0, - CMT = 1, - .regimen = regimen$regimen - ) - if(is.null(regimen$t_inf)) regimen$t_inf <- 0 - dose$RATE <- 0 - dose$RATE[regimen$t_inf != 0] <- dose$AMT[regimen$t_inf != 0] / regimen$t_inf[regimen$t_inf != 0] - dose <- dose |> - dplyr::mutate(CMT = dplyr::case_when( - regimen$route %in% c("oral", "sc", "im") ~ cmt_oral, # logic for picking dosing cmt - regimen$route %in% c("iv", "bolus", "infusion") ~ cmt_iv, - .default = 1 - )) - dose_df <- lapply(1:n_subjects, function(i) { - dose |> - dplyr::mutate(ID = i) - }) |> - dplyr::bind_rows() - dose_df -} - -#' Create observation records, given a specified t_obs vector -#' -create_obs_records <- function( - data, - t_obs, - n_subjects, - dictionary, - model -) { - unq_reg <- unique(data[[".regimen"]]) - ## create a template row - ## 1st try pull CMT from data. if not available in data, try based on ADVAN - cmt <- data |> - dplyr::filter(ID == 1 & EVID == 0) |> - dplyr::slice(1) |> - dplyr::pull(CMT) - if(is.null(cmt) || is.na(cmt)) { - cmt <- get_obs_compartment(model) - } - obs <- data.frame( - ID = 1, - TIME = t_obs, - AMT = 0, - EVID = 0, - MDV = 0, - DV = 0, - CMT = cmt, - RATE = 0 - ) - ## extend single sampling design to multiple subjects - obs_df <- lapply(1:n_subjects, function(i) { - obs |> - dplyr::mutate(ID = i) - }) |> - dplyr::bind_rows() - ## extend to multiple regimens, if needed - obs_df <- lapply(1:length(unq_reg), function(i) { - obs_df |> - dplyr::mutate(.regimen = unq_reg[i]) - }) |> - dplyr::bind_rows() - obs_df -} diff --git a/R/save_model_code.R b/R/save_model_code.R deleted file mode 100644 index ab38737..0000000 --- a/R/save_model_code.R +++ /dev/null @@ -1,23 +0,0 @@ -#' Save model code to a markdown file -#' -#' @param model nlmixr2 model object -#' @param path path to .md file to save model code to -#' -#' @export -save_model_code <- function( - model, - path -) { - - ## Works for nlmixr2 models. Will need to adapt for NONMEM models - md <- paste( - "## Model code", - "", - "```", - model, - "```", - sep = "\n" - ) - - writeLines(md, path) -} diff --git a/R/set_compartment_scale.R b/R/set_compartment_scale.R deleted file mode 100644 index 6c1a926..0000000 --- a/R/set_compartment_scale.R +++ /dev/null @@ -1,137 +0,0 @@ -#' Set scaling for certain compartments, e.g. dose and observation -#' compartments. -#' -#' Currently not available in Pharmpy, this is a workaround function. -#' -#' @inheritParams run_nlme -#' @param compartment compartment number. If `NULL` will be attempted to -#' infer from ADVAN. If not a default ADVAN is used, will use 1 as default. So -#' for safe use, please always specify the observation compartment to be scaled. -#' @param expression specification of new scaling, should always contain variable -#' and scale arguments. E.g. `list(variable = "V", "scale" = 1000)`. -#' @param update_inits update initial estimates for basic PK parameters? This is -#' likely needed when applying scale, or else it is very likely that the model -#' starts too far off from the maximum likelihood and the fit will not -#' converge properly. `TRUE` by default. -#' -#' @returns Pharmpy model -#' -#' @export -set_compartment_scale <- function( - model, - compartment = NULL, - expression = list(variable = "V", scale = 1000), - update_inits = TRUE, - verbose = TRUE -) { - ## if compartment not specified, then try to guess - if(is.null(compartment)) { - advan <- get_advan(model) - if(advan %in% c(2, 4, 12)) { - compartment <- 2 - } else { - compartment <- 1 - if(! advan %in% c(1, 3, 11)) { - cli::cli_warn("No `compartment` specified to scale, assuming compartment 1 is observation compartment!") - } - } - } - - ## get current scaling for compartment, if present - Sx <- paste0("S", compartment) - curr_expr <- get_compartment_scale(model, compartment) - if(is.null(curr_expr)) { - cli::cli_alert_info("No scaling specified for compartment {compartment}, adding scale.") - } else { - cli::cli_alert_info("Scaling already specified for compartment {compartment}, updating scale.") - } - if(! class(expression$scale) %in% c("numeric", "integer")) { - cli::cli_abort("`expression$scale` should be a numeric value.") - } - expr_var <- find_pk_parameter(expression$variable, model) - new_expr <- paste0(Sx, " = ", expr_var, "/", expression$scale) - - ## Regex find and update scaling in model code - code <- stringr::str_split(model$code, "\\n")[[1]] - pattern <- paste0("^S", compartment, " *=") - idx <- grep(pattern, code)[1] - code[idx] <- new_expr - new_code <- paste0(code, collapse = "\n") - - ## Reload model from file - model <- pharmr::read_model_from_string(new_code) - - ## Update initial estimates for PK parameters - if(update_inits) { - model <- scale_initial_estimates_pk( - model, - scale = expression$scale - ) - } - - model -} - -#` Scale initial estimates by factor -#' -#' Only applies to PK parameters, not all parameters -#' -#' @inheritParams set_compartment_scale -#' -#' @returns Pharmpy model object -#' -#' @export -#' -scale_initial_estimates_pk <- function( - model, - scale -) { - pars <- model$parameters$to_dataframe() - pk_params <- rownames(pars) - all_pk <- c( - "CL", "V", - "V1", "V2", "V3", "V4", - "VP1", "VP2", "VP3", - "Q", "Q1", "Q2", "Q3", "QP1", "QP2", "QP3" - ) - par_to_scale <- intersect( - pk_params, - c(all_pk, paste0("POP_", all_pk)) - ) - updated_inits <- list() - for(key in par_to_scale) { - idx <- match(key, pk_params) - if(!is.na(idx)) { - updated_inits[[key]] <- pars$value[idx] * scale - } - } - model <- pharmr::set_initial_estimates( - model, - inits = updated_inits - ) - model -} - -#' Get compartment scale definition -#' -#' Assumes scale is always defined either as a single variable -#' (e.g. `S2 = V2`), or as a variable divided by a factor (e.g. -#' `S2 = V2/1000`. Other expressions will very likely not result -#' in a correct extraction, or errors. -#' -#' @inheritParams set_compartment_scale -#' -#' @returns a list with elements `variable` and `scale`, e.g. -#' -get_compartment_scale <- function(model, compartment = 2) { - tmp <- model$statements$find_assignment(paste0("S", compartment)) - if(!is.null(tmp) && inherits(tmp, "pharmpy.model.statements.Assignment")) { - elements <- stringr::str_split(as.character(tmp$expression), "\\/")[[1]] - if(is.na(elements[2])) { - elements[2] <- 1 - } - return(list(variable = elements[1], scale = as.numeric(elements[2]))) - } else { - return(invisible()) - } -} diff --git a/R/set_iiv.R b/R/set_iiv.R deleted file mode 100644 index 7bda958..0000000 --- a/R/set_iiv.R +++ /dev/null @@ -1,243 +0,0 @@ -#' Set inter-individual variability on parameters -#' -#' @param mod pharmpy model object -#' @param iiv what parameters to put IIV on. Can be one of three formats: -#' - character: `all` or `basic`. -#' - character: `c("CL", "V")`. Will assume SD of 0.5 for initial estimate. -#' - list of numeric: e.g. `list(CL = 0.5, V = 0.5)` with SD for initial -#' estimates. -#' @param iiv_type one of IIV types accepted by pharmr::add_iiv(), i.e. -#' `add`, `prop`, `exp` (default), `log`, or `re_log`. -#' -set_iiv <- function(mod, iiv, iiv_type = "exp") { - - if(inherits(iiv, "character")) { - pars <- get_defined_pk_parameters(mod) - if(length(iiv) == 1 && iiv == "all") { - iiv <- list() - for(key in pars) iiv[[key]] <- 0.5 - } else if(length(iiv) == 1 && iiv == "basic") { - iiv <- list(CL = 0.5) - if("V" %in% pars) iiv$V <- 0.5 - if("V2" %in% pars) iiv$V2 <- 0.5 - } else { # assume user passed a vector of parameter names to put IIV on - iiv_list <- list() - for(key in iiv) iiv_list[[key]] <- 0.5 - iiv <- iiv_list - } - } - - ## Make sure iiv_type is a list - if(inherits(iiv_type, "character")) { - iiv_type_list <- list() - for(key in names(iiv)) { - iiv_type_list[[key]] <- iiv_type - } - } else { - iiv_type_list <- iiv_type - } - - if(!is.null(iiv)) { - if(!inherits(iiv, "list")) { - stop("`iiv` parameter should be a `list` or a `character` object.") - } - - ## First remove all existing IIV - ## Then, add univariate IIV (no BLOCKs yet) - all_params <- get_defined_pk_parameters(mod) - current <- get_parameters_with_iiv(mod) - iiv_goal <- names(iiv)[!stringr::str_detect(names(iiv), "~")] - iiv_corr <- names(iiv)[stringr::str_detect(names(iiv), "~")] - has_corr <- unique(unlist(stringr::str_split(iiv_corr, "~"))) - to_remove <- setdiff(current, iiv_goal) - to_reset <- intersect(iiv_goal, current) - to_add <- setdiff(iiv_goal, current) - map <- data.frame( # build a map for each parameter, whether it needs to be reset or not - name = c(to_add, to_reset), - reset = c(rep(FALSE, length(to_add)), rep(TRUE, length(to_reset))) - ) |> - dplyr::mutate(parameter = name) |> - dplyr::mutate(correlation = name %in% has_corr) |> - dplyr::arrange(reset, correlation) # make sure to first do the parameters that don't need a reset, to avoid creating DUMMYOMEGA - for(i in seq_along(map$name)) { - key <- map$name[i] - if(key == "V" && (! "V" %in% all_params) && "V1" %in% all_params) { - map$parameter[i] <- "V1" - } - if(key == "Q" && (! "QP1" %in% all_params) && "QP1" %in% all_params) { - map$parameter[i] <- "QP1" - } - names(iiv)[key == names(iiv)] <- map$parameter[i] - } - for(i in seq_along(map$parameter)) { - key <- map$name[i] - par <- map$parameter[i] - if(map$reset[match(par, map$parameter)]) { - mod <- pharmr::remove_iiv(mod, par) - } - if(length(mod$statements$find_assignment(par)) > 0) { - mod <- pharmr::add_iiv( - model = mod, - list_of_parameters = par, - expression = iiv_type_list[[key]], - initial_estimate = signif(iiv[[par]]^2, 5) - ) - } else { - cli::cli_alert_warning(paste0("Parameter declaration for ", key, " not found, cannot add IIV for ", key, ".")) - } - } - - ## Then, if needed, change relevant $OMEGA to BLOCK - ## Currently, pharmpy/pharmr does not support setting covariances currently - ## so we'll write a custom function that just uses regex. It's a hacky solution - ## but expectation is that pharmr will support this in the future. - if(length(iiv_corr) > 0) { - mod <- set_iiv_block(mod, iiv) - } - - } - mod -} - -set_iiv_block <- function( - model, - iiv -) { - - ## make sure we have the IIV object in the same - ## order as the IIVs in the NONMEM model - pars <- get_parameters_with_iiv(model) - iiv_ordered <- list() - for(par in pars) { - iiv_ordered[[par]] <- iiv[[par]] - iiv[[par]] <- NULL - } - corr_params <- names(iiv)[grep("~", names(iiv))] - for(par in corr_params) { # remainder of parameters - iiv_ordered[[par]] <- iiv[[par]] - } - pars_with_corr <- intersect( - names(iiv_ordered), - unique(unlist(stringr::str_split(corr_params, "~"))) - ) - - ## get omega lines, only the ones with correlations - code <- stringr::str_split(model$code, "\\n")[[1]] - omega_idx <- c() - for(par in pars_with_corr) { - idx <- grep(paste0("^\\$OMEGA .*? ; IIV_", par), code) - omega_idx <- c(omega_idx, idx) - } - omega_lines <- code[omega_idx] - - ## Create the omega block - om_block <- get_cov_matrix( - iiv_ordered, - nonmem = TRUE, - limit = 0.001 - ) - omega <- c( - glue::glue("$OMEGA BLOCK({length(om_block)})"), - paste(om_block, paste0("; IIV_", pars_with_corr)) - ) - new_code <- c( - code[1:(min(omega_idx)-1)], - omega, - code[(max(omega_idx)+1):length(code)] - ) - temp <- list( - code = paste0(new_code, collapse = "\n"), - dataset = model$dataset, - datainfo = model$datainfo - ) - new_model <- create_pharmpy_model_from_list(temp) - new_model -} - -#' Get a character vector with all parameters on which IIV is present -#' -get_parameters_with_iiv <- function(mod) { - pars <- mod$random_variables$variance_parameters - idx <- grep("IIV_", pars) - eta_pars <- c() - if(length(idx) > 0) { - eta_pars <- pars[idx] - eta_pars <- gsub("IIV_", "", eta_pars) - } - eta_pars -} - -#' Get all parameters that are defined (from a predefined vector of possible parameters) -#' -get_defined_pk_parameters <- function( - mod, - possible = c("CL", "V", "V1", "V2", "V3", "Q", "Q2", "Q3", "K10", "K12", "K21", "K13", "K31") -) { - pars <- c() - statements <- mod$statements$to_dict()$statements - for(i in seq(statements)) { - obj <- statements[[i]] - if(obj$class == "Assignment") { - symbol <- gsub("(Symbol\\(\\'|\\'\\))", "", obj$symbol) - if(symbol %in% possible) { - pars <- c(pars, symbol) - } - } - } - pars -} - -#' Function to set covariance between parameters in the omega block -#' -#' One caveat is that it will remove any existing covariances, since currently -#' there is no feature in pharmr/pharmpy to extract the covariance info. -#' -#' @inheritParams set_iiv -#' @param covariance character vector specifying the parameters and initial -#' value for the correlation between the respective parameters, e.g. -#' `c("CL~V" = 0.1, "Q~V2" = 0.2)`. -#' -#' @returns Pharmpy model object -#' -#' @export -set_covariance <- function(model, covariance) { - omegas <- pharmr::get_omegas(model) - advan <- get_advan(model) - params <- pharmr::get_pk_parameters(model) - om_names <- omegas$names |> - stringr::str_replace_all("IIV_", "") - om_values <- lapply(omegas$inits, "sqrt") |> - setNames(om_names) - ## remove existing covariance entries - idx_cov <- !grepl("^OMEGA_", om_names) - om_names <- om_names[idx_cov] - om_values <- om_values[idx_cov] - cov_terms <- c() - for(key in names(covariance)) { - if(stringr::str_detect(key, "\\~")) { - om_values[[key]] <- covariance[[key]] - terms <- stringr::str_split(key, "\\~")[[1]] - cov_terms_safe <- lapply(terms, find_pk_parameter, model) |> - as.character() - names(om_values)[grepl(key, names(om_values))] <- paste(cov_terms_safe, collapse = "~") - cov_terms <- c(cov_terms, cov_terms_safe) - } - } - om_safe_names <- lapply(om_names, find_pk_parameter, model) |> - as.character() - ## Need to re-add parameters that are listed under a different name, e.g. V -> V2 - to_add <- setdiff(om_safe_names, om_names) - model <- model |> - pharmr::remove_iiv(to_add) |> - pharmr::add_iiv(to_add, expression = "exp") - if(! all(cov_terms %in% om_safe_names)) { - cli::cli_abort("Cannot add covariance: no IIV is present on one or more of the parameters between which covariance is requested.") - } - names(om_values)[1:length(om_safe_names)] <- om_safe_names - new_model <- set_iiv( - model, - iiv = om_values, - iiv_type = "exp" - ) - new_model -} diff --git a/R/stack_encounters.R b/R/stack_encounters.R deleted file mode 100644 index e11af7a..0000000 --- a/R/stack_encounters.R +++ /dev/null @@ -1,75 +0,0 @@ -#' Stack encounters when data from multiple encounters is available for the -#' same ID, and TIME is starting at 0 for each encounter. -#' -#' @param data NONMEM input dataset -#' @param gap rounding resolution for next . E.g. if set to `100` and if the -#' maximum encounter length in the data is 168 hours, will start the encounters -#' at t = 0, 200, 400 etc. -#' @param reset_encounters add an EVID=3 event to reset all compartments to 0 before -#' starting the new encounter? Default is `TRUE`. -#' @param time time column, `"TIME"` by default -#' @param verbose verbose output -#' -#' @export -stack_encounters <- function( - data, - gap = 100, - reset_encounters = TRUE, - time = "TIME", - verbose = FALSE -) { - if(time_is_always_increasing(data, time = time)) { - ## Still add the column ENC_TIME, for safer post-processing - data$ENC_TIME <- data$TIME - return(data) - } else { - input_columns <- names(data) - if(verbose) cli::cli_alert_info("Multiple encounters per subject detected, stacking them in TIME, keeping original TIME column as ENC_TIME column.") - enct_length <- ceiling(max(data[[time]])/gap) * gap - tmp <- data |> - dplyr::mutate(TIME_COLUMN = .data[[time]]) |> - dplyr::mutate(idx = 1:length(TIME_COLUMN)) |> - dplyr::group_by(ID) |> - dplyr::mutate( - ENC_TIME = TIME_COLUMN, - prv_time = c(0, TIME_COLUMN)[-length(TIME_COLUMN)], - is_decreasing = c(0, diff(TIME_COLUMN)) < 0) |> - dplyr::mutate( - encounter_idx = cumsum(is_decreasing), - enct_start_time = encounter_idx * enct_length - ) - if(reset_encounters) { - evid3_events <- tmp |> - dplyr::filter(is_decreasing) |> - dplyr::mutate(TIME_COLUMN = enct_start_time, EVID = 3, MDV = 1, DV = 0, AMT = 0, idx = idx - 0.5) # make sure to squeeze in, and not make other changes to dataset order - for(key in names(tmp)) { # revert back auto-converted columns to character - if(inherits(tmp[[key]], "character")) { - class(evid3_events[[key]]) <- "character" - } - } - comb <- dplyr::bind_rows( - tmp |> - dplyr::mutate(TIME_COLUMN = TIME_COLUMN + ifelse(is.na(enct_start_time), 0, enct_start_time)), - evid3_events - ) |> - dplyr::arrange(idx) - } else { - comb <- tmp - } - return( - comb |> ## make sure to remove helper columns - dplyr::mutate(!!time := TIME_COLUMN) |> - dplyr::select(!!input_columns, ENC_TIME) |> - as.data.frame() - ) - } -} - -## Function to check if time in NONMEM dataset is always increasing. -time_is_always_increasing <- function(data, time = "TIME") { - data |> - dplyr::group_by(ID) |> - dplyr::mutate(is_increasing = c(0, diff(.data[[time]])) >= 0) |> - dplyr::pull(is_increasing) |> - all() -} diff --git a/R/update_estimation_method.R b/R/update_estimation_method.R deleted file mode 100644 index 7873e6a..0000000 --- a/R/update_estimation_method.R +++ /dev/null @@ -1,43 +0,0 @@ -#' Wrapper around pharmr's functions to set/add estimation methods -#' -#' The current pharmpy functionality is not stable, hence the need for this -#' wrapper. -#' -#' @inheritParams run_nlme -#' -update_estimation_method <- function( - model, - estimation_method, - verbose = TRUE -) { - estimation_method <- toupper(estimation_method) - allowed <- c("FO", "FOCE", "ITS", "LAPLACE", "IMPMAP", "IMP", "SAEM") - if(length(estimation_method) > 1) { - cli::cli_alert_warning("Currently setting estimation methods supports only a single estimation method. Using {estimation_method[1]}") - estimation_method <- estimation_method[1] - } - if(any(! estimation_method %in% allowed)) { - cli::cli_abort("The requested estimation method was not recognized. Available estimation methods are {allowed} or their lower-case equivalents.") - } - ## Due to an issue with indexing in Pharmpy, we can currently only - ## override existing estimation steps, not add new ones. - existing_steps <- model$execution_steps$to_dataframe() - n_existing <- nrow(existing_steps) - for(i in seq_along(estimation_method)) { - model <- pharmr::set_estimation_step( - model, - method = estimation_method[i], - idx = 0 - ) - if(verbose) { - cli::cli_alert_info("Setting estimation method to {estimation_method}") - } - } - n_remove <- nrow(model$execution_steps$to_dataframe()) - n_existing - if(n_remove > 1) { - for(i in 1:n_remove) { - model <- pharmr::remove_estimation_step(model, i) - } - } - model -} diff --git a/R/update_parameters.R b/R/update_parameters.R deleted file mode 100644 index 92576f7..0000000 --- a/R/update_parameters.R +++ /dev/null @@ -1,42 +0,0 @@ -#' Update parameter estimates (and fix) -#' -#' For example for using model in simulations. -#' -#' @inheritParams attach_fit_info -#' @param fix fix the estimates? -#' -#' @export -#' -#' -update_parameters <- function( - model, - fit, - fix = FALSE, - verbose = FALSE -) { - final_model <- attr(fit, "model") - params <- fit$parameter_estimates - if(is.null(params)) { - cli::cli_abort("No parameter estimates found in fit object; cannot update model.") - } - if(all(is.nan(params))) { - cli::cli_alert_warning("No parameter estimates were available, not updating model.") - return(invisible()) - } - if(any(is.nan(params))) { - params <- params[!is.nan(params)] - cli::cli_alert_info("Only some parameters were estimated, updating only for {names(params)}.") - } - if(fix) { - model <- pharmr::fix_parameters_to( - model, - params - ) - } else { - model <- pharmr::set_initial_estimates( - model = model, - inits = params - ) - } - model -} diff --git a/R/update_pk_tables.R b/R/update_pk_tables.R deleted file mode 100644 index 7148e28..0000000 --- a/R/update_pk_tables.R +++ /dev/null @@ -1,38 +0,0 @@ -#' Updates PK parameter tables (patab) -#' -#' E.g. useful to call after pharmr::add_peripheral_compartment() to update -#' the $TABLE with parameter estimates -#' -#' @inheritParams run_nlme -#' -#' @param ... passed to add_default_output_tables() -#' -#' @export -update_pk_tables <- function(model, ...) { - - # figure out which pk parameters - pk_params <- luna:::get_defined_pk_parameters(model) - tables <- luna::get_tables_in_model_code(model$code) - tables <- c("patab", "sdtab") - data <- model$dataset - - ## remove any table starting with "patab" - model <- luna::remove_tables_from_model(model, file = "patab") - - ## Re-add dataset - new_model <- model |> - pharmr::set_dataset(data) - - ## add back parameter table - new_model <- luna::add_default_output_tables( - model = new_model, - iiv = "all", - tables = "parameters", - verbose = FALSE, - remove_existing = FALSE, - ... - ) - - ## return new model object - new_model -} diff --git a/R/validate_model.R b/R/validate_model.R deleted file mode 100644 index 6b04ce7..0000000 --- a/R/validate_model.R +++ /dev/null @@ -1,24 +0,0 @@ -#' Validate the specified model, ensure it's valid Pharmpy model -#' -validate_model <- function( - model -) { - if(inherits(model, "pharmpy.model.model.Model")) { - tool <- get_tool_from_model(model) - if(tool != "nonmem") { - cli::cli_abort("Currently only NONMEM is supported.") - } - } else if(inherits(model, "character")) { - tool <- "nonmem" - if(file.exists(model)) { ## specified as file? - model <- pharmr::read_model(path = model) - } else { ## specified as code? - model <- pharmr::read_model_from_string( - code = paste0(model, collapse = "\n") - ) - } - } else { - cli::cli_abort("`model` should either be model code or a pharmpy model object") - } - model -} diff --git a/inst/models/nonmem/base_iv.mod b/inst/models/nonmem/base_iv.mod deleted file mode 100644 index 3850187..0000000 --- a/inst/models/nonmem/base_iv.mod +++ /dev/null @@ -1,32 +0,0 @@ -$SIZES PD=100 - -$PROBLEM Base linear model with iv input - -$INPUT ID TIME DV MDV EVID SS II AMT - -$DATA nm_data.csv IGNORE=@ - -$SUBROUTINES ADVAN1 TRANS2 - -$ABBR REPLACE ETA_CL=ETA(1) -$PK -TVCL = THETA(1) -TVV = THETA(2) - -CL=TVCL*EXP(ETA_CL) -V=TVV - -S1 = V - -$ERROR -W = 1 -IPRED = F -Y = IPRED + W * EPS(1) - -$THETA (0, 15) ; POP_CL -$THETA (0, 5) ; POP_V -$OMEGA 0.3 ; IIV_CL -$SIGMA 0.5 ; RUV_ADD - -$EST METHOD=1 -$COV UNCOND diff --git a/inst/models/nonmem/base_oral.mod b/inst/models/nonmem/base_oral.mod deleted file mode 100644 index 147050c..0000000 --- a/inst/models/nonmem/base_oral.mod +++ /dev/null @@ -1,35 +0,0 @@ -$SIZES PD=100 - -$PROBLEM Base linear model with oral input - -$INPUT ID TIME DV MDV EVID SS II AMT - -$DATA nm_data.csv IGNORE=@ - -$SUBROUTINES ADVAN2 TRANS2 - -$ABBR REPLACE ETA_CL=ETA(1) -$PK -TVKA = THETA(1) -TVCL = THETA(2) -TVV = THETA(3) - -KA=TVKA -CL=TVCL*EXP(ETA_CL) -V=TVV - -S2 = V - -$ERROR -W = 1 -IPRED = F -Y = IPRED + W * EPS(1) - -$THETA (0, 0.5) ; POP_KA -$THETA (0, 15) ; POP_CL -$THETA (0, 5) ; POP_V -$OMEGA 0.3 ; IIV_CL -$SIGMA 0.5 ; RUV_ADD - -$EST METHOD=1 -$COV UNCOND diff --git a/man/add_covariates_to_model.Rd b/man/add_covariates_to_model.Rd deleted file mode 100644 index ae79b7f..0000000 --- a/man/add_covariates_to_model.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_covariates_to_model.R -\name{add_covariates_to_model} -\alias{add_covariates_to_model} -\title{Wrapper function to add covariates to a pharmpy model} -\usage{ -add_covariates_to_model(model, covariates, data = NULL) -} -\arguments{ -\item{covariates}{list of parameter-covariate effects, e.g. -\verb{list(CL = list(WT = "pow", CRCL = "lin"), V = list(WT = "pow")} -Values in list need to match one of the effects allowed by pharmpy.} - -\item{data}{data.frame as input to NONMEM / nlmixr.} -} -\description{ -Wrapper function to add covariates to a pharmpy model -} diff --git a/man/add_default_output_tables.Rd b/man/add_default_output_tables.Rd deleted file mode 100644 index b95f5d3..0000000 --- a/man/add_default_output_tables.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_default_output_tables.R -\name{add_default_output_tables} -\alias{add_default_output_tables} -\title{Add one or more default output tables to a model, -if they don't already exist in the model.} -\usage{ -add_default_output_tables( - model, - iiv = NULL, - tables = c("fit", "parameters"), - full_tables = FALSE, - remove_existing = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{model}{Pharmpy model object} - -\item{iiv}{vector of parameters with iiv. Optional, if not specified -will use pharmpy function to retrieve it. Shortcut strings "basic" and "all" -are also treated as NULL and will auto-detect parameters.} - -\item{tables}{character vector of which default tables -to add, options are \code{fit} and \code{parameters}.} - -\item{full_tables}{For the default tables, should all input columns from be -included in the output tables? Default \code{FALSE}.} - -\item{verbose}{verbose output?} -} -\description{ -Add one or more default output tables to a model, -if they don't already exist in the model. -} diff --git a/man/add_table_to_model.Rd b/man/add_table_to_model.Rd deleted file mode 100644 index 5ed0cf6..0000000 --- a/man/add_table_to_model.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/add_table_to_model.R -\name{add_table_to_model} -\alias{add_table_to_model} -\title{Add new $TABLE record to output variables} -\usage{ -add_table_to_model(model, variables, firstonly = FALSE, file) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{variables}{character vector with variable names} - -\item{firstonly}{add \code{FIRSTONLY} parameter to $TABLE record} - -\item{file}{path to file, e.g. \code{sdtab}} -} -\description{ -Add new $TABLE record to output variables -} diff --git a/man/attach_fit_info.Rd b/man/attach_fit_info.Rd deleted file mode 100644 index 1271c0c..0000000 --- a/man/attach_fit_info.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/attach_fit_info.R -\name{attach_fit_info} -\alias{attach_fit_info} -\title{Attach fit info and tables to a fit object, e.g. from model fit or -Pharmpy grid search final results} -\usage{ -attach_fit_info( - fit, - model, - fit_folder, - output_file = file.path(fit_folder, "model.lst"), - is_sim_model = FALSE, - verbose = TRUE -) -} -\arguments{ -\item{fit}{pharmpy fit object} - -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{output_file}{NONMEM output file, default is \code{run.lst}} - -\item{verbose}{verbose output?} -} -\description{ -Attach fit info and tables to a fit object, e.g. from model fit or -Pharmpy grid search final results -} diff --git a/man/calc_condition_number.Rd b/man/calc_condition_number.Rd deleted file mode 100644 index 611582b..0000000 --- a/man/calc_condition_number.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_condition_number_for_fit.R -\name{calc_condition_number} -\alias{calc_condition_number} -\title{Calculate the condition number given a matrix} -\usage{ -calc_condition_number(mat) -} -\description{ -Calculate the condition number given a matrix -} diff --git a/man/calc_pk_variables.Rd b/man/calc_pk_variables.Rd deleted file mode 100644 index 3c8a5b2..0000000 --- a/man/calc_pk_variables.Rd +++ /dev/null @@ -1,28 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_sim.R -\name{calc_pk_variables} -\alias{calc_pk_variables} -\title{Calculate some basic PK variables from simulated or observed data} -\usage{ -calc_pk_variables(data, regimen = NULL, dictionary = NULL) -} -\arguments{ -\item{data}{data.frame in NONMEM format} - -\item{regimen}{if specified, will replace the regimens for each subject with -a custom regimen. Can be specified in two ways. The simplest way is to just -specify a list with elements \code{dose}, \code{interval}, \code{n}, and -\code{route} (and \code{t_inf} / \code{rate} for infusions). -E.g. \code{regimen = list(dose = 500, interval = 12, n = 5, route = "oral")}. -Alternatively, regimens can be specified as a data.frame. The data.frame -specified all dosing times (\code{dose}, \code{time} columns) and \code{route} and \code{t_inf} / -\code{rate}. The data.frame may also optionally contain a \code{regimen} column that -specifies a name for the regimen. This can be used to simulate multiple -regimens.} -} -\value{ -data.frame -} -\description{ -Calculate some basic PK variables from simulated or observed data -} diff --git a/man/call_nmfe.Rd b/man/call_nmfe.Rd deleted file mode 100644 index c93116f..0000000 --- a/man/call_nmfe.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{call_nmfe} -\alias{call_nmfe} -\title{Call nmfe} -\usage{ -call_nmfe( - model_file, - output_file, - path, - nmfe = "/opt/NONMEM/nm_cxurrent/run/nmfe75", - console = FALSE, - check_only = FALSE, - verbose = FALSE -) -} -\arguments{ -\item{model_file}{model file, e.g. "run.mod"} - -\item{output_file}{output file, e.g. "run.lst"} - -\item{path}{run folder path, e.g. "run1"} - -\item{nmfe}{path to nmfe batch file to run NONMEM} - -\item{console}{show output from nmfe in console? Default \code{FALSE}} - -\item{check_only}{only run NM-TRAN, to check the model syntax} - -\item{verbose}{verbose output?} -} -\description{ -Call nmfe -} diff --git a/man/call_pharmpy_fit.Rd b/man/call_pharmpy_fit.Rd deleted file mode 100644 index 830fcb0..0000000 --- a/man/call_pharmpy_fit.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/call_pharmpy_fit.R -\name{call_pharmpy_fit} -\alias{call_pharmpy_fit} -\title{Run model with pharmpy} -\usage{ -call_pharmpy_fit( - model_file, - path, - clean = TRUE, - console = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{model_file}{model file, e.g. "run.mod"} - -\item{path}{run folder path, e.g. "run1"} - -\item{console}{show output from nmfe in console? Default \code{FALSE}} - -\item{verbose}{verbose output?} -} -\description{ -Run model with pharmpy -} diff --git a/man/call_pharmpy_tool.Rd b/man/call_pharmpy_tool.Rd deleted file mode 100644 index 069cd3f..0000000 --- a/man/call_pharmpy_tool.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/call_pharmpy_tool.R -\name{call_pharmpy_tool} -\alias{call_pharmpy_tool} -\title{Generic function for running a pharmpy tool, like bootstrap, -or modelsearch. A separate function is available for \code{fit()}} -\usage{ -call_pharmpy_tool( - id, - model = NULL, - results = NULL, - tool = NULL, - folder = NULL, - clean = TRUE, - verbose = TRUE, - force = FALSE, - options = list() -) -} -\arguments{ -\item{id}{model id. Optional. If not specified, will generate random modelfit -id. The \code{id} will be used to create the run folder.} - -\item{model}{Pharmpy model object, preferably created using -\code{luna::create_model()}.} - -\item{verbose}{verbose output?} - -\item{options}{list of arguments pass on to \code{tool} as argument. Documentation -for available arguments for each Pharmpy tool can be found here: -https://pharmpy.github.io/latest/mfl.html.} - -\item{clear}{if one or more run folders exists for the tool, -do we want to remove them first?} -} -\value{ -fit object -} -\description{ -Generic function for running a pharmpy tool, like bootstrap, -or modelsearch. A separate function is available for \code{fit()} -} diff --git a/man/call_psn.Rd b/man/call_psn.Rd deleted file mode 100644 index f811eb6..0000000 --- a/man/call_psn.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/call_psn.R -\name{call_psn} -\alias{call_psn} -\title{Call PsN} -\usage{ -call_psn( - model_file, - output_file, - path, - options = c(), - tool = c("execute", "vpc", "bootstrap", "sir", "proseval", "update_inits", "cdd"), - console = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{model_file}{model file, e.g. "run.mod"} - -\item{output_file}{output file, e.g. "run.lst"} - -\item{path}{run folder path, e.g. "run1"} - -\item{options}{a vector of arguments to pass to the PsN tool, e.g. -\verb{c("--samples=100", "--dir="test")}} - -\item{console}{show output from nmfe in console? Default \code{FALSE}} - -\item{verbose}{verbose output?} -} -\description{ -Call PsN -} diff --git a/man/change_nonmem_dataset.Rd b/man/change_nonmem_dataset.Rd deleted file mode 100644 index e73ca4f..0000000 --- a/man/change_nonmem_dataset.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{change_nonmem_dataset} -\alias{change_nonmem_dataset} -\title{Change $DATA in NONMEM model code} -\usage{ -change_nonmem_dataset(code, path) -} -\arguments{ -\item{code}{model code, either as single line string, or vector of lines} - -\item{path}{path of new dataset} -} -\description{ -Change $DATA in NONMEM model code -} diff --git a/man/clean_modelfit_data.Rd b/man/clean_modelfit_data.Rd deleted file mode 100644 index 0b30ad1..0000000 --- a/man/clean_modelfit_data.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/clean_modelfit_data.R -\name{clean_modelfit_data} -\alias{clean_modelfit_data} -\title{Clean / check the dataset before passing to model fitting tool} -\usage{ -clean_modelfit_data( - model, - try_make_numeric = TRUE, - data = NULL, - verbose = TRUE -) -} -\arguments{ -\item{try_make_numeric}{should function try to turn character columns -into numeric columns? If \code{FALSE} will just set all values to 0 (but -retain column to avoid issues).} -} -\description{ -Clean / check the dataset before passing to model fitting tool -} diff --git a/man/clean_nonmem_folder.Rd b/man/clean_nonmem_folder.Rd deleted file mode 100644 index ba34962..0000000 --- a/man/clean_nonmem_folder.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/clean_nonmem_folder.R -\name{clean_nonmem_folder} -\alias{clean_nonmem_folder} -\title{Remove temporary files from NONMEM run} -\usage{ -clean_nonmem_folder(path) -} -\arguments{ -\item{path}{path to NONMEM run folder} -} -\description{ -Remove temporary files from NONMEM run -} diff --git a/man/clean_pharmpy_runfolders.Rd b/man/clean_pharmpy_runfolders.Rd deleted file mode 100644 index 4237eb1..0000000 --- a/man/clean_pharmpy_runfolders.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/clean_pharmpy_runfolders.R -\name{clean_pharmpy_runfolders} -\alias{clean_pharmpy_runfolders} -\title{Clean pharmpy run folders like modelfit1 etc} -\usage{ -clean_pharmpy_runfolders( - id = NULL, - folder, - tool, - remove = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{id}{run id, e.g. \code{run1}. This will be the folder in which the NONMEM -model is run. If no folder is specified, it will create a folder \code{run1} in -the current working directory, and will increment the run number for each -subsequent run.} - -\item{verbose}{verbose output?} - -\item{clean}{should folders really be removed (\code{TRUE}), or just show a warning (\code{FALSE})} -} -\description{ -Clean pharmpy run folders like modelfit1 etc -} diff --git a/man/combine_info_columns.Rd b/man/combine_info_columns.Rd deleted file mode 100644 index 3a47a8e..0000000 --- a/man/combine_info_columns.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/compare_nlme_fit.R -\name{combine_info_columns} -\alias{combine_info_columns} -\title{Combine columns with run info into a data.frame -and make sure that rows match (e.g. parameters)} -\usage{ -combine_info_columns(fit_info, table = "info_tab", label = "Detail") -} -\description{ -data.frames in list should have the same column names but can have different -row names (e.g. parameter names). -} diff --git a/man/combine_regimens.Rd b/man/combine_regimens.Rd deleted file mode 100644 index c1dc9d3..0000000 --- a/man/combine_regimens.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_regimen.R -\name{combine_regimens} -\alias{combine_regimens} -\title{Combine several regimens into a single data.frame, which can be passed into -\code{luna::run_sim()} as \code{regimen} argument.} -\usage{ -combine_regimens(...) -} -\arguments{ -\item{...}{each argument is a named regimen, that in itself is specified as -a list containing multiple regimens, each created using \code{create_regimen()}. -See examples.} -} -\description{ -Combine several regimens into a single data.frame, which can be passed into -\code{luna::run_sim()} as \code{regimen} argument. -} -\details{ -This allows both for combination of two or more phases, e.g. loading doses -and maintenance phase in a single regimen. It also allows for specification -of multiple separate regimens to simulate, e.g. a high-dose regimen and a -low-dose regimen. -} -\examples{ -\dontrun{ -regimens <- combine_regimens( - "without_load" = list( - create_regimen( - dose = 500, - interval = 12, - n = 10, - route = "oral" - ) - ), - "with_load" = list( - create_regimen( - dose = 2000, - n = 1, - interval = 12, - route = "iv", - t_inf = 1 - ), - create_regimen( - dose = 500, - n = 5, - interval = 24, - route = "oral" - ) - ) -) -} - -} diff --git a/man/compare_nlme_fit.Rd b/man/compare_nlme_fit.Rd deleted file mode 100644 index 348559b..0000000 --- a/man/compare_nlme_fit.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/compare_nlme_fit.R -\name{compare_nlme_fit} -\alias{compare_nlme_fit} -\title{Compare fit of two or more NLME fits} -\usage{ -compare_nlme_fit(..., return_object = FALSE) -} -\arguments{ -\item{...}{fit objects} - -\item{return_object}{logical, if TRUE, return a list of the combined info and parameter tables} -} -\description{ -Compare fit of two or more NLME fits -} diff --git a/man/create_covariate_search_space.Rd b/man/create_covariate_search_space.Rd deleted file mode 100644 index 2c19905..0000000 --- a/man/create_covariate_search_space.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_covariate_search_space.R -\name{create_covariate_search_space} -\alias{create_covariate_search_space} -\title{Create covariate search space definition for pharmpy \code{covsearch}} -\usage{ -create_covariate_search_space( - parameters, - covariates, - operation = c("LIN", "POW"), - explore = TRUE, - struct_parameters = NULL, - struct_covariates = NULL, - struct_operation = "POW" -) -} -\arguments{ -\item{parameters}{vector of parameter names} - -\item{covariates}{vector of covariate names} - -\item{operation}{parameter-covariate model type (operation)} - -\item{explore}{should the specified \code{parameters} and \code{covariates} -be used as structural model elements, or as exploration space?} - -\item{struct_parameters}{vector of parameter names for structural model} - -\item{struct_covariates}{vector of covariate names for structural model} - -\item{struct_operation}{parameter-covariate model type (operation) -for structural model} -} -\description{ -See Pharmpy MFL documentation for more info: -https://pharmpy.github.io/latest/covsearch.html -} diff --git a/man/create_dosing_records.Rd b/man/create_dosing_records.Rd deleted file mode 100644 index 5062dbb..0000000 --- a/man/create_dosing_records.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_sim.R -\name{create_dosing_records} -\alias{create_dosing_records} -\title{Create dosing records, given a specified regimen as a data frame with -potentially multiple regimens and varying dosing times / doses} -\usage{ -create_dosing_records(regimen, data, n_subjects, dictionary, advan = NULL) -} -\description{ -Create dosing records, given a specified regimen as a data frame with -potentially multiple regimens and varying dosing times / doses -} diff --git a/man/create_model.Rd b/man/create_model.Rd deleted file mode 100644 index 72eefe7..0000000 --- a/man/create_model.Rd +++ /dev/null @@ -1,126 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_model.R -\name{create_model} -\alias{create_model} -\title{Create model} -\usage{ -create_model( - route = c("auto", "oral", "iv"), - lag_time = FALSE, - n_transit_compartments = 0, - bioavailability = FALSE, - n_cmt = 1, - elimination = c("linear", "michaelis-menten"), - iiv = "all", - iiv_type = "exp", - ruv = c("additive", "proportional", "combined", "ltbs"), - covariates = NULL, - scale_observations = NULL, - data = NULL, - name = NULL, - estimation_method = c("foce", "saem"), - estimation_options = list(), - uncertainty_method = c("sandwich", "smat", "rmat", "efim", "none"), - blq_method = NULL, - lloq = NULL, - tool = c("nonmem", "nlmixr", "nlmixr2"), - tables = c("fit"), - full_tables = FALSE, - auto_init = TRUE, - auto_stack_encounters = TRUE, - mu_reference = FALSE, - settings = list(), - verbose = FALSE -) -} -\arguments{ -\item{route}{route of administration, either \code{oral} or \code{iv}} - -\item{lag_time}{add a lag time, default is \code{FALSE}} - -\item{n_transit_compartments}{number of transit-compartments for absorption -model. Default is \code{0}.} - -\item{bioavailability}{Add a bioavailability parameter? Default is \code{FALSE}. -Will add using a logit function.} - -\item{n_cmt}{number of elimination and distribution compartments. Default is -1, i.e. no peripheral distributions.} - -\item{elimination}{elimination type, either \code{linear} or \code{michaelis-menten}.} - -\item{iiv}{either \code{character} or a \code{list} object. If \code{character}, should be -either "basic" (only CL and V parameters) or "all" (IIV on all parameters). -If specified as a list object, it should contain the IIV magnitude (on SD -scale) for parameters and potential correlations specified using a tilde, -e.g. \code{list("CL" = 0.2, "V" = 0.3, "CL~V" = 0.1)}.} - -\item{ruv}{one of \code{proportional}, \code{additive}, or \code{combined}.} - -\item{covariates}{list of parameter-covariate effects, e.g. -\verb{list(CL = list(WT = "pow", CRCL = "lin"), V = list(WT = "pow")} -Values in list need to match one of the effects allowed by pharmpy.} - -\item{scale_observations}{scale observations by factor, e.g. due to unit -differences between dose and concentration. E.g. \code{scale_observations = 1000} -will add \code{S1 = V/1000} (for a 1-compartment model) to NONMEM code.} - -\item{data}{data.frame as input to NONMEM / nlmixr.} - -\item{name}{name of model} - -\item{estimation_method}{estimation method.} - -\item{estimation_options}{options for estimation method, specified as list, -e.g. \code{NITER} or \code{ISAMPLE}.} - -\item{uncertainty_method}{Compute uncertainty for parameter estimations. -One of \code{sandwich} (default), \code{smat}, \code{fmat}, \code{efim}.} - -\item{blq_method}{method for handling data below the limit of quantification. -Available options are \code{m1}, \code{m3}, \code{m4}, \code{m5}, \code{m6}, \code{m7}, as described -by Beal et al. Default is no handling of BLQ data (\code{NULL}).} - -\item{lloq}{(optional) a numeric value specifying the limit of -quantification for observations. Will be disregarded if an \code{LLOQ} column is -in the dataset.} - -\item{tool}{output model type, either \code{nonmem} or \code{nlmixr}} - -\item{tables}{which pre-specified tables to add, defaults to \code{parameters} -and \code{fit} tables.} - -\item{full_tables}{For the default tables, should all input columns from be -included in the output tables? Default \code{FALSE}.} - -\item{auto_init}{automatically update initial estimates to reasonable values -based on a crude assessment of the PK data. Default is \code{TRUE}.} - -\item{auto_stack_encounters}{detects if TIME within an individual is -decreasing from one record to another, which NONMEM cannot handle. -If this happens, it will add a reset event (EVID=3) at that time, and -increase the TIME for subsequent events so that NONMEM does not throw an -error. It will increase the time for the next encounter to the maximum -encounter length across all subjects in the dataset (rounded up to 100). -If no decreasing TIME is detected, nothing will be done (most common case). -This feature is useful e.g. for crossover trials when data on the same -individual ispresent but is included in the dataset as time-after-dose and -not actual time since first overall dose.} - -\item{mu_reference}{MU-reference the model, useful for SAEM estimation -method.} - -\item{settings}{additional settings for model creation and model estimation. -TBD} - -\item{verbose}{verbose output?} - -\item{iiv_effect}{either \code{character} or \code{list}. If character, one of -\code{c("exp", "add", "prop", "log", "re_log")}. If \code{list}, should specify for -each parameter the effect type, e.g. \code{list(CL = "add", V = "exp")}. Default -is \code{"exp"} for all.} -} -\description{ -This is essentially a wrapper around the model-creation and -modification -functionality in pharmr/Pharmpy. -} diff --git a/man/create_model_nlmixr.Rd b/man/create_model_nlmixr.Rd deleted file mode 100644 index 832266a..0000000 --- a/man/create_model_nlmixr.Rd +++ /dev/null @@ -1,12 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_model_nlmixr.R -\name{create_model_nlmixr} -\alias{create_model_nlmixr} -\title{Temporary function that returns a hardcoded nlmixr2 model} -\usage{ -create_model_nlmixr(...) -} -\description{ -Any arguments to the function are just ignored, this is just for demo -purposes -} diff --git a/man/create_modelfit_info_table.Rd b/man/create_modelfit_info_table.Rd deleted file mode 100644 index dfb19ad..0000000 --- a/man/create_modelfit_info_table.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_fit_info.R -\name{create_modelfit_info_table} -\alias{create_modelfit_info_table} -\title{Create a data.frame with basic model fit info} -\usage{ -create_modelfit_info_table(fit) -} -\arguments{ -\item{fit}{pharmpy fit object} -} -\description{ -Create a data.frame with basic model fit info -} diff --git a/man/create_modelfit_parameter_table.Rd b/man/create_modelfit_parameter_table.Rd deleted file mode 100644 index 5583b1c..0000000 --- a/man/create_modelfit_parameter_table.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_fit_info.R -\name{create_modelfit_parameter_table} -\alias{create_modelfit_parameter_table} -\title{Create a data.frame with parameter estimates} -\usage{ -create_modelfit_parameter_table(fit) -} -\description{ -Create a data.frame with parameter estimates -} diff --git a/man/create_obs_records.Rd b/man/create_obs_records.Rd deleted file mode 100644 index 0a2d27b..0000000 --- a/man/create_obs_records.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_sim.R -\name{create_obs_records} -\alias{create_obs_records} -\title{Create observation records, given a specified t_obs vector} -\usage{ -create_obs_records(data, t_obs, n_subjects, dictionary) -} -\description{ -Create observation records, given a specified t_obs vector -} diff --git a/man/create_pharmpy_model_from_list.Rd b/man/create_pharmpy_model_from_list.Rd deleted file mode 100644 index 4b4006c..0000000 --- a/man/create_pharmpy_model_from_list.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_pharmpy_model_from_list.R -\name{create_pharmpy_model_from_list} -\alias{create_pharmpy_model_from_list} -\title{Create a model object from the model code and dataset stored as a list -object.} -\usage{ -create_pharmpy_model_from_list(model_obj) -} -\arguments{ -\item{model_obj}{list object with entries \code{code} and \code{dataset}} -} -\description{ -Create a model object from the model code and dataset stored as a list -object. -} diff --git a/man/create_pkmodel_search_space.Rd b/man/create_pkmodel_search_space.Rd deleted file mode 100644 index ffbcab2..0000000 --- a/man/create_pkmodel_search_space.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_pkmodel_search_space.R -\name{create_pkmodel_search_space} -\alias{create_pkmodel_search_space} -\title{Create PK mmodel search space definition for pharmpy \code{modelsearch}} -\usage{ -create_pkmodel_search_space( - absorption = c("FO", "ZO"), - elimination = c("FO", "MM"), - peripherals = c(0, 1), - transits = c(0, 1, 3), - lagtime = c("OFF", "ON") -) -} -\arguments{ -\item{absorption}{absorption model options} - -\item{elimination}{elimination model options} - -\item{peripherals}{peripheral compartment options} - -\item{transits}{transit model options} - -\item{lagtime}{lagtime options} -} -\description{ -See Pharmpy MFL documentation for more info: -https://pharmpy.github.io/latest/modelsearch.html -} diff --git a/man/create_regimen.Rd b/man/create_regimen.Rd deleted file mode 100644 index a4a2815..0000000 --- a/man/create_regimen.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_regimen.R -\name{create_regimen} -\alias{create_regimen} -\title{Create a single regimen} -\usage{ -create_regimen( - dose, - interval = 24, - n, - t_inf = NULL, - route = c("oral", "iv", "sc", "im") -) -} -\description{ -The resulting data.frame can be passed to \code{luna::run_sim()} as the \code{regimen} -argument. -} -\examples{ - -\dontrun{ -reg1 <- create_regimen( - dose = 500, - interval = 12, - n = 10, - route = "oral" -) -luna::run_sim(..., regimen = reg1) -} - -} diff --git a/man/create_run_folder.Rd b/man/create_run_folder.Rd deleted file mode 100644 index 5ae41b5..0000000 --- a/man/create_run_folder.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_run_folder.R -\name{create_run_folder} -\alias{create_run_folder} -\title{Create a folder for a run} -\usage{ -create_run_folder(id, path, force = FALSE, verbose = TRUE) -} -\arguments{ -\item{id}{run id, e.g. \code{run1}. This will be the folder in which the NONMEM -model is run. If no folder is specified, it will create a folder \code{run1} in -the current working directory, and will increment the run number for each -subsequent run.} - -\item{path}{path to nonmem model. If not specified, will assume current -working directory.} - -\item{force}{if run folder (\code{id}) exists, should existing results be -removed before rerunning NONMEM? Default \code{FALSE}.} - -\item{verbose}{verbose output?} -} -\description{ -Create a folder for a run -} diff --git a/man/create_vpc_data.Rd b/man/create_vpc_data.Rd deleted file mode 100644 index 8c888f4..0000000 --- a/man/create_vpc_data.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_vpc_data.R -\name{create_vpc_data} -\alias{create_vpc_data} -\title{Run a simulation based on supplied parameters estimates, -and combine into proper format for VPC} -\usage{ -create_vpc_data( - fit = NULL, - model = NULL, - parameters = NULL, - keep_columns = c(), - n = 100, - verbose = FALSE, - id = NULL, - use_pharmpy = TRUE -) -} -\arguments{ -\item{fit}{fit object from \code{pharmr::run_modelfit()}. Optional, can supply a -\code{model} and \code{parameters} argument} - -\item{model}{pharmpy model object. Optional, can also only supply just a -\code{fit} object} - -\item{parameters}{list of parameter estimates, e.g. \code{list(CL = 5, V = 50)}. -Optional, can also supply a \code{fit} object.} - -\item{keep_columns}{character vector of column names in original dataset -to keep in the output dataset} - -\item{n}{number of simulation iterations to generate} - -\item{verbose}{verbose output?} -} -\description{ -Run a simulation based on supplied parameters estimates, -and combine into proper format for VPC -} diff --git a/man/detect_nmfe_version.Rd b/man/detect_nmfe_version.Rd deleted file mode 100644 index 450b53f..0000000 --- a/man/detect_nmfe_version.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/luna_run.R -\name{detect_nmfe_version} -\alias{detect_nmfe_version} -\title{get nmfe file name from a NONMEM installation folder} -\usage{ -detect_nmfe_version(nm_path) -} -\description{ -get nmfe file name from a NONMEM installation folder -} diff --git a/man/estimation_options_defaults.Rd b/man/estimation_options_defaults.Rd deleted file mode 100644 index b7e8c0e..0000000 --- a/man/estimation_options_defaults.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_model.R -\docType{data} -\name{estimation_options_defaults} -\alias{estimation_options_defaults} -\title{List of default options for estimation method.} -\format{ -An object of class \code{list} of length 2. -} -\usage{ -estimation_options_defaults -} -\description{ -List of default options for estimation method. -} -\keyword{datasets} diff --git a/man/extract.Rd b/man/extract.Rd deleted file mode 100644 index 09df08a..0000000 --- a/man/extract.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_pharmpy_conf.R -\name{extract} -\alias{extract} -\title{Helper function for read_ini} -\usage{ -extract(regexp, x) -} -\description{ -Helper function for read_ini -} diff --git a/man/find_pk_parameter.Rd b/man/find_pk_parameter.Rd deleted file mode 100644 index c8b0b66..0000000 --- a/man/find_pk_parameter.Rd +++ /dev/null @@ -1,23 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/find_pk_parameter.R -\name{find_pk_parameter} -\alias{find_pk_parameter} -\title{Find / match PK parameter based on generic name.} -\usage{ -find_pk_parameter(parameter, model) -} -\arguments{ -\item{parameter}{name of the parameter to find} - -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} -} -\description{ -E.g. a user may request \code{pharmr::remove_iiv("V")}, to remove -IIV on the central volume. But if in the model the central volume is actually -parametrized as \code{V1} or \code{V2}, then it will error. When wrapped in -\code{find_pk_parameter} this adds more safety. It will first look if the -parameter is used in the model as such. If not found directly, it will -attempt other common names for the parameter, depending on the ADVAN number -of the model. -} diff --git a/man/fit_model.Rd b/man/fit_model.Rd deleted file mode 100644 index e692aa1..0000000 --- a/man/fit_model.Rd +++ /dev/null @@ -1,24 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_model.R -\name{fit_model} -\alias{fit_model} -\title{Fit model using NONMEM or nlmixr2} -\usage{ -fit_model(model, data, tool = "nonmem", path, ...) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{data}{data.frame with data to fit} - -\item{tool}{either \code{nonmem} or \code{nlmixr}} - -\item{path}{path to .rds file to save fit results to} - -\item{...}{passed onto \code{run_nmfe()} function} -} -\description{ -Takes a pharmpy-loaded NONMEM model as input, and returns a pharmpy model -results object. So essentially this function is a drop-in replacement for the -run_modelfit() function in pharmr/pharmpy. -} diff --git a/man/fit_model_nlmixr.Rd b/man/fit_model_nlmixr.Rd deleted file mode 100644 index 40c2efe..0000000 --- a/man/fit_model_nlmixr.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_model.R -\name{fit_model_nlmixr} -\alias{fit_model_nlmixr} -\title{Fit model using nlmixr2} -\usage{ -fit_model_nlmixr(model, data = NULL, ...) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{data}{data.frame with data to fit} - -\item{...}{passed onto \code{run_nmfe()} function} -} -\description{ -Fit model using nlmixr2 -} diff --git a/man/fit_model_nonmem.Rd b/man/fit_model_nonmem.Rd deleted file mode 100644 index 08dc973..0000000 --- a/man/fit_model_nonmem.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/fit_model.R -\name{fit_model_nonmem} -\alias{fit_model_nonmem} -\title{Fit model using NONMEM} -\usage{ -fit_model_nonmem(model, data = NULL, ...) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{data}{data.frame with data to fit} - -\item{...}{passed onto \code{run_nmfe()} function} -} -\description{ -Fit model using NONMEM -} diff --git a/man/get_advan.Rd b/man/get_advan.Rd deleted file mode 100644 index 65bf4da..0000000 --- a/man/get_advan.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_advan.R -\name{get_advan} -\alias{get_advan} -\title{Get ADVAN number for model} -\usage{ -get_advan(model) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} -} -\value{ -integer (advan number) -} -\description{ -Get ADVAN number for model -} diff --git a/man/get_compartment_scale.Rd b/man/get_compartment_scale.Rd deleted file mode 100644 index 076b5c5..0000000 --- a/man/get_compartment_scale.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_compartment_scale.R -\name{get_compartment_scale} -\alias{get_compartment_scale} -\title{Get compartment scale definition} -\usage{ -get_compartment_scale(model, compartment = 2) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{compartment}{compartment number. If \code{NULL} will be attempted to -infer from ADVAN. If not a default ADVAN is used, will use 1 as default. So -for safe use, please always specify the observation compartment to be scaled.} -} -\value{ -a list with elements \code{variable} and \code{scale}, e.g. -} -\description{ -Assumes scale is always defined either as a single variable -(e.g. \code{S2 = V2}), or as a variable divided by a factor (e.g. -\code{S2 = V2/1000}. Other expressions will very likely not result -in a correct extraction, or errors. -} diff --git a/man/get_condition_number_for_fit.Rd b/man/get_condition_number_for_fit.Rd deleted file mode 100644 index e4d6ad5..0000000 --- a/man/get_condition_number_for_fit.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_condition_number_for_fit.R -\name{get_condition_number_for_fit} -\alias{get_condition_number_for_fit} -\title{Calculate the condition number for a model fit object -Performs some safety checks} -\usage{ -get_condition_number_for_fit(fit) -} -\arguments{ -\item{fit}{pharmpy fit object} -} -\description{ -Calculate the condition number for a model fit object -Performs some safety checks -} diff --git a/man/get_cov_matrix.Rd b/man/get_cov_matrix.Rd deleted file mode 100644 index 0857fda..0000000 --- a/man/get_cov_matrix.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_cov_matrix.R -\name{get_cov_matrix} -\alias{get_cov_matrix} -\title{Create a covariance block matrix} -\usage{ -get_cov_matrix( - params, - keep_all = FALSE, - triangle = FALSE, - nonmem = TRUE, - limit = 0.001 -) -} -\arguments{ -\item{params}{parameters, a vector of standard deviations and correlations, -e.g. \code{list("CL" = 0.1, "V" = 0.2, "KA" = 0.3, "CL~V" = 0.3)}.} - -\item{keep_all}{Should all parameters be kept in the covariance matrix, -even if they do not have a correlation with other parameters?} - -\item{triangle}{return the lower triangle as a vector instead of a -matrix object?} - -\item{limit}{lower limit, to avoid becoming zero, which is not allowed by -NONMEM (\verb{A COVARIANCE IS ZERO, BUT THE BLOCK IS NOT A BAND MATRIX.})} -} -\description{ -Create a covariance block matrix -} -\examples{ -\dontrun{ -make_cov_matrix(list("CL" = 0.1, "V" = 0.2, "KA" = 0.3, "CL~V" = 0.3)) -} - -} diff --git a/man/get_defined_pk_parameters.Rd b/man/get_defined_pk_parameters.Rd deleted file mode 100644 index 8c44661..0000000 --- a/man/get_defined_pk_parameters.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_iiv.R -\name{get_defined_pk_parameters} -\alias{get_defined_pk_parameters} -\title{Get all parameters that are defined (from a predefined vector of possible parameters)} -\usage{ -get_defined_pk_parameters( - mod, - possible = c("CL", "V", "V1", "V2", "V3", "Q", "Q2", "Q3", "K10", "K12", "K21", "K13", - "K31") -) -} -\description{ -Get all parameters that are defined (from a predefined vector of possible parameters) -} diff --git a/man/get_estimation_options.Rd b/man/get_estimation_options.Rd deleted file mode 100644 index 81b5071..0000000 --- a/man/get_estimation_options.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_model.R -\name{get_estimation_options} -\alias{get_estimation_options} -\title{Helper function to combine default estimation options with user-specified, -and ensure correct format.} -\usage{ -get_estimation_options(tool, estimation_method, estimation_options) -} -\description{ -Helper function to combine default estimation options with user-specified, -and ensure correct format. -} diff --git a/man/get_final_results_from_search.Rd b/man/get_final_results_from_search.Rd deleted file mode 100644 index 1137848..0000000 --- a/man/get_final_results_from_search.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_final_results_from_search.R -\name{get_final_results_from_search} -\alias{get_final_results_from_search} -\title{For a Pharmpy grid search, fetch the fit info and attach to object} -\usage{ -get_final_results_from_search(id, results, tool = NULL, verbose = TRUE) -} -\arguments{ -\item{id}{run id} - -\item{results}{Pharmpy results object from grid search} - -\item{tool}{Pharmpy search tool. If \code{NULL}, will try to infer from class of -results object} -} -\description{ -For a Pharmpy grid search, fetch the fit info and attach to object -} diff --git a/man/get_fit_info.Rd b/man/get_fit_info.Rd deleted file mode 100644 index e12257e..0000000 --- a/man/get_fit_info.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_fit_info.R -\name{get_fit_info} -\alias{get_fit_info} -\title{Get fit info from NONMEM run} -\usage{ -get_fit_info(fit, path = NULL, output_file = "run.lst") -} -\arguments{ -\item{fit}{pharmpy fit object} - -\item{path}{path to run folder} - -\item{output_file}{NONMEM output file, default is \code{run.lst}} -} -\description{ -Get fit info from NONMEM run -} diff --git a/man/get_initial_estimates_from_data.Rd b/man/get_initial_estimates_from_data.Rd deleted file mode 100644 index 98fcd0a..0000000 --- a/man/get_initial_estimates_from_data.Rd +++ /dev/null @@ -1,32 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_initial_estimates_from_data.R -\name{get_initial_estimates_from_data} -\alias{get_initial_estimates_from_data} -\title{Get a very crude estimate for V to serve as initial estimate -for CL and V, without performing an NCA. The calculation is based on -the assumption that often in clinical trial data, there is at least a -peak and a trough (and likely other samples) taken, hence it's -possible to get a crude estimate for CL and V from that. -For 2-compartment models we just set Q and V to half and -twice the size of CL and V, which is often a good starting point. -In most scenarios this is sufficiently close to the final estimates that -estimation methods will be able to find the global minimum.} -\usage{ -get_initial_estimates_from_data(data, n_cmt = 1, scale_observations = NULL) -} -\arguments{ -\item{data}{NONMEM-style dataset} - -\item{n_cmt}{number of distribution / elimination compartments.} -} -\description{ -Get a very crude estimate for V to serve as initial estimate -for CL and V, without performing an NCA. The calculation is based on -the assumption that often in clinical trial data, there is at least a -peak and a trough (and likely other samples) taken, hence it's -possible to get a crude estimate for CL and V from that. -For 2-compartment models we just set Q and V to half and -twice the size of CL and V, which is often a good starting point. -In most scenarios this is sufficiently close to the final estimates that -estimation methods will be able to find the global minimum. -} diff --git a/man/get_initial_estimates_from_individual_data.Rd b/man/get_initial_estimates_from_individual_data.Rd deleted file mode 100644 index 3ba6003..0000000 --- a/man/get_initial_estimates_from_individual_data.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_initial_estimates_from_data.R -\name{get_initial_estimates_from_individual_data} -\alias{get_initial_estimates_from_individual_data} -\title{Core function to get parameter estimates from individual data} -\usage{ -get_initial_estimates_from_individual_data(data, ...) -} -\description{ -Core function to get parameter estimates from individual data -} diff --git a/man/get_new_run_number.Rd b/man/get_new_run_number.Rd deleted file mode 100644 index f3414a0..0000000 --- a/man/get_new_run_number.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{get_new_run_number} -\alias{get_new_run_number} -\title{Get new run number for model fit} -\usage{ -get_new_run_number(path = getwd()) -} -\arguments{ -\item{path}{path to folder in which to create subfolder for run} -} -\description{ -Get new run number for model fit -} diff --git a/man/get_nmfe_location_for_run.Rd b/man/get_nmfe_location_for_run.Rd deleted file mode 100644 index 54cbfbc..0000000 --- a/man/get_nmfe_location_for_run.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/luna_run.R -\name{get_nmfe_location_for_run} -\alias{get_nmfe_location_for_run} -\title{Helper function to determine nmfe location from various sources -The order is as follows:} -\usage{ -get_nmfe_location_for_run(nmfe = NULL, verbose = FALSE) -} -\description{ -\enumerate{ -\item argument specified by user -\item check project settings (not implemented for now, will add later) -\item check pharmpy config -\item throw error, force user to specify -} -} diff --git a/man/get_nmfe_output.Rd b/man/get_nmfe_output.Rd deleted file mode 100644 index 890dcf6..0000000 --- a/man/get_nmfe_output.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{get_nmfe_output} -\alias{get_nmfe_output} -\title{Get output from NMFE} -\usage{ -get_nmfe_output(path, results_file = "run.lst") -} -\arguments{ -\item{path}{path to folder with NMFE run} - -\item{results_file}{name of output file} -} -\description{ -Get output from NMFE -} diff --git a/man/get_nmtran_from_nmfe.Rd b/man/get_nmtran_from_nmfe.Rd deleted file mode 100644 index 4f1dca6..0000000 --- a/man/get_nmtran_from_nmfe.Rd +++ /dev/null @@ -1,13 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{get_nmtran_from_nmfe} -\alias{get_nmtran_from_nmfe} -\title{Get the location of NM-TRAN based on the location of nmfe -It's usually up one folder from nmfe, then in tr/NMTRAN.exe} -\usage{ -get_nmtran_from_nmfe(nmfe) -} -\description{ -Get the location of NM-TRAN based on the location of nmfe -It's usually up one folder from nmfe, then in tr/NMTRAN.exe -} diff --git a/man/get_obs_compartment.Rd b/man/get_obs_compartment.Rd deleted file mode 100644 index 8dbf5ee..0000000 --- a/man/get_obs_compartment.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_advan.R -\name{get_obs_compartment} -\alias{get_obs_compartment} -\title{Get observation compartment number from model} -\usage{ -get_obs_compartment(model) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} -} -\value{ -single integer value -} -\description{ -Get observation compartment number from model -} -\details{ -For ADVAN1-4/11-12 this is easy, for other ADVANs we have to make some -assumptions based on whether scaling parameters have already been defined -for the model. Logic is as follows: -\itemize{ -\item if S1 is defined and not S2, assume it's 1. -\item if S2 is defined and not S1, assume it's 2 -\item if both are defined, assume it's 2 but show a warning -\item if none are defined, assume it's 2 but show a warning -} -} diff --git a/man/get_ode_size.Rd b/man/get_ode_size.Rd deleted file mode 100644 index 275599f..0000000 --- a/man/get_ode_size.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_advan.R -\name{get_ode_size} -\alias{get_ode_size} -\title{Get size of ODE system in $DES} -\usage{ -get_ode_size(model) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} -} -\value{ -single integer value -} -\description{ -Get size of ODE system in $DES -} diff --git a/man/get_parameters_with_iiv.Rd b/man/get_parameters_with_iiv.Rd deleted file mode 100644 index d8cb9de..0000000 --- a/man/get_parameters_with_iiv.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_iiv.R -\name{get_parameters_with_iiv} -\alias{get_parameters_with_iiv} -\title{Get a character vector with all parameters on which IIV is present} -\usage{ -get_parameters_with_iiv(mod) -} -\description{ -Get a character vector with all parameters on which IIV is present -} diff --git a/man/get_pharmpy_conf.Rd b/man/get_pharmpy_conf.Rd deleted file mode 100644 index 5fba9cc..0000000 --- a/man/get_pharmpy_conf.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_pharmpy_conf.R -\name{get_pharmpy_conf} -\alias{get_pharmpy_conf} -\title{Get pharmpy configuration, as an R object (list)} -\usage{ -get_pharmpy_conf() -} -\value{ -a list object -} -\description{ -Get pharmpy configuration, as an R object (list) -} diff --git a/man/get_pharmpy_runfolders.Rd b/man/get_pharmpy_runfolders.Rd deleted file mode 100644 index 2155f25..0000000 --- a/man/get_pharmpy_runfolders.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_pharmpy_runfolders.R -\name{get_pharmpy_runfolders} -\alias{get_pharmpy_runfolders} -\title{Find last pharmpy run folder} -\usage{ -get_pharmpy_runfolders(id = NULL, folder = NULL, tool) -} -\arguments{ -\item{id}{model id. Optional. If not specified, will generate random modelfit -id. The \code{id} will be used to create the run folder.} -} -\description{ -Find last pharmpy run folder -} diff --git a/man/get_random_id.Rd b/man/get_random_id.Rd deleted file mode 100644 index 9747a7c..0000000 --- a/man/get_random_id.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/misc.R -\name{get_random_id} -\alias{get_random_id} -\title{Get a random sequence of letters and numbers of size \code{n}} -\usage{ -get_random_id(prefix = NULL, n = 6) -} -\arguments{ -\item{prefix}{optional prefix} -} -\value{ -character -} -\description{ -Get a random sequence of letters and numbers of size \code{n} -} diff --git a/man/get_route_from_data.Rd b/man/get_route_from_data.Rd deleted file mode 100644 index e62f699..0000000 --- a/man/get_route_from_data.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_model.R -\name{get_route_from_data} -\alias{get_route_from_data} -\title{Get route from data. -If dose and observation events all happen in the same compartment, -then assume IV administration, else oral absorption (or sc, im, etc).} -\usage{ -get_route_from_data(data, default = "iv") -} -\description{ -Get route from data. -If dose and observation events all happen in the same compartment, -then assume IV administration, else oral absorption (or sc, im, etc). -} diff --git a/man/get_shrinkage_summary.Rd b/man/get_shrinkage_summary.Rd deleted file mode 100644 index 2edf85e..0000000 --- a/man/get_shrinkage_summary.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_shrinkage_summary.R -\name{get_shrinkage_summary} -\alias{get_shrinkage_summary} -\title{Parses a NONMEM output file and extracts shrinkage} -\usage{ -get_shrinkage_summary(path = NULL, fit = NULL) -} -\arguments{ -\item{path}{path to nonmem output file (.lst)} - -\item{fit}{pharmpy model object} -} -\description{ -Parses a NONMEM output file and extracts shrinkage -} diff --git a/man/get_shrinkage_values.Rd b/man/get_shrinkage_values.Rd deleted file mode 100644 index f673983..0000000 --- a/man/get_shrinkage_values.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_shrinkage_summary.R -\name{get_shrinkage_values} -\alias{get_shrinkage_values} -\title{Get shrinkage values from a single line in NONMEM output} -\usage{ -get_shrinkage_values(txt, type = "ETASHRINKSD") -} -\description{ -Get shrinkage values from a single line in NONMEM output -} diff --git a/man/get_tables_from_fit.Rd b/man/get_tables_from_fit.Rd deleted file mode 100644 index 256dbc0..0000000 --- a/man/get_tables_from_fit.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_tables_from_fit.R -\name{get_tables_from_fit} -\alias{get_tables_from_fit} -\title{Read tables created in model run and return as a list of data.frames} -\usage{ -get_tables_from_fit(model, path) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{path}{path to model execution folder} -} -\description{ -Read tables created in model run and return as a list of data.frames -} diff --git a/man/get_tables_from_folder.Rd b/man/get_tables_from_folder.Rd deleted file mode 100644 index 97e2dd7..0000000 --- a/man/get_tables_from_folder.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_tables_from_fit.R -\name{get_tables_from_folder} -\alias{get_tables_from_folder} -\title{Get tables from a folder, by table_names} -\usage{ -get_tables_from_folder(table_names, path) -} -\arguments{ -\item{table_names}{file names of tables} - -\item{path}{path to model execution folder} -} -\description{ -Get tables from a folder, by table_names -} diff --git a/man/get_tables_in_model_code.Rd b/man/get_tables_in_model_code.Rd deleted file mode 100644 index 635dc4d..0000000 --- a/man/get_tables_in_model_code.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_tables_in_model_code.R -\name{get_tables_in_model_code} -\alias{get_tables_in_model_code} -\title{extract FILE names from $TABLE using simple regex. -For some reason the tables are not (yet?) available in pharmpy} -\usage{ -get_tables_in_model_code(code) -} -\arguments{ -\item{code}{a character string with NONMEM model code} -} -\description{ -extract FILE names from $TABLE using simple regex. -For some reason the tables are not (yet?) available in pharmpy -} diff --git a/man/get_tool_from_model.Rd b/man/get_tool_from_model.Rd deleted file mode 100644 index 17509bf..0000000 --- a/man/get_tool_from_model.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_tool_from_model.R -\name{get_tool_from_model} -\alias{get_tool_from_model} -\title{Get estimation/simulation engine from pharmpy model} -\usage{ -get_tool_from_model(model) -} -\arguments{ -\item{model}{pharmpy model} -} -\description{ -Get estimation/simulation engine from pharmpy model -} diff --git a/man/is_ltbs_model.Rd b/man/is_ltbs_model.Rd deleted file mode 100644 index 61d05ec..0000000 --- a/man/is_ltbs_model.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/is_ltbs_model.R -\name{is_ltbs_model} -\alias{is_ltbs_model} -\title{Is the residual error model "log-transform both-sides"?} -\usage{ -is_ltbs_model(model) -} -\description{ -Is the residual error model "log-transform both-sides"? -} diff --git a/man/is_maxeval_zero.Rd b/man/is_maxeval_zero.Rd deleted file mode 100644 index 50df948..0000000 --- a/man/is_maxeval_zero.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/misc.R -\name{is_maxeval_zero} -\alias{is_maxeval_zero} -\title{Does the last estimation method in a model have maxeval=0?} -\usage{ -is_maxeval_zero(model) -} -\description{ -Does the last estimation method in a model have maxeval=0? -} diff --git a/man/luna.Rd b/man/luna.Rd new file mode 100644 index 0000000..d231039 --- /dev/null +++ b/man/luna.Rd @@ -0,0 +1,8 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/luna-package.R +\name{luna} +\alias{luna} +\title{luna package} +\description{ +Pharmacometrics workflow manager +} diff --git a/man/luna_check.Rd b/man/luna_check.Rd index deffec6..81f2d0a 100644 --- a/man/luna_check.Rd +++ b/man/luna_check.Rd @@ -8,11 +8,9 @@ luna_check(id, folder = NULL, verbose = FALSE, ...) } \arguments{ \item{id}{run id, e.g. \code{run1}. This will be the folder in which the NONMEM -model is run. If no folder is specified, it will create a folder \code{run1} in -the current working directory, and will increment the run number for each -subsequent run.} +model is run.} -\item{verbose}{verbose output?} +\item{folder}{path to folder containing the model file. Default is current directory.} } \description{ Syntax-check a NONMEM model diff --git a/man/nm_read_model.Rd b/man/nm_read_model.Rd deleted file mode 100644 index daa63c4..0000000 --- a/man/nm_read_model.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/nm_read_model.R -\name{nm_read_model} -\alias{nm_read_model} -\title{Parse NONMEM model file into a list containing blocks of code} -\usage{ -nm_read_model(modelfile = NULL, as_block = FALSE, code = NULL) -} -\arguments{ -\item{modelfile}{NONMEM model filename} - -\item{as_block}{import code blocks as block of text (\code{TRUE}, default) or as -separate lines (\code{FALSE})} - -\item{code}{NONMEM code (alternative to specifying file name)} -} -\description{ -Parse NONMEM model file into a list containing blocks of code -} diff --git a/man/nm_save_dataset.Rd b/man/nm_save_dataset.Rd deleted file mode 100644 index c2f6631..0000000 --- a/man/nm_save_dataset.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/nm_save_dataset.R -\name{nm_save_dataset} -\alias{nm_save_dataset} -\title{Save an R data.frame to a NONMEM-style dataset as CSV} -\usage{ -nm_save_dataset(data, filename, tool = c("nonmem", "nlmixr")) -} -\arguments{ -\item{data}{data.frame} - -\item{filename}{filename to save to.} - -\item{tool}{type of dataset, either \code{nonmem} or \code{nlmixr}} -} -\description{ -Save an R data.frame to a NONMEM-style dataset as CSV -} diff --git a/man/nm_save_model.Rd b/man/nm_save_model.Rd deleted file mode 100644 index 16f8a56..0000000 --- a/man/nm_save_model.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/nm_save_model.R -\name{nm_save_model} -\alias{nm_save_model} -\title{Write a NONMEM model object to file} -\usage{ -nm_save_model(model = NULL, modelfile = NULL, overwrite = FALSE) -} -\arguments{ -\item{model}{NONMEM model object (imported with \code{read_nm()})} - -\item{modelfile}{NONMEM model filename} - -\item{overwrite}{overwrite model file if exists?} -} -\description{ -Write a NONMEM model object to file -} diff --git a/man/nm_update_dataset.Rd b/man/nm_update_dataset.Rd deleted file mode 100644 index 745dd4e..0000000 --- a/man/nm_update_dataset.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/nm_update_dataset.R -\name{nm_update_dataset} -\alias{nm_update_dataset} -\title{Update $DATA in NONMEM model with new dataset} -\usage{ -nm_update_dataset(model_filename, dataset_filename, ...) -} -\arguments{ -\item{model_filename}{model filename} - -\item{dataset_filename}{dataset filename} - -\item{...}{parameters passed to \code{nm_save_model()}} -} -\description{ -Update $DATA in NONMEM model with new dataset -} diff --git a/man/parse_psn_args.Rd b/man/parse_psn_args.Rd deleted file mode 100644 index 4cbf9d7..0000000 --- a/man/parse_psn_args.Rd +++ /dev/null @@ -1,15 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/luna_tool.R -\name{parse_psn_args} -\alias{parse_psn_args} -\title{Parse tool options specified in YAML into PsN commandline args} -\usage{ -parse_psn_args(options) -} -\arguments{ -\item{options}{list of options. Logical arguments should be specified -as TRUE/FALSE.} -} -\description{ -Parse tool options specified in YAML into PsN commandline args -} diff --git a/man/prepare_run_folder.Rd b/man/prepare_run_folder.Rd deleted file mode 100644 index 7b53461..0000000 --- a/man/prepare_run_folder.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/prepare_model_folder.R -\name{prepare_run_folder} -\alias{prepare_run_folder} -\title{Create a folder for running model, with the model and dataset} -\usage{ -prepare_run_folder( - id, - model, - path, - force = FALSE, - data = NULL, - auto_stack_encounters = FALSE, - verbose = TRUE -) -} -\description{ -Create a folder for running model, with the model and dataset -} diff --git a/man/print.pharmpy.workflows.results.ModelfitResults.Rd b/man/print.pharmpy.workflows.results.ModelfitResults.Rd deleted file mode 100644 index 4e9e172..0000000 --- a/man/print.pharmpy.workflows.results.ModelfitResults.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_fit_info.R -\name{print.pharmpy.workflows.results.ModelfitResults} -\alias{print.pharmpy.workflows.results.ModelfitResults} -\title{Print function that provides basic run information for a pharmpy modelfit} -\usage{ -\method{print}{pharmpy.workflows.results.ModelfitResults}(x, ...) -} -\arguments{ -\item{x}{pharmpy fit object} -} -\description{ -Print function that provides basic run information for a pharmpy modelfit -} diff --git a/man/print_nmfe_output.Rd b/man/print_nmfe_output.Rd deleted file mode 100644 index 3adb75e..0000000 --- a/man/print_nmfe_output.Rd +++ /dev/null @@ -1,14 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{print_nmfe_output} -\alias{print_nmfe_output} -\title{Print nmfe output (stdout and stderr) from a run folder} -\usage{ -print_nmfe_output(nmfe_output) -} -\arguments{ -\item{nmfe_output}{output from nmfe command, as list} -} -\description{ -Print nmfe output (stdout and stderr) from a run folder -} diff --git a/man/read_ini.Rd b/man/read_ini.Rd deleted file mode 100644 index 3befc9e..0000000 --- a/man/read_ini.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_pharmpy_conf.R -\name{read_ini} -\alias{read_ini} -\title{Read ini file core function} -\usage{ -read_ini(fn) -} -\description{ -Read ini file core function -} diff --git a/man/read_table_nm.Rd b/man/read_table_nm.Rd deleted file mode 100644 index 7515d70..0000000 --- a/man/read_table_nm.Rd +++ /dev/null @@ -1,45 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/read_table_nm.R -\name{read_table_nm} -\alias{read_table_nm} -\title{NONMEM output table import function} -\usage{ -read_table_nm( - file = NULL, - skip = NULL, - header = NULL, - rm_duplicates = FALSE, - nonmem_tab = TRUE -) -} -\arguments{ -\item{file}{full file name} - -\item{skip}{number of lines to skip before reading data} - -\item{header}{logical value indicating whether the file contains the names -of the variables as its first line} - -\item{rm_duplicates}{logical value indicating whether duplicated columns should be removed} - -\item{nonmem_tab}{logical value indicating to the function whether the file is a -table or a nonmem additional output file.} -} -\value{ -A \code{data.frame} -} -\description{ -Quickly import NONMEM output tables into R. -Function taken from \code{modelviz} package by Benjamin Guiastrennec. -When both \code{skip} and \code{header} are \code{NULL}, -\code{read_nmtab} will automatically detect the optimal -settings to import the tables. When more than one files are -provided for a same NONMEM run, they will be combined into -a single \code{data.frame}. -} -\examples{ -\dontrun{ -data <- read_table_nm(file = '../models/pk/sdtab101') -} - -} diff --git a/man/remove_data_section.Rd b/man/remove_data_section.Rd deleted file mode 100644 index be2eb8f..0000000 --- a/man/remove_data_section.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/remove_tables_from_model.R -\name{remove_data_section} -\alias{remove_data_section} -\title{Remove $DATA from a NONMEM model} -\usage{ -remove_data_section(text) -} -\arguments{ -\item{text}{model code} -} -\value{ -character string -} -\description{ -Remove $DATA from a NONMEM model -} diff --git a/man/remove_table_from_model.Rd b/man/remove_table_from_model.Rd deleted file mode 100644 index ba4ea6c..0000000 --- a/man/remove_table_from_model.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/remove_table_from_model.R -\name{remove_table_from_model} -\alias{remove_table_from_model} -\title{Remove all $TABLE records from a model} -\usage{ -remove_table_from_model(model, variables, firstonly = FALSE, file) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{variables}{character vector with variable names} - -\item{firstonly}{add \code{FIRSTONLY} parameter to $TABLE record} - -\item{file}{path to file, e.g. \code{sdtab}} -} -\description{ -Remove all $TABLE records from a model -} diff --git a/man/remove_table_sections.Rd b/man/remove_table_sections.Rd deleted file mode 100644 index 6332a64..0000000 --- a/man/remove_table_sections.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/remove_tables_from_model.R -\name{remove_table_sections} -\alias{remove_table_sections} -\title{Function to remove all $TABLE sections} -\usage{ -remove_table_sections(text, file = NULL) -} -\description{ -Function to remove all $TABLE sections -} diff --git a/man/remove_tables_from_model.Rd b/man/remove_tables_from_model.Rd deleted file mode 100644 index 3c8e3bd..0000000 --- a/man/remove_tables_from_model.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/remove_tables_from_model.R -\name{remove_tables_from_model} -\alias{remove_tables_from_model} -\title{Remove all $TABLE records from a model} -\usage{ -remove_tables_from_model(model, file = NULL) -} -\arguments{ -\item{model}{pharmpy model object} - -\item{file}{remove only a specific table defined as FILE=\if{html}{\out{}}. \code{file} can -also specify only the start of a filename, e.g. \code{patab}} -} -\description{ -Remove all $TABLE records from a model -} diff --git a/man/run_nlme.Rd b/man/run_nlme.Rd deleted file mode 100644 index 9ca0e79..0000000 --- a/man/run_nlme.Rd +++ /dev/null @@ -1,109 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_nlme.R -\name{run_nlme} -\alias{run_nlme} -\title{Run model in NONMEM} -\usage{ -run_nlme( - model, - data = NULL, - tables = NULL, - full_tables = FALSE, - id, - path = getwd(), - method = c("nmfe", "pharmpy", "psn"), - nmfe = get_nmfe_location_for_run(), - force = NULL, - console = FALSE, - save_fit = TRUE, - save_summary = TRUE, - estimation_method = NULL, - auto_stack_encounters = TRUE, - clean = TRUE, - as_job = FALSE, - save_final = TRUE, - check_only = FALSE, - verbose = TRUE -) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{data}{dataset (data.frame). Optional, can also be included in \code{model} -object (if specified as pharmpy model object).} - -\item{tables}{acharacter vector of which default tables -to add, options are \code{fit} and \code{parameters}. Default is NULL, -i.e. don't add any new tables (but will keep existing).} - -\item{full_tables}{For the default tables, should all input columns from be -included in the output tables? Default \code{FALSE}.} - -\item{id}{run id, e.g. \code{run1}. This will be the folder in which the NONMEM -model is run. If no folder is specified, it will create a folder \code{run1} in -the current working directory, and will increment the run number for each -subsequent run.} - -\item{path}{path to nonmem model. If not specified, will assume current -working directory.} - -\item{method}{run method, either \code{pharmpy} dispatch, \code{nmfe} or \code{psn} -(psn::execute).} - -\item{nmfe}{full path to nmfe file to run NONMEM with, if \code{method=="nmfe"}.} - -\item{force}{if run folder (\code{id}) exists, should existing results be -removed before rerunning NONMEM? Default \code{FALSE}.} - -\item{console}{show stderr and stdout in R console? If FALSE, will stream -to files \code{stdout} and \code{stderr} in fit folder.} - -\item{save_fit}{save fit object. If \code{TRUE}, will save as . Can -also specify filename (rds) to save to.} - -\item{save_summary}{save fit summary and parameter estimates to file? -Default is \code{TRUE}. Will use current folder, and save as -\verb{fit_summary_.txt} and \verb{fit_parameters_.csv}.} - -\item{estimation_method}{Optional. Character vector of estimation method(s) -to apply to model. Will remove all existing estimation steps in the model -and update with methods specified in argument.} - -\item{auto_stack_encounters}{only invoked if \code{data} argument supplied, not if -a pharmpy model object is supplied without \code{data}. -Detects if TIME within an individual is -decreasing from one record to another, which NONMEM cannot handle. -If this happens, it will add a reset event (EVID=3) at that time, and -increase the TIME for subsequent events so that NONMEM does not throw an -error. It will increase the time for the next encounter to the maximum -encounter length across all subjects in the dataset (rounded up to 100). -If no decreasing TIME is detected, nothing will be done (most common case). -This feature is useful e.g. for crossover trials when data on the same -individual ispresent but is included in the dataset as time-after-dose and -not actual time since first overall dose.} - -\item{clean}{clean up run folder after NONMEM execution?} - -\item{as_job}{run as RStudio job?} - -\item{save_final}{after running the model, should a file \code{final.mod} be created -with the final estimates from the run.} - -\item{check_only}{if \code{TRUE}, will only check the model code (NM-TRAN in the case -of NONMEM), but not run the model. Will return \code{TRUE} if model syntax is -correct, and \code{FALSE} if not. Will also attach stdout as \code{message} attribute.} - -\item{verbose}{verbose output?} -} -\description{ -Run the model directly using nmfe (not through pharmpy). -This is a more reliable way of running NONMEM, and it is now possible to -stream stdout and stderr to file or to console, which is useful for -inspection of intermediate model fit. -} -\details{ -The function does take a pharmpy model as input (optionally), and uses -pharmpy to read the results from the model fit, and returns a pharmpy -\code{modelfit} object. -} diff --git a/man/run_psn.Rd b/man/run_psn.Rd deleted file mode 100644 index 29c9754..0000000 --- a/man/run_psn.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_psn.R -\name{run_psn} -\alias{run_psn} -\title{Run a PsN tool} -\usage{ -run_psn(model) -} -\description{ -Run a PsN tool -} diff --git a/man/run_sim.Rd b/man/run_sim.Rd deleted file mode 100644 index c302118..0000000 --- a/man/run_sim.Rd +++ /dev/null @@ -1,86 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/run_sim.R -\name{run_sim} -\alias{run_sim} -\title{Run simulations} -\usage{ -run_sim( - fit = NULL, - data = NULL, - model = NULL, - id = get_random_id("sim_"), - force = FALSE, - t_obs = NULL, - dictionary = list(ID = "ID", DV = "DV", EVID = "EVID", AMT = "AMT", CMT = "CMT", MDV = - "MDV"), - regimen = NULL, - covariates = NULL, - tool = c("auto", "nonmem", "nlmixr2"), - n_subjects = NULL, - n_iterations = 1, - variables = c("ID", "TIME", "DV", "EVID", "IPRED", "PRED"), - add_pk_variables = TRUE, - output_file = "simtab", - update_table = TRUE, - seed = 12345, - verbose = TRUE -) -} -\arguments{ -\item{data}{dataset (data.frame). Optional, can also be included in \code{model} -object (if specified as pharmpy model object).} - -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{id}{run id, e.g. \code{run1}. This will be the folder in which the NONMEM -model is run. If no folder is specified, it will create a folder \code{run1} in -the current working directory, and will increment the run number for each -subsequent run.} - -\item{force}{if run folder (\code{id}) exists, should existing results be -removed before rerunning NONMEM? Default \code{FALSE}.} - -\item{t_obs}{a vector of observations times. If specified, will override -the observations in each subject in the input dataset.} - -\item{regimen}{if specified, will replace the regimens for each subject with -a custom regimen. Can be specified in two ways. The simplest way is to just -specify a list with elements \code{dose}, \code{interval}, \code{n}, and -\code{route} (and \code{t_inf} / \code{rate} for infusions). -E.g. \code{regimen = list(dose = 500, interval = 12, n = 5, route = "oral")}. -Alternatively, regimens can be specified as a data.frame. The data.frame -specified all dosing times (\code{dose}, \code{time} columns) and \code{route} and \code{t_inf} / -\code{rate}. The data.frame may also optionally contain a \code{regimen} column that -specifies a name for the regimen. This can be used to simulate multiple -regimens.} - -\item{covariates}{if specified, will replace subjects with subjects specified -in a data.frame. In the data.frame, the column names should correspond -exactly to any covariates included in the model. An \code{ID} column is required, -and for time-varying covariates, a \code{TIME} column is also required (otherwise -it will be assumed covariates are not changing over time).} - -\item{n_subjects}{number of subjects to simulate, when using sampled data -(i.e. requires \code{covariates} argument)} - -\item{n_iterations}{number of iterations of the entire simulation to -perform. The dataset for the simulation will stay the same between each -iterations.} - -\item{add_pk_variables}{calculate basic PK variables that can be extracted -in post-processing, such as CMAX_OBS, TMAX_OBS, AUC_SS.} - -\item{update_table}{should any existing $TABLE records be removed, and a new -\code{simtab} be created? This is default. If \code{FALSE}, it will leave $TABLEs as -specifed in the model. However, in the return object, only the first table -is returned back. If \code{FALSE}, the \code{add_pk_variables} argument will be ignored.} - -\item{verbose}{verbose output?} -} -\value{ -data.frame with simulation results -} -\description{ -Run simulations -} diff --git a/man/save_model_code.Rd b/man/save_model_code.Rd deleted file mode 100644 index 3c5c6cb..0000000 --- a/man/save_model_code.Rd +++ /dev/null @@ -1,16 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/save_model_code.R -\name{save_model_code} -\alias{save_model_code} -\title{Save model code to a markdown file} -\usage{ -save_model_code(model, path) -} -\arguments{ -\item{model}{nlmixr2 model object} - -\item{path}{path to .md file to save model code to} -} -\description{ -Save model code to a markdown file -} diff --git a/man/scale_initial_estimates_pk.Rd b/man/scale_initial_estimates_pk.Rd deleted file mode 100644 index 6968771..0000000 --- a/man/scale_initial_estimates_pk.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_compartment_scale.R -\name{scale_initial_estimates_pk} -\alias{scale_initial_estimates_pk} -\title{Only applies to PK parameters, not all parameters} -\usage{ -scale_initial_estimates_pk(model, scale) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} -} -\value{ -Pharmpy model object -} -\description{ -Only applies to PK parameters, not all parameters -} diff --git a/man/set_compartment_scale.Rd b/man/set_compartment_scale.Rd deleted file mode 100644 index 78683fc..0000000 --- a/man/set_compartment_scale.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_compartment_scale.R -\name{set_compartment_scale} -\alias{set_compartment_scale} -\title{Set scaling for certain compartments, e.g. dose and observation -compartments.} -\usage{ -set_compartment_scale( - model, - compartment = NULL, - expression = list(variable = "V", scale = 1000), - update_inits = TRUE, - verbose = TRUE -) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{compartment}{compartment number. If \code{NULL} will be attempted to -infer from ADVAN. If not a default ADVAN is used, will use 1 as default. So -for safe use, please always specify the observation compartment to be scaled.} - -\item{expression}{specification of new scaling, should always contain variable -and scale arguments. E.g. \code{list(variable = "V", "scale" = 1000)}.} - -\item{update_inits}{update initial estimates for basic PK parameters? This is -likely needed when applying scale, or else it is very likely that the model -starts too far off from the maximum likelihood and the fit will not -converge properly. \code{TRUE} by default.} - -\item{verbose}{verbose output?} -} -\value{ -Pharmpy model -} -\description{ -Currently not available in Pharmpy, this is a workaround function. -} diff --git a/man/set_covariance.Rd b/man/set_covariance.Rd deleted file mode 100644 index 5432a34..0000000 --- a/man/set_covariance.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_iiv.R -\name{set_covariance} -\alias{set_covariance} -\title{Function to set covariance between parameters in the omega block} -\usage{ -set_covariance(model, covariance) -} -\arguments{ -\item{covariance}{character vector specifying the parameters and initial -value for the correlation between the respective parameters, e.g. -\code{c("CL~V" = 0.1, "Q~V2" = 0.2)}.} -} -\value{ -Pharmpy model object -} -\description{ -One caveat is that it will remove any existing covariances, since currently -there is no feature in pharmr/pharmpy to extract the covariance info. -} diff --git a/man/set_iiv.Rd b/man/set_iiv.Rd deleted file mode 100644 index 1d37fed..0000000 --- a/man/set_iiv.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_iiv.R -\name{set_iiv} -\alias{set_iiv} -\title{Set inter-individual variability on parameters} -\usage{ -set_iiv(mod, iiv, iiv_type = "exp") -} -\arguments{ -\item{mod}{pharmpy model object} - -\item{iiv}{what parameters to put IIV on. Can be one of three formats: -\itemize{ -\item character: \code{all} or \code{basic}. -\item character: \code{c("CL", "V")}. Will assume SD of 0.5 for initial estimate. -\item list of numeric: e.g. \code{list(CL = 0.5, V = 0.5)} with SD for initial -estimates. -}} - -\item{iiv_type}{one of IIV types accepted by pharmr::add_iiv(), i.e. -\code{add}, \code{prop}, \code{exp} (default), \code{log}, or \code{re_log}.} -} -\description{ -Set inter-individual variability on parameters -} diff --git a/man/set_residual_error.Rd b/man/set_residual_error.Rd deleted file mode 100644 index ee6d23a..0000000 --- a/man/set_residual_error.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/create_model.R -\name{set_residual_error} -\alias{set_residual_error} -\title{Logic to set the residual error model structure for the model} -\usage{ -set_residual_error(mod, ruv) -} -\description{ -Logic to set the residual error model structure for the model -} diff --git a/man/stack_encounters.Rd b/man/stack_encounters.Rd deleted file mode 100644 index 8fc79d5..0000000 --- a/man/stack_encounters.Rd +++ /dev/null @@ -1,33 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stack_encounters.R -\name{stack_encounters} -\alias{stack_encounters} -\title{Stack encounters when data from multiple encounters is available for the -same ID, and TIME is starting at 0 for each encounter.} -\usage{ -stack_encounters( - data, - gap = 100, - reset_encounters = TRUE, - time = "TIME", - verbose = FALSE -) -} -\arguments{ -\item{data}{NONMEM input dataset} - -\item{gap}{rounding resolution for next . E.g. if set to \code{100} and if the -maximum encounter length in the data is 168 hours, will start the encounters -at t = 0, 200, 400 etc.} - -\item{reset_encounters}{add an EVID=3 event to reset all compartments to 0 before -starting the new encounter? Default is \code{TRUE}.} - -\item{time}{time column, \code{"TIME"} by default} - -\item{verbose}{verbose output} -} -\description{ -Stack encounters when data from multiple encounters is available for the -same ID, and TIME is starting at 0 for each encounter. -} diff --git a/man/update_estimation_method.Rd b/man/update_estimation_method.Rd deleted file mode 100644 index 3095904..0000000 --- a/man/update_estimation_method.Rd +++ /dev/null @@ -1,22 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/update_estimation_method.R -\name{update_estimation_method} -\alias{update_estimation_method} -\title{Wrapper around pharmr's functions to set/add estimation methods} -\usage{ -update_estimation_method(model, estimation_method, verbose = TRUE) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{estimation_method}{Optional. Character vector of estimation method(s) -to apply to model. Will remove all existing estimation steps in the model -and update with methods specified in argument.} - -\item{verbose}{verbose output?} -} -\description{ -The current pharmpy functionality is not stable, hence the need for this -wrapper. -} diff --git a/man/update_parameters.Rd b/man/update_parameters.Rd deleted file mode 100644 index d4269e9..0000000 --- a/man/update_parameters.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/update_parameters.R -\name{update_parameters} -\alias{update_parameters} -\title{Update parameter estimates (and fix)} -\usage{ -update_parameters(model, fit, fix = FALSE, verbose = FALSE) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{fit}{pharmpy fit object} - -\item{fix}{fix the estimates?} - -\item{verbose}{verbose output?} -} -\description{ -For example for using model in simulations. -} diff --git a/man/update_pk_tables.Rd b/man/update_pk_tables.Rd deleted file mode 100644 index 22b7735..0000000 --- a/man/update_pk_tables.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/update_pk_tables.R -\name{update_pk_tables} -\alias{update_pk_tables} -\title{Updates PK parameter tables (patab)} -\usage{ -update_pk_tables(model, ...) -} -\arguments{ -\item{model}{pharmpy model object or NONMEM model code (character) or path -to NONMEM model file.} - -\item{...}{passed to add_default_output_tables()} -} -\description{ -E.g. useful to call after pharmr::add_peripheral_compartment() to update -the $TABLE with parameter estimates -} diff --git a/man/validate_model.Rd b/man/validate_model.Rd deleted file mode 100644 index 50516fd..0000000 --- a/man/validate_model.Rd +++ /dev/null @@ -1,11 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/validate_model.R -\name{validate_model} -\alias{validate_model} -\title{Validate the specified model, ensure it's valid Pharmpy model} -\usage{ -validate_model(model) -} -\description{ -Validate the specified model, ensure it's valid Pharmpy model -} diff --git a/tests/testthat/test-create_dosing_records.R b/tests/testthat/test-create_dosing_records.R deleted file mode 100644 index 433c3ed..0000000 --- a/tests/testthat/test-create_dosing_records.R +++ /dev/null @@ -1,229 +0,0 @@ -test_that("create_dosing_records creates correct basic dosing schedule", { - # Setup test data - test_data <- data.frame( - ID = c(1, 1, 1), - TIME = c(0, 1, 2), - EVID = c(1, 0, 0), - CMT = c(1, 1, 1), - AMT = c(100, 0, 0), - MDV = c(1, 0, 0), - DV = c(0, 5, 3) - ) - - regimen <- list( - dose = c(500), - interval = 12, - time = c(0, 12, 24), - route = "oral" - ) - - result <- create_dosing_records( - regimen = regimen, - data = test_data, - n_subjects = 2, - dictionary = NULL - ) - - # Test basic structure - expect_s3_class(result, "data.frame") - expect_equal(nrow(result), 6) # 3 doses × 2 subjects - expect_equal(unique(result$ID), c(1, 2)) - - # Test dosing times - expected_times <- c(0, 12, 24) - expect_equal(unique(result$TIME), expected_times) - - # Test dose amounts - expect_true(all(result$AMT == 500)) - expect_true(all(result$EVID == 1)) - expect_true(all(result$MDV == 1)) - expect_true(all(result$DV == 0)) -}) - -test_that("create_dosing_records handles IV route with infusion time", { - test_data <- data.frame( - ID = c(1, 1), - TIME = c(0, 1), - EVID = c(1, 0), - CMT = c(2, 2), - AMT = c(100, 0), - MDV = c(1, 0), - DV = c(0, 5) - ) - - regimen <- list( - dose = 1000, - interval = 24, - time = c(0, 24), - route = "iv", - t_inf = 2 - ) - - result <- create_dosing_records( - regimen = regimen, - data = test_data, - n_subjects = 1, - dictionary = NULL - ) - - # Test that RATE is calculated correctly - expect_true("RATE" %in% names(result)) - expect_equal(unique(result$RATE), 500) # 1000/2 - expect_equal(unique(result$CMT), 2) # Should use CMT from template -}) - -test_that("create_dosing_records handles SC route with infusion time", { - test_data <- data.frame( - ID = c(1, 1), - TIME = c(0, 1), - EVID = c(1, 0), - CMT = c(1, 1), - AMT = c(100, 0), - MDV = c(1, 0), - DV = c(0, 5) - ) - - regimen <- list( - dose = 500, - interval = 12, - time = c(0, 12), - route = "sc", - t_inf = 0.5 - ) - - result <- create_dosing_records( - regimen = regimen, - data = test_data, - n_subjects = 1, - dictionary = NULL - ) - - expect_true("RATE" %in% names(result)) - expect_equal(unique(result$RATE), 1000) # 500/0.5 -}) - -test_that("create_dosing_records handles vector doses correctly", { - test_data <- data.frame( - ID = c(1, 1), - TIME = c(0, 1), - EVID = c(1, 0), - CMT = c(1, 1), - AMT = c(100, 0), - MDV = c(1, 0), - DV = c(0, 5) - ) - - regimen <- list( - dose = c(500, 750), # Vector of doses - should use first element - interval = 12, - time = c(0, 12), - route = "oral" - ) - - result <- create_dosing_records( - regimen = regimen, - data = test_data, - n_subjects = 1, - dictionary = NULL - ) - - expect_equal(unique(result$AMT), c(500, 750)) # Should use first dose -}) - -test_that("create_dosing_records fails with missing required arguments", { - test_data <- data.frame( - ID = c(1, 1), - TIME = c(0, 1), - EVID = c(1, 0), - CMT = c(1, 1) - ) - - # Missing 'dose' - regimen_no_dose <- list( - interval = 12, - time = c(0, 12, 24), - route = "oral" - ) - - expect_error( - create_dosing_records(regimen_no_dose, test_data, 1, NULL) - ) - - # Missing 'route' - regimen_no_route <- list( - dose = 500, - interval = 12, - time = c(0, 12, 24) - ) - - expect_error( - create_dosing_records(regimen_no_route, test_data, 1, NULL) - ) -}) - -test_that("create_dosing_records handles single dose correctly", { - test_data <- data.frame( - ID = c(1, 1), - TIME = c(0, 1), - EVID = c(1, 0), - CMT = c(1, 1), - AMT = c(100, 0), - MDV = c(1, 0), - DV = c(0, 5) - ) - - regimen <- list( - dose = 1000, - interval = 24, - time = 0, - route = "iv" - ) - - result <- create_dosing_records( - regimen = regimen, - data = test_data, - n_subjects = 2, - dictionary = NULL - ) - - expect_equal(nrow(result), 2) # 1 dose × 2 subjects - expect_equal(unique(result$TIME), 0) - expect_equal(unique(result$AMT), 1000) -}) - -test_that("create_dosing_records handles multiple subjects correctly", { - test_data <- data.frame( - ID = c(1, 1), - TIME = c(0, 1), - EVID = c(1, 0), - CMT = c(1, 1), - AMT = c(100, 0), - MDV = c(1, 0), - DV = c(0, 5) - ) - - regimen <- list( - dose = 250, - interval = 6, - time = c(0, 6, 12, 18), - route = "oral" - ) - - n_subjects <- 5 - result <- create_dosing_records( - regimen = regimen, - data = test_data, - n_subjects = n_subjects, - dictionary = NULL - ) - - expect_equal(length(unique(result$ID)), n_subjects) - expect_equal(nrow(result), 4 * n_subjects) # 4 doses × 5 subjects - - # Check each subject has correct dosing times - for(id in 1:n_subjects) { - subject_data <- result[result$ID == id, ] - expect_equal(subject_data$TIME, c(0, 6, 12, 18)) - expect_true(all(subject_data$AMT == 250)) - } -}) diff --git a/tests/testthat/test-dummy.R b/tests/testthat/test-dummy.R new file mode 100644 index 0000000..3b95b3f --- /dev/null +++ b/tests/testthat/test-dummy.R @@ -0,0 +1,3 @@ +test_that("Dummy test", { + expect_true(TRUE) +}) diff --git a/tests/testthat/test-set_compartment_scale.R b/tests/testthat/test-set_compartment_scale.R deleted file mode 100644 index 7a82b76..0000000 --- a/tests/testthat/test-set_compartment_scale.R +++ /dev/null @@ -1,17 +0,0 @@ -test_that("Finds parameter by common name (e.g. 'V' when actually named 'V2'", { - model <- create_model( - n_cmt = 2, - route = "oral" - ) - model2 <- model |> - set_compartment_scale( - compartment = 2, - expression = list( - variable = "V", - scale = 1000 - ) - ) - expect_true( - stringr::str_detect(model2$code, "S2 = V2/1000") - ) -}) diff --git a/tests/testthat/test-set_covariance.R b/tests/testthat/test-set_covariance.R deleted file mode 100644 index 57bdecc..0000000 --- a/tests/testthat/test-set_covariance.R +++ /dev/null @@ -1,22 +0,0 @@ -test_that("set_covariance() works on a model with V2 but V is specified", { - model <- pharmr::read_model_from_string("$SIZES PD=100\n\n$PROBLEM Base linear model with oral input\n\n$INPUT ID DV TIME EVID AMT MDV CMT AGE HEIGHT WEIGHT CREATININE ALBUMIN BILIRUBIN HEMATOCRIT SEX RACE ETHNIC ENC_TIME\n$DATA /tmp/RtmpYiwpu8/file33d74abce82_volume/8fe0097e-fe0b-418d-8cd9-b56fefc23deb/19:40:34_2025_11_18_poppk_run/data.csv IGNORE=@\n\n$SUBROUTINES ADVAN4 TRANS4\n\n$ABBR REPLACE ETA_VP1=ETA(1)\n$ABBR REPLACE ETA_QP1=ETA(2)\n$ABBR REPLACE ETA_V2=ETA(3)\n$ABBR REPLACE ETA_CL=ETA(4)\n$PK\nVP1 = THETA(5)*EXP(ETA_VP1)\nQP1 = THETA(4)*EXP(ETA_QP1)\nTVKA = THETA(1)\nTVCL = THETA(2)\nTVV = THETA(3)\n\nKA=TVKA\nCL = TVCL*EXP(ETA_CL)\n\nV2 = TVV*EXP(ETA_V2)\nS2 = V2\nQ = QP1\nV3 = VP1\n\n$ERROR\nW = 1\nIPRED = F\nIF (IPRED.EQ.0) THEN\n IPREDADJ = 2.22500000000000E-16\nELSE\n IPREDADJ = IPRED\nEND IF\nY = IPRED + EPS(1)*IPREDADJ\n\n$THETA (0, 0.26389) ; POP_KA\n$THETA (0, 8.10698) ; POP_CL\n$THETA (0, 55.1912) ; POP_V\n$THETA (0,5.10817) ; POP_QP1\n$THETA (0,146.883) ; POP_VP1\n$OMEGA 0.05181 ; IIV_VP1\n$OMEGA 0.0080219 ; IIV_QP1\n$OMEGA BLOCK(2)\n0.356 ; IIV_V2\n0.028 0.223 ; IIV_CL\n$SIGMA 0.015453 ; sigma\n$ESTIMATION METHOD=COND INTER MAXEVAL=2000 PRINT=5 POSTHOC NOABORT\n$COVARIANCE UNCONDITIONAL PRINT=E PRECOND=1\n\n$TABLE\n ID TIME DV EVID MDV PRED IPRED CWRES NPDE\n NOAPPEND NOPRINT\n FILE=sdtab\n$TABLE\n ID CL QP1 TVKA V2 VP1\n NOAPPEND NOPRINT\n FILE=patab\n\n\n") - expect_message( - model <- model |> - set_covariance(list("CL~V" = 0.1)), - "Found parameter V in model as V2" - ) - expect_true(inherits(model, "pharmpy.model.external.nonmem.model.Model")) - om <- pharmr::get_omegas(model) - expect_equal( - data.frame(om$to_dataframe()), - structure(list( - value = c(0.05181, 0.0080219, 0.356, 0.028, 0.223), - lower = c(0, 0, 0, -Inf, 0), - upper = c(Inf, Inf, Inf, Inf, Inf), - fix = c(FALSE, FALSE, FALSE, FALSE, FALSE) - ), - class = "data.frame", - row.names = c("IIV_VP1", "IIV_QP1", "IIV_V2", "OMEGA_4_3", "IIV_CL") - ) - ) -}) diff --git a/tests/testthat/test_add_table_to_model.R b/tests/testthat/test_add_table_to_model.R deleted file mode 100644 index 8beabd2..0000000 --- a/tests/testthat/test_add_table_to_model.R +++ /dev/null @@ -1,90 +0,0 @@ -test_that("add_table_to_model adds table correctly", { - # Create a mock model object - mock_model <- list( - code = "$PROBLEM test\n$INPUT ID TIME DV\n$DATA test.csv", - tables = data.frame(file = "existing.txt") - ) - class(mock_model) <- c("list", "pharmpy.model.external.nonmem.model.Model") - - # Mock the dependencies - mockery::stub(add_table_to_model, "get_tables_in_model", function(model) c("existing.txt")) - mockery::stub(add_table_to_model, "pharmr::read_model_from_string", function(code) { - list(code = code) - }) - - # Test basic functionality - result <- add_table_to_model( - model = mock_model, - variables = c("ID", "CL", "V"), - firstonly = FALSE, - file = "patab" - ) - - expected_addition <- "\\n\\$TABLE\\n ID CL V\\n NOAPPEND NOPRINT\\n FILE=patab\\n\\n" - expect_true(grepl(expected_addition, result$code)) - - # Test with firstonly = TRUE - result <- add_table_to_model( - model = mock_model, - variables = c("ID", "CL", "KA"), - firstonly = TRUE, - file = "patab" - ) - - expected_addition <- "\\n\\$TABLE\\n ID CL KA\\n FIRSTONLY\\n NOAPPEND NOPRINT\\n FILE=patab\\n\\n" - expect_true(grepl(expected_addition, result$code)) -}) - -test_that("add_table_to_model warns on duplicate file", { - # Create a mock model object - mock_model <- list( - code = "$PROBLEM test\n$INPUT ID TIME DV\n$DATA test.csv $TABLE ID TIME FILE=patab", - tables = data.frame(file = "patab") - ) - class(mock_model) <- c("list", "pharmpy.model.external.nonmem.model.Model") - - # Mock get_tables_in_model to return our test file - mockery::stub(add_table_to_model, "get_tables_in_model", function(model) c("patab")) - mockery::stub(add_table_to_model, "pharmr::read_model_from_string", function(code) { - list(code = code) - }) - - # Test warning is issued for duplicate file - expect_warning( - add_table_to_model( - model = mock_model, - variables = c("ID", "CL", "V"), - firstonly = FALSE, - file = "patab" - ), - "Table file already in a \\$TABLE record in model" - ) -}) - -test_that("add_table_to_model handles empty variables", { - # Create a mock model object - mock_model <- list( - code = "$PROBLEM test\n$INPUT ID TIME DV\n$DATA test.csv", - tables = data.frame(file = character(0)) - ) - class(mock_model) <- c("list", "pharmpy.model.external.nonmem.model.Model") - - # Mock the dependencies - mockery::stub(add_table_to_model, "get_tables_in_model", function(model) character(0)) - mockery::stub(add_table_to_model, "pharmr::read_model_from_string", function(code) { - list(code = code) - }) - - # Test with empty variables vector - expect_warning( - result <- add_table_to_model( - model = mock_model, - variables = character(0), - firstonly = FALSE, - file = "patab" - ) - ) - expect_equal(result$code, mock_model$code) - -}) - diff --git a/tests/testthat/test_create_model.R b/tests/testthat/test_create_model.R deleted file mode 100644 index 7e902c9..0000000 --- a/tests/testthat/test_create_model.R +++ /dev/null @@ -1,774 +0,0 @@ -test_that("create_model call without arguments works", { - mod <- create_model() - expect_s3_class(mod, "pharmpy.model.external.nonmem.model.Model") -}) - -test_that("create_model basic functionality works", { - # Create minimal test dataset - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0), - BW = 70 - ) - - # Test basic oral model creation - mod_oral <- create_model( - route = "oral", - data = test_data, - verbose = FALSE - ) - expect_s3_class(mod_oral, "pharmpy.model.external.nonmem.model.Model") - expect_true(grepl("POP_KA", mod_oral$code)) - expect_true(grepl("TVKA", mod_oral$code)) - - # Test basic IV model creation - mod_iv <- create_model( - route = "iv", - data = test_data, - verbose = FALSE - ) - expect_s3_class(mod_oral, "pharmpy.model.external.nonmem.model.Model") - expect_true(grepl("POP_CL", mod_iv$code)) - expect_true(grepl("TVCL", mod_iv$code)) - expect_true(!grepl("POP_KA", mod_iv$code)) - expect_true(!grepl("TVKA", mod_iv$code)) -}) - -test_that("model features are correctly added", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0), - BW = 70 - ) - - # Test lag time - mod_lag <- create_model( - route = "oral", - lag_time = TRUE, - data = test_data, - verbose = FALSE - ) - expect_true(grepl("ALAG", mod_lag$code)) - - # Test transit compartments - mod_transit <- create_model( - route = "oral", - n_transit_compartments = 3, - data = test_data, - verbose = FALSE - ) - expect_true(grepl("MDT", mod_transit$code)) - expect_true(grepl("\\$MODEL COMPARTMENT=\\(TRANSIT1 DEFDOSE\\)", mod_transit$code)) - - # Test multiple compartments - mod_multi2 <- create_model( - route = "iv", - n_cmt = 2, - data = test_data, - verbose = FALSE - ) - expect_true(grepl("QP1", mod_multi2$code)) - expect_true(grepl("VP1", mod_multi2$code)) - - mod_multi3 <- create_model( - route = "iv", - n_cmt = 3, - data = test_data, - verbose = FALSE - ) - expect_true(grepl("QP1", mod_multi3$code)) - expect_true(grepl("VP1", mod_multi3$code)) - expect_true(grepl("QP2", mod_multi3$code)) - expect_true(grepl("VP2", mod_multi3$code)) -}) - -test_that("estimation methods are correctly set", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0), - BW = 70 - ) - - # Test FOCE method - mod_foce <- create_model( - route = "iv", - estimation_method = "foce", - data = test_data, - verbose = FALSE - ) - steps <- mod_foce$execution_steps$to_dataframe() - expect_true("foce" %in% tolower(steps$method)) - - # Test SAEM method - mod_saem <- create_model( - route = "iv", - estimation_method = "saem", - data = test_data, - verbose = FALSE - ) - steps <- mod_saem$execution_steps$to_dataframe() - expect_true("saem" %in% tolower(steps$method)) -}) - -test_that("error handling works correctly", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0), - BW = 70 - ) - - # Test invalid route - expect_error( - create_model(route = "invalid"), - "'arg' should be one of" - ) - - # Test invalid elimination - expect_error( - create_model(elimination = "invalid"), - "'arg' should be one of" - ) - - # Test invalid tool - expect_error( - create_model(tool = "invalid"), - "'arg' should be one of" - ) -}) - -test_that("IIV settings work as expected", { - # Test default IIV settings - mod <- create_model() - expect_true("ETA_CL" %in% mod$random_variables$names) - expect_true("ETA_V" %in% mod$random_variables$names) - - # Test custom IIV magnitudes - mod <- create_model(iiv = list(CL = 0.4, V = 0.5)) - par_df <- mod$parameters$to_dataframe() - pars <- rownames(par_df) - expect_equal(par_df[pars == "IIV_CL",]$value, 0.16) # 0.4^2 - expect_equal(par_df[pars == "IIV_V",]$value, 0.25) # 0.5^2 - - # Test different IIV types - mod <- create_model( - iiv = list(CL = 0.2, V = 0.3), - iiv_type = list(CL = "add", V = "prop") - ) - expect_match( - as.character(mod$statements$find_assignment("CL")$expression), - ".*ETA_CL \\+ .*", - all = FALSE - ) - expect_match( - as.character(mod$statements$find_assignment("V")$expression), - ".*TVV\\*\\(ETA_V \\+ 1\\).*", - all = FALSE - ) - - # Test no IIV - mod <- create_model(iiv = NULL) - expect_false("IIV_CL" %in% mod$random_variables$names) - expect_false("IIV_V" %in% mod$random_variables$names) -}) - -test_that("IIV argument works with multi-compartment models", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test 2-compartment model - mod_2cmt <- create_model( - route = "iv", - n_cmt = 2, - iiv = list(CL = 0.2, V1 = 0.3, Q = 0.4, V2 = 0.5), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_2cmt$random_variables$names) - expect_true("ETA_V1" %in% mod_2cmt$random_variables$names) - expect_true("ETA_Q" %in% mod_2cmt$random_variables$names) - expect_true("ETA_V2" %in% mod_2cmt$random_variables$names) - - # Test 2-compartment model with correlation - mod_2cmt <- create_model( - route = "iv", - n_cmt = 2, - iiv = list(CL = 0.2, V1 = 0.3, Q = 0.4, V2 = 0.5, "CL~V1" = 0.4), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_2cmt$random_variables$names) - expect_true("ETA_V1" %in% mod_2cmt$random_variables$names) - expect_true("ETA_Q" %in% mod_2cmt$random_variables$names) - expect_true("ETA_V2" %in% mod_2cmt$random_variables$names) - - expect_true(grepl("\\$OMEGA BLOCK\\(2\\)", mod_2cmt$code)) - expect_true(grepl("IIV_Q", mod_2cmt$code)) - expect_true(grepl("IIV_V2", mod_2cmt$code)) - - # Test 2-compartment model with multiple correlations - mod_2cmt2 <- create_model( - route = "iv", - n_cmt = 2, - tool = "nlmixr2", - iiv = list( - CL = 0.2, V1 = 0.3, Q = 0.4, V2 = 0.5, - "CL~V1" = 0.4, "Q~V2" = 0.3 - ), - data = test_data, - verbose = FALSE - ) - expect_true(grepl("ETA_V1 \\+ ETA_Q \\+ ETA_V2 \\+ ETA_CL", mod_2cmt2$code)) - expect_true(grepl("0.09,", mod_2cmt2$code)) - expect_true(grepl("0.001, 0.16,", mod_2cmt2$code)) - expect_true(grepl("0.001, 0.06, 0.25", mod_2cmt2$code)) - expect_true(grepl("0.024, 0.001, 0.001, 0.04", mod_2cmt2$code)) - - ## create_model works when `parameters` table is requested - mod_2cmt3 <- create_model( - route = "iv", - n_cmt = 2, - iiv = list(CL = 0.2, V1 = 0.3, Q = 0.4, V2 = 0.5, "CL~V2" = 0.4), - data = test_data, - tables = c("parameters"), - verbose = FALSE - ) - expect_true(grepl("\\$OMEGA BLOCK\\(2\\)", mod_2cmt3$code)) - expect_true(grepl("ID CL V1 Q V2", mod_2cmt3$code)) -}) - -test_that("IIV argument handles edge cases correctly", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test with single parameter IIV - mod_single <- create_model( - route = "iv", - iiv = list(CL = 0.2), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_single$random_variables$names) - expect_false("ETA_V" %in% mod_single$random_variables$names) - - # Test with very small IIV values - mod_small <- create_model( - route = "iv", - iiv = list(CL = 0.01, V = 0.02), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_small$random_variables$names) - expect_true("ETA_V" %in% mod_small$random_variables$names) - - # Test with large IIV values - mod_large <- create_model( - route = "iv", - iiv = list(CL = 1.0, V = 1.5), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_large$random_variables$names) - expect_true("ETA_V" %in% mod_large$random_variables$names) -}) - -test_that("IIV argument works with bioavailability parameter", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test with bioavailability parameter and IIV - mod_bio <- create_model( - route = "oral", - bioavailability = TRUE, - iiv = list(CL = 0.2, V = 0.3, BIO = 0.4), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_bio$random_variables$names) - expect_true("ETA_V" %in% mod_bio$random_variables$names) - expect_true("ETA_BIO" %in% mod_bio$random_variables$names) -}) - -test_that("IIV argument works with Michaelis-Menten elimination", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test with Michaelis-Menten elimination and IIV - mod_mm <- create_model( - route = "iv", - elimination = "michaelis-menten", - iiv = list(CL = 0.2, V = 0.3, KM = 0.5), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_mm$random_variables$names) - expect_true("ETA_V" %in% mod_mm$random_variables$names) - expect_true("ETA_KM" %in% mod_mm$random_variables$names) -}) - -test_that("IIV argument preserves parameter initial estimates correctly", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test that IIV values are correctly converted from SD to variance - mod <- create_model( - route = "iv", - iiv = list(CL = 0.3, V = 0.4), - data = test_data, - verbose = FALSE - ) - - par_df <- mod$parameters$to_dataframe() - pars <- rownames(par_df) - - # Check that IIV parameters are set to variance (SD^2) - expect_equal(par_df[pars == "IIV_CL",]$value, 0.09) # 0.3^2 - expect_equal(par_df[pars == "IIV_V",]$value, 0.16) # 0.4^2 - - # Check that population parameters are preserved - expect_true("POP_CL" %in% pars) - expect_true("POP_V" %in% pars) -}) - -test_that("IIV covariance works", { - model_pk <- create_model( - route = "iv", - n_cmt = 2, - tool = "nonmem", - estimation_method = "foce", - elimination = "linear", - iiv = list(CL = 0.2, V = 0.2), - iiv_type = "exp", - ruv = "additive", - uncertainty_method = "none", - name = "run1", - tables = c("fit"), - verbose = T - ) - - model_pk2 <- set_covariance(model_pk, list("CL~V1" = 0.32)) - par_df <- model_pk2$parameters$to_dataframe() - pars <- rownames(par_df) - expect_true(all(c("IIV_CL", "IIV_V1") %in% pars)) - expect_true(stringr::str_detect(model_pk2$code, "\\$OMEGA BLOCK\\(2\\)")) - - model_pk3 <- set_iiv(model_pk, list("CL" = 0.1, "V1" = 0.1, "QP1" = 0.1)) - par_df <- model_pk3$parameters$to_dataframe() - pars <- rownames(par_df) - expect_true(all(c("IIV_QP1", "IIV_CL", "IIV_V1") %in% pars)) - expect_false(stringr::str_detect(model_pk3$code, "\\$OMEGA BLOCK\\(2\\)")) - - model_pk4 <- set_covariance(model_pk3, list("QP1~V1" = 0.32)) - par_df <- model_pk4$parameters$to_dataframe() - pars <- rownames(par_df) - expect_true(all(c("IIV_QP1", "IIV_CL", "IIV_V1") %in% pars)) - expect_true(stringr::str_detect(model_pk2$code, "\\$OMEGA BLOCK\\(2\\)")) - -}) - -test_that("IIV argument works with different tools", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test with nlmixr tool - mod_nlmixr <- create_model( - route = "iv", - iiv = list(CL = 0.2, V = 0.3), - tool = "nlmixr", - data = test_data, - verbose = FALSE - ) - # nlmixr models should still have the same IIV structure - expect_true("ETA_CL" %in% mod_nlmixr$random_variables$names) - expect_true("ETA_V" %in% mod_nlmixr$random_variables$names) -}) - -test_that("RUV settings work as expected", { - # Test proportional error - mod <- create_model(ruv = "proportional") - expect_equal( - "EPS_1*IPREDADJ + IPRED", - as.character(mod$statements$find_assignment("Y")$expression) - ) - - # Test additive error - mod <- create_model(ruv = "additive") - expect_equal( - "EPS_1*W + IPRED", - as.character(mod$statements$find_assignment("Y")$expression) - ) - - # Test combined error - mod <- create_model(ruv = "combined") - expect_equal( - "EPS_1*IPRED + EPS_2 + IPRED", - as.character(mod$statements$find_assignment("Y")$expression) - ) - - # Test log-transformed both sides - mod <- create_model(ruv = "ltbs") - expect_equal( - "EPS_1 + log(IPREDADJ)", - as.character(mod$statements$find_assignment("Y")$expression) - ) -}) - -test_that("LTBS model is handled, and LNDV is set to DV", { - nm_data <- data.frame( - ID = c(1, 1,1,1,1), - AMT = c(100, 0,0,0,0), - TIME = c(0, 1,2,3,4), - DV = c(0, 1,2,3,4), - LNDV = c(0, -2,-1,0,1), - EVID = c(1, 0, 0, 0, 0), - CMT = c(1, 1,1,1,1) - ) - mod <- create_model( - ruv = "ltbs", - data = nm_data - ) - expect_equal( - mod$dataset$DV, - mod$dataset$LNDV - ) - expect_true( - "ODV" %in% names(mod$dataset) - ) -}) - -test_that("can create mu-referenced model", { - mod <- create_model(mu_reference = TRUE) - expect_s3_class(mod, "pharmpy.model.external.nonmem.model.Model") -}) - -test_that("IIV argument handles all input formats correctly", { - # Test data for consistent testing - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test 1: Character "all" - should add IIV to all parameters - mod_all <- create_model( - route = "iv", - iiv = "all", - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_all$random_variables$names) - expect_true("ETA_V" %in% mod_all$random_variables$names) - - # Test 2: Character "basic" - should add IIV only to CL and V - mod_basic <- create_model( - route = "iv", - iiv = "basic", - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_basic$random_variables$names) - expect_true("ETA_V" %in% mod_basic$random_variables$names) - - # Test 3: Character vector of parameter names - mod_char_vec <- create_model( - route = "iv", - iiv = c("CL", "V"), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_char_vec$random_variables$names) - expect_true("ETA_V" %in% mod_char_vec$random_variables$names) - - # Test 4: List with numeric values (SD scale) - mod_list <- create_model( - route = "iv", - iiv = list(CL = 0.3, V = 0.4), - data = test_data, - verbose = FALSE - ) - par_df <- mod_list$parameters$to_dataframe() - pars <- rownames(par_df) - expect_equal(par_df[pars == "IIV_CL",]$value, 0.09) # 0.3^2 - expect_equal(par_df[pars == "IIV_V",]$value, 0.16) # 0.4^2 - - # Test 5: NULL - should remove all IIV - mod_null <- create_model( - route = "iv", - iiv = NULL, - data = test_data, - verbose = FALSE - ) - ## There always has to remain one ETA (in current Pharmpy version) - expect_true("ETA_CL" %in% mod_null$random_variables$names) - expect_false("ETA_V" %in% mod_null$random_variables$names) -}) - -test_that("IIV argument works with different routes", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test IV route with IIV - mod_iv <- create_model( - route = "iv", - iiv = list(CL = 0.2, V = 0.3), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_iv$random_variables$names) - expect_true("ETA_V" %in% mod_iv$random_variables$names) - - # Test oral route with IIV (should include KA parameter) - mod_oral <- create_model( - route = "oral", - iiv = list(CL = 0.2, V = 0.3, KA = 0.4), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_oral$random_variables$names) - expect_true("ETA_V" %in% mod_oral$random_variables$names) - expect_true("ETA_KA" %in% mod_oral$random_variables$names) -}) - -test_that("IIV argument works with multi-compartment models", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test 2-compartment model - mod_2cmt <- create_model( - route = "iv", - n_cmt = 2, - iiv = list(CL = 0.2, V1 = 0.3, Q = 0.4, V2 = 0.5), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_2cmt$random_variables$names) - expect_true("ETA_V1" %in% mod_2cmt$random_variables$names) - expect_true("ETA_Q" %in% mod_2cmt$random_variables$names) - expect_true("ETA_V2" %in% mod_2cmt$random_variables$names) - - # Test 3-compartment model - mod_3cmt <- create_model( - route = "iv", - n_cmt = 3, - iiv = list(CL = 0.2, V1 = 0.3, Q2 = 0.4, V2 = 0.5, Q3 = 0.6, V3 = 0.7), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_3cmt$random_variables$names) - expect_true("ETA_V1" %in% mod_3cmt$random_variables$names) - expect_true("ETA_Q2" %in% mod_3cmt$random_variables$names) - expect_true("ETA_V2" %in% mod_3cmt$random_variables$names) - expect_true("ETA_Q3" %in% mod_3cmt$random_variables$names) - expect_true("ETA_V3" %in% mod_3cmt$random_variables$names) -}) - -test_that("IIV argument works with different IIV types", { - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, 5), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0) - ) - - # Test exponential IIV (default) - mod_exp <- create_model( - route = "iv", - iiv = list(CL = 0.2, V = 0.3), - iiv_type = "exp", - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_exp$random_variables$names) - expect_true("ETA_V" %in% mod_exp$random_variables$names) - - # Test additive IIV - mod_add <- create_model( - route = "iv", - iiv = list(CL = 0.2, V = 0.3), - iiv_type = "add", - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_add$random_variables$names) - expect_true("ETA_V" %in% mod_add$random_variables$names) - - # Test proportional IIV - mod_prop <- create_model( - route = "iv", - iiv = list(CL = 0.2, V = 0.3), - iiv_type = "prop", - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_prop$random_variables$names) - expect_true("ETA_V" %in% mod_prop$random_variables$names) - - # Test mixed IIV types - mod_mixed <- create_model( - route = "iv", - iiv = list(CL = 0.2, V = 0.3), - iiv_type = list(CL = "add", V = "exp"), - data = test_data, - verbose = FALSE - ) - expect_true("ETA_CL" %in% mod_mixed$random_variables$names) - expect_true("ETA_V" %in% mod_mixed$random_variables$names) -}) - -test_that("create_model with scaling works", { - # Create minimal test dataset - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 15, 9), # mg/L - AMT = c(1, 0, 0), # 1 g - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0), - BW = 70 - ) - - # Test basic oral model creation, when no IIV on V - mod_scale1 <- create_model( - route = "oral", - data = test_data, - scale_observations = 1000, - verbose = FALSE - ) - expect_true(stringr::str_detect(mod_scale1$code, "S2 = V/1000")) - expect_true(stringr::str_detect(mod_scale1$code, "\\$THETA \\(0, 34.1\\)")) - expect_true(stringr::str_detect(mod_scale1$code, "\\$THETA \\(0, 66.7\\)")) - - # Test 1-cmt oral model creation, with IIV on V - mod_scale2 <- create_model( - route = "oral", - data = test_data, - n_cmt = 1, - iiv = list(CL = .2, V = .3), - scale_observations = 1000, - verbose = FALSE - ) - expect_true(stringr::str_detect(mod_scale2$code, "S2 = V/1000")) - expect_true(stringr::str_detect(mod_scale2$code, "\\$THETA \\(0, 34.1\\)")) - expect_true(stringr::str_detect(mod_scale2$code, "\\$THETA \\(0, 66.7\\)")) - - # Test 2-cmt oral model creation, with IIV on V - mod_scale3 <- create_model( - route = "oral", - data = test_data, - n_cmt = 2, - iiv = list(CL = .2, V2 = .3), - scale_observations = 1000, - verbose = FALSE - ) - expect_true(stringr::str_detect(mod_scale3$code, "S2 = V2/1000")) - expect_true(stringr::str_detect(mod_scale3$code, "\\$THETA \\(0, 34.1\\)")) - expect_true(stringr::str_detect(mod_scale3$code, "\\$THETA \\(0, 66.7\\)")) - expect_true(stringr::str_detect(mod_scale3$code, "\\$THETA \\(0,133.0\\)")) - -}) - -test_that("create_model BLQ with LLOQ coded in DV works", { - # Create minimal test dataset - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2), - DV = c(0, 10, "<3"), - AMT = c(100, 0, 0), - CMT = 1, - EVID = c(1, 0, 0), - MDV = c(1, 0, 0), - BW = 70 - ) - - # Test basic oral model creation - mod_oral <- create_model( - route = "oral", - data = test_data, - verbose = FALSE - ) - expect_s3_class(mod_oral, "pharmpy.model.external.nonmem.model.Model") - expect_equal(mod_oral$dataset$LLOQ, c(0, 0, 3)) -}) diff --git a/tests/testthat/test_find_pk_parameters.R b/tests/testthat/test_find_pk_parameters.R deleted file mode 100644 index 96e07fb..0000000 --- a/tests/testthat/test_find_pk_parameters.R +++ /dev/null @@ -1,184 +0,0 @@ -# tests/testthat/test-find_pk_parameter.R - -test_that("find_pk_parameter returns parameter when it exists as-is in model", { - # Mock the dependencies - mock_model <- list(params = c("CL", "V", "KA")) - - # Mock get_pk_parameters to return the model parameters - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V", "KA")) - - result <- find_pk_parameter("V", mock_model) - expect_equal(result, "V") - - result <- find_pk_parameter("CL", mock_model) - expect_equal(result, "CL") -}) - -test_that("find_pk_parameter maps parameters correctly for ADVAN 1, 3, 11", { - mock_model <- list(advan = 1) - - # Mock dependencies - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V1")) - mockery::stub(find_pk_parameter, "get_advan", 1) - - # Test V -> V1 mapping for ADVAN 1 - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V1" - ) - expect_equal(result, "V1") - - # Test with ADVAN 3 - mockery::stub(find_pk_parameter, "get_advan", 3) - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V1" - ) - expect_equal(result, "V1") - - # Test with ADVAN 11 - mockery::stub(find_pk_parameter, "get_advan", 11) - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V1" - ) - expect_equal(result, "V1") -}) - -test_that("find_pk_parameter maps parameters correctly for other ADVAN numbers", { - mock_model <- list(advan = 2) - - # Mock dependencies - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V2")) - mockery::stub(find_pk_parameter, "get_advan", 2) - - # Test V -> V2 mapping for ADVAN 2 - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V2" - ) - expect_equal(result, "V2") - - # Test with ADVAN 4 - mockery::stub(find_pk_parameter, "get_advan", 4) - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V2" - ) - expect_equal(result, "V2") -}) - -test_that("find_pk_parameter maps all parameters correctly for ADVAN 1, 3, 11", { - mock_model <- list() - - # Mock dependencies - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL")) - mockery::stub(find_pk_parameter, "get_advan", 1) - - # Test all mappings for ADVAN 1/3/11 - expected_mappings <- list( - "V" = "V1", - "Q" = "QP1", - "V2" = "VP1", - "V3" = "VP2" - ) - - for (param in names(expected_mappings)) { - expect_message( - result <- find_pk_parameter(param, mock_model), - paste("Found parameter", param, "in model as", expected_mappings[[param]]) - ) - expect_equal(result, expected_mappings[[param]]) - } -}) - -test_that("find_pk_parameter maps all parameters correctly for other ADVAN numbers", { - mock_model <- list() - - # Mock dependencies - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL")) - mockery::stub(find_pk_parameter, "get_advan", 2) - - # Test all mappings for other ADVANs - expected_mappings <- list( - "V" = "V2", - "Q" = "QP1", - "V3" = "VP1", - "V4" = "VP2" - ) - - for (param in names(expected_mappings)) { - expect_message( - result <- find_pk_parameter(param, mock_model), - paste("Found parameter", param, "in model as", expected_mappings[[param]]) - ) - expect_equal(result, expected_mappings[[param]]) - } -}) - -test_that("find_pk_parameter warns and returns original parameter when not found in mapping", { - mock_model <- list() - - # Mock dependencies - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL")) - mockery::stub(find_pk_parameter, "get_advan", 1) - - # Test parameter not in mapping - expect_warning( - result <- find_pk_parameter("UNKNOWN_PARAM", mock_model), - "Could not find parameter UNKNOWN_PARAM in model as UNKNOWN_PARAM, nor under different name." - ) - expect_equal(result, "UNKNOWN_PARAM") -}) - -test_that("find_pk_parameter handles edge cases", { - mock_model <- list() - - # Test empty parameter name - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V")) - - expect_error( - result <- find_pk_parameter("", mock_model) - ) - - # Test NULL parameter - expect_error(find_pk_parameter(NULL, mock_model)) -}) - -test_that("find_pk_parameter doesn't use mapping when parameter exists as-is", { - mock_model <- list() - - # Mock V exists in model parameters, so mapping shouldn't be used - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V", "KA")) - - # Even though ADVAN would map V to V1, since V exists, it should return V - result <- find_pk_parameter("V", mock_model) - expect_equal(result, "V") - - # Verify get_advan is not called when parameter exists as-is - # (This is harder to test directly, but the function should return early) -}) - -test_that("find_pk_parameter integration test with realistic parameter names", { - mock_model <- list() - - # Test realistic scenario: model has V1, user asks for V - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V1", "KA")) - mockery::stub(find_pk_parameter, "get_advan", 1) - - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V1" - ) - expect_equal(result, "V1") - - # Test realistic scenario: model has V2, user asks for V - mockery::stub(find_pk_parameter, "pharmr::get_pk_parameters", c("CL", "V2", "Q")) - mockery::stub(find_pk_parameter, "get_advan", 2) - - expect_message( - result <- find_pk_parameter("V", mock_model), - "Found parameter V in model as V2" - ) - expect_equal(result, "V2") -}) diff --git a/tests/testthat/test_get_estimation_options.R b/tests/testthat/test_get_estimation_options.R deleted file mode 100644 index 82cb64f..0000000 --- a/tests/testthat/test_get_estimation_options.R +++ /dev/null @@ -1,41 +0,0 @@ -test_that("get_estimation_options returns correct defaults and handles user options", { - # Test NONMEM FOCE defaults - defaults_nonmem_foce <- get_estimation_options("nonmem", "foce", NULL) - expect_equal( - defaults_nonmem_foce, - list( - MAXEVAL = "2000", - PRINT = "5", - POSTHOC = "", - NOABORT = "" - ) - ) - - # Test NONMEM SAEM defaults - defaults_nonmem_saem <- get_estimation_options("nonmem", "saem", NULL) - expect_equal( - defaults_nonmem_saem, - list( - NBURN = "500", - NITER = "1000", - ISAMPLE = "2" - ) - ) - - # Test user-specified options override defaults - user_opts <- list(MAXEVAL = 1000, PRINT = 1) - custom_opts <- get_estimation_options("nonmem", "foce", user_opts) - expect_equal( - custom_opts, - list( - MAXEVAL = "1000", - PRINT = "1", - POSTHOC = "", - NOABORT = "" - ) - ) - - # Test nlmixr returns empty list (as per current implementation) - nlmixr_opts <- get_estimation_options("nlmixr", "foce", NULL) - expect_equal(nlmixr_opts, list()) -}) \ No newline at end of file diff --git a/tests/testthat/test_get_initial_estimates_from_data.R b/tests/testthat/test_get_initial_estimates_from_data.R deleted file mode 100644 index 565ea96..0000000 --- a/tests/testthat/test_get_initial_estimates_from_data.R +++ /dev/null @@ -1,166 +0,0 @@ -test_that("get_initial_estimates_from_data works for 1-compartment model", { - # Create test data - test_data <- data.frame( - ID = c(1, 1, 1, 1), - TIME = c(0, 1, 4, 8), - DV = c(0, 100, 50, 25), - EVID = c(1, 0, 0, 0), - MDV = c(1, 0, 0, 0), - AMT = c(1000, 0, 0, 0) - ) - - # Get estimates - result <- get_initial_estimates_from_data(test_data, n_cmt = 1) - - # Test results - expect_type(result, "list") - expect_named(result, c("V", "CL")) - expect_true(all(result > 0)) # All parameters should be positive - - # Test approximate values (using known decay pattern) - expect_equal(result$V, 1000/100, tolerance = 0.1) # V = dose/Cmax - expect_equal(result$CL, 1.98, tolerance = 0.2) # Approximate half-life -}) - -test_that("get_initial_estimates_from_data works for 2-compartment model", { - # Create test data - test_data <- data.frame( - ID = c(1, 1, 1, 1), - TIME = c(0, 1, 4, 8), - DV = c(0, 100, 50, 25), - EVID = c(1, 0, 0, 0), - MDV = c(1, 0, 0, 0), - AMT = c(1000, 0, 0, 0) - ) - - # Get estimates - result <- get_initial_estimates_from_data(test_data, n_cmt = 2) - - # Test results - expect_type(result, "list") - expect_named(result, c("V", "CL", "QP1", "VP1")) - expect_true(all(result > 0)) # All parameters should be positive - - # Test relationships between parameters - expect_equal(result$QP1, result$CL) # Q equals CL for initial estimate - expect_equal(result$VP1, result$V * 2) # VP1 is twice V -}) - -test_that("get_initial_estimates_from_data works for 3-compartment model", { - # Create test data - test_data <- data.frame( - ID = c(1, 1, 1, 1), - TIME = c(0, 1, 4, 8), - DV = c(0, 100, 50, 25), - EVID = c(1, 0, 0, 0), - MDV = c(1, 0, 0, 0), - AMT = c(1000, 0, 0, 0) - ) - - # Get estimates - result <- get_initial_estimates_from_data(test_data, n_cmt = 3) - - # Test results - expect_type(result, "list") - expect_named(result, c("V", "CL", "QP1", "VP1", "QP2", "VP2")) - expect_true(all(result > 0)) # All parameters should be positive - - # Test relationships between parameters - expect_equal(result$QP1, result$CL) - expect_equal(result$QP2, result$CL) - expect_equal(result$VP1, result$V * 2) - expect_equal(result$VP2, result$V * 3) -}) - - -## Individual data: -test_that("get_initial_estimates_from_data handles multiple subjects", { - # Create test data with two subjects - test_data <- data.frame( - ID = rep(c(1, 2), each = 4), - TIME = rep(c(0, 1, 4, 8), 2), - DV = c(0, 100, 50, 25, 0, 120, 60, 30), - EVID = rep(c(1, 0, 0, 0), 2), - MDV = rep(c(1, 0, 0, 0), 2), - AMT = rep(c(1000, 0, 0, 0), 2) - ) - - # Get estimates - result <- get_initial_estimates_from_data(test_data, n_cmt = 1) - - # Test results - expect_type(result, "list") - expect_named(result, c("V", "CL")) - expect_true(all(result > 0)) - - # Test that results are averages of individual estimates - expect_true(result$V > 1000/120 && result$V < 1000/100) # Should be between individual estimates -}) - -test_that("get_initial_estimates_from_individual_data works with simple PK data", { - # Create test data - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2, 4, 8), - DV = c(0, 10, 7, 3, 1), - MDV = c(1, 0, 0, 0, 0), - EVID = c(1, 0, 0, 0, 0), - AMT = c(100, 0, 0, 0, 0) - ) - - # Get estimates - estimates <- get_initial_estimates_from_individual_data(test_data) - - # Test that we get the expected parameters - expect_named(estimates, c("V", "CL")) - - # Test that values are positive - expect_true(all(estimates > 0)) - - # Test approximate values (allowing for some numerical tolerance) - # V should be approximately dose/Cmax = 100/10 = 10 - expect_equal(estimates["V"], c(V = 10), tolerance = 0.1) - - # Calculate expected CL from the data - # Using two timepoints (1h and 8h): - # KEL = (ln(10) - ln(1))/(8-1) ≈ 0.329 - # Expected CL = KEL * V ≈ 3.29 - expect_equal(estimates["CL"], c(CL=3.29), tolerance = 0.5) -}) - -test_that("get_initial_estimates_from_individual_data handles missing data", { - # Create test data with some missing observations - test_data <- data.frame( - ID = 1, - TIME = c(0, 1, 2, 4, 8), - DV = c(0, NA, 7, 3, 1), - MDV = c(1, 1, 0, 0, 0), - EVID = c(1, 0, 0, 0, 0), - AMT = c(100, 0, 0, 0, 0) - ) - - # Get estimates - estimates <- get_initial_estimates_from_individual_data(test_data) - - # Test that we still get estimates - expect_named(estimates, c("V", "CL")) - expect_true(all(estimates > 0)) -}) - -test_that("get_initial_estimates_from_individual_data handles insufficient data", { - # Create test data with only one observation - test_data <- data.frame( - ID = 1, - TIME = c(0, 1), - DV = c(0, 10), - MDV = c(1, 0), - EVID = c(1, 0), - AMT = c(100, 0) - ) - - # Get estimates - should return empty - estimates <- get_initial_estimates_from_individual_data(test_data) - - # Test that we get an empty result - expect_equal(estimates, c(V = 2, CL = 0.2)) -}) diff --git a/tests/testthat/test_get_obs_compartment.R b/tests/testthat/test_get_obs_compartment.R deleted file mode 100644 index d0485a0..0000000 --- a/tests/testthat/test_get_obs_compartment.R +++ /dev/null @@ -1,82 +0,0 @@ -test_that("get_obs_compartment() works for advan1", { - advan1 <- create_model(route = "iv", n_cmt = 1) - expect_equal( - get_advan(advan1), - 1 - ) - expect_equal( - get_obs_compartment(advan1), - 1 - ) - expect_equal( - get_ode_size(advan1), - 0 - ) -}) - -test_that("get_obs_compartment() works for advan2", { - advan2 <- create_model(route = "oral", n_cmt = 1) - expect_equal( - get_advan(advan2), - 2 - ) - expect_equal( - get_obs_compartment(advan2), - 2 - ) - expect_equal( - get_ode_size(advan2), - 0 - ) -}) - -test_that("get_obs_compartment() works for advan1", { - advan3 <- create_model(route = "iv", n_cmt = 2) - expect_equal( - get_advan(advan3), - 3 - ) - expect_equal( - get_obs_compartment(advan3), - 1 - ) - expect_equal( - get_ode_size(advan3), - 0 - ) -}) - -test_that("get_obs_compartment() works for advan4", { - advan4 <- create_model(route = "oral", n_cmt = 2) - expect_equal( - get_advan(advan4), - 4 - ) - expect_equal( - get_obs_compartment(advan4), - 2 - ) - expect_equal( - get_ode_size(advan4), - 0 - ) -}) - -test_that("get_obs_compartment() works for advan6", { - advan6 <- create_model( - route = "oral", n_cmt = 2, - elimination = "michaelis-menten" - ) - expect_true( - get_advan(advan6) %in% c(6, 13) - ) - expect_equal( - get_obs_compartment(advan6), - 2 - ) - expect_equal( - get_ode_size(advan6), - 3 - ) -}) - diff --git a/tests/testthat/test_get_shrinkage_summary.R b/tests/testthat/test_get_shrinkage_summary.R deleted file mode 100644 index 37966b7..0000000 --- a/tests/testthat/test_get_shrinkage_summary.R +++ /dev/null @@ -1,52 +0,0 @@ -test_that("get_shrinkage_values extracts correct values", { - # Test case with valid NONMEM output format - test_txt <- c( - "Some other text", - "ETASHRINKSD(%) 2.345E+01 3.456E+01", - "More text" - ) - - result <- get_shrinkage_values(test_txt, "ETASHRINKSD") - expect_equal(result, c(23.45, 34.56)) - - # Test case with no matches - test_txt_empty <- c( - "Some other text", - "No shrinkage here" - ) - result_empty <- get_shrinkage_values(test_txt_empty, "ETASHRINKSD") - expect_equal(result_empty, NA) - - # Test different shrinkage types - test_txt_eps <- "EPSSHRINKSD(%) 1.234E+01 2.345E+01" - result_eps <- get_shrinkage_values(test_txt_eps, "EPSSHRINKSD") - expect_equal(result_eps, c(12.34, 23.45)) -}) - -test_that("get_shrinkage_summary returns correct structure", { - # Create a temporary file with test content - test_content <- c( - "Some header", - "ETASHRINKSD(%) 2.345E+01 3.456E+01", - "EBVSHRINKSD(%) 1.234E+01 2.345E+01", - "EPSSHRINKSD(%) 3.456E+01 4.567E+01" - ) - temp_file <- tempfile(fileext = ".lst") - writeLines(test_content, temp_file) - - # Test without fit object - result <- get_shrinkage_summary(path = temp_file) - expect_type(result, "list") - expect_named(result, c("eta", "ebv", "eps")) - expect_equal(result$eta, c(ETA_1 = 23.45, ETA_2 = 34.56)) - expect_equal(result$ebv, c(ETA_1 = 12.34, ETA_2 = 23.45)) - expect_equal(result$eps, c(34.56, 45.67)) - - # Test with NULL path - null_result <- get_shrinkage_summary(path = NULL) - expect_equal(null_result, list()) - - # Clean up - unlink(temp_file) -}) - diff --git a/tests/testthat/test_get_tables_from_fit.R b/tests/testthat/test_get_tables_from_fit.R deleted file mode 100644 index 8642b36..0000000 --- a/tests/testthat/test_get_tables_from_fit.R +++ /dev/null @@ -1,82 +0,0 @@ -test_that("get_tables_from_fit handles models with tables correctly", { - # Setup mock model and path - mock_model <- list( - name = "run001", - code = " - $TABLE ID TIME DV PRED IPRED - FILE=sdtab001 - - $TABLE CL V KA - FILE=patab001 - " - ) - temp_dir <- tempdir() - model_dir <- file.path(temp_dir, "models", "run001") - dir.create(model_dir, recursive = TRUE) - - # Create mock table files - write.table( - data.frame(ID = 1:3, TIME = 0:2, DV = 1:3, PRED = 2:4, IPRED = 1:3), - file = file.path(model_dir, "sdtab001"), - row.names = FALSE, - quote = FALSE, - sep = " " - ) - - write.table( - data.frame(CL = c(0.1, 0.2, 0.3), V = c(1, 2, 3), KA = c(0.5, 0.6, 0.7)), - file = file.path(model_dir, "patab001"), - row.names = FALSE, - quote = FALSE, - sep = " " - ) - - # Test the function - result <- get_tables_from_fit(mock_model, model_dir) - - # Assertions - expect_type(result, "list") - expect_named(result, c("sdtab001", "patab001")) - expect_equal(ncol(result$sdtab001), 5) - expect_equal(ncol(result$patab001), 3) - expect_equal(nrow(result$sdtab001), 3) - expect_equal(nrow(result$patab001), 3) - - # Cleanup - unlink(model_dir, recursive = TRUE) -}) - -test_that("get_tables_from_fit handles models without tables correctly", { - # Setup mock model without tables - mock_model <- list( - name = "run002", - code = "$PROBLEM test\n$INPUT ID TIME\n$DATA data.csv" - ) - - result <- get_tables_from_fit(mock_model, tempdir()) - - # Assertions - expect_type(result, "list") - expect_length(result, 0) -}) - -test_that("get_tables_from_fit handles missing files gracefully", { - # Setup mock model with non-existent tables - mock_model <- list( - name = "run003", - code = " - $TABLE ID TIME - FILE=missing001 - " - ) - - # Test should not error but return empty data - expect_warning( - result <- get_tables_from_fit(mock_model, tempdir()), - NA - ) - - # Assertions - expect_type(result, "list") -}) - diff --git a/tests/testthat/test_get_tables_in_model_code.R b/tests/testthat/test_get_tables_in_model_code.R deleted file mode 100644 index 009bcf3..0000000 --- a/tests/testthat/test_get_tables_in_model_code.R +++ /dev/null @@ -1,44 +0,0 @@ -test_that("get_tables_in_model_code extracts table filenames correctly", { - # Test case 1: Simple table - model_simple <- list( - code = "$TABLE FILE=sdtab001" - ) - expect_equal( - get_tables_in_model_code(model_simple), - "sdtab001" - ) - - # Test case 2: Multiple tables - model_multiple <- list( - code = "$TABLE FILE=sdtab001 NOPRINT ONEHEADER\n$TABLE FILE=patab001" - ) - expect_equal( - get_tables_in_model_code(model_multiple), - c("sdtab001", "patab001") - ) - - # Test case 3: Complex model with other sections - model_complex <- list( - code = " - $PROBLEM Test model - $INPUT ID TIME DV - $DATA data.csv - $TABLE FILE=sdtab001 NOPRINT - $TABLE FILE=mytab002 NOAPPEND - $TABLE FILE=cotab003 - " - ) - expect_equal( - get_tables_in_model_code(model_complex), - c("sdtab001", "mytab002", "cotab003") - ) - - # Test case 4: No tables - model_no_tables <- list( - code = "$PROBLEM Test model\n$INPUT ID TIME DV\n$DATA data.csv" - ) - expect_equal( - get_tables_in_model_code(model_no_tables), - character(0) - ) -}) diff --git a/tests/testthat/test_is_ltbs_model.R b/tests/testthat/test_is_ltbs_model.R deleted file mode 100644 index 70ec939..0000000 --- a/tests/testthat/test_is_ltbs_model.R +++ /dev/null @@ -1,220 +0,0 @@ -# tests/testthat/test-is_ltbs_model.R - -test_that("is_ltbs_model returns FALSE when control_stream is missing from model internals", { - # Create a mock model without control_stream - model <- list( - internals = list( - other_component = "some_value" - ) - ) - - # Expect a warning and FALSE return - expect_message( - result <- is_ltbs_model(model), - "Check for LTBS not yet implemented for nlmixr2." - ) - expect_false(result) -}) - -test_that("is_ltbs_model returns FALSE when model internals is missing", { - # Create a mock model without internals - model <- list( - some_other_field = "value" - ) - - expect_message( - result <- is_ltbs_model(model), - "Check for LTBS not yet implemented for nlmixr2." - ) - expect_false(result) -}) - -test_that("is_ltbs_model returns FALSE when get_error_record returns NULL", { - # Create a mock model with control_stream that returns NULL - mock_control_stream <- list( - get_error_record = function() NULL - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_false(result) -}) - -test_that("is_ltbs_model returns FALSE when error record is not a CodeRecord", { - # Create a mock that returns something that's not a CodeRecord - mock_control_stream <- list( - get_error_record = function() "not_a_code_record" - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_false(result) -}) - -test_that("is_ltbs_model returns FALSE when Y assignment is not found", { - # Create a mock CodeRecord without Y assignment - mock_statements <- list( - find_assignment = function(var) { - if (var == "Y") return(NULL) - return("some_other_assignment") - } - ) - - mock_error_record <- list(statements = mock_statements) - class(mock_error_record) <- "pharmpy.model.external.nonmem.records.code_record.CodeRecord" - - mock_control_stream <- list( - get_error_record = function() mock_error_record - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_false(result) -}) - -test_that("is_ltbs_model returns FALSE when Y assignment is not an Assignment object", { - # Create a mock where find_assignment returns something that's not an Assignment - mock_statements <- list( - find_assignment = function(var) { - if (var == "Y") return("not_an_assignment") - return(NULL) - } - ) - - mock_error_record <- list(statements = mock_statements) - class(mock_error_record) <- "pharmpy.model.external.nonmem.records.code_record.CodeRecord" - - mock_control_stream <- list( - get_error_record = function() mock_error_record - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_false(result) -}) - -test_that("is_ltbs_model returns TRUE when Y assignment contains log transformation", { - # Create a mock Assignment with log transformation - mock_assignment <- list( - to_dict = function() { - list(expression = "log(THETA(1) + ETA(1))") - } - ) - class(mock_assignment) <- "pharmpy.model.statements.Assignment" - - mock_statements <- list( - find_assignment = function(var) { - if (var == "Y") return(mock_assignment) - return(NULL) - } - ) - - mock_error_record <- list(statements = mock_statements) - class(mock_error_record) <- "pharmpy.model.external.nonmem.records.code_record.CodeRecord" - - mock_control_stream <- list( - get_error_record = function() mock_error_record - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_true(result) -}) - -test_that("is_ltbs_model returns FALSE when Y assignment does not contain log transformation", { - # Create a mock Assignment without log transformation - mock_assignment <- list( - to_dict = function() { - list(expression = "THETA(1) + ETA(1)") - } - ) - class(mock_assignment) <- "pharmpy.model.statements.Assignment" - - mock_statements <- list( - find_assignment = function(var) { - if (var == "Y") return(mock_assignment) - return(NULL) - } - ) - - mock_error_record <- list(statements = mock_statements) - class(mock_error_record) <- "pharmpy.model.external.nonmem.records.code_record.CodeRecord" - - mock_control_stream <- list( - get_error_record = function() mock_error_record - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_false(result) -}) - -test_that("is_ltbs_model detects various log expressions", { - # Test different log expressions - log_expressions <- c( - "log(THETA(1))", - "log(F + ETA(1))", - "log(IPRED)", - "Y = log(F) + EPS(1)" - ) - - for (expr in log_expressions) { - mock_assignment <- list( - to_dict = function() list(expression = expr) - ) - class(mock_assignment) <- "pharmpy.model.statements.Assignment" - - mock_statements <- list( - find_assignment = function(var) { - if (var == "Y") return(mock_assignment) - return(NULL) - } - ) - - mock_error_record <- list(statements = mock_statements) - class(mock_error_record) <- "pharmpy.model.external.nonmem.records.code_record.CodeRecord" - - mock_control_stream <- list( - get_error_record = function() mock_error_record - ) - - model <- list( - internals = list( - control_stream = mock_control_stream - ) - ) - - result <- is_ltbs_model(model) - expect_true(result, info = paste("Failed for expression:", expr)) - } -}) diff --git a/tests/testthat/test_nm_save_model.R b/tests/testthat/test_nm_save_model.R deleted file mode 100644 index 3adde89..0000000 --- a/tests/testthat/test_nm_save_model.R +++ /dev/null @@ -1,43 +0,0 @@ -test_that("nm_save_model stops with error if `modelfile` is not provided", { - expect_error( - nm_save_model(model = list(), modelfile = NULL, overwrite = FALSE), - "Please specify an output NONMEM modelfile." - ) -}) - -test_that("nm_save_model stops with error if `model` is not provided", { - expect_error( - nm_save_model(model = NULL, modelfile = "model.txt", overwrite = FALSE), - "Please specify an imported NONMEM model" - ) -}) - -test_that("nm_save_model stops with error if file already exists and `overwrite` is set to FALSE", { - # Create a dummy file - file.create("dummy.txt") - expect_error( - nm_save_model(model = list(), modelfile = "dummy.txt", overwrite = FALSE), - "Sorry, the output NONMEM file already exists and `overwrite` is set to FALSE." - ) - - # Remove the dummy file - file.remove("dummy.txt") -}) - -test_that("nm_save_model stops with error if `model` is not a NONMEM model", { - expect_error( - nm_save_model(model = list(), modelfile = "model.txt", overwrite = TRUE), - "Sorry, this object does not seem to be a valid NONMEM model object." - ) -}) - -test_that("nm_save_model writes a file with the correct content", { - # Create a dummy NONMEM model - model <- structure( - list(PROBLEM = "problem", INPUT = "input", DATA = "data", ABBR = "abbr"), - class = "NONMEM" - ) - nm_save_model(model = model, modelfile = "test.txt", overwrite = TRUE) - expect_equal(readLines("test.txt"), c("problem", "input", "data", "abbr")) - file.remove("test.txt") -}) diff --git a/tests/testthat/test_remove_tables_from_code.R b/tests/testthat/test_remove_tables_from_code.R deleted file mode 100644 index 7804feb..0000000 --- a/tests/testthat/test_remove_tables_from_code.R +++ /dev/null @@ -1,74 +0,0 @@ -test_that("remove_table_sections handles various cases correctly", { - # Test 1: Basic case with single $TABLE - basic_text <- "$INPUT\nsome input\n$TABLE\nsome table\n$ERROR\nsome error" - expect_equal( - remove_table_sections(basic_text), - "$INPUT\nsome input\n$ERROR\nsome error" - ) - - # Test 2: Multiple $TABLE sections - multiple_tables <- "$INPUT\ndata\n$TABLE\ntable1\n$PK\npk data\n$TABLE\ntable2\n$ERROR\nerror" - expect_equal( - remove_table_sections(multiple_tables), - "$INPUT\ndata\n$PK\npk data\n$ERROR\nerror" - ) - - # Test 3: $TABLE at the end of text - end_table <- "$INPUT\ndata\n$PK\npk data\n$TABLE\ntable data" - expect_equal( - remove_table_sections(end_table), - "$INPUT\ndata\n$PK\npk data" - ) - - # Test 4: No $TABLE sections - no_table <- "$INPUT\ndata\n$PK\npk data\n$ERROR\nerror" - expect_equal( - remove_table_sections(no_table), - no_table - ) - - # Test 5: Empty string - expect_equal( - remove_table_sections(""), - "" - ) - - # Test 6: Complex case with multiple newlines and spacing - complex_text <- "$INPUT\ndata\n\n$TABLE \n ID TIME DV\n EVID\n\n$PK\npk\n\n$TABLE\nmore table\n\n$ERROR" - expect_equal( - remove_table_sections(complex_text), - "$INPUT\ndata\n\n$PK\npk\n\n$ERROR" - ) - - # Test 7: Case with $TABLE-like content in other sections - table_like <- "$INPUT\nTABLE1 TABLE2\n$PK\nTABLE_VAR=1\n$TABLE\nreal table\n$ERROR" - expect_equal( - remove_table_sections(table_like), - "$INPUT\nTABLE1 TABLE2\n$PK\nTABLE_VAR=1\n$ERROR" - ) -}) - -# Additional test for verifying no $TABLE sections remain -test_that("no $TABLE sections remain after removal", { - test_cases <- list( - "$INPUT\n$TABLE\ndata\n$ERROR", - "$INPUT\n$TABLE\ndata1\n$PK\n$TABLE\ndata2\n$ERROR", - "$INPUT\n$TABLE\ndata\n", - "$INPUT\n$TABLE\ndata1\n$TABLE\ndata2" - ) - - for (test_case in test_cases) { - result <- remove_table_sections(test_case) - expect_false(grepl("\\$TABLE", result), - info = "Found $TABLE section that should have been removed") - } -}) - -test_that("remove_table_sections with file argument", { - # Test 1: Basic case with single $TABLE - basic_text <- "$INPUT\nsome input\n$TABLE\nsome table FILE=sdtab1 \n$TABLE\nsome table FILE=patab1\n$ERROR\nsome error" - expect_equal( - remove_table_sections(basic_text, file = "patab"), - "$INPUT\nsome input\n$TABLE\nsome table FILE=sdtab1 \n1\n$ERROR\nsome error" - ) -}) diff --git a/tests/testthat/test_run_nlme.R b/tests/testthat/test_run_nlme.R deleted file mode 100644 index d0cf1cf..0000000 --- a/tests/testthat/test_run_nlme.R +++ /dev/null @@ -1,69 +0,0 @@ -library(mockery) - -## TODO: needs tests for main run_nlme function - -test_that("get_new_run_number works correctly", { - # Create temporary directory for testing - temp_dir <- tempdir() - on.exit(unlink(temp_dir, recursive = TRUE)) - - # Test 1: Empty directory should return 1 - expect_equal(get_new_run_number(temp_dir), 1) - - # Test 2: With existing run folders - dir.create(file.path(temp_dir, "run1")) - dir.create(file.path(temp_dir, "run2")) - expect_equal(get_new_run_number(temp_dir), 3) - - # Test 3: Non-sequential numbers - unlink(file.path(temp_dir, "run2")) - dir.create(file.path(temp_dir, "run5")) - expect_equal(get_new_run_number(temp_dir), 6) - - # Test 4: With non-run folders present - dir.create(file.path(temp_dir, "other_folder")) - expect_equal(get_new_run_number(temp_dir), 6) - - # Test 5: With invalid run folder names - dir.create(file.path(temp_dir, "runA")) - dir.create(file.path(temp_dir, "run")) - expect_equal(get_new_run_number(temp_dir), 6) -}) - -test_that("change_nonmem_dataset handles different input formats correctly", { - # Test single-line string input - model_code_single <- "$PROB TEST\n$DATA old_data.csv IGNORE=@\n$INPUT ID TIME DV" - result1 <- change_nonmem_dataset(model_code_single, "new_data.csv") - expect_match(result1, "\\$DATA new_data\\.csv IGNORE=@") - - # Test vector input - model_code_vector <- c("$PROB TEST", "$DATA old_data.csv IGNORE=@", "$INPUT ID TIME DV") - result2 <- change_nonmem_dataset(model_code_vector, "new_data.csv") - expect_match(result2, "\\$DATA new_data\\.csv IGNORE=@") - - # Test with multiple options after dataset - model_code <- "$PROB TEST\n$DATA old_data.csv IGNORE=@ ACCEPT=(DV.GT.0)\n$INPUT ID TIME DV" - result3 <- change_nonmem_dataset(model_code, "new_data.csv") - expect_match(result3, "\\$DATA new_data\\.csv IGNORE=@ ACCEPT=\\(DV\\.GT\\.0\\)") -}) - -test_that("change_nonmem_dataset handles errors appropriately", { - # Test missing $DATA line - model_code_no_data <- "$PROB TEST\n$INPUT ID TIME DV" - expect_error( - change_nonmem_dataset(model_code_no_data, "new_data.csv"), - "No \\$DATA line found in the model file" - ) -}) - -test_that("change_nonmem_dataset preserves whitespace and formatting", { - # Test with extra whitespace - model_code <- "$PROB TEST\n$DATA old_data.csv IGNORE=@ \n$INPUT ID TIME DV" - result <- change_nonmem_dataset(model_code, "new_data.csv") - expect_match(result, "\\$DATA new_data\\.csv IGNORE=@") - - # Test with tabs - model_code_tabs <- "$PROB TEST\n$DATA\told_data.csv\tIGNORE=@\n$INPUT ID TIME DV" - result <- change_nonmem_dataset(model_code_tabs, "new_data.csv") - expect_match(result, "\\$DATA new_data\\.csv IGNORE=@") -}) diff --git a/tests/testthat/test_run_sim.R b/tests/testthat/test_run_sim.R deleted file mode 100644 index 51221f6..0000000 --- a/tests/testthat/test_run_sim.R +++ /dev/null @@ -1,9 +0,0 @@ -## TODO: add tests for simulations -## -## - basic simulations -## - test case for this fix: https://github.com/InsightRX/luna/pull/56 - -test_that( - "dummy check", - expect_true(TRUE) -) diff --git a/tests/testthat/test_set_compartment_scale.R b/tests/testthat/test_set_compartment_scale.R deleted file mode 100644 index 7462da2..0000000 --- a/tests/testthat/test_set_compartment_scale.R +++ /dev/null @@ -1,346 +0,0 @@ -# Tests for get_compartment_scale() ---- - -test_that("get_compartment_scale returns correct scale when S assignment exists with division", { - # Mock assignment with division - mock_assignment <- list( - expression = "V2/1000" - ) - class(mock_assignment) <- "pharmpy.model.statements.Assignment" - - mock_statements <- list( - find_assignment = function(var) { - if (var == "S2") return(mock_assignment) - return(NULL) - } - ) - - model <- list(statements = mock_statements) - - result <- get_compartment_scale(model, compartment = 2) - expect_equal(result$variable, "V2") - expect_equal(result$scale, 1000) -}) - -test_that("get_compartment_scale returns scale of 1 when no scale present", { - # Mock assignment without division - mock_assignment <- list( - expression = "V1" - ) - class(mock_assignment) <- "pharmpy.model.statements.Assignment" - - mock_statements <- list( - find_assignment = function(var) { - if (var == "S1") return(mock_assignment) - return(NULL) - } - ) - - model <- list(statements = mock_statements) - - result <- get_compartment_scale(model, compartment = 1) - expect_equal(result$variable, "V1") - expect_equal(result$scale, 1) -}) - -test_that("get_compartment_scale returns NULL when no S assignment found", { - mock_statements <- list( - find_assignment = function(var) NULL - ) - - model <- list(statements = mock_statements) - - result <- get_compartment_scale(model, compartment = 2) - expect_null(result) -}) - -test_that("get_compartment_scale returns NULL when assignment is not Assignment class", { - mock_statements <- list( - find_assignment = function(var) "not_an_assignment" - ) - - model <- list(statements = mock_statements) - - result <- get_compartment_scale(model, compartment = 2) - expect_null(result) -}) - -# Tests for scale_initial_estimates_pk() ---- - -test_that("scale_initial_estimates_pk scales basic PK parameters correctly", { - # Mock parameters dataframe - mock_params_df <- data.frame( - value = c(10, 50, 2), - row.names = c("CL", "V1", "KA") - ) - - mock_parameters <- list( - to_dataframe = function() mock_params_df - ) - - model <- list(parameters = mock_parameters) - - # Mock pharmr::set_initial_estimates to capture what gets passed - expected_inits <- list(CL = 100, V1 = 500) # scaled by 10 - actual_inits <- NULL - - mockery::stub(scale_initial_estimates_pk, "pharmr::set_initial_estimates", - function(model, inits) { - actual_inits <<- inits - return(model) - }) - - result <- scale_initial_estimates_pk(model, scale = 10) - - expect_equal(actual_inits, expected_inits) -}) - -test_that("scale_initial_estimates_pk scales POP_ prefixed parameters", { - mock_params_df <- data.frame( - value = c(5, 25), - row.names = c("POP_CL", "POP_V2") - ) - - mock_parameters <- list( - to_dataframe = function() mock_params_df - ) - - model <- list(parameters = mock_parameters) - - expected_inits <- list(POP_CL = 10, POP_V2 = 50) # scaled by 2 - actual_inits <- NULL - - mockery::stub(scale_initial_estimates_pk, "pharmr::set_initial_estimates", - function(model, inits) { - actual_inits <<- inits - return(model) - }) - - result <- scale_initial_estimates_pk(model, scale = 2) - - expect_equal(actual_inits, expected_inits) -}) - -test_that("scale_initial_estimates_pk ignores non-PK parameters", { - mock_params_df <- data.frame( - value = c(10, 0.1, 2), - row.names = c("CL", "SIGMA", "OTHER_PARAM") - ) - - mock_parameters <- list( - to_dataframe = function() mock_params_df - ) - - model <- list(parameters = mock_parameters) - - expected_inits <- list(CL = 50) # only CL should be scaled - actual_inits <- NULL - - mockery::stub(scale_initial_estimates_pk, "pharmr::set_initial_estimates", - function(model, inits) { - actual_inits <<- inits - return(model) - }) - - result <- scale_initial_estimates_pk(model, scale = 5) - - expect_equal(actual_inits, expected_inits) -}) - -test_that("scale_initial_estimates_pk handles all defined PK parameters", { - all_pk_params <- c("CL", "V", "V1", "V2", "V3", "V4", "VP1", "VP2", "VP3", - "Q", "Q1", "Q2", "Q3", "QP1", "QP2", "QP3") - - mock_params_df <- data.frame( - value = rep(10, length(all_pk_params)), - row.names = all_pk_params - ) - - mock_parameters <- list( - to_dataframe = function() mock_params_df - ) - - model <- list(parameters = mock_parameters) - - expected_inits <- as.list(rep(20, length(all_pk_params))) # scaled by 2 - names(expected_inits) <- all_pk_params - actual_inits <- NULL - - mockery::stub(scale_initial_estimates_pk, "pharmr::set_initial_estimates", - function(model, inits) { - actual_inits <<- inits - return(model) - }) - - result <- scale_initial_estimates_pk(model, scale = 2) - - expect_equal(actual_inits, expected_inits) -}) - -# Tests for set_compartment_scale() ---- - -test_that("set_compartment_scale infers compartment 2 for ADVAN 2, 4, 12", { - for (i in c(1,2,3)) { - model <- create_model( - n_cmt = i, - route = "oral" - ) - expect_message( - result <- set_compartment_scale(model, expression = list(variable = "V", scale = 1000)), - "Scaling already specified" - ) - } -}) - -test_that("set_compartment_scale infers compartment 1 for ADVAN 1, 3, 11", { - for (i in c(1,2,3)) { - model <- create_model( - n_cmt = i, - route = "iv" - ) - expect_message( - result <- set_compartment_scale(model, expression = list(variable = "V", scale = 1000)), - "Scaling already specified" - ) - } -}) - -test_that("set_compartment_scale adds new scaling when none exists", { - model <- list(code = "other code\nmore code") - - mockery::stub(set_compartment_scale, "get_compartment_scale", NULL) - mockery::stub(set_compartment_scale, "pharmr::read_model_from_string", - function(code) { - grepl("S2 = V/1000", code, fixed = TRUE) - return(list(code = code)) - }) - mockery::stub(set_compartment_scale, "scale_initial_estimates_pk", - function(model, scale) model) - mockery::stub(set_compartment_scale, "find_pk_parameter", - function(model, scale) "V") - - expect_message( - result <- set_compartment_scale( - model, - compartment = 2, - expression = list(variable = "V", scale = 1000) - ), - "No scaling specified for compartment 2, adding scale" - ) -}) - -test_that("set_compartment_scale updates existing scaling", { - model <- list(code = "S2 = V2/500\nother code") - - mockery::stub(set_compartment_scale, "get_compartment_scale", - list(variable = "V2", scale = "500")) - mockery::stub(set_compartment_scale, "pharmr::read_model_from_string", - function(code) { - expect_true(grepl("S2 = V/1000", code, fixed = TRUE)) - return(list(code = code)) - }) - mockery::stub(set_compartment_scale, "scale_initial_estimates_pk", - function(model, scale) model) - mockery::stub(set_compartment_scale, "find_pk_parameter", - function(model, scale) "V") - - expect_message( - result <- set_compartment_scale( - model, - compartment = 2, - expression = list(variable = "V", scale = 1000) - ), - "Scaling already specified for compartment 2, updating scale" - ) -}) - -test_that("set_compartment_scale calls scale_initial_estimates_pk when update_inits is TRUE", { - model <- list(code = "S2 = V2") - - mockery::stub(set_compartment_scale, "get_compartment_scale", NULL) - mockery::stub(set_compartment_scale, "pharmr::read_model_from_string", - function(code) model) - - scale_called <- FALSE - mockery::stub(set_compartment_scale, "find_pk_parameter", - function(model, scale) "V") - mockery::stub(set_compartment_scale, "scale_initial_estimates_pk", - function(model, scale) { - scale_called <<- TRUE - expect_equal(scale, 1000) - return(model) - }) - - result <- set_compartment_scale( - model, - compartment = 2, - expression = list(variable = "V", scale = 1000), - update_inits = TRUE - ) - - expect_true(scale_called) -}) - -test_that("set_compartment_scale skips scaling when update_inits is FALSE", { - model <- list(code = "S2 = V2") - - mockery::stub(set_compartment_scale, "get_compartment_scale", NULL) - mockery::stub(set_compartment_scale, "pharmr::read_model_from_string", - function(code) model) - - scale_called <- FALSE - mockery::stub(set_compartment_scale, "find_pk_parameter", - function(model, scale) "V") - mockery::stub(set_compartment_scale, "scale_initial_estimates_pk", - function(model, scale) { - scale_called <<- TRUE - return(model) - }) - - result <- set_compartment_scale( - model, - compartment = 2, - expression = list(variable = "V", scale = 1000), - update_inits = FALSE - ) - - expect_false(scale_called) -}) - -## End-to-end tests for set_comparmtent_scale() with pharmpy model -test_that("set_compartment_scale works for pharmpy model", { - model1 <- create_model(n_cmt = 1, route = "oral") # advan2 - model2 <- set_compartment_scale( - model1, - expression = list(variable = "V", scale = 1000) - ) - expect_equal( - model2$parameters$to_dataframe()$value[1], - 0.5 # KA, unchanged - ) - expect_equal( - model2$parameters$to_dataframe()$value[2], - 15000 - ) - expect_equal( - model2$parameters$to_dataframe()$value[3], - 5000 - ) -}) - -test_that("Finds parameter by common name (e.g. 'V' when actually named 'V2'", { - model <- create_model( - n_cmt = 2, - route = "oral" - ) - model2 <- model |> - set_compartment_scale( - compartment = 2, - expression = list( - variable = "V", - scale = 1000 - ) - ) - expect_true( - stringr::str_detect(model2$code, "S2 = V2/1000") - ) -}) diff --git a/tests/testthat/test_stack_encounters.R b/tests/testthat/test_stack_encounters.R deleted file mode 100644 index fae5ebe..0000000 --- a/tests/testthat/test_stack_encounters.R +++ /dev/null @@ -1,134 +0,0 @@ -test_that("stack_encounters handles single encounters correctly", { - # Create simple dataset with one encounter - data <- data.frame( - ID = c(1, 1, 1), - TIME = c(0, 1, 2), - DV = c(1, 2, 3), - EVID = c(0, 0, 0), - AMT = c(0, 0, 0), - MDV = c(0, 0, 0) - ) - - result <- stack_encounters(data) - - # Should return unchanged data when time is always increasing, but have - # column ENC_TIME added - expect_true("ENC_TIME" %in% names(result)) - expect_equal(result |> dplyr::select(-ENC_TIME), data) -}) - -test_that("stack_encounters correctly stacks multiple encounters", { - # Create dataset with two encounters - data <- data.frame( - ID = c(1, 1, 1, 1, 1, 1), - TIME = c(0, 1, 2, 0, 1, 2), - DV = c(1, 2, 3, 4, 5, 6), - EVID = c(0, 0, 0, 0, 0, 0), - AMT = c(0, 0, 0, 0, 0, 0), - MDV = c(0, 0, 0, 0, 0, 0) - ) - - result <- stack_encounters(data, gap = 10) - - # Check that TIME has been adjusted for second encounter - expect_equal(result$TIME[1:3], c(0, 1, 2)) - expect_equal(result$TIME[4:7], c(10, 10, 11, 12)) - - # Check that original times are preserved in ENC_TIME - expect_equal(result$ENC_TIME, c(0, 1, 2, 0, 0, 1, 2)) - - # Check that all original columns are preserved - expect_true(all(names(data) %in% names(result))) -}) - -test_that("reset_encounters adds EVID=3 events correctly", { - data <- data.frame( - ID = c(1, 1, 1, 1, 1, 1), - TIME = c(0, 1, 2, 0, 1, 2), - DV = c(1, 2, 3, 4, 5, 6), - EVID = c(0, 0, 0, 0, 0, 0), - AMT = c(0, 0, 0, 0, 0, 0), - MDV = c(0, 0, 0, 0, 0, 0) - ) - - # Test with reset_encounters = TRUE - result_reset <- stack_encounters(data, gap = 10, reset_encounters = TRUE) - - # Should have one additional row for EVID=3 event - expect_equal(nrow(result_reset), nrow(data) + 1) - - # Check EVID=3 event properties - evid3_row <- result_reset[result_reset$EVID == 3, ] - expect_equal(nrow(evid3_row), 1) - expect_equal(evid3_row$TIME, 10) - expect_equal(evid3_row$MDV, 1) - expect_equal(evid3_row$DV, 0) - expect_equal(evid3_row$AMT, 0) - - # Test with reset_encounters = FALSE - result_no_reset <- stack_encounters(data, gap = 10, reset_encounters = FALSE) - expect_equal(nrow(result_no_reset), nrow(data)) - expect_equal(sum(result_no_reset$EVID == 3), 0) -}) - -test_that("stack_encounters handles different gap values", { - data <- data.frame( - ID = c(1, 1, 1, 1, 1, 1), - TIME = c(0, 1, 2, 0, 1, 2), - DV = c(1, 2, 3, 4, 5, 6), - EVID = c(0, 0, 0, 0, 0, 0), - AMT = c(0, 0, 0, 0, 0, 0), - MDV = c(0, 0, 0, 0, 0, 0) - ) - - result_gap_5 <- stack_encounters(data, gap = 5) - result_gap_20 <- stack_encounters(data, gap = 20) - - # Check that second encounter starts at different times based on gap - expect_equal(min(result_gap_5$TIME[4:6]), 5) - expect_equal(min(result_gap_20$TIME[4:6]), 20) -}) - -test_that("stack_encounters handles multiple subjects correctly", { - data <- data.frame( - ID = c(1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2), - TIME = c(0, 1, 2, 0, 1, 2, 0, 1, 2, 0, 1, 2), - DV = 1:12, - EVID = rep(0, 12), - AMT = rep(0, 12), - MDV = rep(0, 12) - ) - - result <- stack_encounters(data, gap = 10) - - # Check that stacking is done independently for each ID - expect_equal(result$TIME[result$ID == 1][4:7], c(10, 10, 11, 12)) - expect_equal(result$TIME[result$ID == 2][4:7], c(10, 10, 11, 12)) - - # Check that original order of IDs is preserved - expect_equal(result$ID, c(1, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2)) # Additional rows for EVID=3 events -}) - -test_that("stack_encounter() doesn't error when DV is character", { - dat <- structure( - list( - ID = c(10011001, 10011001, 10011001, 10011001, 10011001), - DV = c("<0.05", NA, "<0.05", "<0.05", "<0.05"), - TIME = c(0, 0, 0.5, 1, 1.5), - EVID = c(0, 1, 0, 0, 0), - AMT = c(NA, 100, NA, NA, NA), - GROUP = c("A", "A", "A", "A", "A"), - AGE = c(60.0027684797834, 60.0027684797834, 60.0027684797834, 60.0027684797834, 60.0027684797834), - WEIGHT = c(54.1672683117584, 54.1672683117584, 54.1672683117584, 54.1672683117584, 54.1672683117584) - ), - row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame") - ) - nm_dat <- stack_encounters( - data = dat, - verbose = TRUE - ) - expect_equal( - names(nm_dat), - c("ID", "DV", "TIME", "EVID", "AMT", "GROUP", "AGE", "WEIGHT", "ENC_TIME") - ) -}) diff --git a/tests/testthat/test_time_is_always_increasing.R b/tests/testthat/test_time_is_always_increasing.R deleted file mode 100644 index fe2f079..0000000 --- a/tests/testthat/test_time_is_always_increasing.R +++ /dev/null @@ -1,38 +0,0 @@ -test_that("time_is_always_increasing correctly identifies increasing and non-increasing time sequences", { - - # Test case 1: Single subject with increasing time - data1 <- data.frame( - ID = 1, - TIME = c(0, 1, 2, 3) - ) - expect_true(time_is_always_increasing(data1)) - - # Test case 2: Single subject with non-increasing time - data2 <- data.frame( - ID = 1, - TIME = c(0, 2, 1, 3) - ) - expect_false(time_is_always_increasing(data2)) - - # Test case 3: Multiple subjects with increasing time - data3 <- data.frame( - ID = c(1, 1, 2, 2), - TIME = c(0, 1, 0, 1) - ) - expect_true(time_is_always_increasing(data3)) - - # Test case 4: Multiple subjects, one with non-increasing time - data4 <- data.frame( - ID = c(1, 1, 2, 2), - TIME = c(0, 1, 1, 0) - ) - expect_false(time_is_always_increasing(data4)) - - # Test case 5: Equal times should be considered increasing (>= 0) - data5 <- data.frame( - ID = 1, - TIME = c(0, 1, 1, 2) - ) - expect_true(time_is_always_increasing(data5)) - -})