From 4cef4ec600fe7cff84cc7fef604c44f5ed924b1d Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 24 Jan 2025 17:38:17 -0500 Subject: [PATCH 01/19] refactor bootstrap setup functions to be more general - new setup and handling "analysis" functions meant to be used with bootstrap and SSE analyses. - prepare for SSE setup inclusion (prototype) --- R/analysis-run-utils.R | 543 ++++++++++++++++++ R/bootstrap-model.R | 438 +------------- R/check-up-to-date.R | 2 +- R/config-log.R | 2 +- R/get-path-from-object.R | 93 ++- R/model-status.R | 28 +- R/modify-records.R | 2 +- R/print.R | 28 +- R/submit-model.R | 2 +- man/get_analysis_models.Rd | 16 + man/get_analysis_spec.Rd | 21 + man/get_boot_spec.Rd | 19 - man/get_spec_path.Rd | 6 + man/make_analysis_model.Rd | 17 + ...ake_boot_spec.Rd => make_analysis_spec.Rd} | 12 +- man/make_boot_run.Rd | 17 - man/new_analysis_run.Rd | 41 ++ man/new_bootstrap_run.Rd | 2 +- man/setup_analysis_run.Rd | 57 ++ man/setup_bootstrap_run.Rd | 7 +- tests/testthat/helpers-create-example-model.R | 2 +- tests/testthat/test-workflow-bootstrap.R | 22 +- 22 files changed, 863 insertions(+), 514 deletions(-) create mode 100644 R/analysis-run-utils.R create mode 100644 man/get_analysis_models.Rd create mode 100644 man/get_analysis_spec.Rd delete mode 100644 man/get_boot_spec.Rd create mode 100644 man/make_analysis_model.Rd rename man/{make_boot_spec.Rd => make_analysis_spec.Rd} (51%) delete mode 100644 man/make_boot_run.Rd create mode 100644 man/new_analysis_run.Rd create mode 100644 man/setup_analysis_run.Rd diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R new file mode 100644 index 000000000..879e5332f --- /dev/null +++ b/R/analysis-run-utils.R @@ -0,0 +1,543 @@ +#' Create a bootstrap or SSE run from an existing model +#' +#' @param .mod A `bbr` model object. +#' @param .suffix A suffix for the new run directory. Will be prefixed by +#' the model id of `.mod`. +#' @param .type Either `"nmboot"` or `"nmsse"` +#' @inheritParams copy_model_from +#' @param .inherit_tags If `TRUE`, the default, inherit any tags from `.mod`. +#' @param remove_cov,remove_tables If `TRUE`, the default, remove `$COVARIANCE` +#' and `$TABLE` records respectively, allowing for notably faster run times. +#' +#' @keywords internal +new_analysis_run <- function( + .mod, + .suffix, + .type = c("nmboot", "nmsse"), + .add_tags = NULL, + .inherit_tags = TRUE, + .overwrite = FALSE, + remove_cov = TRUE, + remove_tables = TRUE +){ + .type <- match.arg(.type) + check_model_object(.mod, NM_MOD_CLASS) + + # Create new run directory + model_dir <- get_model_working_directory(.mod) + run_dir <- glue("{get_model_id(.mod)}-{.suffix}") + + # Copy the model + new_run <- copy_model_from( + .parent_mod = .mod, + .new_model = run_dir, + .add_tags = .add_tags, + .inherit_tags = .inherit_tags, + .update_model_file = TRUE, + .overwrite = .overwrite + ) + + # Modify YAML to set model type (e.g., "nmboot" or "nmsse") + new_run[[YAML_MOD_TYPE]] <- .type + new_run <- save_model_yaml(new_run) + + # Update `$PROBLEM` block + prob_type <- dplyr::case_when( + .type == "nmboot" ~ "Bootstrap run", + .type == "nmsse" ~ "SSE" + ) + problem_text <- glue("{prob_type} of model {get_model_id(.mod)}") + modify_prob_statement(new_run, problem_text) + + # Optionally remove `$TABLE` and `$COV` blocks + if (isTRUE(remove_cov)) remove_records(new_run, type = "covariance") + if (isTRUE(remove_tables)) remove_records(new_run, type = "table") + + # Update table and estimation record file paths + new_run <- update_model_id(new_run) %>% suppressMessages() + + # Return read-in model to get the updated class as part of the model object + return(read_model(file.path(model_dir, run_dir))) +} + + +#' Set up a bootstrap or SSE run +#' +#' @param .run A `bbi_nmboot_model` or `bbi_nmsse_model` object. +#' @param .run_type Either `"bootstrap"` or `"sse"`. Determines behavior for dataset handling. +#' @param n Number of datasets and model runs to generate. +#' @param sample_size Sample size for each new dataset. Defaults to `NULL`, which +#' matches the length of the original dataset. +#' @param strat_cols Columns to maintain proportion for stratification. +#' @param replace Logical (T/F). If `TRUE`, stratify with replacement. +#' @param seed A numeric seed to set prior to resampling the data; use `NULL` to +#' avoid setting a seed. +#' @param data Custom dataset to use for setup. Defaults to `NULL`. +#' @param sim_col Column denoting the simulation run number. This will be `"nn"`, +#' if using [bbr::add_simulation()], though `"IREP"` is also common (e.g., when +#' using `mrgsolve`). +#' @param .bbi_args Named list passed to `model_summary(orig_mod, .bbi_args)`, +#' where `orig_mod` is the model `.boot_run` is based on. See +#' [print_bbi_args()] for valid options. Defaults to `list(no_grd_file = TRUE, +#' no_shk_file = TRUE)` because [model_summary()] is only called internally to +#' extract the number of records, so those files are irrelevant. Only used if +#' the based on model (the model the analysis is being performed on) has been +#' executed. +#' @param .overwrite Logical (T/F) indicating whether or not to overwrite +#' existing setup. +#' @keywords internal +setup_analysis_run <- function( + .run, + run_type = c("bootstrap", "sse"), + n = 200, + sample_size = NULL, + strat_cols = NULL, + replace = FALSE, + seed = 1234, + data = NULL, + sim_col = NULL, + .bbi_args = list( + no_grd_file = TRUE, + no_shk_file = TRUE + ), + .overwrite = FALSE +){ + run_type <- match.arg(run_type) + checkmate::assert_number(n, lower = 1) + checkmate::assert_number(seed, null.ok = TRUE) + checkmate::assert_logical(.overwrite) + + # Run directory and data directory + run_dir <- get_output_dir(.run, .check_exists = FALSE) + data_dir <- file.path(run_dir, "data") + + # Create or overwrite directories + if(!fs::dir_exists(run_dir) || isTRUE(.overwrite)){ + if(fs::dir_exists(run_dir)) fs::dir_delete(run_dir) + fs::dir_create(run_dir) + fs::dir_create(data_dir) + }else{ + cli::cli_abort( + c( + glue("{run_type} run has already been set up at `{run_dir}`"), + "pass `.overwrite = TRUE` to overwrite" + ) + ) + } + + # New model setup + n_seq <- seq(n) + mod_names <- purrr::map_chr(n_seq, max_char = nchar(n), pad_left) + mod_paths <- file.path(run_dir, mod_names) + orig_mod <- read_model(get_based_on(.run)) + + # Store data within run folder and gitignore & ignore individual model files + f_sep <- .Platform$file.sep + default_ignore <- paste0( + c("*.ctl", "*.mod", "*.yaml", paste0(f_sep, "data"), "OUTPUT"), + collapse = "\n" + ) + ignore_models <- paste0(f_sep, mod_names, collapse = "\n") + ignore_lines <- paste(default_ignore, ignore_models, sep = "\n\n") + writeLines(ignore_lines, file.path(run_dir, ".gitignore")) + + if(is.null(data)){ + if(run_type == "bootstrap"){ + # Overwrite data path in control stream + # - This is not necessary in most cases, but is if overwriting a previous + # run where a starting dataset was provided. The data path must then + # be updated to reflect the original control stream + data_path <- get_data_path(.run, .check_exists = FALSE) + if(!fs::file_exists(data_path)){ + data_path_rel <- get_data_path_from_ctl(orig_mod, normalize = FALSE) + modify_data_path_ctl(.run, data_path_rel) + } + + # Only include subjects that entered the original problem by default + starting_data <- tryCatch({ + nm_data(.run, filter = TRUE) %>% suppressMessages() + }, error = function(cond){ + fs::dir_delete(run_dir) + # If IGNORE/ACCEPT expressions cant be turned into dplyr expressions + cli::cli_div(theme = list(span.code = list(color = "blue"))) + cli::cli_abort( + c( + cond$message, + "i" = "Please check your control stream or provide a starting dataset ({.var data} arg)", + "i" = "You may try {.code setup_bootstrap_run(.run, data = nm_join(mod))}" + ) + ) + }) + + # Check the number of records to ensure the filtering was done correctly + check_nm_data_filter(.run, starting_data, .bbi_args) + }else if(run_type == "sse"){ + # TODO: maybe abort here if we want to require `data` + sim <- add_simulation( + orig_mod, n = n, seed = seed, .bbi_args = .bbi_args, .mode = "local" + ) + starting_data <- nm_join_sim(sim) + } + }else{ + checkmate::assert_data_frame(data) + data_name <- ifelse(run_type == "bootstrap", "boot-data.csv", "sse-data.csv") + + # Get input columns from dataset referenced in based_on model + # - must be from based_on model, as the data path of .boot_run may already + # have been adjusted to point to a new dataset (which wont exist if overwriting) + input_cols <- get_input_columns(orig_mod) + if(!all(input_cols %in% names(data))){ + mod_name <- ifelse(run_type == "bootstrap", ".boot_run", ".sse_run") + missing_cols <- input_cols[!(input_cols %in% names(data))] + missing_txt <- paste(missing_cols, collapse = ", ") + fs::dir_delete(run_dir) + cli::cli_abort( + c( + glue("The following required input columns were not found in the input data: {missing_txt}"), + "Check `nm_data(read_model(get_based_on({mod_name})))` to see expected columns." + ) + ) + } + + # Remove any extra columns + starting_data <- dplyr::select(data, all_of(c(input_cols, sim_col))) + + # Save data to run_dir + data_path_new <- file.path(run_dir, data_name) + readr::write_csv(starting_data, data_path_new, na = ".") + + # Update data path in control stream (adjusting for .mod vs .ctl extension) + data_path_rel <- adjust_data_path_ext( + file.path(basename(run_dir), basename(data_path_new)), + get_model_path(.run), reverse = TRUE + ) + modify_data_path_ctl(.run, data_path_rel) + } + + # Check stratification columns + if(!is.null(strat_cols)){ + if(!all(strat_cols %in% names(starting_data))){ + strat_cols_miss <- strat_cols[!(strat_cols %in% names(starting_data))] + # Clean up files before aborting (leave if .overwrite is TRUE) + if(fs::dir_exists(run_dir)) fs::dir_delete(run_dir) + cli::cli_abort( + "The following `strat_cols` are missing from the input data: {.val {strat_cols_miss}}" + ) + } + } + + # Check simulation column (SSE only) + if(run_type == "sse"){ + if(!is.null(sim_col)){ + if(!(sim_col %in% names(starting_data))){ + if(fs::dir_exists(run_dir)) fs::dir_delete(run_dir) + cli::cli_abort( + "`sim_col` ({.val {sim_col}}) is missing from the input data" + ) + } + + n_sim <- dplyr::n_distinct(starting_data[[sim_col]]) + if(n_sim != n){ + if(fs::dir_exists(run_dir)) fs::dir_delete(run_dir) + cli::cli_abort( + "The number of simulations ({.val {n_sim}}) does not match the provided `n` ({.val {n}})" + ) + } + }else{ + if(fs::dir_exists(run_dir)) fs::dir_delete(run_dir) + cli::cli_abort("sim_col is a required argument for SSE runs") + } + } + + + metadata <- list( + run = .run, + run_type = run_type, + all_mod_names = mod_names, + run_mod_path = get_model_path(.run), + orig_mod_path = get_model_path(orig_mod), + orig_mod_id = get_model_id(orig_mod), + orig_mod_bbi_args = orig_mod$bbi_args, + orig_data = starting_data, + sample_size = sample_size, + strat_cols = strat_cols, + replace = replace, + seed = seed, + sim_col = sim_col, + n_samples = n, + run_dir = run_dir, + data_dir = data_dir, + overwrite = .overwrite + ) + + # Create model object per run + if(!is.null(seed)) withr::local_seed(seed) + run_models <- purrr::map(mod_paths, make_analysis_model, metadata) + make_analysis_spec(run_models, metadata) + + return(invisible(.run)) +} + + +#' Set up a single bootstrap or SSE model run +#' +#' @param mod_path Absolute model path (no file extension) of a model run. +#' @param metadata List of parameters needed to create a model run. +#' +#' @keywords internal +make_analysis_model <- function(mod_path, metadata){ + # Update the user every 100 runs (plus beginning and end) + new_mod_index <- which(basename(mod_path) == metadata$all_mod_names) + if(new_mod_index == 1 || new_mod_index == length(metadata$all_mod_names) || + new_mod_index %% 100 == 0){ + verbose_msg(glue("Sampling run {new_mod_index}/{length(metadata$all_mod_names)}")) + } + + # Copy over control stream + # - Cant use copy_model_from, as we want these individual model runs to be + # regular `bbi_base_model` objects + run_mod_path <- metadata$run_mod_path + mod_path_ext <- paste0(mod_path, ".", fs::path_ext(run_mod_path)) + fs::file_copy( + run_mod_path, mod_path_ext, overwrite = metadata$overwrite + ) + + # Filter to simulation rep for SSE runs + if(metadata$run_type == "sse" && !is.null(metadata$sim_col)){ + sim_col <- metadata$sim_col + irep <- unique(data$nn)[new_mod_index] + data <- metadata$orig_data %>% dplyr::filter(!!rlang::sym(sim_col) == irep) + }else{ + data <- metadata$orig_data + } + + # Sample data and assign new IDs + data_new <- mrgmisc::resample_df( + data, + key_cols = "ID", + strat_cols = metadata$strat_cols, + n = metadata$sample_size, + replace = metadata$replace + ) %>% dplyr::rename("OID" = "ID", "ID" = "KEY") %>% + dplyr::select(all_of(unique(c(names(data), "OID")))) + + mod_name <- basename(mod_path) + orig_mod_id <- metadata$orig_mod_id + + # Write out new dataset + data_run_name <- glue("{mod_name}.csv") + data_path <- file.path(metadata$data_dir, data_run_name) + data.table::fwrite(data_new, data_path , na = '.', quote = FALSE) + + # Set Problem and relative datapath (to be sourced in control stream) + prob <- glue("{metadata$run_type} run {mod_name} of model {orig_mod_id}") + data_path_rel <- fs::path_rel(data_path, metadata$run_dir) %>% + adjust_data_path_ext(mod_path = mod_path_ext, reverse = TRUE) + + # Create new model object + mod <- new_model( + mod_path, + .overwrite = metadata$overwrite, + .tags = paste0(toupper(metadata$run_type), "_RUN"), + .based_on = run_mod_path, + .bbi_args = metadata$orig_mod_bbi_args + + ) + + # Overwrite $PROB and $DATA records + modify_prob_statement(mod, prob) + modify_data_path_ctl(mod, data_path_rel) + + # Update table names if present + if(isTRUE(mod_has_record(mod, "table"))){ + mod <- update_model_id(mod) %>% suppressMessages() + } + + return(mod) +} + + +#' Read in all analysis run model objects +#' @inheritParams get_analysis_spec +#' @keywords internal +get_analysis_models <- function(.run){ + run_dir <- .run[[ABS_MOD_PATH]] + output_dir <- get_output_dir(.run, .check_exists = FALSE) + + run_type <- dplyr::case_when( + .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap run", + .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" + ) + + if(!fs::file_exists(output_dir)){ + verbose_msg( + glue("{run_type} `{get_model_id(.run)}` has not been set up.") + ) + return(invisible(NULL)) + } + + if(analysis_is_cleaned_up(.run)){ + verbose_msg( + glue("{run_type} `{get_model_id(.run)}` has been cleaned up.") + ) + return(invisible(NULL)) + } + + spec <- get_analysis_spec(.run) + model_ids <- fs::path_ext_remove(basename(spec$analysis_runs$mod_path_abs)) + + mods <- tryCatch({ + find_models(.run[[ABS_MOD_PATH]], .recurse = FALSE, .include = model_ids) + }, warning = function(cond){ + if(!stringr::str_detect(cond$message, "All models excluded|Found no valid model")){ + warning(cond) + } + return(NULL) + }) + + + # This shouldnt happen, but could if the directory existed and models + # referenced in the spec file aren't found for any reason _other than_ + # cleaning up the run + if(is.null(mods) || rlang::is_empty(mods)){ + rlang::abort( + c( + glue("At least one {run_type} model does not exist in `{run_dir}`") + ) + ) + }else{ + if(length(model_ids) != length(mods)){ + rlang::warn( + c( + glue("Found an unexpected number of models in {run_dir}"), + glue("Expected number of models: {length(model_ids)}"), + glue("Discovered number of models: {length(mods)}") + ) + ) + } + } + + return(mods) +} + +#' Store bootstrap run details before submission +#' +#' @param run_models List of model objects created by `make_analysis_model()`. +#' @inheritParams make_analysis_model +#' +#' @details +#' This is mainly meant to ensure traceability and enhance the portability of +#' bootstrap "model" objects. +#' +#' +#' @keywords internal +make_analysis_spec <- function(run_models, metadata){ + run_dir <- metadata$run_dir + json_name <- ifelse(metadata$run_type == "bootstrap", "boot", "sse") + json_path <- file.path(run_dir, glue("bbr_{json_name}_spec.json")) + + if(fs::file_exists(json_path) && isFALSE(metadata$overwrite)){ + rlang::abort( + c( + glue("A specification file already exists at `{json_path}`"), + "i" = "Pass `.overwrite = TRUE` to overwrite." + ) + ) + } + + analysis_spec <- list( + problem = glue("{metadata$run_type} of {basename(metadata$orig_mod_path)}"), + strat_cols = metadata$strat_cols, + seed = metadata$seed, + n_samples = metadata$n_samples, + sample_size = metadata$sample_size, + model_path = get_model_path(metadata$run), + based_on_model_path = metadata$orig_mod_path, + based_on_data_path = get_data_path_from_ctl(metadata$run, normalize = FALSE), + model_md5 = tools::md5sum(get_model_path(metadata$run)), + based_on_model_md5 = tools::md5sum(metadata$orig_mod_path), + based_on_data_md5 = tools::md5sum(get_data_path(metadata$run)), + output_dir = metadata$run[[ABS_MOD_PATH]] + ) + + run_ids <- purrr::map_chr(run_models, function(.mod){ + paste0("run_", basename(.mod[[ABS_MOD_PATH]])) + }) + + analysis_runs <- purrr::map(run_models, function(.mod){ + list( + mod_path = get_model_path(.mod) %>% fs::path_rel(run_dir), + yaml_path = get_yaml_path(.mod) %>% fs::path_rel(run_dir) + ) + }) %>% stats::setNames(run_ids) + + spec_lst <- c( + analysis_spec = list(analysis_spec), + analysis_runs = list(analysis_runs) + ) + + spec_lst_json <- jsonlite::toJSON( + spec_lst, pretty = TRUE, simplifyVector = TRUE, null = "null" + ) + writeLines(spec_lst_json, json_path) + return(invisible(json_path)) +} + +# helpers ----------------------------------------------------------------- + + +#' If model has finished, check the number of records to ensure the filtering +#' was done correctly via `nm_data(.mod, filter = TRUE)` +#' @param data a dataset created via `nm_data(.mod. filter = TRUE)` +#' @inheritParams setup_analysis_run +#' @noRd +check_nm_data_filter <- function(.run, data, .bbi_args = NULL){ + run_dir <- get_output_dir(.run, .check_exists = FALSE) + orig_mod <- read_model(get_based_on(.run)) + + # If model has finished, check the number of records to ensure the filtering + # was done correctly + if(check_nonmem_finished(orig_mod)){ + .s <- model_summary(orig_mod, .bbi_args = .bbi_args) + nrec <- .s$run_details$number_of_data_records + nrec_f <- nrow(data) + if(nrec != nrec_f){ + fs::dir_delete(run_dir) + cli::cli_div(theme = list(.code = list(color = "blue"), .val = list(color = "red3"))) + cli::cli_abort( + c( + "!" = "The filtered dataset does not have the same number of records as the original model:", + "*" = "{.code nm_data(.boot_run, filter = TRUE)} returned {.val {nrec_f}} records", + "*" = "{.code model_summary(orig_mod)} returned {.val {nrec}} records", + "i" = "where {.code orig_mod <- read_model(get_based_on(.boot_run))}", + "i" = "Try providing a starting dataset (e.g., {.code setup_bootstrap_run(.boot_run, data = nm_join(orig_mod))})" + ) + ) + } + }else{ + orig_mod_name <- fs::path_rel( + get_model_path(orig_mod), + get_model_working_directory(orig_mod) + ) + cli::cli_div(theme = list(.code = list(color = "blue"), .val = list(color = "red3"))) + cli::cli_warn( + c( + "The parent model ({.code {orig_mod_name}}) has not been submitted", + "i" = "Consider executing {.code {orig_mod_name}} to perform additional checks" + ) + ) + } +} + + +pad_left <- function(x, padding = "0", max_char = 4){ + n_pad <- max_char - nchar(x) + checkmate::assert_true(n_pad >= 0) + val <- if(n_pad >= 1){ + pad <- paste(rep(padding, n_pad), collapse = "") + glue::glue("{pad}{x}") + }else if(n_pad == 0){ + as.character(x) + } + return(val) +} diff --git a/R/bootstrap-model.R b/R/bootstrap-model.R index da7fc6eb7..facd9ad93 100644 --- a/R/bootstrap-model.R +++ b/R/bootstrap-model.R @@ -6,13 +6,7 @@ #' `remove_tables` arguments). The object returned from this must then be passed #' to [setup_bootstrap_run()] before submission (see examples). #' -#' @param .mod A `bbr` model object. -#' @param .suffix A suffix for the bootstrap run directory. Will be prefixed by -#' the model id of `.mod`. -#' @inheritParams copy_model_from -#' @param .inherit_tags If `TRUE`, the default, inherit any tags from `.mod`. -#' @param remove_cov,remove_tables If `TRUE`, the default, remove `$COVARIANCE` -#' and `$TABLE` records respectively, allowing for notably faster run times. +#' @inheritParams new_analysis_run #' #' @seealso [setup_bootstrap_run()] [summarize_bootstrap_run()] #' @examples @@ -38,36 +32,16 @@ new_bootstrap_run <- function( remove_tables = TRUE ){ - check_model_object(.mod, NM_MOD_CLASS) - - model_dir <- get_model_working_directory(.mod) - boot_dir <- glue("{get_model_id(.mod)}-{.suffix}") - - boot_run <- copy_model_from( - .parent_mod = .mod, - .new_model = boot_dir, + new_analysis_run( + .mod, + .suffix = .suffix, + .type = "nmboot", .add_tags = "BOOTSTRAP_SUBMISSION", .inherit_tags = .inherit_tags, - .update_model_file = TRUE, - .overwrite = .overwrite + .overwrite = .overwrite, + remove_cov = remove_cov, + remove_tables = remove_tables ) - - boot_run[[YAML_MOD_TYPE]] <- "nmboot" - boot_run <- save_model_yaml(boot_run) - - # Change problem statement - prob <- glue("Bootstrap run of model {get_model_id(.mod)}") - modify_prob_statement(boot_run, prob) - - # Optionally remove $TABLE and $COV statements here - if(isTRUE(remove_cov)) remove_records(boot_run, type = "covariance") - if(isTRUE(remove_tables)) remove_records(boot_run, type = "table") - - # Update table and estimation record file paths - boot_run <- update_model_id(boot_run) %>% suppressMessages() - - # Return read-in model to get the updated class as part of the model object - return(read_model(file.path(model_dir, boot_dir))) } @@ -82,23 +56,12 @@ new_bootstrap_run <- function( #' #' @param .boot_run A `bbi_nmboot_model` object. #' @param n Number of data sets and model runs to generate. -#' @param strat_cols Columns to maintain proportion for stratification -#' @param seed A numeric seed to set prior to resampling the data; use `NULL` to -#' avoid setting a seed. #' @param data A dataset to resample from. Defaults to `NULL`, which will use #' the _filtered_ output from `nm_data(.boot_run, filter = TRUE)`. If provided, #' must include the same column names as what's returned from `nm_data(.mod)`. -#' @param .bbi_args Named list passed to `model_summary(orig_mod, .bbi_args)`, -#' where `orig_mod` is the model `.boot_run` is based on. See -#' [print_bbi_args()] for valid options. Defaults to `list(no_grd_file = TRUE, -#' no_shk_file = TRUE)` because [model_summary()] is only called internally to -#' extract the number of records, so those files are irrelevant. Only used if -#' the based on model (the model being bootstrapped) has been executed. -#' @param .overwrite Logical (T/F) indicating whether or not to overwrite -#' existing setup for a bootstrap run. +#' @inheritParams setup_analysis_run #' #' @details -#' #' Once you have run this function, you can execute your bootstrap with #' [submit_model()]. You can use [get_model_status()] to check on your submitted #' bootstrap run. Once all models have finished, use [summarize_bootstrap_run()] @@ -144,307 +107,17 @@ setup_bootstrap_run <- function( .overwrite = FALSE ){ check_model_object(.boot_run, NMBOOT_MOD_CLASS) - checkmate::assert_number(n, lower = 1) - checkmate::assert_number(seed, null.ok = TRUE) - checkmate::assert_logical(.overwrite) - - boot_dir <- get_output_dir(.boot_run, .check_exists = FALSE) - boot_data_dir <- file.path(boot_dir, "data") - - # Bootstrap directory setup - if(!fs::dir_exists(boot_dir) || isTRUE(.overwrite)){ - if(fs::dir_exists(boot_dir)) fs::dir_delete(boot_dir) - fs::dir_create(boot_dir) - fs::dir_create(boot_data_dir) - - # New model setup - n_seq <- seq(n) - mod_names <- purrr::map_chr(n_seq, max_char = nchar(n), pad_left) - mod_paths <- file.path(boot_dir, mod_names) - orig_mod <- read_model(get_based_on(.boot_run)) - - # Store data within run folder and gitignore & ignore individual model files - f_sep <- .Platform$file.sep - default_ignore <- paste0( - c("*.ctl", "*.mod", "*.yaml", paste0(f_sep, "data"), "OUTPUT"), - collapse = "\n" - ) - ignore_models <- paste0(f_sep, mod_names, collapse = "\n") - ignore_lines <- paste(default_ignore, ignore_models, sep = "\n\n") - writeLines(ignore_lines, file.path(boot_dir, ".gitignore")) - - if(is.null(data)){ - # Overwrite data path in control stream - # - This is not necessary in most cases, but is if overwriting a previous - # run where a starting dataset was provided. The data path must then - # be updated to reflect the original control stream - data_path <- get_data_path(.boot_run, .check_exists = FALSE) - if(!fs::file_exists(data_path)){ - data_path_rel <- get_data_path_from_ctl(orig_mod, normalize = FALSE) - modify_data_path_ctl(.boot_run, data_path_rel) - } - - # Only include subjects that entered the original problem by default - starting_data <- tryCatch({ - nm_data(.boot_run, filter = TRUE) %>% suppressMessages() - }, error = function(cond){ - fs::dir_delete(boot_dir) - # If IGNORE/ACCEPT expressions cant be turned into dplyr expressions - cli::cli_div(theme = list(span.code = list(color = "blue"))) - cli::cli_abort( - c( - cond$message, - "i" = "Please check your control stream or provide a starting dataset ({.var data} arg)", - "i" = "You may try {.code setup_bootstrap_run(.boot_run, data = nm_join(mod))}" - ) - ) - }) - - # If model has finished, check the number of records to ensure the filtering - # was done correctly - if(check_nonmem_finished(orig_mod)){ - .s <- model_summary(orig_mod, .bbi_args = .bbi_args) - nrec <- .s$run_details$number_of_data_records - nrec_f <- nrow(starting_data) - if(nrec != nrec_f){ - fs::dir_delete(boot_dir) - cli::cli_div(theme = list(.code = list(color = "blue"), .val = list(color = "red3"))) - cli::cli_abort( - c( - "!" = "The filtered dataset does not have the same number of records as the original model:", - "*" = "{.code nm_data(.boot_run, filter = TRUE)} returned {.val {nrec_f}} records", - "*" = "{.code model_summary(orig_mod)} returned {.val {nrec}} records", - "i" = "where {.code orig_mod <- read_model(get_based_on(.boot_run))}", - "i" = "Try providing a starting dataset (e.g., {.code setup_bootstrap_run(.boot_run, data = nm_join(orig_mod))})" - ) - ) - } - }else{ - orig_mod_name <- fs::path_rel( - get_model_path(orig_mod), - get_model_working_directory(orig_mod) - ) - cli::cli_div(theme = list(.code = list(color = "blue"), .val = list(color = "red3"))) - cli::cli_warn( - c( - "The parent model ({.code {orig_mod_name}}) has not been submitted", - "i" = "Consider executing {.code {orig_mod_name}} to perform additional checks" - ) - ) - } - }else{ - checkmate::assert_data_frame(data) - # Get input columns from dataset referenced in based_on model - # - must be from based_on model, as the data path of .boot_run may already - # have been adjusted to point to a new dataset (which wont exist if overwriting) - input_cols <- get_input_columns(orig_mod) - if(!all(input_cols %in% names(data))){ - missing_cols <- input_cols[!(input_cols %in% names(data))] - missing_txt <- paste(missing_cols, collapse = ", ") - fs::dir_delete(boot_dir) - rlang::abort( - c( - glue("The following required input columns were not found in the input data: {missing_txt}"), - "Check `nm_data(read_model(get_based_on(.boot_run)))` to see expected columns." - ) - ) - } - - # Remove any extra columns - starting_data <- dplyr::select(data, all_of(input_cols)) - - # Save data to boot_dir - data_path_new <- file.path(boot_dir, "boot-data.csv") - readr::write_csv(starting_data, data_path_new, na = ".") - - # Update data path in control stream (adjusting for .mod vs .ctl extension) - data_path_rel <- adjust_data_path_ext( - file.path(basename(boot_dir), basename(data_path_new)), - get_model_path(.boot_run), reverse = TRUE - ) - modify_data_path_ctl(.boot_run, data_path_rel) - } - - if(!is.null(strat_cols)){ - if(!all(strat_cols %in% names(starting_data))){ - strat_cols_miss <- strat_cols[!(strat_cols %in% names(starting_data))] - strat_cols_txt <- paste(strat_cols_miss, collapse = ", ") - # Clean up files before aborting (leave if .overwrite is TRUE) - if(fs::dir_exists(boot_dir)) fs::dir_delete(boot_dir) - rlang::abort( - glue("The following `strat_cols` are missing from the input data: {strat_cols_txt}") - ) - } - } - - boot_args <- list( - boot_run = .boot_run, - all_mod_names = mod_names, - boot_mod_path = get_model_path(.boot_run), - orig_mod_path = get_model_path(orig_mod), - orig_mod_id = get_model_id(orig_mod), - orig_mod_bbi_args = orig_mod$bbi_args, - orig_data = starting_data, - strat_cols = strat_cols, - seed = seed, - n_samples = n, - boot_dir = boot_dir, - boot_data_dir = boot_data_dir, - overwrite = .overwrite - ) - - # Create model object per boot run - if(!is.null(seed)) withr::local_seed(seed) - boot_models <- purrr::map(mod_paths, make_boot_run, boot_args) - make_boot_spec(boot_models, boot_args) - # Garbage collect - may help after handling many (potentially large) datasets - # - It can be useful to call gc() after a large object has been removed, as - # this may prompt R to return memory to the operating system. - gc() - }else{ - rlang::abort( - c( - glue("Bootstrap run has already been set up at `{boot_dir}`"), - "pass `.overwrite = TRUE` to overwrite" - ) - ) - } + .boot_run <- setup_analysis_run( + .boot_run, run_type = "bootstrap", n = n, + sample_size = NULL, replace = TRUE, + strat_cols = strat_cols, seed = seed, data = data, + .bbi_args = .bbi_args, .overwrite = .overwrite + ) return(invisible(.boot_run)) } -#' Set up a single bootstrap model run -#' -#' @param mod_path Absolute model path (no file extension) of a bootstrap model run. -#' @param boot_args List of parameters needed to create a bootstrap model run. -#' -#' @keywords internal -make_boot_run <- function(mod_path, boot_args){ - - # Update the user every 100 runs (plus beginning and end) - new_mod_index <- which(basename(mod_path) == boot_args$all_mod_names) - if(new_mod_index == 1 || new_mod_index == length(boot_args$all_mod_names) || - new_mod_index %% 100 == 0){ - verbose_msg(glue("Sampling run {new_mod_index}/{length(boot_args$all_mod_names)}")) - } - - # Copy over control stream - # - Cant use copy_model_from, as we want these individual model runs to be - # regular `bbi_base_model` objects - boot_mod_path <- boot_args$boot_mod_path - mod_path_ext <- paste0(mod_path, ".", fs::path_ext(boot_mod_path)) - fs::file_copy( - boot_mod_path, mod_path_ext, overwrite = boot_args$overwrite - ) - - - # Sample data and assign new IDs - data_new <- mrgmisc::resample_df( - boot_args$orig_data, - key_cols = "ID", # TODO: should this be a user arg? - strat_cols = boot_args$strat_cols, - replace = TRUE - ) %>% dplyr::rename("OID" = "ID", "ID" = "KEY") %>% # TODO: should this be a user arg? - dplyr::select(all_of(unique(c(names(boot_args$orig_data), "OID")))) - - mod_name <- basename(mod_path) - orig_mod_id <- boot_args$orig_mod_id - - # Write out new dataset - data_boot_name <- glue("{mod_name}.csv") - data_path_boot <- file.path(boot_args$boot_data_dir, data_boot_name) - data.table::fwrite(data_new, data_path_boot , na = '.', quote = FALSE) - - # Set Problem and relative datapath (to be sourced in control stream) - prob <- glue("Bootstrap run {mod_name} of model {orig_mod_id}") - data_path_rel <- fs::path_rel(data_path_boot, boot_args$boot_dir) %>% - adjust_data_path_ext(mod_path = mod_path_ext, reverse = TRUE) - - # Create new model object - mod <- new_model( - mod_path, - .overwrite = boot_args$overwrite, - .tags = "BOOTSTRAP_RUN", - .based_on = boot_mod_path, - .bbi_args = boot_args$orig_mod_bbi_args - - ) - - # Overwrite $PROB and $DATA records - modify_prob_statement(mod, prob) - modify_data_path_ctl(mod, data_path_rel) - - # Update table names if present - if(isTRUE(mod_has_record(mod, "table"))){ - mod <- update_model_id(mod) %>% suppressMessages() - } - - return(mod) -} - - -#' Store bootstrap run details before submission -#' -#' @param boot_models List of boostrap model objects created by `make_boot_run()`. -#' @inheritParams make_boot_run -#' -#' @details -#' This is mainly meant to ensure traceability and enhance the portability of -#' bootstrap "model" objects. -#' -#' -#' @keywords internal -make_boot_spec <- function(boot_models, boot_args){ - boot_dir <- boot_args$boot_dir - json_path <- file.path(boot_dir, "bbr_boot_spec.json") - - if(fs::file_exists(json_path) && isFALSE(boot_args$overwrite)){ - rlang::abort( - c( - glue("A bootstrap specification file already exists at `{json_path}`"), - "i" = "Pass `.overwrite = TRUE` to overwrite." - ) - ) - } - - overall_boot_spec <- list( - problem = glue("Bootstrap of {basename(boot_args$orig_mod_path)}"), - strat_cols = boot_args$strat_cols, - seed = boot_args$seed, - n_samples = boot_args$n_samples, - model_path = get_model_path(boot_args$boot_run), - based_on_model_path = boot_args$orig_mod_path, - based_on_data_path = get_data_path_from_ctl(boot_args$boot_run, normalize = FALSE), - model_md5 = tools::md5sum(get_model_path(boot_args$boot_run)), - based_on_model_md5 = tools::md5sum(boot_args$orig_mod_path), - based_on_data_md5 = tools::md5sum(get_data_path(boot_args$boot_run)), - output_dir = boot_args$boot_run[[ABS_MOD_PATH]] - ) - - boot_run_ids <- purrr::map_chr(boot_models, function(boot_run){ - paste0("run_", basename(boot_run[[ABS_MOD_PATH]])) - }) - - boot_run_spec <- purrr::map(boot_models, function(boot_run){ - list( - mod_path = get_model_path(boot_run) %>% fs::path_rel(boot_dir), - yaml_path = get_yaml_path(boot_run) %>% fs::path_rel(boot_dir) - ) - }) %>% stats::setNames(boot_run_ids) - - spec_lst <- c( - bootstrap_spec = list(overall_boot_spec), - bootstrap_runs = list(boot_run_spec) - ) - - spec_lst_json <- jsonlite::toJSON( - spec_lst, pretty = TRUE, simplifyVector = TRUE, null = "null" - ) - writeLines(spec_lst_json, json_path) - return(invisible(json_path)) -} - #' Summarize a bootstrap run #' @@ -586,13 +259,13 @@ summarize_bootstrap_run <- function( spec_path <- get_spec_path(.boot_run) boot_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - boot_spec$bootstrap_spec$bbi_version <- config_lst$bbi_version - boot_spec$bootstrap_spec$configuration <- config_lst$configuration + boot_spec$analysis_spec$bbi_version <- config_lst$bbi_version + boot_spec$analysis_spec$configuration <- config_lst$configuration spec_lst_json <- jsonlite::toJSON(boot_spec, pretty = TRUE, simplifyVector = TRUE) writeLines(spec_lst_json, spec_path) # Create summary object to save to RDS - boot_spec <- get_boot_spec(.boot_run) + boot_spec <- get_analysis_spec(.boot_run) boot_sum <- c( list2(!!ABS_MOD_PATH := boot_dir), list( @@ -691,7 +364,7 @@ bootstrap_estimates <- function( bootstrap_can_be_summarized <- function(.boot_run){ # Check that runs can still be summarized (e.g, after cleanup) - cleaned_up <- bootstrap_is_cleaned_up(.boot_run) + cleaned_up <- analysis_is_cleaned_up(.boot_run) if(isTRUE(cleaned_up)){ rlang::abort( paste( @@ -715,7 +388,7 @@ bootstrap_can_be_summarized <- function(.boot_run){ #' @describeIn summarize_bootstrap Read in all bootstrap run model objects -#' @inheritParams get_boot_spec +#' @inheritParams get_analysis_spec #' @export get_boot_models <- function(.boot_run){ check_model_object(.boot_run, c(NMBOOT_MOD_CLASS, NMBOOT_SUM_CLASS)) @@ -723,57 +396,7 @@ get_boot_models <- function(.boot_run){ .boot_run <- read_model(.boot_run[[ABS_MOD_PATH]]) } - boot_dir <- .boot_run[[ABS_MOD_PATH]] - output_dir <- get_output_dir(.boot_run, .check_exists = FALSE) - if(!fs::file_exists(output_dir)){ - verbose_msg( - glue("Bootstrap run `{get_model_id(.boot_run)}` has not been set up.") - ) - return(invisible(NULL)) - } - - if(bootstrap_is_cleaned_up(.boot_run)){ - verbose_msg( - glue("Bootstrap run `{get_model_id(.boot_run)}` has been cleaned up.") - ) - return(invisible(NULL)) - } - - boot_spec <- get_boot_spec(.boot_run) - boot_model_ids <- fs::path_ext_remove(basename(boot_spec$bootstrap_runs$mod_path_abs)) - - boot_models <- tryCatch({ - find_models(.boot_run[[ABS_MOD_PATH]], .recurse = FALSE, .include = boot_model_ids) - }, warning = function(cond){ - if(!stringr::str_detect(cond$message, "All models excluded|Found no valid model")){ - warning(cond) - } - return(NULL) - }) - - - # This shouldnt happen, but could if the directory existed and models - # referenced in the spec file aren't found for any reason _other than_ - # cleaning up the run - if(is.null(boot_models) || rlang::is_empty(boot_models)){ - rlang::abort( - c( - glue("At least one bootstrap run model does not exist in `{boot_dir}`") - ) - ) - }else{ - if(length(boot_model_ids) != length(boot_models)){ - rlang::warn( - c( - glue("Found an unexpected number of models in {boot_dir}"), - glue("Expected number of models: {length(boot_model_ids)}"), - glue("Discovered number of models: {length(boot_models)}") - ) - ) - } - } - - return(boot_models) + get_analysis_models(.boot_run) } @@ -827,7 +450,7 @@ cleanup_bootstrap_run <- function(.boot_run, .force = FALSE){ ) } - if(bootstrap_is_cleaned_up(.boot_run)){ + if(analysis_is_cleaned_up(.boot_run)){ rlang::abort("Bootstrap run has already been cleaned up") } @@ -835,11 +458,11 @@ cleanup_bootstrap_run <- function(.boot_run, .force = FALSE){ spec_path <- get_spec_path(.boot_run) boot_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) # Set cleaned up - impacts status checking - boot_spec$bootstrap_spec$cleaned_up <- TRUE + boot_spec$analysis_spec$cleaned_up <- TRUE # Delete individual run specs # - dont need to store this information anymore since we wont be reading in # individual models anymore - boot_spec$bootstrap_runs <- NULL + boot_spec$analysis_runs <- NULL spec_lst_json <- jsonlite::toJSON(boot_spec, pretty = TRUE, simplifyVector = TRUE) # Delete individual model files @@ -854,16 +477,3 @@ cleanup_bootstrap_run <- function(.boot_run, .force = FALSE){ } } - - -pad_left <- function(x, padding = "0", max_char = 4){ - n_pad <- max_char - nchar(x) - checkmate::assert_true(n_pad >= 0) - val <- if(n_pad >= 1){ - pad <- paste(rep(padding, n_pad), collapse = "") - glue::glue("{pad}{x}") - }else if(n_pad == 0){ - as.character(x) - } - return(val) -} diff --git a/R/check-up-to-date.R b/R/check-up-to-date.R index df1efc58a..02cb45839 100644 --- a/R/check-up-to-date.R +++ b/R/check-up-to-date.R @@ -84,7 +84,7 @@ check_up_to_date.bbi_nmboot_model <- function(.bbi_object, ...) { rlang::abort(paste(glue("Model {get_model_id(.bbi_object)}:"), CHECK_UP_TO_DATE_ERR_MSG)) } - boot_spec <- get_boot_spec(.bbi_object) + boot_spec <- get_analysis_spec(.bbi_object) # check necessary files for changes model_file <- get_model_path(.bbi_object) diff --git a/R/config-log.R b/R/config-log.R index 9ff7540f7..990a8b2ac 100644 --- a/R/config-log.R +++ b/R/config-log.R @@ -184,7 +184,7 @@ config_log_make_entry.bbi_nonmem_model <- function(.mod, config, fields = NULL) #' @export config_log_make_entry.bbi_nmboot_model <- function(.mod, config, fields = NULL) { # Make data names consistent with other models in config_log (path and md5) - boot_config <- config$bootstrap_spec + boot_config <- config$analysis_spec boot_config[[CONFIG_DATA_PATH]] <- boot_config[["based_on_data_path"]] boot_config[["data_md5"]] <- boot_config[["based_on_data_md5"]] # bbi and nonmem versions will be NULL until the run has been summarized diff --git a/R/get-path-from-object.R b/R/get-path-from-object.R index 9d5605d65..f2919e46f 100644 --- a/R/get-path-from-object.R +++ b/R/get-path-from-object.R @@ -122,6 +122,10 @@ get_config_path.bbi_nmboot_model <- function(.bbi_object, .check_exists = TRUE) get_spec_path(.bbi_object, .check_exists = .check_exists) } +#' @export +get_config_path.bbi_nmsse_model <- function(.bbi_object, .check_exists = TRUE) { + get_spec_path(.bbi_object, .check_exists = .check_exists) +} #' Get the relevant specification file path #' @@ -156,6 +160,22 @@ get_spec_path.bbi_nmboot_model <- function(.mod, .check_exists = TRUE) { return(.path) } +#' @describeIn get_spec_path Get the SSE specification file path from a +#' `bbi_nmsse_model` object +#' @keywords internal +get_spec_path.bbi_nmsse_model <- function(.mod, .check_exists = TRUE) { + # Spec file saved to modeling directory of sse run + .path <- file.path( + get_output_dir(.mod, .check_exists = .check_exists), + "bbr_sse_spec.json") + + if (isTRUE(.check_exists)) { + checkmate::assert_file_exists(.path) + } + + return(.path) +} + #' @describeIn get_spec_path Get the simulation specification file path from a #' `bbi_nmsim_model` or `bbi_nonmem_model` object @@ -183,6 +203,7 @@ get_spec_path.bbi_base_model <- function(.mod, .check_exists = TRUE) { # Register private S3 methods for development purposes .S3method("get_spec_path", "bbi_nmboot_model", get_spec_path.bbi_nmboot_model) +.S3method("get_spec_path", "bbi_nmsse_model", get_spec_path.bbi_nmsse_model) .S3method("get_spec_path", "bbi_base_model", get_spec_path.bbi_base_model) #' Get model identifier @@ -292,6 +313,30 @@ get_data_path.bbi_nmboot_model <- function( return(data_path) } +#' @export +get_data_path.bbi_nmsse_model <- function( + .bbi_object, + .check_exists = TRUE, + ... +){ + # nmsse models do not have a config file, so we can only extract from the + # $DATA record in a control stream file + data_path <- get_data_path_from_ctl(.bbi_object) + + if(isTRUE(.check_exists)){ + if(!fs::file_exists(data_path)){ + rlang::abort( + c( + "x" = "Input data file does not exist or cannot be opened", + "i" = glue("Referenced input data path: {data_path}") + ) + ) + } + } + + return(data_path) +} + #' @export get_data_path.bbi_nmsim_model <- function( .bbi_object, @@ -385,7 +430,7 @@ get_data_path_nonmem <- function( #' Get the data path from a control stream file #' @noRd get_data_path_from_ctl <- function(.mod, normalize = TRUE){ - check_model_object(.mod, c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSIM_MOD_CLASS)) + check_model_object(.mod, c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMSIM_MOD_CLASS)) mod_path <- get_model_path(.mod) ctl <- nmrec::read_ctl(mod_path) @@ -717,43 +762,45 @@ find_nonmem_model_file_path <- function(.path, .check_exists = TRUE) { } -#' Read in and format the bootstrap specification file. +#' Read in and format an analysis specification file, such as for bootstraps or +#' SSE. #' -#' Tabulates all relevant `bbi_nonmem_model` model files from a bootstrap -#' specification file. -#' @param .boot_run Either a `bbi_nmboot_model` or `bbi_nmboot_summary` object +#' Tabulates analysis metadata and all relevant `bbi_nonmem_model` model files +#' from an analysis specification file. +#' @param .run An analysis run (`bbi_nmboot_model`, `bbi_nmsse_model`) or +#' analysis run summary (`bbi_nmboot_summary`) object. #' @returns a list #' @keywords internal -get_boot_spec <- function(.boot_run){ - check_model_object(.boot_run, c(NMBOOT_MOD_CLASS, NMBOOT_SUM_CLASS)) - if(inherits(.boot_run, NMBOOT_SUM_CLASS)){ - .boot_run <- read_model(.boot_run[[ABS_MOD_PATH]]) +get_analysis_spec <- function(.run){ + check_model_object(.run, c(NMBOOT_MOD_CLASS, NMBOOT_SUM_CLASS, NMSSE_MOD_CLASS)) + if(inherits(.run, NMBOOT_SUM_CLASS)){ + .run <- read_model(.run[[ABS_MOD_PATH]]) } - spec_path <- get_spec_path(.boot_run, .check_exists = FALSE) + spec_path <- get_spec_path(.run, .check_exists = FALSE) if(!fs::file_exists(spec_path)) return(NULL) - boot_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - boot_dir <- .boot_run[[ABS_MOD_PATH]] + analysis_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) + run_dir <- .run[[ABS_MOD_PATH]] - # Format individual bootstrap model runs if not cleaned up - if(!is.null(boot_spec$bootstrap_runs)){ - boot_runs <- boot_spec$bootstrap_runs + # Format individual analysis model runs if not cleaned up + if(!is.null(analysis_spec$analysis_runs)){ + analysis_runs <- analysis_spec$analysis_runs - boot_mod_files <- data.frame( - matrix(unlist(boot_runs), nrow=length(boot_runs), byrow = TRUE), + analysis_mod_files <- data.frame( + matrix(unlist(analysis_runs), nrow=length(analysis_runs), byrow = TRUE), stringsAsFactors = FALSE - ) %>% stats::setNames(names(boot_runs[[1]])) %>% + ) %>% stats::setNames(names(analysis_runs[[1]])) %>% tibble::as_tibble() - spec_df <- boot_mod_files %>% dplyr::mutate( - run = names(boot_runs), - mod_path_abs = file.path(boot_dir, fs::path_ext_remove(.data$mod_path)) + spec_df <- analysis_mod_files %>% dplyr::mutate( + run = names(analysis_runs), + mod_path_abs = file.path(run_dir, fs::path_ext_remove(.data$mod_path)) ) %>% dplyr::relocate("run") - spec <- c(boot_spec$bootstrap_spec, list(bootstrap_runs = spec_df)) + spec <- c(analysis_spec$analysis_spec, list(analysis_runs = spec_df)) }else{ - spec <- boot_spec$bootstrap_spec + spec <- analysis_spec$analysis_spec } return(spec) diff --git a/R/model-status.R b/R/model-status.R index 7144d80b7..5fcc3835a 100644 --- a/R/model-status.R +++ b/R/model-status.R @@ -50,7 +50,7 @@ bbi_nonmem_model_status.bbi_nmboot_model <- function(.mod) { status <- "Not Run" output_dir <- get_output_dir(.mod, .check_exists = FALSE) if (dir.exists(output_dir)) { - cleaned_up <- bootstrap_is_cleaned_up(.mod) + cleaned_up <- analysis_is_cleaned_up(.mod) if (isTRUE(cleaned_up)) { status <- "Finished Running" } else { @@ -62,8 +62,8 @@ bbi_nonmem_model_status.bbi_nmboot_model <- function(.mod) { if (!fs::file_exists(spec_path)) { status <- "Not Run" }else{ - boot_spec <- get_boot_spec(.mod) - for(output_dir.i in boot_spec$bootstrap_runs$mod_path_abs){ + boot_spec <- get_analysis_spec(.mod) + for(output_dir.i in boot_spec$analysis_runs$mod_path_abs){ if (dir.exists(output_dir.i)) { # Exit early as incomplete if any model cannot be read in for any reason boot_m <- tryCatch({read_model(output_dir.i)}, error = function(e) NULL) @@ -113,21 +113,25 @@ model_is_finished <- function(.mod){ #' Check if bootstrap run has been cleaned up -#' @param .boot_run Either a `bbi_nmboot_model` or `bbi_nmboot_summary` object +#' @param .run An analysis run (`bbi_nmboot_model`, `bbi_nmsse_model`) or +#' analysis run summary (`bbi_nmboot_summary`, `bbi_nmsse_summary`) object #' @noRd -bootstrap_is_cleaned_up <- function(.boot_run){ - check_model_object(.boot_run, c(NMBOOT_MOD_CLASS, NMBOOT_SUM_CLASS)) - if(inherits(.boot_run, NMBOOT_SUM_CLASS)){ - .boot_run <- read_model(.boot_run[[ABS_MOD_PATH]]) +analysis_is_cleaned_up <- function(.run){ + check_model_object( + .run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMBOOT_SUM_CLASS, NMSSE_SUM_CLASS) + ) + + if(inherits(.run, c(NMBOOT_SUM_CLASS, NMSSE_SUM_CLASS))){ + .run <- read_model(.run[[ABS_MOD_PATH]]) } - output_dir <- get_output_dir(.boot_run, .check_exists = FALSE) + output_dir <- get_output_dir(.run, .check_exists = FALSE) if(!fs::file_exists(output_dir)) return(FALSE) - spec_path <- get_spec_path(.boot_run, .check_exists = FALSE) + spec_path <- get_spec_path(.run, .check_exists = FALSE) if(!fs::file_exists(spec_path)) return(FALSE) - boot_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - cleaned_up <- boot_spec$bootstrap_spec$cleaned_up + spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) + cleaned_up <- spec$analysis_spec$cleaned_up if(!is.null(cleaned_up) && isTRUE(cleaned_up)){ return(TRUE) }else{ diff --git a/R/modify-records.R b/R/modify-records.R index 25900a91a..c4ee85690 100644 --- a/R/modify-records.R +++ b/R/modify-records.R @@ -54,7 +54,7 @@ NULL #' `nmrec` #' @keywords internal get_model_ctl <- function(.mod){ - check_model_object(.mod, c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSIM_MOD_CLASS)) + check_model_object(.mod, c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMSIM_MOD_CLASS)) mod_path <- get_model_path(.mod) ctl <- nmrec::read_ctl(mod_path) return(ctl) diff --git a/R/print.R b/R/print.R index a20332473..86f0de3bb 100644 --- a/R/print.R +++ b/R/print.R @@ -189,7 +189,7 @@ print.bbi_model <- function(x, ...) { if (inherits(x, NMBOOT_MOD_CLASS)) { heading('Bootstrap Args') - boot_spec <- get_boot_spec(x) + boot_spec <- get_analysis_spec(x) # Spec file doesnt exist until bootstrap run is set up via setup_bootstrap_run if(!is.null(boot_spec)){ boot_args <- boot_spec[SPEC_NMBOOT_KEYS] @@ -199,7 +199,27 @@ print.bbi_model <- function(x, ...) { iwalk(boot_args, ~ bullet_list(paste0(.y, ": ", col_blue(paste(.x, collapse = ", "))))) # Add bullet if cleaned up - if(isTRUE(bootstrap_is_cleaned_up(x))){ + if(isTRUE(analysis_is_cleaned_up(x))){ + cli::cat_bullet(paste("Cleaned up:", col_green(TRUE))) + } + }else{ + bullet_list(cli::col_red("Not set up")) + } + } + + if (inherits(x, NMSSE_MOD_CLASS)) { + heading('SSE Args') + sse_spec <- get_analysis_spec(x) + # Spec file doesnt exist until sse run is set up via setup_sse_run + if(!is.null(sse_spec)){ + sse_args <- sse_spec[SPEC_NMSSE_KEYS] + names(sse_args) <- c("Number of runs", "Sample Size", "Stratification Columns") + # strat_cols can be NULL + sse_args[sapply(sse_args, is.null)] <- NA + iwalk(sse_args, + ~ bullet_list(paste0(.y, ": ", col_blue(paste(.x, collapse = ", "))))) + # Add bullet if cleaned up + if(isTRUE(analysis_is_cleaned_up(x))){ cli::cat_bullet(paste("Cleaned up:", col_green(TRUE))) } }else{ @@ -369,7 +389,7 @@ print.bbi_nmboot_summary <- function(x, .digits = 3, .nrow = 10, ...) { iwalk(run_specs, ~ cat_bullet(paste0(.y, ": ", col_blue(.x)))) # Add bullet if cleaned up - if(isTRUE(bootstrap_is_cleaned_up(x))){ + if(isTRUE(analysis_is_cleaned_up(x))){ cli::cat_bullet(paste("Cleaned up:", col_green(TRUE))) } @@ -561,6 +581,8 @@ color_model_type.bbi_base_model <- function(.mod, msg = NULL){ model_type <- cli::col_br_magenta(paste("Simulation", msg)) } else if (model_type == "nmboot"){ model_type <- cli::col_yellow(paste("Bootstrap Run", msg)) + } else if (model_type == "nmsse"){ + model_type <- cli::col_yellow(paste("SSE Run", msg)) } else { # For bbr.bayes or other bbi_base_models not defined within bbr # - Other packages may implement separate methods rather than relying diff --git a/R/submit-model.R b/R/submit-model.R index a871b1818..845c61e6c 100644 --- a/R/submit-model.R +++ b/R/submit-model.R @@ -184,7 +184,7 @@ submit_model.bbi_nmboot_model <- function( } boot_models <- get_boot_models(.mod) - cleaned_up <- bootstrap_is_cleaned_up(.mod) + cleaned_up <- analysis_is_cleaned_up(.mod) if (!isTRUE(.dry_run)) { outdirs <- purrr::map_chr(boot_models, ~ get_output_dir(.x, .check_exists = FALSE)) diff --git a/man/get_analysis_models.Rd b/man/get_analysis_models.Rd new file mode 100644 index 000000000..d5fa3174a --- /dev/null +++ b/man/get_analysis_models.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{get_analysis_models} +\alias{get_analysis_models} +\title{Read in all analysis run model objects} +\usage{ +get_analysis_models(.run) +} +\arguments{ +\item{.run}{An analysis run (\code{bbi_nmboot_model}, \code{bbi_nmsse_model}) or +analysis run summary (\code{bbi_nmboot_summary}) object.} +} +\description{ +Read in all analysis run model objects +} +\keyword{internal} diff --git a/man/get_analysis_spec.Rd b/man/get_analysis_spec.Rd new file mode 100644 index 000000000..bd3279d07 --- /dev/null +++ b/man/get_analysis_spec.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get-path-from-object.R +\name{get_analysis_spec} +\alias{get_analysis_spec} +\title{Read in and format an analysis specification file, such as for bootstraps or +SSE.} +\usage{ +get_analysis_spec(.run) +} +\arguments{ +\item{.run}{An analysis run (\code{bbi_nmboot_model}, \code{bbi_nmsse_model}) or +analysis run summary (\code{bbi_nmboot_summary}) object.} +} +\value{ +a list +} +\description{ +Tabulates analysis metadata and all relevant \code{bbi_nonmem_model} model files +from an analysis specification file. +} +\keyword{internal} diff --git a/man/get_boot_spec.Rd b/man/get_boot_spec.Rd deleted file mode 100644 index a0f2c31f7..000000000 --- a/man/get_boot_spec.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get-path-from-object.R -\name{get_boot_spec} -\alias{get_boot_spec} -\title{Read in and format the bootstrap specification file.} -\usage{ -get_boot_spec(.boot_run) -} -\arguments{ -\item{.boot_run}{Either a \code{bbi_nmboot_model} or \code{bbi_nmboot_summary} object} -} -\value{ -a list -} -\description{ -Tabulates all relevant \code{bbi_nonmem_model} model files from a bootstrap -specification file. -} -\keyword{internal} diff --git a/man/get_spec_path.Rd b/man/get_spec_path.Rd index f9eb8ec29..0981f95f4 100644 --- a/man/get_spec_path.Rd +++ b/man/get_spec_path.Rd @@ -3,6 +3,7 @@ \name{get_spec_path} \alias{get_spec_path} \alias{get_spec_path.bbi_nmboot_model} +\alias{get_spec_path.bbi_nmsse_model} \alias{get_spec_path.bbi_base_model} \title{Get the relevant specification file path} \usage{ @@ -10,6 +11,8 @@ get_spec_path(.mod, .check_exists = TRUE) \method{get_spec_path}{bbi_nmboot_model}(.mod, .check_exists = TRUE) +\method{get_spec_path}{bbi_nmsse_model}(.mod, .check_exists = TRUE) + \method{get_spec_path}{bbi_base_model}(.mod, .check_exists = TRUE) } \arguments{ @@ -31,6 +34,9 @@ object. \item \code{get_spec_path(bbi_nmboot_model)}: Get the bootstrap specification file path from a \code{bbi_nmboot_model} object +\item \code{get_spec_path(bbi_nmsse_model)}: Get the SSE specification file path from a +\code{bbi_nmsse_model} object + \item \code{get_spec_path(bbi_base_model)}: Get the simulation specification file path from a \code{bbi_nmsim_model} or \code{bbi_nonmem_model} object diff --git a/man/make_analysis_model.Rd b/man/make_analysis_model.Rd new file mode 100644 index 000000000..bb6576f9f --- /dev/null +++ b/man/make_analysis_model.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{make_analysis_model} +\alias{make_analysis_model} +\title{Set up a single bootstrap or SSE model run} +\usage{ +make_analysis_model(mod_path, metadata) +} +\arguments{ +\item{mod_path}{Absolute model path (no file extension) of a model run.} + +\item{metadata}{List of parameters needed to create a model run.} +} +\description{ +Set up a single bootstrap or SSE model run +} +\keyword{internal} diff --git a/man/make_boot_spec.Rd b/man/make_analysis_spec.Rd similarity index 51% rename from man/make_boot_spec.Rd rename to man/make_analysis_spec.Rd index ee3a56289..071576743 100644 --- a/man/make_boot_spec.Rd +++ b/man/make_analysis_spec.Rd @@ -1,15 +1,15 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bootstrap-model.R -\name{make_boot_spec} -\alias{make_boot_spec} +% Please edit documentation in R/analysis-run-utils.R +\name{make_analysis_spec} +\alias{make_analysis_spec} \title{Store bootstrap run details before submission} \usage{ -make_boot_spec(boot_models, boot_args) +make_analysis_spec(run_models, metadata) } \arguments{ -\item{boot_models}{List of boostrap model objects created by \code{make_boot_run()}.} +\item{run_models}{List of model objects created by \code{make_analysis_model()}.} -\item{boot_args}{List of parameters needed to create a bootstrap model run.} +\item{metadata}{List of parameters needed to create a model run.} } \description{ Store bootstrap run details before submission diff --git a/man/make_boot_run.Rd b/man/make_boot_run.Rd deleted file mode 100644 index 612218607..000000000 --- a/man/make_boot_run.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/bootstrap-model.R -\name{make_boot_run} -\alias{make_boot_run} -\title{Set up a single bootstrap model run} -\usage{ -make_boot_run(mod_path, boot_args) -} -\arguments{ -\item{mod_path}{Absolute model path (no file extension) of a bootstrap model run.} - -\item{boot_args}{List of parameters needed to create a bootstrap model run.} -} -\description{ -Set up a single bootstrap model run -} -\keyword{internal} diff --git a/man/new_analysis_run.Rd b/man/new_analysis_run.Rd new file mode 100644 index 000000000..e4f648de5 --- /dev/null +++ b/man/new_analysis_run.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{new_analysis_run} +\alias{new_analysis_run} +\title{Create a bootstrap or SSE run from an existing model} +\usage{ +new_analysis_run( + .mod, + .suffix, + .type = c("nmboot", "nmsse"), + .add_tags = NULL, + .inherit_tags = TRUE, + .overwrite = FALSE, + remove_cov = TRUE, + remove_tables = TRUE +) +} +\arguments{ +\item{.mod}{A \code{bbr} model object.} + +\item{.suffix}{A suffix for the new run directory. Will be prefixed by +the model id of \code{.mod}.} + +\item{.type}{Either \code{"nmboot"} or \code{"nmsse"}} + +\item{.add_tags}{Character vector with any new tags(s) to be added to +\verb{\{.new_model\}.yaml}} + +\item{.inherit_tags}{If \code{TRUE}, the default, inherit any tags from \code{.mod}.} + +\item{.overwrite}{If \code{FALSE}, the default, function will error if a model +file already exists at specified \code{.new_model} path. If \code{TRUE} any existing +file at \code{.new_model} will be overwritten silently.} + +\item{remove_cov, remove_tables}{If \code{TRUE}, the default, remove \verb{$COVARIANCE} +and \verb{$TABLE} records respectively, allowing for notably faster run times.} +} +\description{ +Create a bootstrap or SSE run from an existing model +} +\keyword{internal} diff --git a/man/new_bootstrap_run.Rd b/man/new_bootstrap_run.Rd index 909b11b9f..173eae7e4 100644 --- a/man/new_bootstrap_run.Rd +++ b/man/new_bootstrap_run.Rd @@ -16,7 +16,7 @@ new_bootstrap_run( \arguments{ \item{.mod}{A \code{bbr} model object.} -\item{.suffix}{A suffix for the bootstrap run directory. Will be prefixed by +\item{.suffix}{A suffix for the new run directory. Will be prefixed by the model id of \code{.mod}.} \item{.inherit_tags}{If \code{TRUE}, the default, inherit any tags from \code{.mod}.} diff --git a/man/setup_analysis_run.Rd b/man/setup_analysis_run.Rd new file mode 100644 index 000000000..90691112d --- /dev/null +++ b/man/setup_analysis_run.Rd @@ -0,0 +1,57 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{setup_analysis_run} +\alias{setup_analysis_run} +\title{Set up a bootstrap or SSE run} +\usage{ +setup_analysis_run( + .run, + run_type = c("bootstrap", "sse"), + n = 200, + sample_size = NULL, + strat_cols = NULL, + replace = FALSE, + seed = 1234, + data = NULL, + sim_col = NULL, + .bbi_args = list(no_grd_file = TRUE, no_shk_file = TRUE), + .overwrite = FALSE +) +} +\arguments{ +\item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} object.} + +\item{n}{Number of datasets and model runs to generate.} + +\item{sample_size}{Sample size for each new dataset. Defaults to \code{NULL}, which +matches the length of the original dataset.} + +\item{strat_cols}{Columns to maintain proportion for stratification.} + +\item{replace}{Logical (T/F). If \code{TRUE}, stratify with replacement.} + +\item{seed}{A numeric seed to set prior to resampling the data; use \code{NULL} to +avoid setting a seed.} + +\item{data}{Custom dataset to use for setup. Defaults to \code{NULL}.} + +\item{sim_col}{Column denoting the simulation run number. This will be \code{"nn"}, +if using \code{\link[=add_simulation]{add_simulation()}}, though \code{"IREP"} is also common (e.g., when +using \code{mrgsolve}).} + +\item{.bbi_args}{Named list passed to \code{model_summary(orig_mod, .bbi_args)}, +where \code{orig_mod} is the model \code{.boot_run} is based on. See +\code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to +extract the number of records, so those files are irrelevant. Only used if +the based on model (the model the analysis is being performed on) has been +executed.} + +\item{.overwrite}{Logical (T/F) indicating whether or not to overwrite +existing setup.} + +\item{.run_type}{Either \code{"bootstrap"} or \code{"sse"}. Determines behavior for dataset handling.} +} +\description{ +Set up a bootstrap or SSE run +} +\keyword{internal} diff --git a/man/setup_bootstrap_run.Rd b/man/setup_bootstrap_run.Rd index 630184660..c19fdc8b4 100644 --- a/man/setup_bootstrap_run.Rd +++ b/man/setup_bootstrap_run.Rd @@ -19,7 +19,7 @@ setup_bootstrap_run( \item{n}{Number of data sets and model runs to generate.} -\item{strat_cols}{Columns to maintain proportion for stratification} +\item{strat_cols}{Columns to maintain proportion for stratification.} \item{seed}{A numeric seed to set prior to resampling the data; use \code{NULL} to avoid setting a seed.} @@ -32,10 +32,11 @@ must include the same column names as what's returned from \code{nm_data(.mod)}. where \code{orig_mod} is the model \code{.boot_run} is based on. See \code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to extract the number of records, so those files are irrelevant. Only used if -the based on model (the model being bootstrapped) has been executed.} +the based on model (the model the analysis is being performed on) has been +executed.} \item{.overwrite}{Logical (T/F) indicating whether or not to overwrite -existing setup for a bootstrap run.} +existing setup.} } \description{ This function takes a \code{bbi_nmboot_model} (created by a previous diff --git a/tests/testthat/helpers-create-example-model.R b/tests/testthat/helpers-create-example-model.R index 110211b1b..10f202019 100644 --- a/tests/testthat/helpers-create-example-model.R +++ b/tests/testthat/helpers-create-example-model.R @@ -131,7 +131,7 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ ) # Need to explicitly point to internal function for vignette building - bbr:::make_boot_spec(boot_mods, boot_args) + bbr:::make_analysis_spec(boot_mods, boot_args) # Read in summary to adjust estimates to look like real bootstrap boot_sum <- summarize_bootstrap_run(boot_run) diff --git a/tests/testthat/test-workflow-bootstrap.R b/tests/testthat/test-workflow-bootstrap.R index 6ce2687e7..b6c8cf5ca 100644 --- a/tests/testthat/test-workflow-bootstrap.R +++ b/tests/testthat/test-workflow-bootstrap.R @@ -85,8 +85,8 @@ withr::with_options( expect_message(get_model_status(.boot_run), "has not been set up") expect_false(check_nonmem_finished(.boot_run)) expect_false(model_is_finished(.boot_run)) - expect_false(bootstrap_is_cleaned_up(.boot_run)) - expect_true(is.null(get_boot_spec(.boot_run))) + expect_false(analysis_is_cleaned_up(.boot_run)) + expect_true(is.null(get_analysis_spec(.boot_run))) }) # Read in model for remainder of tests @@ -182,11 +182,11 @@ withr::with_options( }) # Check boot spec - boot_spec <- get_boot_spec(.boot_run) + boot_spec <- get_analysis_spec(.boot_run) expect_true(is.null(boot_spec$cleaned_up)) expect_true(is.null(boot_spec$seed)) expect_true(is.null(boot_spec$strat_cols)) - expect_true(tibble::is_tibble(boot_spec$bootstrap_runs)) + expect_true(tibble::is_tibble(boot_spec$analysis_runs)) # Check helper functions after setup & before submission expect_no_message(boot_models <- get_boot_models(.boot_run)) @@ -197,7 +197,7 @@ withr::with_options( expect_false(all(res)) # Logical and error checks expect_false(model_is_finished(.boot_run)) - expect_false(bootstrap_is_cleaned_up(.boot_run)) + expect_false(analysis_is_cleaned_up(.boot_run)) expect_error( bootstrap_can_be_summarized(.boot_run), "One or more bootstrap runs have not finished executing" @@ -251,7 +251,7 @@ withr::with_options( expect_equal(as.vector(table(data$ETN)), c(340, 140, 300)) # Check boot spec - boot_spec <- get_boot_spec(.boot_run) + boot_spec <- get_analysis_spec(.boot_run) expect_equal(boot_spec$seed, 1234) expect_equal(boot_spec$strat_cols, c("SEX", "ETN")) }) @@ -292,7 +292,7 @@ withr::with_options( expect_true(check_nonmem_finished(.boot_run)) expect_true(all(check_nonmem_finished(boot_models))) expect_true(model_is_finished(.boot_run)) - expect_false(bootstrap_is_cleaned_up(.boot_run)) # cannot be cleaned up + expect_false(analysis_is_cleaned_up(.boot_run)) # cannot be cleaned up expect_true(bootstrap_can_be_summarized(.boot_run)) # can now be summarized expect_error( cleanup_bootstrap_run(.boot_run), "Model has not been summarized yet" @@ -376,7 +376,7 @@ withr::with_options( # Check helper functions after summarization & before cleanup expect_true(check_nonmem_finished(.boot_run)) expect_true(model_is_finished(.boot_run)) - expect_false(bootstrap_is_cleaned_up(.boot_run)) # is not cleaned up + expect_false(analysis_is_cleaned_up(.boot_run)) # is not cleaned up expect_true(bootstrap_can_be_summarized(.boot_run)) # can still be summarized }) @@ -456,7 +456,7 @@ withr::with_options( expect_message(boot_models <- get_boot_models(.boot_run), "has been cleaned up") expect_true(is.null(boot_models)) expect_true(model_is_finished(.boot_run)) - expect_true(bootstrap_is_cleaned_up(.boot_run)) + expect_true(analysis_is_cleaned_up(.boot_run)) expect_error( bootstrap_can_be_summarized(.boot_run), "The bootstrap run has been cleaned up" @@ -479,9 +479,9 @@ withr::with_options( # Confirm boot spec alterations - boot_spec <- get_boot_spec(.boot_run) + boot_spec <- get_analysis_spec(.boot_run) expect_true(boot_spec$cleaned_up) - expect_true(is.null(boot_spec$bootstrap_runs)) + expect_true(is.null(boot_spec$analysis_runs)) # Cannot be overwritten expect_error( From 639c549f4223e305cffb31289f3414623c672f1b Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 24 Jan 2025 17:39:03 -0500 Subject: [PATCH 02/19] add new SSE model type and setup functions --- NAMESPACE | 5 ++ R/aaa.R | 12 ++++ R/classes.R | 8 +++ R/sse-model.R | 116 +++++++++++++++++++++++++++++++++++++++ man/create_model_hook.Rd | 3 + man/new_sse_run.Rd | 50 +++++++++++++++++ man/setup_sse_run.Rd | 91 ++++++++++++++++++++++++++++++ 7 files changed, 285 insertions(+) create mode 100644 R/sse-model.R create mode 100644 man/new_sse_run.Rd create mode 100644 man/setup_sse_run.Rd diff --git a/NAMESPACE b/NAMESPACE index 6c09f664d..065d9d388 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ S3method(cov_cor,bbi_nonmem_model) S3method(cov_cor,bbi_nonmem_summary) S3method(create_model_hook,bbi_nmboot_model) S3method(create_model_hook,bbi_nmsim_model) +S3method(create_model_hook,bbi_nmsse_model) S3method(create_model_hook,bbi_nonmem_model) S3method(create_model_hook,default) S3method(get_based_on,bbi_run_log_df) @@ -32,11 +33,13 @@ S3method(get_based_on,default) S3method(get_config_path,bbi_log_df) S3method(get_config_path,bbi_model) S3method(get_config_path,bbi_nmboot_model) +S3method(get_config_path,bbi_nmsse_model) S3method(get_config_path,bbi_nonmem_summary) S3method(get_data_path,bbi_log_df) S3method(get_data_path,bbi_model) S3method(get_data_path,bbi_nmboot_model) S3method(get_data_path,bbi_nmsim_model) +S3method(get_data_path,bbi_nmsse_model) S3method(get_data_path,bbi_nonmem_model) S3method(get_data_path,bbi_nonmem_summary) S3method(get_model_ancestry,bbi_run_log_df) @@ -159,6 +162,7 @@ export(modify_model_field) export(new_bootstrap_run) export(new_ext) export(new_model) +export(new_sse_run) export(nm_data) export(nm_file) export(nm_file_multi_tab) @@ -197,6 +201,7 @@ export(replace_tag) export(run_log) export(run_nmtran) export(setup_bootstrap_run) +export(setup_sse_run) export(submit_model) export(submit_models) export(summarize_bootstrap_run) diff --git a/R/aaa.R b/R/aaa.R index 732ffe175..6ae2c0eda 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -202,6 +202,8 @@ NM_MOD_CLASS <- "bbi_nonmem_model" # SHARED with bbr.bayes NM_SUM_CLASS <- "bbi_nonmem_summary" # SHARED with bbr.bayes NMBOOT_MOD_CLASS <- "bbi_nmboot_model" NMBOOT_SUM_CLASS <- "bbi_nmboot_summary" +NMSSE_MOD_CLASS <- "bbi_nmsse_model" +NMSSE_SUM_CLASS <- "bbi_nmsse_summary" NMSIM_MOD_CLASS <- "bbi_nmsim_model" SL_CLASS <- "bbi_summary_list" PROC_CLASS <- "bbi_process" @@ -234,6 +236,10 @@ SPEC_NMSIM_NSIM <- "n_sim" SPEC_NMBOOT_NSAMPLE <- "n_samples" SPEC_NMBOOT_STRAT <- "strat_cols" +SPEC_NMSSE_NSAMPLE <- "n_samples" +SPEC_NMSSE_STRAT <- "strat_cols" +SPEC_NMSSE_SAMPLE_SIZE <- "sample_size" + # List of keys required to print a bbi_nmsim_model object SPEC_NMSIM_KEYS <- c( SPEC_NMSIM_NSIM @@ -245,6 +251,12 @@ SPEC_NMBOOT_KEYS <- c( SPEC_NMBOOT_STRAT ) +# List of keys required to print a bbi_nmsse_model object +SPEC_NMSSE_KEYS <- c( + SPEC_NMSSE_NSAMPLE, + SPEC_NMSSE_SAMPLE_SIZE, + SPEC_NMSSE_STRAT +) # keys required to create a model object MODEL_REQ_INPUT_KEYS <- c( diff --git a/R/classes.R b/R/classes.R index 3f7266930..0fb50aeeb 100644 --- a/R/classes.R +++ b/R/classes.R @@ -45,6 +45,14 @@ create_model_hook.bbi_nmboot_model <- function(.mod, ...) { find_nonmem_model_file_path(.mod[[ABS_MOD_PATH]], .check_exists = TRUE) } +#' @rdname create_model_hook +#' @export +create_model_hook.bbi_nmsse_model <- function(.mod, ...) { + # we won't know the model file extension, so we rely on this helper to check + # the possible extensions and throw an error if none exists + find_nonmem_model_file_path(.mod[[ABS_MOD_PATH]], .check_exists = TRUE) +} + #' @rdname create_model_hook #' @export create_model_hook.bbi_nmsim_model <- function(.mod, ...) { diff --git a/R/sse-model.R b/R/sse-model.R new file mode 100644 index 000000000..eca9597c2 --- /dev/null +++ b/R/sse-model.R @@ -0,0 +1,116 @@ +#' Create an SSE run from an existing model +#' +#' Creates a new `bbi_nmsse_model` object, from an existing `bbi_nonmem_model` +#' object. This function creates a new control stream, that is a copy of `.mod` +#' with the `$TABLE` and `$COV` records optionally removed (see `remove_cov` and +#' `remove_tables` arguments). The object returned from this must then be passed +#' to [setup_sse_run()] before submission (see examples). +#' +#' @inheritParams new_analysis_run +#' +#' @examples +#' \dontrun{ +#' +#' # Create new bootstrap object +#' .sse_run <- new_sse_run(.mod) +#' +#' # Set up the run +#' setup_sse_run(.sse_run) +#' } +#' @return S3 object of class `bbi_nmsse_model`. +#' @export +new_sse_run <- function( + .mod, + .suffix = "sse", + .inherit_tags = TRUE, + .overwrite = FALSE, + remove_cov = TRUE, + remove_tables = TRUE +){ + + new_analysis_run( + .mod, + .suffix = .suffix, + .type = "nmsse", + .add_tags = "SSE_SUBMISSION", + .inherit_tags = .inherit_tags, + .overwrite = .overwrite, + remove_cov = remove_cov, + remove_tables = remove_tables + ) +} + + + +#' Set up a bootstrap model run +#' +#' This function takes a `bbi_nmsse_model` (created by a previous +#' [new_sse_run()] call) and creates `n` new model objects and re-sampled +#' datasets in a subdirectory. The control stream found at +#' `get_model_path(.sse_run)` is used as the "template" for these new model +#' objects, and the new datasets are sampled from the dataset passed to `data`. +#' +#' @param .sse_run A `bbi_nmsse_model` object. +#' @param n Number of data sets and model runs to generate. +#' @param data A dataset to resample from. +#' @inheritParams setup_analysis_run +#' +#' @details +#' Once you have run this function, you can execute your SSE with +#' [submit_model()]. You can use [get_model_status()] to check on your submitted +#' bootstrap run. Once all models have finished, use [summarize_sse_run()] +#' to view the results. See examples below. +#' +#' +#' @seealso [new_sse_run()] [summarize_sse_run()] [submit_model()] +#' +#' @examples +#' \dontrun{ +#' +#' # Setup +#' .sse_run <- new_sse_run(.mod) +#' .sse_run <- setup_sse_run( +#' .sse_run, +#' n = 1000, +#' sample_size = 50, +#' seed = 1234, +#' strat_cols = c("STUDY", "SEX") +#' ) +#' +#' # Submit +#' submit_model(.sse_run) +#' +#' # Check status of runs during submission +#' get_model_status(.sse_run) +#' +#' # Summarize results, once all runs have finished +#' if (check_nonmem_finished(.sse_run)) { +#' .sse_sum <- summarize_sse_run(.sse_run) +#' } +#' } +#' @export +setup_sse_run <- function( + .sse_run, + n = 200, + sample_size = NULL, + strat_cols = NULL, + replace = FALSE, + seed = 1234, + data = NULL, + sim_col = "nn", + .bbi_args = list( + no_grd_file = TRUE, + no_shk_file = TRUE + ), + .overwrite = FALSE +){ + check_model_object(.sse_run, NMSSE_MOD_CLASS) + + .sse_run <- setup_analysis_run( + .sse_run, run_type = "sse", n = n, + sample_size = sample_size, replace = replace, + strat_cols = strat_cols, seed = seed, data = data, sim_col = sim_col, + .bbi_args = .bbi_args, .overwrite = .overwrite + ) + return(invisible(.sse_run)) +} diff --git a/man/create_model_hook.Rd b/man/create_model_hook.Rd index 1b960d66d..0b72cba1f 100644 --- a/man/create_model_hook.Rd +++ b/man/create_model_hook.Rd @@ -5,6 +5,7 @@ \alias{create_model_hook.default} \alias{create_model_hook.bbi_nonmem_model} \alias{create_model_hook.bbi_nmboot_model} +\alias{create_model_hook.bbi_nmsse_model} \alias{create_model_hook.bbi_nmsim_model} \title{Perform model-type specific setup} \usage{ @@ -16,6 +17,8 @@ create_model_hook(.mod, ...) \method{create_model_hook}{bbi_nmboot_model}(.mod, ...) +\method{create_model_hook}{bbi_nmsse_model}(.mod, ...) + \method{create_model_hook}{bbi_nmsim_model}(.mod, ...) } \arguments{ diff --git a/man/new_sse_run.Rd b/man/new_sse_run.Rd new file mode 100644 index 000000000..2f04f1e28 --- /dev/null +++ b/man/new_sse_run.Rd @@ -0,0 +1,50 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sse-model.R +\name{new_sse_run} +\alias{new_sse_run} +\title{Create an SSE run from an existing model} +\usage{ +new_sse_run( + .mod, + .suffix = "sse", + .inherit_tags = TRUE, + .overwrite = FALSE, + remove_cov = TRUE, + remove_tables = TRUE +) +} +\arguments{ +\item{.mod}{A \code{bbr} model object.} + +\item{.suffix}{A suffix for the new run directory. Will be prefixed by +the model id of \code{.mod}.} + +\item{.inherit_tags}{If \code{TRUE}, the default, inherit any tags from \code{.mod}.} + +\item{.overwrite}{If \code{FALSE}, the default, function will error if a model +file already exists at specified \code{.new_model} path. If \code{TRUE} any existing +file at \code{.new_model} will be overwritten silently.} + +\item{remove_cov, remove_tables}{If \code{TRUE}, the default, remove \verb{$COVARIANCE} +and \verb{$TABLE} records respectively, allowing for notably faster run times.} +} +\value{ +S3 object of class \code{bbi_nmsse_model}. +} +\description{ +Creates a new \code{bbi_nmsse_model} object, from an existing \code{bbi_nonmem_model} +object. This function creates a new control stream, that is a copy of \code{.mod} +with the \verb{$TABLE} and \verb{$COV} records optionally removed (see \code{remove_cov} and +\code{remove_tables} arguments). The object returned from this must then be passed +to \code{\link[=setup_sse_run]{setup_sse_run()}} before submission (see examples). +} +\examples{ +\dontrun{ + +# Create new bootstrap object +.sse_run <- new_sse_run(.mod) + +# Set up the run +setup_sse_run(.sse_run) +} +} diff --git a/man/setup_sse_run.Rd b/man/setup_sse_run.Rd new file mode 100644 index 000000000..d5bf611de --- /dev/null +++ b/man/setup_sse_run.Rd @@ -0,0 +1,91 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sse-model.R +\name{setup_sse_run} +\alias{setup_sse_run} +\title{Set up a bootstrap model run} +\usage{ +setup_sse_run( + .sse_run, + n = 200, + sample_size = NULL, + strat_cols = NULL, + replace = FALSE, + seed = 1234, + data = NULL, + sim_col = "nn", + .bbi_args = list(no_grd_file = TRUE, no_shk_file = TRUE), + .overwrite = FALSE +) +} +\arguments{ +\item{.sse_run}{A \code{bbi_nmsse_model} object.} + +\item{n}{Number of data sets and model runs to generate.} + +\item{sample_size}{Sample size for each new dataset. Defaults to \code{NULL}, which +matches the length of the original dataset.} + +\item{strat_cols}{Columns to maintain proportion for stratification.} + +\item{replace}{Logical (T/F). If \code{TRUE}, stratify with replacement.} + +\item{seed}{A numeric seed to set prior to resampling the data; use \code{NULL} to +avoid setting a seed.} + +\item{data}{A dataset to resample from.} + +\item{sim_col}{Column denoting the simulation run number. This will be \code{"nn"}, +if using \code{\link[=add_simulation]{add_simulation()}}, though \code{"IREP"} is also common (e.g., when +using \code{mrgsolve}).} + +\item{.bbi_args}{Named list passed to \code{model_summary(orig_mod, .bbi_args)}, +where \code{orig_mod} is the model \code{.boot_run} is based on. See +\code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to +extract the number of records, so those files are irrelevant. Only used if +the based on model (the model the analysis is being performed on) has been +executed.} + +\item{.overwrite}{Logical (T/F) indicating whether or not to overwrite +existing setup.} +} +\description{ +This function takes a \code{bbi_nmsse_model} (created by a previous +\code{\link[=new_sse_run]{new_sse_run()}} call) and creates \code{n} new model objects and re-sampled +datasets in a subdirectory. The control stream found at +\code{get_model_path(.sse_run)} is used as the "template" for these new model +objects, and the new datasets are sampled from the dataset passed to \code{data}. +} +\details{ +Once you have run this function, you can execute your SSE with +\code{\link[=submit_model]{submit_model()}}. You can use \code{\link[=get_model_status]{get_model_status()}} to check on your submitted +bootstrap run. Once all models have finished, use \code{\link[=summarize_sse_run]{summarize_sse_run()}} +to view the results. See examples below. +} +\examples{ +\dontrun{ + +# Setup +.sse_run <- new_sse_run(.mod) +.sse_run <- setup_sse_run( + .sse_run, + n = 1000, + sample_size = 50, + seed = 1234, + strat_cols = c("STUDY", "SEX") +) + +# Submit +submit_model(.sse_run) + +# Check status of runs during submission +get_model_status(.sse_run) + +# Summarize results, once all runs have finished +if (check_nonmem_finished(.sse_run)) { + .sse_sum <- summarize_sse_run(.sse_run) +} +} +} +\seealso{ +\code{\link[=new_sse_run]{new_sse_run()}} \code{\link[=summarize_sse_run]{summarize_sse_run()}} \code{\link[=submit_model]{submit_model()}} +} From fe4eecabdff5d144f0823caab477ef5421fbc73d Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Mon, 27 Jan 2025 15:54:43 -0500 Subject: [PATCH 03/19] setup SSE submission and summarization - summarization is incomplete --- NAMESPACE | 5 + R/analysis-run-utils.R | 372 +++++++++++++++--- R/bootstrap-model.R | 204 +--------- R/get-path-from-object.R | 48 ++- R/model-status.R | 65 +-- R/param-estimates-batch.R | 2 +- R/sse-model.R | 168 +++++++- R/submit-model.R | 126 ++++-- man/analysis_can_be_summarized.Rd | 15 + man/analysis_estimates.Rd | 22 ++ man/bbi_nonmem_model_status.Rd | 3 + man/cleanup_analysis_run.Rd | 29 ++ man/cleanup_sse_run.Rd | 39 ++ man/get_analysis_sum_path.Rd | 33 ++ man/get_spec_path.Rd | 6 +- man/mod_list_setup.Rd | 9 +- man/submit_model.Rd | 26 +- man/submit_models.Rd | 11 +- man/submit_nonmem_analysis.Rd | 66 ++++ man/summarize_analysis_run.Rd | 15 + man/summarize_sse.Rd | 80 ++++ tests/testthat/helpers-create-example-model.R | 2 +- tests/testthat/test-workflow-bootstrap.R | 12 +- 23 files changed, 1028 insertions(+), 330 deletions(-) create mode 100644 man/analysis_can_be_summarized.Rd create mode 100644 man/analysis_estimates.Rd create mode 100644 man/cleanup_analysis_run.Rd create mode 100644 man/cleanup_sse_run.Rd create mode 100644 man/get_analysis_sum_path.Rd create mode 100644 man/submit_nonmem_analysis.Rd create mode 100644 man/summarize_analysis_run.Rd create mode 100644 man/summarize_sse.Rd diff --git a/NAMESPACE b/NAMESPACE index 065d9d388..a4e369157 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -84,6 +84,7 @@ S3method(print_model_files,default) S3method(submit_model,bbi_base_model) S3method(submit_model,bbi_nmboot_model) S3method(submit_model,bbi_nmsim_model) +S3method(submit_model,bbi_nmsse_model) S3method(submit_models,bbi_nonmem_models) S3method(submit_models,default) S3method(submit_models,list) @@ -127,6 +128,7 @@ export(check_status_code) export(check_up_to_date) export(check_yaml_in_sync) export(cleanup_bootstrap_run) +export(cleanup_sse_run) export(collapse_to_string) export(config_log) export(config_log_make_entry) @@ -148,6 +150,7 @@ export(get_omega) export(get_output_dir) export(get_sigma) export(get_simulation) +export(get_sse_models) export(get_theta) export(get_yaml_path) export(has_simulation) @@ -202,9 +205,11 @@ export(run_log) export(run_nmtran) export(setup_bootstrap_run) export(setup_sse_run) +export(sse_estimates) export(submit_model) export(submit_models) export(summarize_bootstrap_run) +export(summarize_sse_run) export(summary_log) export(suppressSpecificWarning) export(tags_diff) diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R index 879e5332f..e4ed9efa9 100644 --- a/R/analysis-run-utils.R +++ b/R/analysis-run-utils.R @@ -305,7 +305,7 @@ make_analysis_model <- function(mod_path, metadata){ # Filter to simulation rep for SSE runs if(metadata$run_type == "sse" && !is.null(metadata$sim_col)){ sim_col <- metadata$sim_col - irep <- unique(data$nn)[new_mod_index] + irep <- unique(metadata$orig_data[[sim_col]])[new_mod_index] data <- metadata$orig_data %>% dplyr::filter(!!rlang::sym(sim_col) == irep) }else{ data <- metadata$orig_data @@ -357,69 +357,39 @@ make_analysis_model <- function(mod_path, metadata){ } -#' Read in all analysis run model objects -#' @inheritParams get_analysis_spec +#' Check if the analysis run (Bootstrap or SSE) can be summarized +#' @param .run A `bbi_nmboot_model` or `bbi_nmsse_model` model object #' @keywords internal -get_analysis_models <- function(.run){ - run_dir <- .run[[ABS_MOD_PATH]] - output_dir <- get_output_dir(.run, .check_exists = FALSE) - +analysis_can_be_summarized <- function(.run){ run_type <- dplyr::case_when( - .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap run", + .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" ) - if(!fs::file_exists(output_dir)){ - verbose_msg( - glue("{run_type} `{get_model_id(.run)}` has not been set up.") - ) - return(invisible(NULL)) - } - - if(analysis_is_cleaned_up(.run)){ - verbose_msg( - glue("{run_type} `{get_model_id(.run)}` has been cleaned up.") - ) - return(invisible(NULL)) - } - - spec <- get_analysis_spec(.run) - model_ids <- fs::path_ext_remove(basename(spec$analysis_runs$mod_path_abs)) - - mods <- tryCatch({ - find_models(.run[[ABS_MOD_PATH]], .recurse = FALSE, .include = model_ids) - }, warning = function(cond){ - if(!stringr::str_detect(cond$message, "All models excluded|Found no valid model")){ - warning(cond) - } - return(NULL) - }) - - - # This shouldnt happen, but could if the directory existed and models - # referenced in the spec file aren't found for any reason _other than_ - # cleaning up the run - if(is.null(mods) || rlang::is_empty(mods)){ - rlang::abort( - c( - glue("At least one {run_type} model does not exist in `{run_dir}`") + # Check that runs can still be summarized (e.g, after cleanup) + cleaned_up <- analysis_is_cleaned_up(.run) + if(isTRUE(cleaned_up)){ + cli::cli_abort( + paste( + "The {run_type} run has been cleaned up, and cannot be summarized again", + "without resubmitting" ) ) }else{ - if(length(model_ids) != length(mods)){ - rlang::warn( + if(!model_is_finished(.run)){ + cli::cli_abort( c( - glue("Found an unexpected number of models in {run_dir}"), - glue("Expected number of models: {length(model_ids)}"), - glue("Discovered number of models: {length(mods)}") + "One or more {run_type} runs have not finished executing.", + "i" = "Run `get_model_status()` to check the submission status." ) ) } } - - return(mods) + return(invisible(TRUE)) } + + #' Store bootstrap run details before submission #' #' @param run_models List of model objects created by `make_analysis_model()`. @@ -483,6 +453,310 @@ make_analysis_spec <- function(run_models, metadata){ return(invisible(json_path)) } + +#' Summarize an analysis (bootstrap or SSE) run +#' +#' @inheritParams analysis_estimates +#' @importFrom tidyselect any_of +#' @keywords internal +summarize_analysis_run <- function(.run){ + check_model_object(.run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS)) + + # Check that runs can still be summarized (e.g, after cleanup) + analysis_can_be_summarized(.run) + + # Get parameter estimates + param_ests <- analysis_estimates(.run, force_resummarize = TRUE) + + # Tabulate all run details and heuristics + run_dir <- .run[[ABS_MOD_PATH]] + sum_log <- summary_log( + run_dir, .bbi_args = list( + no_grd_file = TRUE, no_ext_file = TRUE, no_shk_file = TRUE + ) + ) %>% dplyr::select(-"error_msg") # only join based on model run + + run_details <- purrr::map_dfr(sum_log$bbi_summary, function(sum){ + as_tibble( + c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[SUMMARY_DETAILS]]) + ) %>% tidyr::nest("output_files_used" = "output_files_used") + }) + + run_heuristics <- purrr::map_dfr(sum_log$bbi_summary, function(sum){ + as_tibble( + c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[SUMMARY_HEURISTICS]]) + ) + }) + + # Run details, heuristics, and other information will be displayed elsewhere + run_cols <- c( + unique(c(names(run_details), names(run_heuristics))), + "estimation_method", "problem_text", "needed_fail_flags", "param_count" + ) + run_cols <- run_cols[-grepl(ABS_MOD_PATH, run_cols)] + + analysis_sum_df <- dplyr::full_join( + param_ests, sum_log %>% dplyr::select(-any_of(run_cols)), + by = c(ABS_MOD_PATH, "run") + ) + + if(any(!is.na(analysis_sum_df$error_msg))){ + err_msgs <- unique(analysis_sum_df$error_msg[!is.na(analysis_sum_df$error_msg)]) + rlang::warn( + c( + "The following error messages occurred for at least one model:", + err_msgs + ) + ) + } + + # Update spec to store bbi_version and configuration details + # - so functions like config_log have to do less of a lift + analysis_models <- get_analysis_models(.run) + + # These should be consistent across all models + config_lst <- purrr::map(analysis_models, function(.m){ + path <- get_config_path(.m, .check_exists = FALSE) + config <- jsonlite::fromJSON(path) + list(bbi_version = config$bbi_version, configuration = config$configuration) + }) %>% unique() + + if(length(config_lst) != 1){ + rlang::warn("Multiple NONMEM or bbi configurations detected: storing the first one") + } + config_lst <- config_lst[[1]] + + # Update spec file with bbi config + spec_path <- get_spec_path(.run) + analysis_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) + analysis_spec$analysis_spec$bbi_version <- config_lst$bbi_version + analysis_spec$analysis_spec$configuration <- config_lst$configuration + spec_lst_json <- jsonlite::toJSON(analysis_spec, pretty = TRUE, simplifyVector = TRUE) + writeLines(spec_lst_json, spec_path) + + # Create summary object to save to RDS + # - Refresh analysis spec + analysis_spec <- get_analysis_spec(.run) + analysis_sum <- c( + list2(!!ABS_MOD_PATH := run_dir), + list( + estimation_method = unique(sum_log$estimation_method), + based_on_model_path = analysis_spec$based_on_model_path, + based_on_data_set = analysis_spec$based_on_data_path, + strat_cols = analysis_spec$strat_cols, + seed = analysis_spec$seed, + n_samples = analysis_spec$n_samples, + run_details = run_details, + run_heuristics = run_heuristics + ), + list( + analysis_summary = analysis_sum_df + ) + ) + + return(analysis_sum) +} + + +#' Tabulate parameter estimates for each model submission in an analysis run +#' +#' @inheritParams setup_analysis_run +#' @param format_long Logical (T/F). If `TRUE`, format data as a long table, +#' making the data more portable for plotting. +#' @param force_resummarize Logical (T/F). If `TRUE`, force re-summarization. +#' Will _only_ update the saved out `RDS` file when specified via +#' `summarize_bootstrap_run()`. See details for more information. +#' +#' @keywords internal +analysis_estimates <- function( + .run, + format_long = FALSE, + force_resummarize = FALSE +){ + check_model_object(.run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS)) + + run_type <- dplyr::case_when( + .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", + .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" + ) + + sum_path <- get_analysis_sum_path(.run, .check_exists = FALSE) + + if(!fs::file_exists(sum_path) || isTRUE(force_resummarize)){ + analysis_can_be_summarized(.run) + param_ests <- param_estimates_batch(.run[[ABS_MOD_PATH]]) + }else{ + verbose_msg( + glue("Reading in {run_type} summary: {fs::path_rel(sum_path, getwd())}\n\n") + ) + analysis_sum <- readRDS(sum_path) + param_ests <- analysis_sum$analysis_summary + } + + if(isTRUE(format_long)){ + # Long format - only keep estimates and error/termination columns for filtering + param_ests <- param_ests %>% dplyr::select( + all_of(ABS_MOD_PATH), "run", "error_msg", "termination_code", + starts_with(c("THETA", "SIGMA", "OMEGA")) + ) %>% tidyr::pivot_longer( + starts_with(c("THETA", "SIGMA", "OMEGA")), + names_to = "parameter_names", values_to = "estimate" + ) %>% dplyr::relocate( + c("error_msg", "termination_code"), .after = dplyr::everything() + ) + } + + return(param_ests) +} + + +#' Read in all analysis run model objects +#' @inheritParams get_analysis_spec +#' @keywords internal +get_analysis_models <- function(.run){ + + check_model_object( + .run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMBOOT_SUM_CLASS, NMSSE_SUM_CLASS) + ) + + if(inherits(.run, c(NMBOOT_SUM_CLASS, NMSSE_SUM_CLASS))){ + .run <- read_model(.run[[ABS_MOD_PATH]]) + } + + run_dir <- .run[[ABS_MOD_PATH]] + output_dir <- get_output_dir(.run, .check_exists = FALSE) + + run_type <- dplyr::case_when( + .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", + .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" + ) + + if(!fs::file_exists(output_dir)){ + verbose_msg( + glue("{run_type} run `{get_model_id(.run)}` has not been set up.") + ) + return(invisible(NULL)) + } + + if(analysis_is_cleaned_up(.run)){ + verbose_msg( + glue("{run_type} run `{get_model_id(.run)}` has been cleaned up.") + ) + return(invisible(NULL)) + } + + spec <- get_analysis_spec(.run) + model_ids <- fs::path_ext_remove(basename(spec$analysis_runs$mod_path_abs)) + + mods <- tryCatch({ + find_models(.run[[ABS_MOD_PATH]], .recurse = FALSE, .include = model_ids) + }, warning = function(cond){ + if(!stringr::str_detect(cond$message, "All models excluded|Found no valid model")){ + warning(cond) + } + return(NULL) + }) + + + # This shouldnt happen, but could if the directory existed and models + # referenced in the spec file aren't found for any reason _other than_ + # cleaning up the run + if(is.null(mods) || rlang::is_empty(mods)){ + rlang::abort( + c( + glue("At least one {run_type} model does not exist in `{run_dir}`") + ) + ) + }else{ + if(length(model_ids) != length(mods)){ + rlang::warn( + c( + glue("Found an unexpected number of models in {run_dir}"), + glue("Expected number of models: {length(model_ids)}"), + glue("Discovered number of models: {length(mods)}") + ) + ) + } + } + + return(mods) +} + + +#' Cleanup analysis run directory +#' +#' This will delete all child models, and only keep the information +#' you need to read in estimates or summary information +#' +#' @details +#' The intent of this function is to help reduce the number of files you need to +#' commit via version control. Collaborators will be able to read in the +#' analysis model and summary objects without needing individual run files. +#' - Note that this will prevent `force_resummarize = TRUE` from working +#' +#' **This should only be done** if you no longer need to re-summarize, as this +#' will clean up (delete) the *individual* analysis model files +#' +#' @inheritParams setup_analysis_run +#' @inheritParams delete_models +#' @keywords internal +cleanup_analysis_run <- function(.run, .force = FALSE){ + check_model_object(.run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS)) + run_type <- dplyr::case_when( + .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", + .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" + ) + + run_dir <- .run[[ABS_MOD_PATH]] + sum_path <- get_analysis_sum_path(.run, .check_exists = FALSE) + data_dir <- file.path(run_dir, "data") + + if(!model_is_finished(.run)){ + cli::cli_abort( + c( + "One or more {run_type} runs have not finished executing.", + "i" = "Run `get_model_status(.run)` to check the submission status." + ) + ) + } + + if(!fs::file_exists(sum_path)){ + cli::cli_abort( + c( + "Model has not been summarized yet.", + "Run `summarize_{run_type}_run() before cleaning up" + ) + ) + } + + if(analysis_is_cleaned_up(.run)){ + cli::cli_abort("{run_type} run has already been cleaned up") + } + + # Overwrite spec file + spec_path <- get_spec_path(.run) + analysis_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) + # Set cleaned up - impacts status checking + analysis_spec$analysis_spec$cleaned_up <- TRUE + # Delete individual run specs + # - dont need to store this information anymore since we wont be reading in + # individual models anymore + analysis_spec$analysis_runs <- NULL + spec_lst_json <- jsonlite::toJSON(analysis_spec, pretty = TRUE, simplifyVector = TRUE) + + # Delete individual model files + analysis_models <- get_analysis_models(.run) + tags_delete <- toupper(paste0(run_type, "_RUN")) + delete_models(analysis_models, .tags = tags_delete, .force = .force) + + # Save out updated spec and delete data directory only if the user says 'yes' + if(!model_is_finished(.run)){ + writeLines(spec_lst_json, spec_path) + if(fs::dir_exists(data_dir)) fs::dir_delete(data_dir) + message(glue("{run_type} run `{get_model_id(.run)}` has been cleaned up")) + } +} + # helpers ----------------------------------------------------------------- diff --git a/R/bootstrap-model.R b/R/bootstrap-model.R index facd9ad93..c0d92242a 100644 --- a/R/bootstrap-model.R +++ b/R/bootstrap-model.R @@ -189,99 +189,10 @@ summarize_bootstrap_run <- function( force_resummarize = FALSE ){ check_model_object(.boot_run, NMBOOT_MOD_CLASS) - boot_dir <- .boot_run[[ABS_MOD_PATH]] - boot_sum_path <- file.path(boot_dir, "boot_summary.RDS") + boot_sum_path <- get_analysis_sum_path(.boot_run, .check_exists = FALSE) if(!fs::file_exists(boot_sum_path) || isTRUE(force_resummarize)){ - # Check that runs can still be summarized (e.g, after cleanup) - bootstrap_can_be_summarized(.boot_run) - - param_ests <- bootstrap_estimates( - .boot_run, force_resummarize = force_resummarize - ) - - boot_sum_log <- summary_log( - boot_dir, .bbi_args = list( - no_grd_file = TRUE, no_ext_file = TRUE, no_shk_file = TRUE - ) - ) %>% dplyr::select(-"error_msg") # only join based on model run - - # Tabulate all run details and heuristics - run_details <- purrr::map_dfr(boot_sum_log$bbi_summary, function(sum){ - as_tibble( - c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[SUMMARY_DETAILS]]) - ) %>% tidyr::nest("output_files_used" = "output_files_used") - }) - - run_heuristics <- purrr::map_dfr(boot_sum_log$bbi_summary, function(sum){ - as_tibble( - c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[SUMMARY_HEURISTICS]]) - ) - }) - - # Run details, heuristics, and other information will be displayed elsewhere - run_cols <- c( - unique(c(names(run_details), names(run_heuristics))), - "estimation_method", "problem_text", "needed_fail_flags", "param_count" - ) - run_cols <- run_cols[-grepl(ABS_MOD_PATH, run_cols)] - - boot_sum_df <- dplyr::full_join( - param_ests, boot_sum_log %>% dplyr::select(-any_of(run_cols)), - by = c(ABS_MOD_PATH, "run") - ) - - if(any(!is.na(boot_sum_df$error_msg))){ - err_msgs <- unique(boot_sum_df$error_msg[!is.na(boot_sum_df$error_msg)]) - rlang::warn( - c( - "The following error messages occurred for at least one model:", - err_msgs - ) - ) - } - - # Update spec to store bbi_version and configuration details - # - so functions like config_log have to do less of a lift - boot_models <- get_boot_models(.boot_run) - - # These should be consistent across all models - config_lst <- purrr::map(boot_models, function(.m){ - path <- get_config_path(.m, .check_exists = FALSE) - config <- jsonlite::fromJSON(path) - list(bbi_version = config$bbi_version, configuration = config$configuration) - }) %>% unique() - - if(length(config_lst) != 1){ - rlang::warn("Multiple NONMEM or bbi configurations detected: storing the first one") - } - config_lst <- config_lst[[1]] - - spec_path <- get_spec_path(.boot_run) - boot_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - boot_spec$analysis_spec$bbi_version <- config_lst$bbi_version - boot_spec$analysis_spec$configuration <- config_lst$configuration - spec_lst_json <- jsonlite::toJSON(boot_spec, pretty = TRUE, simplifyVector = TRUE) - writeLines(spec_lst_json, spec_path) - - # Create summary object to save to RDS - boot_spec <- get_analysis_spec(.boot_run) - boot_sum <- c( - list2(!!ABS_MOD_PATH := boot_dir), - list( - estimation_method = unique(boot_sum_log$estimation_method), - based_on_model_path = boot_spec$based_on_model_path, - based_on_data_set = boot_spec$based_on_data_path, - strat_cols = boot_spec$strat_cols, - seed = boot_spec$seed, - n_samples = boot_spec$n_samples, - run_details = run_details, - run_heuristics = run_heuristics - ), - list( - boot_summary = boot_sum_df - ) - ) + boot_sum <- summarize_analysis_run(.boot_run) # Assign class early for param_estimate_compare method class(boot_sum) <- c(NMBOOT_SUM_CLASS, class(boot_sum)) @@ -322,80 +233,22 @@ summarize_bootstrap_run <- function( #' @describeIn summarize_bootstrap Tabulate parameter estimates for each model #' submission in a bootstrap run -#' @param format_long Logical (T/F). If `TRUE`, format data as a long table, -#' making the data more portable for plotting. +#' @inheritParams analysis_estimates #' @export bootstrap_estimates <- function( .boot_run, format_long = FALSE, force_resummarize = FALSE ){ - check_model_object(.boot_run, NMBOOT_MOD_CLASS) - - - boot_dir <- .boot_run[[ABS_MOD_PATH]] - boot_sum_path <- file.path(boot_dir, "boot_summary.RDS") - - if(!fs::file_exists(boot_sum_path) || isTRUE(force_resummarize)){ - bootstrap_can_be_summarized(.boot_run) - param_ests <- param_estimates_batch(.boot_run[[ABS_MOD_PATH]]) - }else{ - verbose_msg( - glue("Reading in bootstrap summary: {fs::path_rel(boot_sum_path, getwd())}\n\n") - ) - boot_sum <- readRDS(boot_sum_path) - param_ests <- boot_sum$boot_summary - } - - if(isTRUE(format_long)){ - # Long format - only keep estimates and error/termination columns for filtering - param_ests <- param_ests %>% dplyr::select( - all_of(ABS_MOD_PATH), "run", "error_msg", "termination_code", - starts_with(c("THETA", "SIGMA", "OMEGA")) - ) %>% tidyr::pivot_longer( - starts_with(c("THETA", "SIGMA", "OMEGA")), - names_to = "parameter_names", values_to = "estimate" - ) %>% dplyr::relocate( - c("error_msg", "termination_code"), .after = dplyr::everything() - ) - } + param_ests <- analysis_estimates(.boot_run, format_long, force_resummarize) return(param_ests) } -bootstrap_can_be_summarized <- function(.boot_run){ - # Check that runs can still be summarized (e.g, after cleanup) - cleaned_up <- analysis_is_cleaned_up(.boot_run) - if(isTRUE(cleaned_up)){ - rlang::abort( - paste( - "The bootstrap run has been cleaned up, and cannot be summarized again", - "without resubmitting" - ) - ) - }else{ - if(!model_is_finished(.boot_run)){ - rlang::abort( - c( - "One or more bootstrap runs have not finished executing.", - "i" = "Run `get_model_status(.boot_run)` to check the submission status." - ) - ) - } - } - return(invisible(TRUE)) -} - #' @describeIn summarize_bootstrap Read in all bootstrap run model objects -#' @inheritParams get_analysis_spec #' @export get_boot_models <- function(.boot_run){ - check_model_object(.boot_run, c(NMBOOT_MOD_CLASS, NMBOOT_SUM_CLASS)) - if(inherits(.boot_run, NMBOOT_SUM_CLASS)){ - .boot_run <- read_model(.boot_run[[ABS_MOD_PATH]]) - } - get_analysis_models(.boot_run) } @@ -427,53 +280,6 @@ get_boot_models <- function(.boot_run){ #' #' @export cleanup_bootstrap_run <- function(.boot_run, .force = FALSE){ - check_model_object(.boot_run, NMBOOT_MOD_CLASS) - boot_dir <- .boot_run[[ABS_MOD_PATH]] - boot_sum_path <- file.path(boot_dir, "boot_summary.RDS") - boot_data_dir <- file.path(boot_dir, "data") - - if(!model_is_finished(.boot_run)){ - rlang::abort( - c( - "One or more bootstrap runs have not finished executing.", - "i" = "Run `get_model_status(.boot_run)` to check the submission status." - ) - ) - } - - if(!fs::file_exists(boot_sum_path)){ - rlang::abort( - c( - "Model has not been summarized yet.", - "Run `summarize_bootstrap_run() before cleaning up" - ) - ) - } - - if(analysis_is_cleaned_up(.boot_run)){ - rlang::abort("Bootstrap run has already been cleaned up") - } - - # Overwrite spec file - spec_path <- get_spec_path(.boot_run) - boot_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - # Set cleaned up - impacts status checking - boot_spec$analysis_spec$cleaned_up <- TRUE - # Delete individual run specs - # - dont need to store this information anymore since we wont be reading in - # individual models anymore - boot_spec$analysis_runs <- NULL - spec_lst_json <- jsonlite::toJSON(boot_spec, pretty = TRUE, simplifyVector = TRUE) - - # Delete individual model files - boot_models <- get_boot_models(.boot_run) - delete_models(boot_models, .tags = "BOOTSTRAP_RUN", .force = .force) - - # Save out updated spec and delete data directory only if the user says 'yes' - if(!model_is_finished(.boot_run)){ - writeLines(spec_lst_json, spec_path) - if(fs::dir_exists(boot_data_dir)) fs::dir_delete(boot_data_dir) - message(glue("Bootstrap run `{get_model_id(.boot_run)}` has been cleaned up")) - } + cleanup_analysis_run(.boot_run, .force = .force) } diff --git a/R/get-path-from-object.R b/R/get-path-from-object.R index f2919e46f..60e6d4c9f 100644 --- a/R/get-path-from-object.R +++ b/R/get-path-from-object.R @@ -129,9 +129,9 @@ get_config_path.bbi_nmsse_model <- function(.bbi_object, .check_exists = TRUE) { #' Get the relevant specification file path #' -#' Get the bootstrap specification path from a `bbi_nmboot_model` object or the -#' simulation specification path from a `bbi_nmsim_model` _or_ `bbi_nonmem_model` -#' object. +#' Get the **analysis run specification** path from a `bbi_nmboot_model` or +#' `bbi_nmsse_model` object, or the **simulation specification** path from a +#' `bbi_nmsim_model` _or_ `bbi_nonmem_model` object. #' #' @param .mod a `bbi_{.model_type}_model` object. #' @param .check_exists If `TRUE`, the default, will throw an error if the file @@ -206,6 +206,48 @@ get_spec_path.bbi_base_model <- function(.mod, .check_exists = TRUE) { .S3method("get_spec_path", "bbi_nmsse_model", get_spec_path.bbi_nmsse_model) .S3method("get_spec_path", "bbi_base_model", get_spec_path.bbi_base_model) + +#' Get the relevant analysis run summary path +#' @inheritParams get_spec_path +#' @keywords internal +get_analysis_sum_path <- function(.mod, .check_exists = TRUE){ + UseMethod("get_analysis_sum_path") +} + +#' @describeIn get_analysis_sum_path Get the summary RDS file path from a +#' `bbi_nmboot_model` object +#' @keywords internal +get_analysis_sum_path.bbi_nmboot_model <- function(.mod, .check_exists = TRUE){ + .path <- file.path( + get_output_dir(.mod, .check_exists = .check_exists), + "boot_summary.RDS") + + if (isTRUE(.check_exists)) { + checkmate::assert_file_exists(.path) + } + + return(.path) +} + +#' @describeIn get_analysis_sum_path Get the summary RDS file path from a +#' `bbi_nmsse_model` object +#' @keywords internal +get_analysis_sum_path.bbi_nmsse_model <- function(.mod, .check_exists = TRUE){ + .path <- file.path( + get_output_dir(.mod, .check_exists = .check_exists), + "sse_summary.RDS") + + if (isTRUE(.check_exists)) { + checkmate::assert_file_exists(.path) + } + + return(.path) +} + +# Register private S3 methods for development purposes +.S3method("get_analysis_sum_path", "bbi_nmboot_model", get_analysis_sum_path.bbi_nmboot_model) +.S3method("get_analysis_sum_path", "bbi_nmsse_model", get_analysis_sum_path.bbi_nmsse_model) + #' Get model identifier #' #' Helper to strip path and extension from model file to get only model identifier diff --git a/R/model-status.R b/R/model-status.R index 5fcc3835a..25646eeec 100644 --- a/R/model-status.R +++ b/R/model-status.R @@ -47,10 +47,22 @@ bbi_nonmem_model_status.bbi_model <- function(.mod) { #' @rdname bbi_nonmem_model_status #' @keywords internal bbi_nonmem_model_status.bbi_nmboot_model <- function(.mod) { + bbi_nonmem_analysis_status(.mod) +} + +#' @rdname bbi_nonmem_model_status +#' @keywords internal +bbi_nonmem_model_status.bbi_nmsse_model <- function(.mod){ + bbi_nonmem_analysis_status(.mod) +} + +#' @param .run A `bbi_nmboot_model` or `bbi_nmsse_model` model object +#' @noRd +bbi_nonmem_analysis_status <- function(.run){ status <- "Not Run" - output_dir <- get_output_dir(.mod, .check_exists = FALSE) + output_dir <- get_output_dir(.run, .check_exists = FALSE) if (dir.exists(output_dir)) { - cleaned_up <- analysis_is_cleaned_up(.mod) + cleaned_up <- analysis_is_cleaned_up(.run) if (isTRUE(cleaned_up)) { status <- "Finished Running" } else { @@ -58,18 +70,18 @@ bbi_nonmem_model_status.bbi_nmboot_model <- function(.mod) { # - Iterates through all models and sets the status based on whether all # models have finished. This may increase the time required to print an # nmboot model object to the console until the run has been cleaned up. - spec_path <- get_spec_path(.mod, .check_exists = FALSE) + spec_path <- get_spec_path(.run, .check_exists = FALSE) if (!fs::file_exists(spec_path)) { status <- "Not Run" }else{ - boot_spec <- get_analysis_spec(.mod) - for(output_dir.i in boot_spec$analysis_runs$mod_path_abs){ + analysis_spec <- get_analysis_spec(.run) + for(output_dir.i in analysis_spec$analysis_runs$mod_path_abs){ if (dir.exists(output_dir.i)) { # Exit early as incomplete if any model cannot be read in for any reason - boot_m <- tryCatch({read_model(output_dir.i)}, error = function(e) NULL) - if(is.null(boot_m)) return("Incomplete Run") + .mod <- tryCatch({read_model(output_dir.i)}, error = function(e) NULL) + if(is.null(.mod)) return("Incomplete Run") # Otherwise check for presence of config file - json_file <- get_config_path(boot_m, .check_exists = FALSE) + json_file <- get_config_path(.mod, .check_exists = FALSE) if(fs::file_exists(json_file)) { # Set to incomplete if one config file exists. Update at the end # if they all exist @@ -90,10 +102,11 @@ bbi_nonmem_model_status.bbi_nmboot_model <- function(.mod) { return(status) } + # Register private S3 methods for development purposes .S3method("bbi_nonmem_model_status", "bbi_model", bbi_nonmem_model_status.bbi_model) .S3method("bbi_nonmem_model_status", "bbi_nmboot_model", bbi_nonmem_model_status.bbi_nmboot_model) - +.S3method("bbi_nonmem_model_status", "bbi_nmsse_model", bbi_nonmem_model_status.bbi_nmsse_model) #' @describeIn bbi_nonmem_model_status Check if model run has finished (coerces #' the one of the three statuses to a logical value) @@ -232,7 +245,9 @@ check_nonmem_finished.bbi_base_model <- function(.mod, ...) { #' @export check_nonmem_finished.list <- function(.mod, ...) { - check_model_object_list(.mod, .mod_types = c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSIM_MOD_CLASS)) + check_model_object_list( + .mod, .mod_types = c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMSIM_MOD_CLASS) + ) # Return logical values as vector (unique handling) # - used in `wait_for_nonmem` models_finished <- map_lgl(.mod, ~model_is_finished(.x)) @@ -362,23 +377,29 @@ wait_for_nonmem.default <- function(.mod, .time_limit = 300, .interval = 5, .del #' `wait_for_nonmem` #' #' Coerce model object to a list of models (if not one already) for use in -#' `get_model_status` and `wait_for_nonmem`. For `bbi_nmboot_model` objects, the -#' list of individual models corresponding to that run will be returned. +#' `get_model_status` and `wait_for_nonmem`. For `bbi_nmboot_model` and +#' `bbi_nmsse_model` objects, the list of individual models corresponding to +#' that run will be returned. #' @inheritParams check_nonmem_finished -#' @details -#' `.mod` is a list of models regardless of input after this section -#' - Support a single bbi_nonmem_model, a single bbi_nmboot_model, or a list -#' of bbi_base_models (bbi_nonmem_model or bbi_nmboot_model) +#' @details `.mod` is a list of models regardless of input after this section +#' - Support a single bbi_base_model (bbi_nonmem_model, bbi_nmboot_model, +#' bbi_nmsse_model), or a list of bbi_base_models #' @keywords internal mod_list_setup <- function(.mod){ if(inherits(.mod, "list") && !inherits(.mod, "bbi_base_model")){ - check_model_object_list(.mod, .mod_types = c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSIM_MOD_CLASS)) + check_model_object_list( + .mod, + .mod_types = c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMSIM_MOD_CLASS) + ) }else{ - check_model_object(.mod, .mod_types = c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSIM_MOD_CLASS)) - if(inherits(.mod, NMBOOT_MOD_CLASS)){ - # Coerce to list of models for bootstrap model runs to check individually - # - This only happens if checking a single bootstrap run model object - .mod <- get_boot_models(.mod) + check_model_object( + .mod, + .mod_types = c(NM_MOD_CLASS, NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS, NMSIM_MOD_CLASS) + ) + if(inherits(.mod, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS))){ + # Coerce to list of models for analysis runs (bootstrap/SSE) to check individually + # - This only happens if checking a single analysis run model object + .mod <- get_analysis_models(.mod) }else{ .mod <- list(.mod) } diff --git a/R/param-estimates-batch.R b/R/param-estimates-batch.R index 69b4f4084..1bf4fc19b 100644 --- a/R/param-estimates-batch.R +++ b/R/param-estimates-batch.R @@ -205,7 +205,7 @@ param_estimates_compare.bbi_nmboot_summary <- function( # Dont pass .compare_cols here, as we can only use columns in parameter_names, # which could only be the default columns. param_estimates_compare( - .boot_sum$boot_summary, .orig_mod = .orig_mod, probs = probs, na.rm = na.rm + .boot_sum$analysis_summary, .orig_mod = .orig_mod, probs = probs, na.rm = na.rm ) } diff --git a/R/sse-model.R b/R/sse-model.R index eca9597c2..50013eb9b 100644 --- a/R/sse-model.R +++ b/R/sse-model.R @@ -7,6 +7,8 @@ #' to [setup_sse_run()] before submission (see examples). #' #' @inheritParams new_analysis_run +#' @param remove_msf If `TRUE`, the default, remove any `MSFO` options from +#' `$EST` records. #' #' @examples #' \dontrun{ @@ -25,10 +27,11 @@ new_sse_run <- function( .inherit_tags = TRUE, .overwrite = FALSE, remove_cov = TRUE, - remove_tables = TRUE + remove_tables = TRUE, + remove_msf = TRUE ){ - new_analysis_run( + sse_run <- new_analysis_run( .mod, .suffix = .suffix, .type = "nmsse", @@ -38,6 +41,27 @@ new_sse_run <- function( remove_cov = remove_cov, remove_tables = remove_tables ) + + # Check for MSF path and remove if present + # - MSF may have been used if add_simulation was used as the simulation + # method for the based on model. We dont want to generate this for each + # individual SSE model run + if(isTRUE(remove_msf)){ + msf_path <- get_msf_path(sse_run, .check_exists = FALSE) + if(!is.null(msf_path)){ + ctl <- get_model_ctl(sse_run) + ests <- nmrec::select_records(ctl, "est") + + purrr::walk(ests, function(est){ + opt <- nmrec::get_record_option(est, "msf") + if(!is.null(opt)) opt$value <- NULL + }) + mod_path <- get_model_path(sse_run) + nmrec::write_ctl(ctl, mod_path) + } + } + + return(sse_run) } @@ -114,3 +138,143 @@ setup_sse_run <- function( ) return(invisible(.sse_run)) } + + +#' Summarize an SSE run +#' +#' Summarize the parameter estimates, run details, and any heuristics of a +#' SSE run, saving the results to a `sse_summary.RDS` data file within the +#' SSE run directory. +#' +#' @inheritParams setup_sse_run +#' @param force_resummarize Logical (T/F). If `TRUE`, force re-summarization. +#' Will _only_ update the saved out `RDS` file when specified via +#' `summarize_sse_run()`. See details for more information. +#' +#' @details +#' - `summarize_sse_run()` does the following things: +#' - Tabulates run details and heuristics. +#' - Calls `summary_log()` and binds the results to the parameter estimates. +#' information if a `sse_summary.RDS` data file exists. +#' - Either saves this data out to `sse_summary.RDS`, or reads it in if it +#' already exists (see section below). +#' - Formats the returned object as a `bbi_nmsse_summary` S3 object, and +#' displays key summary information when printed to the console. +#' +#' ## Saved out data file: +#' The first time `summarize_sse_run()` is called (or if +#' `force_resummarize = TRUE`), it will save the results to a `sse_summary.RDS` +#' data file within the bootstrap run directory. If one already exists, that data +#' set will be read in by default instead of being re-summarized. +#' - The purpose of this is functionality two fold. For one, it helps avoid the +#' need of re-executing `model_summary()` calls for a large number of runs. It +#' also helps to reduce the number of files you need to commit via version +#' control (see `cleanup_sse_run()`). +#' +#' @seealso [cleanup_sse_run()] [new_sse_run()] [setup_sse_run()] +#' +#' @examples +#' \dontrun{ +#' +#' .sse_run <- read_model(file.path(MODEL_DIR, "1-sse")) +#' boot_sum <- summarize_sse_run(.sse_run) +#' +#' +#' } +#' +#' @name summarize_sse +NULL + + +#' @describeIn summarize_sse Summarize an SSE run and store results +#' @importFrom tidyselect any_of +#' @export +summarize_sse_run <- function( + .sse_run, + force_resummarize = FALSE +){ + check_model_object(.sse_run, NMSSE_MOD_CLASS) + sse_sum_path <- get_analysis_sum_path(.sse_run, .check_exists = FALSE) + + if(!fs::file_exists(sse_sum_path) || isTRUE(force_resummarize)){ + sse_sum <- summarize_analysis_run(.sse_run) + + saveRDS(sse_sum, sse_sum_path) + }else{ + verbose_msg( + glue("Reading in SSE summary: {fs::path_rel(sse_sum_path, getwd())}\n\n") + ) + sse_sum <- readRDS(sse_sum_path) + } + + # reset model path to current absolute path on this system (instead of what's pulled from RDS/JSON) + sse_sum[[ABS_MOD_PATH]] <- .sse_run[[ABS_MOD_PATH]] + + # if parent model is present, reset based on paths as well + based_on_path <- get_based_on(.sse_run)[[1]] + if (fs::file_exists(paste0(based_on_path, ".yaml"))) { + based_on_mod <- read_model(based_on_path) + sse_sum$based_on_model_path <- get_model_path(based_on_mod) + sse_sum$based_on_data_set <- get_data_path(based_on_mod) + } else { + # if not, set to "" to avoid confusion with stale paths + rlang::warn(glue("SSE run {get_model_id(.sse_run)} cannot find parent model. Expected to be found at {based_on_path}")) + sse_sum$based_on_model_path <- "" + sse_sum$based_on_data_set <- "" + } + + # Assign class and return + class(sse_sum) <- c(NMSSE_SUM_CLASS, class(sse_sum)) + return(sse_sum) +} + + +#' @describeIn summarize_sse Tabulate parameter estimates for each model +#' submission in an SSE run +#' @inheritParams analysis_estimates +#' @export +sse_estimates <- function( + .sse_run, + format_long = FALSE, + force_resummarize = FALSE +){ + param_ests <- analysis_estimates(.sse_run, format_long, force_resummarize) + return(param_ests) +} + +#' @describeIn summarize_sse Read in all SSE run model objects +#' @export +get_sse_models <- function(.sse_run){ + get_analysis_models(.sse_run) +} + + +#' Cleanup SSE run directory +#' +#' This will delete all child models, and only keep the information +#' you need to read in estimates or summary information +#' +#' @details +#' The intent of this function is to help reduce the number of files you need to +#' commit via version control. Collaborators will be able to read in the +#' SSE model and summary objects without needing individual run files. +#' - Note that this will prevent `force_resummarize = TRUE` from working +#' +#' **This should only be done** if you no longer need to re-summarize, as this +#' will clean up (delete) the *individual* SSE model files +#' +#' @examples +#' \dontrun{ +#' +#' .sse_run <- read_model(file.path(MODEL_DIR, "1-sse")) +#' cleanup_sse_run(.sse_run) +#' } +#' +#' @inheritParams setup_sse_run +#' @inheritParams delete_models +#' @seealso [summarize_sse_run()] +#' +#' @export +cleanup_sse_run <- function(.sse_run, .force = FALSE){ + cleanup_analysis_run(.sse_run, .force = .force) +} diff --git a/R/submit-model.R b/R/submit-model.R index 845c61e6c..265fd0e37 100644 --- a/R/submit-model.R +++ b/R/submit-model.R @@ -37,11 +37,12 @@ #' @param .overwrite Logical to specify whether or not to overwrite existing #' model output from a previous run. If `NULL`, the default, will defer to #' setting in `.bbi_args` or `bbi.yaml`. If _not_ `NULL` will override any -#' settings in `.bbi_args` or `bbi.yaml`. **The exception to this are -#' bootstrap runs (`bbi_nmboot_model` objects).** For bootstrap runs, this -#' defaults to `FALSE` and does _not_ respect any setting passed via -#' `.bbi_args` or a `bbi.yaml` config file. To overwrite existing bootstrap -#' output, a user must pass `TRUE` through this argument. +#' settings in `.bbi_args` or `bbi.yaml`. **The exception to this are analysis +#' runs (`bbi_nmboot_model` and `bbi_nmsse_model` objects).** For analysis +#' runs (bootstrap and SSE), this defaults to `FALSE` and does _not_ respect +#' any setting passed via `.bbi_args` or a `bbi.yaml` config file. To +#' overwrite an existing analysis output, a user must pass `TRUE` through this +#' argument. #' @param .config_path Path to a bbi configuration file. If `NULL`, the #' default, will attempt to use a `bbi.yaml` in the same directory as the #' model. @@ -134,14 +135,73 @@ submit_model.bbi_nmsim_model <- function( } #' @describeIn submit_model Takes a `bbi_nmboot_model` object. +#' @inheritParams submit_nonmem_analysis +#' @export +submit_model.bbi_nmboot_model <- function( + .mod, + .bbi_args = NULL, + .mode = "sge", + ..., + .overwrite = FALSE, + .config_path = NULL, + .wait = FALSE, + .dry_run = FALSE, + .batch_size = 100 +){ + submit_nonmem_analysis( + .mod, + .bbi_args = .bbi_args, + .mode = .mode, + ..., + .overwrite = .overwrite, + .config_path = .config_path, + .wait = .wait, + .dry_run = .dry_run, + .batch_size = .batch_size + ) +} + +#' @describeIn submit_model Takes a `bbi_nmsse_model` object. +#' @inheritParams submit_nonmem_analysis +#' @export +submit_model.bbi_nmsse_model <- function( + .mod, + .bbi_args = NULL, + .mode = "sge", + ..., + .overwrite = FALSE, + .config_path = NULL, + .wait = FALSE, + .dry_run = FALSE, + .batch_size = 100 +){ + submit_nonmem_analysis( + .mod, + .bbi_args = .bbi_args, + .mode = .mode, + ..., + .overwrite = .overwrite, + .config_path = .config_path, + .wait = .wait, + .dry_run = .dry_run, + .batch_size = .batch_size + ) +} + +#' Submit a NONMEM analysis +#' +#' Private implementation function for submitting bootstrap and SSE runs in +#' batches. +#' #' @param .batch_size Number of models to submit to run concurrently as a #' "batch." Passing `NULL` (or a number larger than the number of submitted #' models) will bypass this and submit all models concurrently. This will #' launch a background process to manage the batch submission. Details from #' this process are logged in the `OUTPUT` file in top-level bootstrap model #' directory. -#' @export -submit_model.bbi_nmboot_model <- function( +#' @inheritParams submit_model +#' @keywords internal +submit_nonmem_analysis <- function( .mod, .bbi_args = NULL, .mode = "sge", @@ -151,16 +211,22 @@ submit_model.bbi_nmboot_model <- function( .wait = FALSE, .dry_run = FALSE, .batch_size = 100 -){ + ){ checkmate::assert_number(.batch_size, null.ok = TRUE, lower = 1) + mod_type <- .mod[[YAML_MOD_TYPE]] + run_type <- dplyr::case_when( + mod_type == "nmboot" ~ "bootstrap", + mod_type == "nmsse" ~ "SSE" + ) + # Ensure bootstrap setup was done spec_path <- get_spec_path(.mod, .check_exists = FALSE) if(!fs::file_exists(spec_path)){ - rlang::abort( + cli::cli_abort( c( - glue("No bootstrap specification file was found at {spec_path}"), - "i" = "Please run `setup_bootstrap_run()` with your bootstrap run model object." + "No {run_type} specification file was found at {spec_path}", + "i" = "Please run `setup_{tolower(run_type)}_run()` with your {run_type} run model object." ) ) } @@ -170,40 +236,40 @@ submit_model.bbi_nmboot_model <- function( # bootstrap runs, which happen one level deeper. file.path(get_model_working_directory(.mod), "bbi.yaml") } else { - # Ensure that user-specified values work from the bootstrap + # Ensure that user-specified values work from the analysis # subdirectory. fs::path_abs(.config_path) } # check overwrite and delete existing output, if requested if (!is.null(.bbi_args[["overwrite"]])) { - rlang::warn(paste( - "submit_model.bbi_nmboot_model does NOT respect setting `overwrite` via .bbi_args or a bbi.yaml config file.", - "To overwrite an existing bootstrap run, use submit_model(..., .overwrite = TRUE)." + cli::cli_warn(paste( + "submit_model.bbi_{mod_type}_model does NOT respect setting `overwrite` via .bbi_args or a bbi.yaml config file.", + "To overwrite an existing {run_type} run, use submit_model(..., .overwrite = TRUE)." )) } - boot_models <- get_boot_models(.mod) + run_models <- get_analysis_models(.mod) cleaned_up <- analysis_is_cleaned_up(.mod) if (!isTRUE(.dry_run)) { - outdirs <- purrr::map_chr(boot_models, ~ get_output_dir(.x, .check_exists = FALSE)) + outdirs <- purrr::map_chr(run_models, ~ get_output_dir(.x, .check_exists = FALSE)) if (any(fs::dir_exists(outdirs)) && !isTRUE(cleaned_up)) { if (isTRUE(.overwrite)) { - rlang::inform(glue("Overwriting existing bootstrap output directories in {get_output_dir(.mod)}")) + cli::cli_inform("Overwriting existing {run_type} output directories in {get_output_dir(.mod)}") fs::dir_delete(outdirs[fs::dir_exists(outdirs)]) # delete other bootstrap artifacts from previous run - boot_output_path <- file.path(.mod[[ABS_MOD_PATH]], "OUTPUT") - if (fs::file_exists(boot_output_path)) fs::file_delete(boot_output_path) + run_output_path <- file.path(.mod[[ABS_MOD_PATH]], "OUTPUT") + if (fs::file_exists(run_output_path)) fs::file_delete(run_output_path) - boot_sum_path <- file.path(.mod[[ABS_MOD_PATH]], "boot_summary.RDS") - if (fs::file_exists(boot_sum_path)) fs::file_delete(boot_sum_path) + run_sum_path <- get_analysis_sum_path(.mod, .check_exists = FALSE) + if (fs::file_exists(run_sum_path)) fs::file_delete(run_sum_path) } else { - rlang::abort( + cli::cli_abort( c( - glue("Model output already exists in {get_output_dir(.mod)}."), + "Model output already exists in {get_output_dir(.mod)}.", "Use submit_model(..., .overwrite = TRUE) to overwrite the existing output directories." ) ) @@ -212,11 +278,11 @@ submit_model.bbi_nmboot_model <- function( if (isTRUE(cleaned_up)) { # We dont want to delete anything if the model has been cleaned up # - All output files would be deleted via: - # `setup_bootstrap_run(.boot_run, .overwrite = TRUE)` - rlang::abort( + # `setup_analysis_run(.run, .overwrite = TRUE)` + cli::cli_abort( c( "Model has been cleaned up and cannot be overwritten", - "Call `setup_bootstrap_run(.boot_run, .overwrite = TRUE)` before re-submitting" + "i" = "Call {.func setup_{tolower(run_type)}_run(..., .overwrite = TRUE)} before re-submitting" ) ) } @@ -225,10 +291,10 @@ submit_model.bbi_nmboot_model <- function( res <- if (!isTRUE(.dry_run) && !is.null(.batch_size) && - .batch_size < length(boot_models) + .batch_size < length(run_models) ) { submit_batch_callr( - .mods = boot_models, + .mods = run_models, .batch_size = .batch_size, .bbi_args = .bbi_args, .mode = .mode, @@ -239,7 +305,7 @@ submit_model.bbi_nmboot_model <- function( } else { submit_models( - boot_models, .bbi_args, .mode, ..., + run_models, .bbi_args, .mode, ..., .overwrite = .overwrite, .config_path = .config_path, .wait = .wait, .dry_run = .dry_run ) diff --git a/man/analysis_can_be_summarized.Rd b/man/analysis_can_be_summarized.Rd new file mode 100644 index 000000000..167db2711 --- /dev/null +++ b/man/analysis_can_be_summarized.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{analysis_can_be_summarized} +\alias{analysis_can_be_summarized} +\title{Check if the analysis run (Bootstrap or SSE) can be summarized} +\usage{ +analysis_can_be_summarized(.run) +} +\arguments{ +\item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} model object} +} +\description{ +Check if the analysis run (Bootstrap or SSE) can be summarized +} +\keyword{internal} diff --git a/man/analysis_estimates.Rd b/man/analysis_estimates.Rd new file mode 100644 index 000000000..f7a589cc9 --- /dev/null +++ b/man/analysis_estimates.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{analysis_estimates} +\alias{analysis_estimates} +\title{Tabulate parameter estimates for each model submission in an analysis run} +\usage{ +analysis_estimates(.run, format_long = FALSE, force_resummarize = FALSE) +} +\arguments{ +\item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} object.} + +\item{format_long}{Logical (T/F). If \code{TRUE}, format data as a long table, +making the data more portable for plotting.} + +\item{force_resummarize}{Logical (T/F). If \code{TRUE}, force re-summarization. +Will \emph{only} update the saved out \code{RDS} file when specified via +\code{summarize_bootstrap_run()}. See details for more information.} +} +\description{ +Tabulate parameter estimates for each model submission in an analysis run +} +\keyword{internal} diff --git a/man/bbi_nonmem_model_status.Rd b/man/bbi_nonmem_model_status.Rd index 4bfd9da9a..2a2e022b5 100644 --- a/man/bbi_nonmem_model_status.Rd +++ b/man/bbi_nonmem_model_status.Rd @@ -4,6 +4,7 @@ \alias{bbi_nonmem_model_status} \alias{bbi_nonmem_model_status.bbi_model} \alias{bbi_nonmem_model_status.bbi_nmboot_model} +\alias{bbi_nonmem_model_status.bbi_nmsse_model} \alias{model_is_finished} \title{Return status of a model} \usage{ @@ -13,6 +14,8 @@ bbi_nonmem_model_status(.mod) \method{bbi_nonmem_model_status}{bbi_nmboot_model}(.mod) +\method{bbi_nonmem_model_status}{bbi_nmsse_model}(.mod) + model_is_finished(.mod) } \arguments{ diff --git a/man/cleanup_analysis_run.Rd b/man/cleanup_analysis_run.Rd new file mode 100644 index 000000000..f0896d4f3 --- /dev/null +++ b/man/cleanup_analysis_run.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{cleanup_analysis_run} +\alias{cleanup_analysis_run} +\title{Cleanup analysis run directory} +\usage{ +cleanup_analysis_run(.run, .force = FALSE) +} +\arguments{ +\item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} object.} + +\item{.force}{logical (T/F). If \code{TRUE}, do not prompt the user if they want to delete the models.} +} +\description{ +This will delete all child models, and only keep the information +you need to read in estimates or summary information +} +\details{ +The intent of this function is to help reduce the number of files you need to +commit via version control. Collaborators will be able to read in the +analysis model and summary objects without needing individual run files. +\itemize{ +\item Note that this will prevent \code{force_resummarize = TRUE} from working +} + +\strong{This should only be done} if you no longer need to re-summarize, as this +will clean up (delete) the \emph{individual} analysis model files +} +\keyword{internal} diff --git a/man/cleanup_sse_run.Rd b/man/cleanup_sse_run.Rd new file mode 100644 index 000000000..7be3bc475 --- /dev/null +++ b/man/cleanup_sse_run.Rd @@ -0,0 +1,39 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sse-model.R +\name{cleanup_sse_run} +\alias{cleanup_sse_run} +\title{Cleanup SSE run directory} +\usage{ +cleanup_sse_run(.sse_run, .force = FALSE) +} +\arguments{ +\item{.sse_run}{A \code{bbi_nmsse_model} object.} + +\item{.force}{logical (T/F). If \code{TRUE}, do not prompt the user if they want to delete the models.} +} +\description{ +This will delete all child models, and only keep the information +you need to read in estimates or summary information +} +\details{ +The intent of this function is to help reduce the number of files you need to +commit via version control. Collaborators will be able to read in the +SSE model and summary objects without needing individual run files. +\itemize{ +\item Note that this will prevent \code{force_resummarize = TRUE} from working +} + +\strong{This should only be done} if you no longer need to re-summarize, as this +will clean up (delete) the \emph{individual} SSE model files +} +\examples{ +\dontrun{ + +.sse_run <- read_model(file.path(MODEL_DIR, "1-sse")) +cleanup_sse_run(.sse_run) +} + +} +\seealso{ +\code{\link[=summarize_sse_run]{summarize_sse_run()}} +} diff --git a/man/get_analysis_sum_path.Rd b/man/get_analysis_sum_path.Rd new file mode 100644 index 000000000..c06c51e51 --- /dev/null +++ b/man/get_analysis_sum_path.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/get-path-from-object.R +\name{get_analysis_sum_path} +\alias{get_analysis_sum_path} +\alias{get_analysis_sum_path.bbi_nmboot_model} +\alias{get_analysis_sum_path.bbi_nmsse_model} +\title{Get the relevant analysis run summary path} +\usage{ +get_analysis_sum_path(.mod, .check_exists = TRUE) + +\method{get_analysis_sum_path}{bbi_nmboot_model}(.mod, .check_exists = TRUE) + +\method{get_analysis_sum_path}{bbi_nmsse_model}(.mod, .check_exists = TRUE) +} +\arguments{ +\item{.mod}{a \verb{bbi_\{.model_type\}_model} object.} + +\item{.check_exists}{If \code{TRUE}, the default, will throw an error if the file +does not exist.} +} +\description{ +Get the relevant analysis run summary path +} +\section{Methods (by class)}{ +\itemize{ +\item \code{get_analysis_sum_path(bbi_nmboot_model)}: Get the summary RDS file path from a +\code{bbi_nmboot_model} object + +\item \code{get_analysis_sum_path(bbi_nmsse_model)}: Get the summary RDS file path from a +\code{bbi_nmsse_model} object + +}} +\keyword{internal} diff --git a/man/get_spec_path.Rd b/man/get_spec_path.Rd index 0981f95f4..d8d4b9f84 100644 --- a/man/get_spec_path.Rd +++ b/man/get_spec_path.Rd @@ -25,9 +25,9 @@ does not exist.} a file path } \description{ -Get the bootstrap specification path from a \code{bbi_nmboot_model} object or the -simulation specification path from a \code{bbi_nmsim_model} \emph{or} \code{bbi_nonmem_model} -object. +Get the \strong{analysis run specification} path from a \code{bbi_nmboot_model} or +\code{bbi_nmsse_model} object, or the \strong{simulation specification} path from a +\code{bbi_nmsim_model} \emph{or} \code{bbi_nonmem_model} object. } \section{Methods (by class)}{ \itemize{ diff --git a/man/mod_list_setup.Rd b/man/mod_list_setup.Rd index d1e32eebf..efdb03eeb 100644 --- a/man/mod_list_setup.Rd +++ b/man/mod_list_setup.Rd @@ -13,14 +13,15 @@ packages (e.g., \code{bbr.bayes}) may add additional methods.} } \description{ Coerce model object to a list of models (if not one already) for use in -\code{get_model_status} and \code{wait_for_nonmem}. For \code{bbi_nmboot_model} objects, the -list of individual models corresponding to that run will be returned. +\code{get_model_status} and \code{wait_for_nonmem}. For \code{bbi_nmboot_model} and +\code{bbi_nmsse_model} objects, the list of individual models corresponding to +that run will be returned. } \details{ \code{.mod} is a list of models regardless of input after this section \itemize{ -\item Support a single bbi_nonmem_model, a single bbi_nmboot_model, or a list -of bbi_base_models (bbi_nonmem_model or bbi_nmboot_model) +\item Support a single bbi_base_model (bbi_nonmem_model, bbi_nmboot_model, +bbi_nmsse_model), or a list of bbi_base_models } } \keyword{internal} diff --git a/man/submit_model.Rd b/man/submit_model.Rd index 65f9d114f..ba257f16a 100644 --- a/man/submit_model.Rd +++ b/man/submit_model.Rd @@ -5,6 +5,7 @@ \alias{submit_model.bbi_base_model} \alias{submit_model.bbi_nmsim_model} \alias{submit_model.bbi_nmboot_model} +\alias{submit_model.bbi_nmsse_model} \title{Submit a model to be run} \usage{ submit_model( @@ -51,6 +52,18 @@ submit_model( .dry_run = FALSE, .batch_size = 100 ) + +\method{submit_model}{bbi_nmsse_model}( + .mod, + .bbi_args = NULL, + .mode = "sge", + ..., + .overwrite = FALSE, + .config_path = NULL, + .wait = FALSE, + .dry_run = FALSE, + .batch_size = 100 +) } \arguments{ \item{.mod}{The model object to submit.} @@ -69,11 +82,12 @@ option. This option defaults to "sge" on Linux and "local" otherwise.} \item{.overwrite}{Logical to specify whether or not to overwrite existing model output from a previous run. If \code{NULL}, the default, will defer to setting in \code{.bbi_args} or \code{bbi.yaml}. If \emph{not} \code{NULL} will override any -settings in \code{.bbi_args} or \code{bbi.yaml}. \strong{The exception to this are -bootstrap runs (\code{bbi_nmboot_model} objects).} For bootstrap runs, this -defaults to \code{FALSE} and does \emph{not} respect any setting passed via -\code{.bbi_args} or a \code{bbi.yaml} config file. To overwrite existing bootstrap -output, a user must pass \code{TRUE} through this argument.} +settings in \code{.bbi_args} or \code{bbi.yaml}. \strong{The exception to this are analysis +runs (\code{bbi_nmboot_model} and \code{bbi_nmsse_model} objects).} For analysis +runs (bootstrap and SSE), this defaults to \code{FALSE} and does \emph{not} respect +any setting passed via \code{.bbi_args} or a \code{bbi.yaml} config file. To +overwrite an existing analysis output, a user must pass \code{TRUE} through this +argument.} \item{.config_path}{Path to a bbi configuration file. If \code{NULL}, the default, will attempt to use a \code{bbi.yaml} in the same directory as the @@ -121,6 +135,8 @@ Submits a model to be run by calling out to \code{bbi}. \item \code{submit_model(bbi_nmboot_model)}: Takes a \code{bbi_nmboot_model} object. +\item \code{submit_model(bbi_nmsse_model)}: Takes a \code{bbi_nmsse_model} object. + }} \section{Notes on \code{NONMEM} model extensions}{ diff --git a/man/submit_models.Rd b/man/submit_models.Rd index 2ac1937df..589bdfab8 100644 --- a/man/submit_models.Rd +++ b/man/submit_models.Rd @@ -44,11 +44,12 @@ option. This option defaults to "sge" on Linux and "local" otherwise.} \item{.overwrite}{Logical to specify whether or not to overwrite existing model output from a previous run. If \code{NULL}, the default, will defer to setting in \code{.bbi_args} or \code{bbi.yaml}. If \emph{not} \code{NULL} will override any -settings in \code{.bbi_args} or \code{bbi.yaml}. \strong{The exception to this are -bootstrap runs (\code{bbi_nmboot_model} objects).} For bootstrap runs, this -defaults to \code{FALSE} and does \emph{not} respect any setting passed via -\code{.bbi_args} or a \code{bbi.yaml} config file. To overwrite existing bootstrap -output, a user must pass \code{TRUE} through this argument.} +settings in \code{.bbi_args} or \code{bbi.yaml}. \strong{The exception to this are analysis +runs (\code{bbi_nmboot_model} and \code{bbi_nmsse_model} objects).} For analysis +runs (bootstrap and SSE), this defaults to \code{FALSE} and does \emph{not} respect +any setting passed via \code{.bbi_args} or a \code{bbi.yaml} config file. To +overwrite an existing analysis output, a user must pass \code{TRUE} through this +argument.} \item{.config_path}{Path to a bbi configuration file. If \code{NULL}, the default, will attempt to use a \code{bbi.yaml} in the same directory as the diff --git a/man/submit_nonmem_analysis.Rd b/man/submit_nonmem_analysis.Rd new file mode 100644 index 000000000..72aad7041 --- /dev/null +++ b/man/submit_nonmem_analysis.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/submit-model.R +\name{submit_nonmem_analysis} +\alias{submit_nonmem_analysis} +\title{Submit a NONMEM analysis} +\usage{ +submit_nonmem_analysis( + .mod, + .bbi_args = NULL, + .mode = "sge", + ..., + .overwrite = FALSE, + .config_path = NULL, + .wait = FALSE, + .dry_run = FALSE, + .batch_size = 100 +) +} +\arguments{ +\item{.mod}{The model object to submit.} + +\item{.bbi_args}{A named list specifying arguments to pass to bbi +formatted like \code{list("nm_version" = "nm74gf_nmfe", "json" = T, "threads" = 4)}. Run \code{\link[=print_bbi_args]{print_bbi_args()}} to see valid arguments. Note that bbr does +not support changing the output directory (including through the model or +global YAML files).} + +\item{.mode}{Mode for model submission: "local", "sge", or "slurm". If +unspecified, the value is set to the value of the \code{bbr.bbi_exe_mode} +option. This option defaults to "sge" on Linux and "local" otherwise.} + +\item{...}{args passed through to \code{bbi_exec()}} + +\item{.overwrite}{Logical to specify whether or not to overwrite existing +model output from a previous run. If \code{NULL}, the default, will defer to +setting in \code{.bbi_args} or \code{bbi.yaml}. If \emph{not} \code{NULL} will override any +settings in \code{.bbi_args} or \code{bbi.yaml}. \strong{The exception to this are analysis +runs (\code{bbi_nmboot_model} and \code{bbi_nmsse_model} objects).} For analysis +runs (bootstrap and SSE), this defaults to \code{FALSE} and does \emph{not} respect +any setting passed via \code{.bbi_args} or a \code{bbi.yaml} config file. To +overwrite an existing analysis output, a user must pass \code{TRUE} through this +argument.} + +\item{.config_path}{Path to a bbi configuration file. If \code{NULL}, the +default, will attempt to use a \code{bbi.yaml} in the same directory as the +model.} + +\item{.wait}{If \code{TRUE}, the default, wait for the bbi process to return +before this function call returns. If \code{FALSE} function will return while +bbi process runs in the background.} + +\item{.dry_run}{Returns an object detailing the command that would be run, +insted of running it. This is primarily for testing but also a debugging +tool.} + +\item{.batch_size}{Number of models to submit to run concurrently as a +"batch." Passing \code{NULL} (or a number larger than the number of submitted +models) will bypass this and submit all models concurrently. This will +launch a background process to manage the batch submission. Details from +this process are logged in the \code{OUTPUT} file in top-level bootstrap model +directory.} +} +\description{ +Private implementation function for submitting bootstrap and SSE runs in +batches. +} +\keyword{internal} diff --git a/man/summarize_analysis_run.Rd b/man/summarize_analysis_run.Rd new file mode 100644 index 000000000..9cb219c7f --- /dev/null +++ b/man/summarize_analysis_run.Rd @@ -0,0 +1,15 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/analysis-run-utils.R +\name{summarize_analysis_run} +\alias{summarize_analysis_run} +\title{Summarize an analysis (bootstrap or SSE) run} +\usage{ +summarize_analysis_run(.run) +} +\arguments{ +\item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} object.} +} +\description{ +Summarize an analysis (bootstrap or SSE) run +} +\keyword{internal} diff --git a/man/summarize_sse.Rd b/man/summarize_sse.Rd new file mode 100644 index 000000000..6cc541ed0 --- /dev/null +++ b/man/summarize_sse.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sse-model.R +\name{summarize_sse} +\alias{summarize_sse} +\alias{summarize_sse_run} +\alias{sse_estimates} +\alias{get_sse_models} +\title{Summarize an SSE run} +\usage{ +summarize_sse_run(.sse_run, force_resummarize = FALSE) + +sse_estimates(.sse_run, format_long = FALSE, force_resummarize = FALSE) + +get_sse_models(.sse_run) +} +\arguments{ +\item{.sse_run}{A \code{bbi_nmsse_model} object.} + +\item{force_resummarize}{Logical (T/F). If \code{TRUE}, force re-summarization. +Will \emph{only} update the saved out \code{RDS} file when specified via +\code{summarize_sse_run()}. See details for more information.} + +\item{format_long}{Logical (T/F). If \code{TRUE}, format data as a long table, +making the data more portable for plotting.} +} +\description{ +Summarize the parameter estimates, run details, and any heuristics of a +SSE run, saving the results to a \code{sse_summary.RDS} data file within the +SSE run directory. +} +\details{ +\itemize{ +\item \code{summarize_sse_run()} does the following things: +\itemize{ +\item Tabulates run details and heuristics. +\item Calls \code{summary_log()} and binds the results to the parameter estimates. +information if a \code{sse_summary.RDS} data file exists. +\item Either saves this data out to \code{sse_summary.RDS}, or reads it in if it +already exists (see section below). +\item Formats the returned object as a \code{bbi_nmsse_summary} S3 object, and +displays key summary information when printed to the console. +} +} +\subsection{Saved out data file:}{ + +The first time \code{summarize_sse_run()} is called (or if +\code{force_resummarize = TRUE}), it will save the results to a \code{sse_summary.RDS} +data file within the bootstrap run directory. If one already exists, that data +set will be read in by default instead of being re-summarized. +\itemize{ +\item The purpose of this is functionality two fold. For one, it helps avoid the +need of re-executing \code{model_summary()} calls for a large number of runs. It +also helps to reduce the number of files you need to commit via version +control (see \code{cleanup_sse_run()}). +} +} +} +\section{Functions}{ +\itemize{ +\item \code{summarize_sse_run()}: Summarize an SSE run and store results + +\item \code{sse_estimates()}: Tabulate parameter estimates for each model +submission in an SSE run + +\item \code{get_sse_models()}: Read in all SSE run model objects + +}} +\examples{ +\dontrun{ + +.sse_run <- read_model(file.path(MODEL_DIR, "1-sse")) +boot_sum <- summarize_sse_run(.sse_run) + + +} + +} +\seealso{ +\code{\link[=cleanup_sse_run]{cleanup_sse_run()}} \code{\link[=new_sse_run]{new_sse_run()}} \code{\link[=setup_sse_run]{setup_sse_run()}} +} diff --git a/tests/testthat/helpers-create-example-model.R b/tests/testthat/helpers-create-example-model.R index 10f202019..87db78bc1 100644 --- a/tests/testthat/helpers-create-example-model.R +++ b/tests/testthat/helpers-create-example-model.R @@ -148,7 +148,7 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ boot_sum$boot_compare <- param_estimates_compare(boot_sum) # Save out - boot_sum_path <- file.path(boot_dir, "boot_summary.RDS") + boot_sum_path <- get_analysis_sum_path(boot_run, .check_exists = FALSE) saveRDS(boot_sum, boot_sum_path) return(boot_run) } diff --git a/tests/testthat/test-workflow-bootstrap.R b/tests/testthat/test-workflow-bootstrap.R index b6c8cf5ca..5397e5824 100644 --- a/tests/testthat/test-workflow-bootstrap.R +++ b/tests/testthat/test-workflow-bootstrap.R @@ -199,7 +199,7 @@ withr::with_options( expect_false(model_is_finished(.boot_run)) expect_false(analysis_is_cleaned_up(.boot_run)) expect_error( - bootstrap_can_be_summarized(.boot_run), + analysis_can_be_summarized(.boot_run), "One or more bootstrap runs have not finished executing" ) expect_error( @@ -293,7 +293,7 @@ withr::with_options( expect_true(all(check_nonmem_finished(boot_models))) expect_true(model_is_finished(.boot_run)) expect_false(analysis_is_cleaned_up(.boot_run)) # cannot be cleaned up - expect_true(bootstrap_can_be_summarized(.boot_run)) # can now be summarized + expect_true(analysis_can_be_summarized(.boot_run)) # can now be summarized expect_error( cleanup_bootstrap_run(.boot_run), "Model has not been summarized yet" ) @@ -332,7 +332,7 @@ withr::with_options( }) test_that("summarize_bootstrap_run works as expected", { - boot_sum_path <- file.path(boot_dir, "boot_summary.RDS") + boot_sum_path <- get_analysis_sum_path(.boot_run, .check_exists = FALSE) expect_false(fs::file_exists(boot_sum_path)) expect_no_message(summarize_bootstrap_run(.boot_run)) expect_true(fs::file_exists(boot_sum_path)) @@ -377,7 +377,7 @@ withr::with_options( expect_true(check_nonmem_finished(.boot_run)) expect_true(model_is_finished(.boot_run)) expect_false(analysis_is_cleaned_up(.boot_run)) # is not cleaned up - expect_true(bootstrap_can_be_summarized(.boot_run)) # can still be summarized + expect_true(analysis_can_be_summarized(.boot_run)) # can still be summarized }) test_that("bootstrap run inclusion in config_log (after summary)", { @@ -458,12 +458,12 @@ withr::with_options( expect_true(model_is_finished(.boot_run)) expect_true(analysis_is_cleaned_up(.boot_run)) expect_error( - bootstrap_can_be_summarized(.boot_run), + analysis_can_be_summarized(.boot_run), "The bootstrap run has been cleaned up" ) expect_error( cleanup_bootstrap_run(.boot_run), - "Bootstrap run has already been cleaned" + "bootstrap run has already been cleaned" ) # Make sure the model object and summary can still be read in From 0dde53283c8b1f3d13a6bf6393b176b8dd429aee Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Mon, 27 Jan 2025 17:29:32 -0500 Subject: [PATCH 04/19] add examples and print method for SSE summary --- NAMESPACE | 1 + R/analysis-run-utils.R | 3 ++ R/print.R | 72 ++++++++++++++++++++++++++++++++++++++++++ R/sse-model.R | 25 +++++++++++++-- man/new_sse_run.Rd | 21 ++++++++++-- man/print_bbi.Rd | 5 +++ man/setup_sse_run.Rd | 10 ++++-- 7 files changed, 130 insertions(+), 7 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index a4e369157..d816fdfd2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -76,6 +76,7 @@ S3method(param_labels,bbi_nonmem_model) S3method(param_labels,character) S3method(print,bbi_model) S3method(print,bbi_nmboot_summary) +S3method(print,bbi_nmsse_summary) S3method(print,bbi_nonmem_summary) S3method(print,bbi_process) S3method(print,model_tree_static) diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R index e4ed9efa9..291e89700 100644 --- a/R/analysis-run-utils.R +++ b/R/analysis-run-utils.R @@ -421,6 +421,7 @@ make_analysis_spec <- function(run_models, metadata){ seed = metadata$seed, n_samples = metadata$n_samples, sample_size = metadata$sample_size, + sample_with_replacement = metadata$replace, model_path = get_model_path(metadata$run), based_on_model_path = metadata$orig_mod_path, based_on_data_path = get_data_path_from_ctl(metadata$run, normalize = FALSE), @@ -544,6 +545,8 @@ summarize_analysis_run <- function(.run){ based_on_model_path = analysis_spec$based_on_model_path, based_on_data_set = analysis_spec$based_on_data_path, strat_cols = analysis_spec$strat_cols, + sample_size = analysis_spec$sample_size, + sample_with_replacement = analysis_spec$sample_with_replacement, seed = analysis_spec$seed, n_samples = analysis_spec$n_samples, run_details = run_details, diff --git a/R/print.R b/R/print.R index 86f0de3bb..c718e089b 100644 --- a/R/print.R +++ b/R/print.R @@ -463,6 +463,78 @@ print.bbi_nmboot_summary <- function(x, .digits = 3, .nrow = 10, ...) { } +#' @describeIn print_bbi Prints a high level summary of a model from a `bbi_nmsse_summary` object +#' @export +print.bbi_nmsse_summary <- function(x, .digits = 3, .nrow = 10, ...) { + + # print top line info + .d <- x[[SUMMARY_DETAILS]] + cli_h1("Based on") + cat_line(paste("Model:", col_blue(x$based_on_model_path))) + cat_line(paste("Dataset:", col_blue(x$based_on_data_set))) + + # Run specifications (seed, stratification columns, cleaned_up) + cli_h1("Run Specifications") + + strat_cols <- if(is.null(x$strat_cols)) "None" else paste(x$strat_cols, collapse = ", ") + names(strat_cols) <- "Stratification Columns" + + sample_size <- if(is.null(x$sample_size)) "Full dataset" else x$sample_size + names(sample_size) <- "Sample Size" + + seed <- if(is.null(x$seed)) "None" else x$seed + names(seed) <- "Seed" + + run_specs <- c(strat_cols, sample_size, seed) + iwalk(run_specs, ~ cat_bullet(paste0(.y, ": ", col_blue(.x)))) + + # Add bullet if cleaned up + if(isTRUE(analysis_is_cleaned_up(x))){ + cli::cat_bullet(paste("Cleaned up:", col_green(TRUE))) + } + + # SSE run summary (n_samples, any heuristics) + cli_h1("SSE Run Summary") + + # TODO: confirm this is appropriate for only_sim (unsure where this comes from) + only_sim <- isTRUE("only_sim" %in% names(.d)) + if (only_sim) { + cat_line("No Estimation Methods (ONLYSIM)\n") + } else { + cli::cat_line("Estimation Method(s):\n") + purrr::walk(paste(x$estimation_method, "\n"), cli::cat_bullet, bullet = "en_dash") + } + + cli::cat_line("Run Status:\n") + n_samples <- c("Number of runs" = x$n_samples) + cli::cat_bullet(paste("Number of runs:", col_blue(x$n_samples)), bullet = "en_dash") + + # check heuristics + .h <- x[[SUMMARY_HEURISTICS]] + heuristics_cols <- names(.h)[!grepl(ABS_MOD_PATH, names(.h))] + heuristics <- purrr::map_dfr(heuristics_cols, function(col){ + tibble(heuristic = col, any_found = any(.h[[col]]), n_found = sum(.h[[col]])) + }) + + if (any(heuristics$any_found)) { + heuristics_found <- heuristics$heuristic[which(heuristics$any_found)] + heuristics_n <- heuristics$n_found[which(heuristics$any_found)] + heuristics_perc <- round((heuristics_n/n_samples) * 100, 2) + purrr::walk( + paste0(heuristics_found, ": ", col_red(heuristics_n)," (", col_red(heuristics_perc), " %)"), + cli::cat_bullet, bullet = "en_dash" + ) + cat("\n") + } else { + cat_line("\n") + } + + if (only_sim) { + return(invisible(NULL)) + } + +} + #' @describeIn print_bbi Prints the `NM-TRAN` evaluation of a `bbi_nonmem_model` #' object #' @export diff --git a/R/sse-model.R b/R/sse-model.R index 50013eb9b..52fc34d3c 100644 --- a/R/sse-model.R +++ b/R/sse-model.R @@ -13,11 +13,24 @@ #' @examples #' \dontrun{ #' +#' # Denote N number of simulations +#' N_SIM <- 20 +#' +#' # Simulate data +#' add_simulation(.mod, n = N_SIM, .mode = "local") +#' sim_data <- nm_join_sim(.mod) +#' #' # Create new bootstrap object #' .sse_run <- new_sse_run(.mod) #' #' # Set up the run -#' setup_sse_run(.sse_run) +#' setup_sse_run( +#' .sse_run, +#' data = sim_data, +#' n = N_SIM, +#' sample_size = 30, +#' sim_col = "nn" +#' ) #' } #' @return S3 object of class `bbi_nmsse_model`. #' @export @@ -91,13 +104,19 @@ new_sse_run <- function( #' @examples #' \dontrun{ #' +#' # Simulate data +#' N_SIM <- 1000 +#' add_simulation(.mod, n = N_SIM, .mode = "local") +#' sim_data <- nm_join_sim(.mod) +#' #' # Setup #' .sse_run <- new_sse_run(.mod) #' .sse_run <- setup_sse_run( #' .sse_run, -#' n = 1000, +#' data = sim_data, +#' sim_col = "nn", +#' n = N_SIM, #' sample_size = 50, -#' seed = 1234, #' strat_cols = c("STUDY", "SEX") #' ) #' diff --git a/man/new_sse_run.Rd b/man/new_sse_run.Rd index 2f04f1e28..0a3045534 100644 --- a/man/new_sse_run.Rd +++ b/man/new_sse_run.Rd @@ -10,7 +10,8 @@ new_sse_run( .inherit_tags = TRUE, .overwrite = FALSE, remove_cov = TRUE, - remove_tables = TRUE + remove_tables = TRUE, + remove_msf = TRUE ) } \arguments{ @@ -27,6 +28,9 @@ file at \code{.new_model} will be overwritten silently.} \item{remove_cov, remove_tables}{If \code{TRUE}, the default, remove \verb{$COVARIANCE} and \verb{$TABLE} records respectively, allowing for notably faster run times.} + +\item{remove_msf}{If \code{TRUE}, the default, remove any \code{MSFO} options from +\verb{$EST} records.} } \value{ S3 object of class \code{bbi_nmsse_model}. @@ -41,10 +45,23 @@ to \code{\link[=setup_sse_run]{setup_sse_run()}} before submission (see examples \examples{ \dontrun{ +# Denote N number of simulations +N_SIM <- 20 + +# Simulate data +add_simulation(.mod, n = N_SIM, .mode = "local") +sim_data <- nm_join_sim(.mod) + # Create new bootstrap object .sse_run <- new_sse_run(.mod) # Set up the run -setup_sse_run(.sse_run) +setup_sse_run( + .sse_run, + data = sim_data, + n = N_SIM, + sample_size = 30, + sim_col = "nn" +) } } diff --git a/man/print_bbi.Rd b/man/print_bbi.Rd index c9a8aed1c..44729d6c3 100644 --- a/man/print_bbi.Rd +++ b/man/print_bbi.Rd @@ -6,6 +6,7 @@ \alias{print.bbi_model} \alias{print.bbi_nonmem_summary} \alias{print.bbi_nmboot_summary} +\alias{print.bbi_nmsse_summary} \alias{print.nmtran_process} \alias{print.model_tree_static} \title{Print methods for bbr objects} @@ -18,6 +19,8 @@ \method{print}{bbi_nmboot_summary}(x, .digits = 3, .nrow = 10, ...) +\method{print}{bbi_nmsse_summary}(x, .digits = 3, .nrow = 10, ...) + \method{print}{nmtran_process}(x, ...) \method{print}{model_tree_static}(x, newpage = is.null(vp), vp = NULL, ...) @@ -62,6 +65,8 @@ will make for prettier formatting, especially of table outputs. \item \code{print(bbi_nmboot_summary)}: Prints a high level summary of a model from a \code{bbi_nmboot_summary} object +\item \code{print(bbi_nmsse_summary)}: Prints a high level summary of a model from a \code{bbi_nmsse_summary} object + \item \code{print(nmtran_process)}: Prints the \code{NM-TRAN} evaluation of a \code{bbi_nonmem_model} object diff --git a/man/setup_sse_run.Rd b/man/setup_sse_run.Rd index d5bf611de..b598f1ae5 100644 --- a/man/setup_sse_run.Rd +++ b/man/setup_sse_run.Rd @@ -64,13 +64,19 @@ to view the results. See examples below. \examples{ \dontrun{ +# Simulate data +N_SIM <- 1000 +add_simulation(.mod, n = N_SIM, .mode = "local") +sim_data <- nm_join_sim(.mod) + # Setup .sse_run <- new_sse_run(.mod) .sse_run <- setup_sse_run( .sse_run, - n = 1000, + data = sim_data, + sim_col = "nn", + n = N_SIM, sample_size = 50, - seed = 1234, strat_cols = c("STUDY", "SEX") ) From 5d287e86e940c07efd00fe811cd5095575851a16 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 28 Jan 2025 15:32:48 -0500 Subject: [PATCH 05/19] fix docs and change default to replace = TRUE --- R/analysis-run-utils.R | 2 +- R/sse-model.R | 10 +++++----- man/new_sse_run.Rd | 2 +- man/setup_analysis_run.Rd | 2 +- man/setup_bootstrap_run.Rd | 2 +- man/setup_sse_run.Rd | 8 ++++---- man/summarize_sse.Rd | 2 +- 7 files changed, 14 insertions(+), 14 deletions(-) diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R index 291e89700..c57dccc3e 100644 --- a/R/analysis-run-utils.R +++ b/R/analysis-run-utils.R @@ -77,7 +77,7 @@ new_analysis_run <- function( #' if using [bbr::add_simulation()], though `"IREP"` is also common (e.g., when #' using `mrgsolve`). #' @param .bbi_args Named list passed to `model_summary(orig_mod, .bbi_args)`, -#' where `orig_mod` is the model `.boot_run` is based on. See +#' where `orig_mod` is the model the analysis is based on. See #' [print_bbi_args()] for valid options. Defaults to `list(no_grd_file = TRUE, #' no_shk_file = TRUE)` because [model_summary()] is only called internally to #' extract the number of records, so those files are irrelevant. Only used if diff --git a/R/sse-model.R b/R/sse-model.R index 52fc34d3c..dd96eebaf 100644 --- a/R/sse-model.R +++ b/R/sse-model.R @@ -20,7 +20,7 @@ #' add_simulation(.mod, n = N_SIM, .mode = "local") #' sim_data <- nm_join_sim(.mod) #' -#' # Create new bootstrap object +#' # Create new SSE object #' .sse_run <- new_sse_run(.mod) #' #' # Set up the run @@ -79,7 +79,7 @@ new_sse_run <- function( -#' Set up a bootstrap model run +#' Set up a SSE model run #' #' This function takes a `bbi_nmsse_model` (created by a previous #' [new_sse_run()] call) and creates `n` new model objects and re-sampled @@ -95,7 +95,7 @@ new_sse_run <- function( #' @details #' Once you have run this function, you can execute your SSE with #' [submit_model()]. You can use [get_model_status()] to check on your submitted -#' bootstrap run. Once all models have finished, use [summarize_sse_run()] +#' SSE run. Once all models have finished, use [summarize_sse_run()] #' to view the results. See examples below. #' #' @@ -137,7 +137,7 @@ setup_sse_run <- function( n = 200, sample_size = NULL, strat_cols = NULL, - replace = FALSE, + replace = TRUE, seed = 1234, data = NULL, sim_col = "nn", @@ -183,7 +183,7 @@ setup_sse_run <- function( #' ## Saved out data file: #' The first time `summarize_sse_run()` is called (or if #' `force_resummarize = TRUE`), it will save the results to a `sse_summary.RDS` -#' data file within the bootstrap run directory. If one already exists, that data +#' data file within the SSE run directory. If one already exists, that data #' set will be read in by default instead of being re-summarized. #' - The purpose of this is functionality two fold. For one, it helps avoid the #' need of re-executing `model_summary()` calls for a large number of runs. It diff --git a/man/new_sse_run.Rd b/man/new_sse_run.Rd index 0a3045534..59d56e1fa 100644 --- a/man/new_sse_run.Rd +++ b/man/new_sse_run.Rd @@ -52,7 +52,7 @@ N_SIM <- 20 add_simulation(.mod, n = N_SIM, .mode = "local") sim_data <- nm_join_sim(.mod) -# Create new bootstrap object +# Create new SSE object .sse_run <- new_sse_run(.mod) # Set up the run diff --git a/man/setup_analysis_run.Rd b/man/setup_analysis_run.Rd index 90691112d..fd7a5d4c7 100644 --- a/man/setup_analysis_run.Rd +++ b/man/setup_analysis_run.Rd @@ -40,7 +40,7 @@ if using \code{\link[=add_simulation]{add_simulation()}}, though \code{"IREP"} i using \code{mrgsolve}).} \item{.bbi_args}{Named list passed to \code{model_summary(orig_mod, .bbi_args)}, -where \code{orig_mod} is the model \code{.boot_run} is based on. See +where \code{orig_mod} is the model the analysis is based on. See \code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to extract the number of records, so those files are irrelevant. Only used if the based on model (the model the analysis is being performed on) has been diff --git a/man/setup_bootstrap_run.Rd b/man/setup_bootstrap_run.Rd index c19fdc8b4..b69fd53d5 100644 --- a/man/setup_bootstrap_run.Rd +++ b/man/setup_bootstrap_run.Rd @@ -29,7 +29,7 @@ the \emph{filtered} output from \code{nm_data(.boot_run, filter = TRUE)}. If pro must include the same column names as what's returned from \code{nm_data(.mod)}.} \item{.bbi_args}{Named list passed to \code{model_summary(orig_mod, .bbi_args)}, -where \code{orig_mod} is the model \code{.boot_run} is based on. See +where \code{orig_mod} is the model the analysis is based on. See \code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to extract the number of records, so those files are irrelevant. Only used if the based on model (the model the analysis is being performed on) has been diff --git a/man/setup_sse_run.Rd b/man/setup_sse_run.Rd index b598f1ae5..13b55e4cc 100644 --- a/man/setup_sse_run.Rd +++ b/man/setup_sse_run.Rd @@ -2,14 +2,14 @@ % Please edit documentation in R/sse-model.R \name{setup_sse_run} \alias{setup_sse_run} -\title{Set up a bootstrap model run} +\title{Set up a SSE model run} \usage{ setup_sse_run( .sse_run, n = 200, sample_size = NULL, strat_cols = NULL, - replace = FALSE, + replace = TRUE, seed = 1234, data = NULL, sim_col = "nn", @@ -39,7 +39,7 @@ if using \code{\link[=add_simulation]{add_simulation()}}, though \code{"IREP"} i using \code{mrgsolve}).} \item{.bbi_args}{Named list passed to \code{model_summary(orig_mod, .bbi_args)}, -where \code{orig_mod} is the model \code{.boot_run} is based on. See +where \code{orig_mod} is the model the analysis is based on. See \code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to extract the number of records, so those files are irrelevant. Only used if the based on model (the model the analysis is being performed on) has been @@ -58,7 +58,7 @@ objects, and the new datasets are sampled from the dataset passed to \code{data} \details{ Once you have run this function, you can execute your SSE with \code{\link[=submit_model]{submit_model()}}. You can use \code{\link[=get_model_status]{get_model_status()}} to check on your submitted -bootstrap run. Once all models have finished, use \code{\link[=summarize_sse_run]{summarize_sse_run()}} +SSE run. Once all models have finished, use \code{\link[=summarize_sse_run]{summarize_sse_run()}} to view the results. See examples below. } \examples{ diff --git a/man/summarize_sse.Rd b/man/summarize_sse.Rd index 6cc541ed0..ba27985f5 100644 --- a/man/summarize_sse.Rd +++ b/man/summarize_sse.Rd @@ -45,7 +45,7 @@ displays key summary information when printed to the console. The first time \code{summarize_sse_run()} is called (or if \code{force_resummarize = TRUE}), it will save the results to a \code{sse_summary.RDS} -data file within the bootstrap run directory. If one already exists, that data +data file within the SSE run directory. If one already exists, that data set will be read in by default instead of being re-summarized. \itemize{ \item The purpose of this is functionality two fold. For one, it helps avoid the From 775bb0db9752996362f19ead10fc1ae16bd07f84 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 28 Jan 2025 15:47:18 -0500 Subject: [PATCH 06/19] fix bootstrap helper function: make_fake_boot - update to use new spec names --- tests/testthat/helpers-create-example-model.R | 11 ++++++----- tests/testthat/test-model-status.R | 2 +- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/tests/testthat/helpers-create-example-model.R b/tests/testthat/helpers-create-example-model.R index 87db78bc1..92f8695e0 100644 --- a/tests/testthat/helpers-create-example-model.R +++ b/tests/testthat/helpers-create-example-model.R @@ -115,9 +115,10 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ boot_data_dir <- file.path(boot_dir, "data") boot_args <- list( - boot_run = boot_run, + run = boot_run, + run_type = "bootstrap", all_mod_names = mod_names, - boot_mod_path = get_model_path(boot_run), + run_mod_path = get_model_path(boot_run), orig_mod_path = get_model_path(mod), orig_mod_id = get_model_id(mod), orig_mod_bbi_args = mod$bbi_args, @@ -125,8 +126,8 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ strat_cols = strat_cols, seed = 1234, n_samples = n, - boot_dir = boot_dir, - boot_data_dir = boot_data_dir, + run_dir = boot_dir, + data_dir = boot_data_dir, overwrite = TRUE ) @@ -138,7 +139,7 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ # Adjust estimates to look like real bootstrap # - jitter and then make normal distribution - boot_sum$boot_summary <- boot_sum$boot_summary %>% dplyr::mutate( + boot_sum$analysis_summary <- boot_sum$analysis_summary %>% dplyr::mutate( dplyr::across(starts_with(c("THETA", "OMEGA")), ~ jitter(.x, factor = 10)) ) %>% dplyr::mutate( dplyr::across(starts_with(c("THETA", "OMEGA")), ~ rnorm(n = n, mean = mean(.x), sd = sd(.x))) diff --git a/tests/testthat/test-model-status.R b/tests/testthat/test-model-status.R index 6aacd36f7..784b347a6 100644 --- a/tests/testthat/test-model-status.R +++ b/tests/testthat/test-model-status.R @@ -63,7 +63,7 @@ describe("Model status helpers return the correct status", { expect_false(check_nonmem_finished(.boot_run)) expect_message( get_model_status(.boot_run), - "Bootstrap run `1-boot` has not been set up", fixed = TRUE + "bootstrap run `1-boot` has not been set up", fixed = TRUE ) # After setup (only get_model_status changes) From 1c9ea342383841002dbfffbd0b4f53fbd101afdd Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 28 Jan 2025 15:54:47 -0500 Subject: [PATCH 07/19] prefix new internal function in make_fake_boot --- tests/testthat/helpers-create-example-model.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/helpers-create-example-model.R b/tests/testthat/helpers-create-example-model.R index 92f8695e0..3147d14f3 100644 --- a/tests/testthat/helpers-create-example-model.R +++ b/tests/testthat/helpers-create-example-model.R @@ -149,7 +149,7 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ boot_sum$boot_compare <- param_estimates_compare(boot_sum) # Save out - boot_sum_path <- get_analysis_sum_path(boot_run, .check_exists = FALSE) + boot_sum_path <- bbr:::get_analysis_sum_path(boot_run, .check_exists = FALSE) saveRDS(boot_sum, boot_sum_path) return(boot_run) } From 7d13e3c73140e6773320f133a110bc6c88fa0ce5 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 28 Jan 2025 16:00:55 -0500 Subject: [PATCH 08/19] fix get_analysis_models expected message --- R/analysis-run-utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R index c57dccc3e..c57d65a37 100644 --- a/R/analysis-run-utils.R +++ b/R/analysis-run-utils.R @@ -667,7 +667,7 @@ get_analysis_models <- function(.run){ if(is.null(mods) || rlang::is_empty(mods)){ rlang::abort( c( - glue("At least one {run_type} model does not exist in `{run_dir}`") + glue("At least one {run_type} run model does not exist in `{run_dir}`") ) ) }else{ From db0cd039b0a00d3b0185fbc781c446c3e27dae1e Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Wed, 29 Jan 2025 11:46:11 -0500 Subject: [PATCH 09/19] update pkgdown - Doing it early so CI is valuable --- _pkgdown.yml | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index 12cead396..8771e6a1e 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -47,21 +47,30 @@ reference: - apply_indices - block -- title: Bootstrap and Simulation +- title: Bootstrap and SSE contents: - - add_simulation - - has_simulation - - get_simulation - - nm_join_sim - new_bootstrap_run + - new_sse_run - setup_bootstrap_run + - setup_sse_run - summarize_bootstrap_run + - summarize_sse_run - bootstrap_estimates + - sse_estimates - get_boot_models + - get_sse_models - cleanup_bootstrap_run + - cleanup_sse_run - param_estimates_batch - param_estimates_compare +- title: Simulation + contents: + - add_simulation + - has_simulation + - get_simulation + - nm_join_sim + - title: Summary log tables contents: - run_log From 2070032a1d24f44d21b9e3e1247275ddf7bf8140 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 31 Jan 2025 13:43:43 -0500 Subject: [PATCH 10/19] add sse model type to model_tree --- R/model-tree.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/model-tree.R b/R/model-tree.R index e519d068e..31e190eaf 100644 --- a/R/model-tree.R +++ b/R/model-tree.R @@ -826,6 +826,7 @@ format_model_type <- function(model_type, fmt_html = FALSE, ...){ mod_type_fmt <- dplyr::case_when( model_type == "nonmem" ~ "NONMEM Model", model_type == "nmboot" ~ "Bootstrap Run", + model_type == "nmsse" ~ "SSE Run", model_type == "nmsim" ~ "Simulation", TRUE ~ paste(toupper(model_type), "Model") ) @@ -837,6 +838,8 @@ format_model_type <- function(model_type, fmt_html = FALSE, ...){ style_html(mod_type_fmt, color = "#119a9c", bold_css, ...), model_type == "nmboot" ~ style_html(mod_type_fmt, color = "#c49f02", bold_css, ...), + model_type == "nmsse" ~ + style_html(mod_type_fmt, color = "#c49f02", bold_css, ...), model_type == "nmsim" ~ style_html(mod_type_fmt, color = "#ad7fa8", bold_css, ...), TRUE ~ From 1b9e0cc7b1a65467cf1918814fd6049a6ff4ecdf Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 31 Jan 2025 13:44:30 -0500 Subject: [PATCH 11/19] add sse method for config_log - pull logic out of nmboot method since sse and bootstrap methods are identical --- R/config-log.R | 31 ++++++++++++++++++++++--------- 1 file changed, 22 insertions(+), 9 deletions(-) diff --git a/R/config-log.R b/R/config-log.R index 990a8b2ac..ac0b0941d 100644 --- a/R/config-log.R +++ b/R/config-log.R @@ -183,27 +183,40 @@ config_log_make_entry.bbi_nonmem_model <- function(.mod, config, fields = NULL) #' @rdname config_log_make_entry #' @export config_log_make_entry.bbi_nmboot_model <- function(.mod, config, fields = NULL) { + config_log_make_entry_analysis(.mod, config, fields) +} + +#' @rdname config_log_make_entry +#' @export +config_log_make_entry.bbi_nmsse_model <- function(.mod, config, fields = NULL) { + config_log_make_entry_analysis(.mod, config, fields) +} + +#' Prepare a model-specific config log entry for an analysis (bootstrap or SSE) +#' @inheritParams config_log_make_entry +#' @noRd +config_log_make_entry_analysis <- function(.mod, config, fields = NULL) { # Make data names consistent with other models in config_log (path and md5) - boot_config <- config$analysis_spec - boot_config[[CONFIG_DATA_PATH]] <- boot_config[["based_on_data_path"]] - boot_config[["data_md5"]] <- boot_config[["based_on_data_md5"]] + analysis_config <- config$analysis_spec + analysis_config[[CONFIG_DATA_PATH]] <- analysis_config[["based_on_data_path"]] + analysis_config[["data_md5"]] <- analysis_config[["based_on_data_md5"]] # bbi and nonmem versions will be NULL until the run has been summarized # - replace with NA to keep the same column order - boot_config[["bbi_version"]] <- boot_config[["bbi_version"]] %||% NA_character_ + analysis_config[["bbi_version"]] <- analysis_config[["bbi_version"]] %||% NA_character_ fields <- fields %||% CONFIG_KEEPERS - if (!all(fields %in% names(boot_config))) { + if (!all(fields %in% names(analysis_config))) { path <- get_config_path(.mod, .check_exists = FALSE) msg <- paste( glue( "{path} is missing the required keys:", - "`{paste(fields[!(fields %in% names(boot_config))], collapse = ', ')}`", + "`{paste(fields[!(fields %in% names(analysis_config))], collapse = ', ')}`", "and will be skipped.", .sep = " " ), glue( "This is likely because it was run with an old version of bbi.", - "Model was run on version {boot_config[['bbi_version']]}", + "Model was run on version {analysis_config[['bbi_version']]}", .sep = " " ), glue( @@ -218,9 +231,9 @@ config_log_make_entry.bbi_nmboot_model <- function(.mod, config, fields = NULL) warning(msg) return(NULL) } - boot_config[["nm_version"]] <- resolve_nonmem_version(boot_config) %||% NA_character_ + analysis_config[["nm_version"]] <- resolve_nonmem_version(analysis_config) %||% NA_character_ - return(list(config = boot_config, fields = c(fields, "nm_version"))) + return(list(config = analysis_config, fields = c(fields, "nm_version"))) } #' Parse a bbi config file From 35d6411d091cad7d55a0b203a0f9d5c8d8a4d1cc Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 31 Jan 2025 13:45:38 -0500 Subject: [PATCH 12/19] refactor make_fake_boot to make_fake_analysis - so we can use the same function to create a fake sse or bootstrap run --- tests/testthat/helpers-create-example-model.R | 72 +++++++++++-------- tests/testthat/test-model-tree.R | 2 +- vignettes/model-tree.Rmd | 2 +- 3 files changed, 45 insertions(+), 31 deletions(-) diff --git a/tests/testthat/helpers-create-example-model.R b/tests/testthat/helpers-create-example-model.R index 3147d14f3..90e352c77 100644 --- a/tests/testthat/helpers-create-example-model.R +++ b/tests/testthat/helpers-create-example-model.R @@ -80,26 +80,35 @@ add_msf_opt <- function(mod, msf_path = paste0(get_model_id(mod), ".MSF")){ # This function makes a fake bootstrap run that appears to have been run # MOD1 results are copied `n` times, and the summary results are jittered # to reflect an actual bootstrap run -make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ - boot_run <- new_bootstrap_run(mod, .overwrite = TRUE) - boot_dir <- boot_run$absolute_model_path - fs::dir_create(boot_dir) - - model_dir <- dirname(boot_dir) - boot_dir_rel <- fs::path_rel(boot_dir, model_dir) +make_fake_analysis <- function( + mod, + run_type = c("bootstrap", "sse"), + n = 100, + strat_cols = c("SEX", "ETN") + ){ + run_type <- match.arg(run_type) + analysis_fn <- if(run_type == "bootstrap") new_bootstrap_run else new_sse_run + analysis_sum_fn <- if(run_type == "bootstrap") summarize_bootstrap_run else summarize_sse_run + + .run <- analysis_fn(mod, .overwrite = TRUE) + run_dir <- .run$absolute_model_path + fs::dir_create(run_dir) + + model_dir <- dirname(run_dir) + run_dir_rel <- fs::path_rel(run_dir, model_dir) # Need to explicitly point to internal function for vignette building mod_names <- purrr::map_chr(seq(n), max_char = nchar(n), bbr:::pad_left) - boot_mods <- purrr::map(mod_names, function(id.i){ - output_dir.i <- file.path(boot_dir_rel, id.i) + analysis_mods <- purrr::map(mod_names, function(id.i){ + output_dir.i <- file.path(run_dir_rel, id.i) new_mod <- copy_model_from( .parent_mod = mod, .new_model = output_dir.i, - .add_tags = "BOOTSTRAP_RUN", + .add_tags = paste0(toupper(run_type), "_RUN"), .overwrite = TRUE ) - new_dir_path <- file.path(boot_dir, id.i) + new_dir_path <- file.path(run_dir, id.i) fs::dir_copy(mod$absolute_model_path, new_dir_path) # replace file names with new model ID (needed for summary call) orig_mod_id <- get_model_id(mod) @@ -113,12 +122,12 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ new_mod }) - boot_data_dir <- file.path(boot_dir, "data") - boot_args <- list( - run = boot_run, - run_type = "bootstrap", + data_dir <- file.path(run_dir, "data") + metadata <- list( + run = .run, + run_type = run_type, all_mod_names = mod_names, - run_mod_path = get_model_path(boot_run), + run_mod_path = get_model_path(.run), orig_mod_path = get_model_path(mod), orig_mod_id = get_model_id(mod), orig_mod_bbi_args = mod$bbi_args, @@ -126,36 +135,41 @@ make_fake_boot <- function(mod, n = 100, strat_cols = c("SEX", "ETN")){ strat_cols = strat_cols, seed = 1234, n_samples = n, - run_dir = boot_dir, - data_dir = boot_data_dir, + run_dir = run_dir, + data_dir = data_dir, overwrite = TRUE ) + if(run_type == "sse") metadata$sample_size <- 30 + # Need to explicitly point to internal function for vignette building - bbr:::make_analysis_spec(boot_mods, boot_args) + bbr:::make_analysis_spec(analysis_mods, metadata) - # Read in summary to adjust estimates to look like real bootstrap - boot_sum <- summarize_bootstrap_run(boot_run) + # Read in summary to adjust estimates to look like real bootstrap/SSE + analysis_sum <- analysis_sum_fn(.run) - # Adjust estimates to look like real bootstrap + # Adjust estimates to look like real bootstrap/SSE # - jitter and then make normal distribution - boot_sum$analysis_summary <- boot_sum$analysis_summary %>% dplyr::mutate( + analysis_sum$analysis_summary <- analysis_sum$analysis_summary %>% dplyr::mutate( dplyr::across(starts_with(c("THETA", "OMEGA")), ~ jitter(.x, factor = 10)) ) %>% dplyr::mutate( dplyr::across(starts_with(c("THETA", "OMEGA")), ~ rnorm(n = n, mean = mean(.x), sd = sd(.x))) ) - # Adjust comparison table - boot_sum$boot_compare <- param_estimates_compare(boot_sum) + # Adjust comparison table for bootstrap + if(run_type == "bootstrap"){ + analysis_sum$boot_compare <- param_estimates_compare(analysis_sum) + } + # Save out - boot_sum_path <- bbr:::get_analysis_sum_path(boot_run, .check_exists = FALSE) - saveRDS(boot_sum, boot_sum_path) - return(boot_run) + sum_path <- bbr:::get_analysis_sum_path(.run, .check_exists = FALSE) + saveRDS(analysis_sum, sum_path) + return(.run) } # This function creates a new model, and attaches a simulation to it -# Unlike make_fake_boot however, the simulation will have a status of "Not Run" +# Unlike make_fake_analysis however, the simulation will have a status of "Not Run" make_fake_sim <- function(mod, mod_id = "mod-sim", n = 100){ mod_sim <- copy_model_from(mod, mod_id) %>% update_model_id() model_dir <- bbr:::get_model_working_directory(mod) diff --git a/tests/testthat/test-model-tree.R b/tests/testthat/test-model-tree.R index 57023061a..bd1adc02c 100644 --- a/tests/testthat/test-model-tree.R +++ b/tests/testthat/test-model-tree.R @@ -231,7 +231,7 @@ withr::with_options(list(bbr.bbi_exe_path = read_bbi_path()), { it("Include bootstrap model", { skip_if_old_bbi("3.2.0") # calls model_summary() clean_test_enviroment(create_tree_models) - boot_run <- make_fake_boot(MOD1, n = 3) + boot_run <- make_fake_analysis(MOD1, run_type = "bootstrap", n = 3) on.exit(delete_models(boot_run, .tags = NULL, .force = TRUE), add = TRUE) run_df <- run_log(MODEL_DIR) tree_data <- make_tree_data(run_df, add_summary = TRUE) diff --git a/vignettes/model-tree.Rmd b/vignettes/model-tree.Rmd index 830705dde..724fa50ca 100644 --- a/vignettes/model-tree.Rmd +++ b/vignettes/model-tree.Rmd @@ -95,7 +95,7 @@ create_tree_models <- function(MODEL_DIR){ copy_output_dir(mod1, mod6) # Fake Bootstrap run - boot_run <- make_fake_boot(mod6, n = 10) + boot_run <- make_fake_analysis(mod6, run_type = "bootstrap", n = 10) # Fake simulation (creates a new model) mod_sim <- make_fake_sim(mod3, n = 10, mod_id = "8") From 2d809caa2557e496a87131dc565c8e85c3ab4bad Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Fri, 31 Jan 2025 13:55:50 -0500 Subject: [PATCH 13/19] add check_up_to_date method for SSE runs - update docs and NAMESPACE --- NAMESPACE | 2 + R/check-up-to-date.R | 121 ++++++++++++++++++------------- man/check_up_to_date.Rd | 3 + man/check_up_to_date_analysis.Rd | 20 +++++ man/config_log_make_entry.Rd | 3 + 5 files changed, 98 insertions(+), 51 deletions(-) create mode 100644 man/check_up_to_date_analysis.Rd diff --git a/NAMESPACE b/NAMESPACE index d816fdfd2..b9f0a4b21 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -15,8 +15,10 @@ S3method(check_output_dir,character) S3method(check_up_to_date,bbi_base_model) S3method(check_up_to_date,bbi_log_df) S3method(check_up_to_date,bbi_nmboot_model) +S3method(check_up_to_date,bbi_nmsse_model) S3method(check_up_to_date,bbi_nonmem_summary) S3method(config_log_make_entry,bbi_nmboot_model) +S3method(config_log_make_entry,bbi_nmsse_model) S3method(config_log_make_entry,bbi_nonmem_model) S3method(config_log_make_entry,default) S3method(copy_model_from,bbi_nonmem_model) diff --git a/R/check-up-to-date.R b/R/check-up-to-date.R index 02cb45839..189ae95f1 100644 --- a/R/check-up-to-date.R +++ b/R/check-up-to-date.R @@ -67,58 +67,13 @@ check_up_to_date.bbi_base_model <- function(.bbi_object, ...) { #' @rdname check_up_to_date #' @export check_up_to_date.bbi_nmboot_model <- function(.bbi_object, ...) { - output_dir <- get_output_dir(.bbi_object, .check_exists = FALSE) - if (!fs::dir_exists(output_dir)) { - rlang::abort( - c( - paste( - glue("Model {get_model_id(.bbi_object)}:"), - "Cannot check if up-to-date because bootstrap run has not been set up yet" - ), - "See `?setup_bootstrap_run` for more details" - ) - ) - } - - if(!model_is_finished(.bbi_object)){ - rlang::abort(paste(glue("Model {get_model_id(.bbi_object)}:"), CHECK_UP_TO_DATE_ERR_MSG)) - } - - boot_spec <- get_analysis_spec(.bbi_object) - - # check necessary files for changes - model_file <- get_model_path(.bbi_object) - based_on_data_file <- get_data_path(.bbi_object, .check_exists = FALSE) - - changed_files <- c( - boot_spec[[CONFIG_MODEL_MD5]] != tools::md5sum(model_file), - boot_spec[[CONFIG_DATA_BASED_ON_MD5]] != tools::md5sum(based_on_data_file) - ) - - any_changes <- any(changed_files) - if(isTRUE(any_changes)) { - message(paste( - glue("The following files have changed in {get_model_id(.bbi_object)}"), - paste("*", names(which(changed_files)), collapse = "\n"), - sep = "\n" - )) - } - - na_files <- is.na(changed_files) - if(isTRUE(any(na_files))) { - message(paste( - glue("The following files in {get_model_id(.bbi_object)} ARE NO LONGER PRESENT"), - paste("*", names(changed_files[na_files]), collapse = "\n"), - sep = "\n" - )) - } - - - # build return value - res <- replace_na(!changed_files, FALSE) - names(res) <- c("model", "data") + check_up_to_date_analysis(.bbi_object) +} - return(invisible(res)) +#' @rdname check_up_to_date +#' @export +check_up_to_date.bbi_nmsse_model <- function(.bbi_object, ...) { + check_up_to_date_analysis(.bbi_object) } #' @rdname check_up_to_date @@ -201,6 +156,70 @@ check_up_to_date_nonmem <- function(.mod) { )) } + # build return value + res <- replace_na(!changed_files, FALSE) + names(res) <- c("model", "data") + + return(invisible(res)) +} + +#' Private implementation to check that NONMEM analysis (bootstrap or SSE) is +#' up-to-date +#' @inheritParams check_up_to_date +#' @keywords internal +check_up_to_date_analysis <- function(.bbi_object){ + run_type <- dplyr::case_when( + .bbi_object[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", + .bbi_object[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" + ) + + output_dir <- get_output_dir(.bbi_object, .check_exists = FALSE) + if (!fs::dir_exists(output_dir)) { + cli::cli_abort( + c( + paste( + "Model {get_model_id(.bbi_object)}:", + "Cannot check if up-to-date because {run_type} run has not been set up yet" + ), + "i" = "See `?setup_{tolower(run_type)}_run` for more details" + ) + ) + } + + if(!model_is_finished(.bbi_object)){ + rlang::abort(paste(glue("Model {get_model_id(.bbi_object)}:"), CHECK_UP_TO_DATE_ERR_MSG)) + } + + analysis_spec <- get_analysis_spec(.bbi_object) + + # check necessary files for changes + model_file <- get_model_path(.bbi_object) + based_on_data_file <- get_data_path(.bbi_object, .check_exists = FALSE) + + changed_files <- c( + analysis_spec[[CONFIG_MODEL_MD5]] != tools::md5sum(model_file), + analysis_spec[[CONFIG_DATA_BASED_ON_MD5]] != tools::md5sum(based_on_data_file) + ) + + any_changes <- any(changed_files) + if(isTRUE(any_changes)) { + message(paste( + glue("The following files have changed in {get_model_id(.bbi_object)}"), + paste("*", names(which(changed_files)), collapse = "\n"), + sep = "\n" + )) + } + + na_files <- is.na(changed_files) + if(isTRUE(any(na_files))) { + message(paste( + glue("The following files in {get_model_id(.bbi_object)} ARE NO LONGER PRESENT"), + paste("*", names(changed_files[na_files]), collapse = "\n"), + sep = "\n" + )) + } + + # build return value res <- replace_na(!changed_files, FALSE) names(res) <- c("model", "data") diff --git a/man/check_up_to_date.Rd b/man/check_up_to_date.Rd index 74e9ad0cc..6b4a0a158 100644 --- a/man/check_up_to_date.Rd +++ b/man/check_up_to_date.Rd @@ -4,6 +4,7 @@ \alias{check_up_to_date} \alias{check_up_to_date.bbi_base_model} \alias{check_up_to_date.bbi_nmboot_model} +\alias{check_up_to_date.bbi_nmsse_model} \alias{check_up_to_date.bbi_nonmem_summary} \title{Check model and data up to date with outputs} \usage{ @@ -13,6 +14,8 @@ check_up_to_date(.bbi_object, ...) \method{check_up_to_date}{bbi_nmboot_model}(.bbi_object, ...) +\method{check_up_to_date}{bbi_nmsse_model}(.bbi_object, ...) + \method{check_up_to_date}{bbi_nonmem_summary}(.bbi_object, ...) } \arguments{ diff --git a/man/check_up_to_date_analysis.Rd b/man/check_up_to_date_analysis.Rd new file mode 100644 index 000000000..f17c390c8 --- /dev/null +++ b/man/check_up_to_date_analysis.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/check-up-to-date.R +\name{check_up_to_date_analysis} +\alias{check_up_to_date_analysis} +\title{Private implementation to check that NONMEM analysis (bootstrap or SSE) is +up-to-date} +\usage{ +check_up_to_date_analysis(.bbi_object) +} +\arguments{ +\item{.bbi_object}{the object to check. Could be +a \verb{bbi_\{.model_type\}_model} object, +a \verb{bbi_\{.model_type\}_summary} object, +or a \code{bbi_log_df} tibble.} +} +\description{ +Private implementation to check that NONMEM analysis (bootstrap or SSE) is +up-to-date +} +\keyword{internal} diff --git a/man/config_log_make_entry.Rd b/man/config_log_make_entry.Rd index acb7fad35..653905677 100644 --- a/man/config_log_make_entry.Rd +++ b/man/config_log_make_entry.Rd @@ -5,6 +5,7 @@ \alias{config_log_make_entry.default} \alias{config_log_make_entry.bbi_nonmem_model} \alias{config_log_make_entry.bbi_nmboot_model} +\alias{config_log_make_entry.bbi_nmsse_model} \title{Prepare a model-specific config log entry} \usage{ config_log_make_entry(.mod, config, fields = NULL) @@ -14,6 +15,8 @@ config_log_make_entry(.mod, config, fields = NULL) \method{config_log_make_entry}{bbi_nonmem_model}(.mod, config, fields = NULL) \method{config_log_make_entry}{bbi_nmboot_model}(.mod, config, fields = NULL) + +\method{config_log_make_entry}{bbi_nmsse_model}(.mod, config, fields = NULL) } \arguments{ \item{.mod}{A model object.} From 9a85795434255e74d04b3d86a53b910abed2b863 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 4 Feb 2025 17:41:03 -0500 Subject: [PATCH 14/19] add helper for fetching information from summary log --- R/summary-log.R | 67 ++++++++++++++++++++++++++++++++++++++ man/get_from_summay_log.Rd | 24 ++++++++++++++ 2 files changed, 91 insertions(+) create mode 100644 man/get_from_summay_log.Rd diff --git a/R/summary-log.R b/R/summary-log.R index 691815463..9e9ea7492 100644 --- a/R/summary-log.R +++ b/R/summary-log.R @@ -266,3 +266,70 @@ do_if_bbi_sum <- function(fn, mode) { return(res) } } + + + +#' Extract a elements or format parameter estimates from the `bbi_summary` object +#' in a summary log +#' +#' @param .log_df A `bbi_summary_log_df` object. +#' @param element Element to extract. `"run_details"` and `"run_heuristics"` are +#' extracted directly. Passing `"parameter_estimates"` will force a call to +#' [bbr::param_estimates()] using the `bbi_summary` object in each row. +#' +#' @keywords internal +get_from_summay_log <- function( + .log_df, + element = c(SUMMARY_DETAILS, SUMMARY_HEURISTICS, "parameter_estimates") +){ + element <- match.arg(element) + check_model_object(.log_df, SUM_LOG_CLASS) + checkmate::assert_true(SL_SUMMARY %in% names(.log_df)) + + if(element != "parameter_estimates"){ + log_details <- purrr::map_dfr(.log_df[[SL_SUMMARY]], function(sum){ + as_tibble( + c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[element]]) + ) %>% + dplyr::mutate(!!RUN_ID_COL := basename(.data[[ABS_MOD_PATH]])) %>% + dplyr::select(all_of(c(ABS_MOD_PATH, RUN_ID_COL)), everything()) + }) + + # One line per run + if("output_files_used" %in% names(log_details)){ + log_details <- log_details %>% + tidyr::nest("output_files_used" = "output_files_used") + } + + }else{ + # Can only be run if "no_ext_file" was _not_ part of .bbi_args + log_details <- purrr::map_dfr(.log_df[[SL_SUMMARY]], function(sum){ + param_ests <- tryCatch({ + sum %>% param_estimates() + }, error = function(cond){ + if(stringr::str_detect(cond$message, "must be vectors")){ + cli::cli_abort( + c( + "Failed to extract estimates", + "i" = paste( + "This may be because `.bbi_args = list(no_ext_file = TRUE)`", + "was provided, which stops the retrieval of estimates from EXT files" + ) + ) + ) + }else{ + cli::cli_abort(c(cond$message, cond$body)) + } + }) + + param_ests %>% dplyr::mutate( + !!ABS_MOD_PATH := sum[[ABS_MOD_PATH]], + !!RUN_ID_COL := basename(.data[[ABS_MOD_PATH]]) + ) %>% dplyr::select( + all_of(c(ABS_MOD_PATH, RUN_ID_COL)), everything() + ) + }) + } + + return(log_details) +} diff --git a/man/get_from_summay_log.Rd b/man/get_from_summay_log.Rd new file mode 100644 index 000000000..b3497ec55 --- /dev/null +++ b/man/get_from_summay_log.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/summary-log.R +\name{get_from_summay_log} +\alias{get_from_summay_log} +\title{Extract a elements or format parameter estimates from the \code{bbi_summary} object +in a summary log} +\usage{ +get_from_summay_log( + .log_df, + element = c(SUMMARY_DETAILS, SUMMARY_HEURISTICS, "parameter_estimates") +) +} +\arguments{ +\item{.log_df}{A \code{bbi_summary_log_df} object.} + +\item{element}{Element to extract. \code{"run_details"} and \code{"run_heuristics"} are +extracted directly. Passing \code{"parameter_estimates"} will force a call to +\code{\link[=param_estimates]{param_estimates()}} using the \code{bbi_summary} object in each row.} +} +\description{ +Extract a elements or format parameter estimates from the \code{bbi_summary} object +in a summary log +} +\keyword{internal} From 0c85cbae6519f1a845e879b634ad9d6b226087c2 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Tue, 4 Feb 2025 17:42:30 -0500 Subject: [PATCH 15/19] adjust print methods for analysis summaries - dont grab run column when tabulating heuristics --- R/print.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/print.R b/R/print.R index c718e089b..fa11eabc7 100644 --- a/R/print.R +++ b/R/print.R @@ -411,7 +411,7 @@ print.bbi_nmboot_summary <- function(x, .digits = 3, .nrow = 10, ...) { # check heuristics .h <- x[[SUMMARY_HEURISTICS]] - heuristics_cols <- names(.h)[!grepl(ABS_MOD_PATH, names(.h))] + heuristics_cols <- names(.h)[!grepl(paste0(ABS_MOD_PATH, "|", RUN_ID_COL), names(.h))] heuristics <- purrr::map_dfr(heuristics_cols, function(col){ tibble(heuristic = col, any_found = any(.h[[col]]), n_found = sum(.h[[col]])) }) @@ -511,7 +511,7 @@ print.bbi_nmsse_summary <- function(x, .digits = 3, .nrow = 10, ...) { # check heuristics .h <- x[[SUMMARY_HEURISTICS]] - heuristics_cols <- names(.h)[!grepl(ABS_MOD_PATH, names(.h))] + heuristics_cols <- names(.h)[!grepl(paste0(ABS_MOD_PATH, "|", RUN_ID_COL), names(.h))] heuristics <- purrr::map_dfr(heuristics_cols, function(col){ tibble(heuristic = col, any_found = any(.h[[col]]), n_found = sum(.h[[col]])) }) From e06525b4a6bb822cde81d8ce8d6f42b06d76d03e Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Wed, 5 Feb 2025 11:09:01 -0500 Subject: [PATCH 16/19] Analysis summary refactor and add SSE summary elements - adds initial_estimates_compare function. This is currently for testing purposes. This is also added to the model summary object in the same way param_estimates_compare is used in the bootstrap --- NAMESPACE | 1 + R/analysis-run-utils.R | 124 ++++++++++++++++--------------- R/bootstrap-model.R | 35 +++++++-- R/print.R | 27 +++++++ R/sse-model.R | 78 ++++++++++++++++++- man/analysis_estimates.Rd | 14 ++-- man/initial_estimates_compare.Rd | 16 ++++ man/summarize_analysis_run.Rd | 6 +- man/summarize_sse.Rd | 5 +- 9 files changed, 224 insertions(+), 82 deletions(-) create mode 100644 man/initial_estimates_compare.Rd diff --git a/NAMESPACE b/NAMESPACE index b9f0a4b21..dd8a5ee57 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -159,6 +159,7 @@ export(get_yaml_path) export(has_simulation) export(inherit_param_estimates) export(initial_estimates) +export(initial_estimates_compare) export(mod_ext) export(model_diff) export(model_summaries) diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R index c57d65a37..7cebb53d9 100644 --- a/R/analysis-run-utils.R +++ b/R/analysis-run-utils.R @@ -455,52 +455,63 @@ make_analysis_spec <- function(run_models, metadata){ } -#' Summarize an analysis (bootstrap or SSE) run -#' -#' @inheritParams analysis_estimates -#' @importFrom tidyselect any_of -#' @keywords internal -summarize_analysis_run <- function(.run){ +make_analysis_summary <- function(.run, .bbi_args = NULL){ check_model_object(.run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS)) - # Check that runs can still be summarized (e.g, after cleanup) analysis_can_be_summarized(.run) - # Get parameter estimates - param_ests <- analysis_estimates(.run, force_resummarize = TRUE) - - # Tabulate all run details and heuristics run_dir <- .run[[ABS_MOD_PATH]] - sum_log <- summary_log( - run_dir, .bbi_args = list( - no_grd_file = TRUE, no_ext_file = TRUE, no_shk_file = TRUE - ) - ) %>% dplyr::select(-"error_msg") # only join based on model run - run_details <- purrr::map_dfr(sum_log$bbi_summary, function(sum){ - as_tibble( - c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[SUMMARY_DETAILS]]) - ) %>% tidyr::nest("output_files_used" = "output_files_used") - }) + # Get parameter estimates in wide format for binding on to summary log + param_ests_w <- param_estimates_batch(run_dir) - run_heuristics <- purrr::map_dfr(sum_log$bbi_summary, function(sum){ - as_tibble( - c(list2(!!ABS_MOD_PATH := sum[[ABS_MOD_PATH]]), sum[[SUMMARY_HEURISTICS]]) - ) - }) + sum_log <- summary_log(run_dir, .bbi_args = .bbi_args) %>% + dplyr::select(-"error_msg") # only join based on model run + + # Tabulate all run details and heuristics + run_details <- get_from_summay_log(sum_log, SUMMARY_DETAILS) + run_heuristics <- get_from_summay_log(sum_log, SUMMARY_HEURISTICS) # Run details, heuristics, and other information will be displayed elsewhere run_cols <- c( unique(c(names(run_details), names(run_heuristics))), "estimation_method", "problem_text", "needed_fail_flags", "param_count" ) - run_cols <- run_cols[-grepl(ABS_MOD_PATH, run_cols)] + run_cols <- run_cols[!grepl(paste0(ABS_MOD_PATH, "|", RUN_ID_COL), run_cols)] + # Create main summary table + # - includes key columns for sorting runs that errored, had heuristics, etc. + # as well as a bbi_summary column analysis_sum_df <- dplyr::full_join( - param_ests, sum_log %>% dplyr::select(-any_of(run_cols)), - by = c(ABS_MOD_PATH, "run") + param_ests_w, sum_log %>% dplyr::select(-any_of(run_cols)), + by = c(ABS_MOD_PATH, RUN_ID_COL) + ) + + return( + list( + estimation_method = unique(sum_log$estimation_method), + analysis_sum_df = analysis_sum_df, + run_details = run_details, + run_heuristics = run_heuristics + ) ) +} +#' Summarize an analysis (bootstrap or SSE) run +#' +#' @inheritParams analysis_estimates +#' @param .bbi_args Named list passed to `summary_log(run_dir, .bbi_args)`, +#' where `run_dir` is the model directory containing the analysis models. See +#' [print_bbi_args()] for valid options. +#' @importFrom tidyselect any_of +#' @keywords internal +summarize_analysis_run <- function(.run, .bbi_args = NULL){ + + # Summarize parameter estimates, run details, and any heuristics + analysis_sum <- make_analysis_summary(.run, .bbi_args) + + # Check for error messages across all runs + analysis_sum_df <- analysis_sum$analysis_sum_df if(any(!is.na(analysis_sum_df$error_msg))){ err_msgs <- unique(analysis_sum_df$error_msg[!is.na(analysis_sum_df$error_msg)]) rlang::warn( @@ -539,9 +550,9 @@ summarize_analysis_run <- function(.run){ # - Refresh analysis spec analysis_spec <- get_analysis_spec(.run) analysis_sum <- c( - list2(!!ABS_MOD_PATH := run_dir), + list2(!!ABS_MOD_PATH := .run[[ABS_MOD_PATH]]), list( - estimation_method = unique(sum_log$estimation_method), + estimation_method = analysis_sum$estimation_method, based_on_model_path = analysis_spec$based_on_model_path, based_on_data_set = analysis_spec$based_on_data_path, strat_cols = analysis_spec$strat_cols, @@ -549,8 +560,8 @@ summarize_analysis_run <- function(.run){ sample_with_replacement = analysis_spec$sample_with_replacement, seed = analysis_spec$seed, n_samples = analysis_spec$n_samples, - run_details = run_details, - run_heuristics = run_heuristics + run_details = analysis_sum$run_details, + run_heuristics = analysis_sum$run_heuristics ), list( analysis_summary = analysis_sum_df @@ -564,55 +575,50 @@ summarize_analysis_run <- function(.run){ #' Tabulate parameter estimates for each model submission in an analysis run #' #' @inheritParams setup_analysis_run -#' @param format_long Logical (T/F). If `TRUE`, format data as a long table, -#' making the data more portable for plotting. #' @param force_resummarize Logical (T/F). If `TRUE`, force re-summarization. -#' Will _only_ update the saved out `RDS` file when specified via -#' `summarize_bootstrap_run()`. See details for more information. #' #' @keywords internal analysis_estimates <- function( .run, - format_long = FALSE, - force_resummarize = FALSE + force_resummarize = FALSE, + .bbi_args = NULL ){ check_model_object(.run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS)) - - run_type <- dplyr::case_when( - .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", - .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" - ) + model_type <- .run[[YAML_MOD_TYPE]] sum_path <- get_analysis_sum_path(.run, .check_exists = FALSE) - if(!fs::file_exists(sum_path) || isTRUE(force_resummarize)){ analysis_can_be_summarized(.run) - param_ests <- param_estimates_batch(.run[[ABS_MOD_PATH]]) + if(model_type == "nmboot"){ + param_ests <- param_estimates_batch(.run[[ABS_MOD_PATH]]) + }else{ + sum_log <- make_analysis_summary(.run, .bbi_args)$analysis_sum_df + class(sum_log) <- c(SUM_LOG_CLASS, class(sum_log)) + param_ests <- get_from_summay_log(sum_log, "parameter_estimates") + } }else{ + run_type <- dplyr::case_when( + model_type == "nmboot" ~ "bootstrap", + model_type == "nmsse" ~ "SSE" + ) + verbose_msg( glue("Reading in {run_type} summary: {fs::path_rel(sum_path, getwd())}\n\n") ) analysis_sum <- readRDS(sum_path) - param_ests <- analysis_sum$analysis_summary - } + if(model_type == "nmboot"){ + param_ests <- analysis_sum$analysis_summary + }else{ + param_ests <- analysis_sum$parameter_estimates + } - if(isTRUE(format_long)){ - # Long format - only keep estimates and error/termination columns for filtering - param_ests <- param_ests %>% dplyr::select( - all_of(ABS_MOD_PATH), "run", "error_msg", "termination_code", - starts_with(c("THETA", "SIGMA", "OMEGA")) - ) %>% tidyr::pivot_longer( - starts_with(c("THETA", "SIGMA", "OMEGA")), - names_to = "parameter_names", values_to = "estimate" - ) %>% dplyr::relocate( - c("error_msg", "termination_code"), .after = dplyr::everything() - ) } return(param_ests) } + #' Read in all analysis run model objects #' @inheritParams get_analysis_spec #' @keywords internal diff --git a/R/bootstrap-model.R b/R/bootstrap-model.R index c0d92242a..0cbfbb22f 100644 --- a/R/bootstrap-model.R +++ b/R/bootstrap-model.R @@ -192,14 +192,19 @@ summarize_bootstrap_run <- function( boot_sum_path <- get_analysis_sum_path(.boot_run, .check_exists = FALSE) if(!fs::file_exists(boot_sum_path) || isTRUE(force_resummarize)){ - boot_sum <- summarize_analysis_run(.boot_run) + boot_sum <- summarize_analysis_run( + .boot_run, + .bbi_args = list( + no_grd_file = TRUE, no_ext_file = TRUE, no_shk_file = TRUE + ) + ) - # Assign class early for param_estimate_compare method + # Add comparison of bootstrap estimates to final estimates of based_on model + # - This gets done here instead of the print method, because we dont want + # the printing of the _saved_ model summary object to be tied to the + # existence of the based_on model. + # - Assign class early for param_estimate_compare method class(boot_sum) <- c(NMBOOT_SUM_CLASS, class(boot_sum)) - - # This gets done here instead of the print method, because we dont want - # the printing of the _saved_ model summary object to be tied to the existence - # of the based_on model. boot_compare <- param_estimates_compare(boot_sum) boot_sum$boot_compare <- boot_compare @@ -233,14 +238,28 @@ summarize_bootstrap_run <- function( #' @describeIn summarize_bootstrap Tabulate parameter estimates for each model #' submission in a bootstrap run -#' @inheritParams analysis_estimates +#' @param format_long Logical (T/F). If `TRUE`, format data as a long table, +#' making the data more portable for plotting. #' @export bootstrap_estimates <- function( .boot_run, format_long = FALSE, force_resummarize = FALSE ){ - param_ests <- analysis_estimates(.boot_run, format_long, force_resummarize) + param_ests <- analysis_estimates(.boot_run, force_resummarize) + + if(isTRUE(format_long)){ + # Long format - only keep estimates and error/termination columns for filtering + param_ests <- param_ests %>% dplyr::select( + all_of(ABS_MOD_PATH), "run", "error_msg", "termination_code", + starts_with(c("THETA", "SIGMA", "OMEGA")) + ) %>% tidyr::pivot_longer( + starts_with(c("THETA", "SIGMA", "OMEGA")), + names_to = "parameter_names", values_to = "estimate" + ) %>% dplyr::relocate( + c("error_msg", "termination_code"), .after = dplyr::everything() + ) + } return(param_ests) } diff --git a/R/print.R b/R/print.R index fa11eabc7..1e27f7bbb 100644 --- a/R/print.R +++ b/R/print.R @@ -533,6 +533,33 @@ print.bbi_nmsse_summary <- function(x, .digits = 3, .nrow = 10, ...) { return(invisible(NULL)) } + # Build parameter comparison table if it exists + # To avoid printing issues before the comparison is added to the summary object + # see summarize_bootstrap_run() for details. + if(!is.null(x$sse_compare)){ + param_df <- x$sse_compare %>% mutate_if(is.numeric, sig, .digits = .digits) + + if (!is.null(.nrow)) { + checkmate::assert_number(.nrow) + orig_rows <- nrow(param_df) + .nrow <- min(.nrow, nrow(param_df)) + param_df <- param_df[1:.nrow, ] + } + + if (requireNamespace("knitr", quietly = TRUE)) { + param_str <- param_df %>% + knitr::kable() %>% + as.character() + } else { + param_str <- param_df %>% + print() %>% + capture.output() + } + + cat_line(param_str) + if (!is.null(.nrow)) cat_line(glue("... {orig_rows - .nrow} more rows"), col = "grey") + } + } #' @describeIn print_bbi Prints the `NM-TRAN` evaluation of a `bbi_nonmem_model` diff --git a/R/sse-model.R b/R/sse-model.R index dd96eebaf..e07b7101b 100644 --- a/R/sse-model.R +++ b/R/sse-model.R @@ -216,7 +216,29 @@ summarize_sse_run <- function( sse_sum_path <- get_analysis_sum_path(.sse_run, .check_exists = FALSE) if(!fs::file_exists(sse_sum_path) || isTRUE(force_resummarize)){ - sse_sum <- summarize_analysis_run(.sse_run) + sse_sum <- summarize_analysis_run( + .sse_run, + .bbi_args = list( + no_grd_file = TRUE, no_shk_file = TRUE + ) + ) + + # Add parameter estimates + # - Append standard error + # - Get parameter estimates again from summary log because we need to tabulate + # standard error for SSE runs, which param_estimates_batch doesnt support + # - return as long format + sum_log <- sse_sum$analysis_summary + class(sum_log) <- c(SUM_LOG_CLASS, class(sum_log)) + param_ests <- get_from_summay_log(sum_log, "parameter_estimates") + sse_sum$parameter_estimates <- param_ests + + # Add comparison of sse estimates to initial estimates of based_on model + # - This gets done here instead of the print method, because we dont want + # the printing of the _saved_ model summary object to be tied to the + # existence of the based_on model. + sse_compare <- initial_estimates_compare(sse_sum) + sse_sum$sse_compare <- sse_compare saveRDS(sse_sum, sse_sum_path) }else{ @@ -250,14 +272,12 @@ summarize_sse_run <- function( #' @describeIn summarize_sse Tabulate parameter estimates for each model #' submission in an SSE run -#' @inheritParams analysis_estimates #' @export sse_estimates <- function( .sse_run, - format_long = FALSE, force_resummarize = FALSE ){ - param_ests <- analysis_estimates(.sse_run, format_long, force_resummarize) + param_ests <- analysis_estimates(.sse_run, force_resummarize) return(param_ests) } @@ -297,3 +317,53 @@ get_sse_models <- function(.sse_run){ cleanup_sse_run <- function(.sse_run, .force = FALSE){ cleanup_analysis_run(.sse_run, .force = .force) } + + + + + +#' Compare SSE results to initial (or "true") estimates. +#' @export +initial_estimates_compare <- function( + .sse_sum, + .orig_mod = NULL, + probs = c(.5, 0.025, 0.975), + na.rm = FALSE +){ + + # Attempt to read in based_on model + if(is.null(.orig_mod)){ + orig_mod_path <- fs::path_ext_remove(.sse_sum$based_on_model_path) + # make sure based_on model still exists + .orig_mod <- tryCatch( + read_model(orig_mod_path), + error = function(cond) NULL + ) + if(is.null(.orig_mod)){ + rlang::warn( + c( + glue("The original model no longer exists at {orig_mod_path}"), + "Cannot compare to original model" + ) + ) + } + } + + # Dont pass .compare_cols here, as we can only use columns in parameter_names, + # which could only be the default columns. + # Dont pass .orig_mod because we want to compare the initial estimates + comp_df <- param_estimates_compare.default( + .sse_sum$analysis_summary, .orig_mod = NULL, probs = probs, na.rm = na.rm + ) + + if (!is.null(.orig_mod)) { + mod_df <- initial_estimates(.orig_mod) + + comp_df <- mod_df %>% + select("parameter_names", "init") %>% + rename(initial = "init") %>% + left_join(comp_df, by = "parameter_names") + } + + return(comp_df) +} diff --git a/man/analysis_estimates.Rd b/man/analysis_estimates.Rd index f7a589cc9..760f6a6ce 100644 --- a/man/analysis_estimates.Rd +++ b/man/analysis_estimates.Rd @@ -4,17 +4,19 @@ \alias{analysis_estimates} \title{Tabulate parameter estimates for each model submission in an analysis run} \usage{ -analysis_estimates(.run, format_long = FALSE, force_resummarize = FALSE) +analysis_estimates(.run, force_resummarize = FALSE, .bbi_args = NULL) } \arguments{ \item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} object.} -\item{format_long}{Logical (T/F). If \code{TRUE}, format data as a long table, -making the data more portable for plotting.} +\item{force_resummarize}{Logical (T/F). If \code{TRUE}, force re-summarization.} -\item{force_resummarize}{Logical (T/F). If \code{TRUE}, force re-summarization. -Will \emph{only} update the saved out \code{RDS} file when specified via -\code{summarize_bootstrap_run()}. See details for more information.} +\item{.bbi_args}{Named list passed to \code{model_summary(orig_mod, .bbi_args)}, +where \code{orig_mod} is the model the analysis is based on. See +\code{\link[=print_bbi_args]{print_bbi_args()}} for valid options. Defaults to \code{list(no_grd_file = TRUE, no_shk_file = TRUE)} because \code{\link[=model_summary]{model_summary()}} is only called internally to +extract the number of records, so those files are irrelevant. Only used if +the based on model (the model the analysis is being performed on) has been +executed.} } \description{ Tabulate parameter estimates for each model submission in an analysis run diff --git a/man/initial_estimates_compare.Rd b/man/initial_estimates_compare.Rd new file mode 100644 index 000000000..3543c5b9e --- /dev/null +++ b/man/initial_estimates_compare.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/sse-model.R +\name{initial_estimates_compare} +\alias{initial_estimates_compare} +\title{Compare SSE results to initial (or "true") estimates.} +\usage{ +initial_estimates_compare( + .sse_sum, + .orig_mod = NULL, + probs = c(0.5, 0.025, 0.975), + na.rm = FALSE +) +} +\description{ +Compare SSE results to initial (or "true") estimates. +} diff --git a/man/summarize_analysis_run.Rd b/man/summarize_analysis_run.Rd index 9cb219c7f..4cab2fcbb 100644 --- a/man/summarize_analysis_run.Rd +++ b/man/summarize_analysis_run.Rd @@ -4,10 +4,14 @@ \alias{summarize_analysis_run} \title{Summarize an analysis (bootstrap or SSE) run} \usage{ -summarize_analysis_run(.run) +summarize_analysis_run(.run, .bbi_args = NULL) } \arguments{ \item{.run}{A \code{bbi_nmboot_model} or \code{bbi_nmsse_model} object.} + +\item{.bbi_args}{Named list passed to \code{summary_log(run_dir, .bbi_args)}, +where \code{run_dir} is the model directory containing the analysis models. See +\code{\link[=print_bbi_args]{print_bbi_args()}} for valid options.} } \description{ Summarize an analysis (bootstrap or SSE) run diff --git a/man/summarize_sse.Rd b/man/summarize_sse.Rd index ba27985f5..93479ce35 100644 --- a/man/summarize_sse.Rd +++ b/man/summarize_sse.Rd @@ -9,7 +9,7 @@ \usage{ summarize_sse_run(.sse_run, force_resummarize = FALSE) -sse_estimates(.sse_run, format_long = FALSE, force_resummarize = FALSE) +sse_estimates(.sse_run, force_resummarize = FALSE) get_sse_models(.sse_run) } @@ -19,9 +19,6 @@ get_sse_models(.sse_run) \item{force_resummarize}{Logical (T/F). If \code{TRUE}, force re-summarization. Will \emph{only} update the saved out \code{RDS} file when specified via \code{summarize_sse_run()}. See details for more information.} - -\item{format_long}{Logical (T/F). If \code{TRUE}, format data as a long table, -making the data more portable for plotting.} } \description{ Summarize the parameter estimates, run details, and any heuristics of a From 7b4a2e5bbdf099cfc9691c028ed410d49d31676e Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Wed, 5 Feb 2025 11:13:45 -0500 Subject: [PATCH 17/19] update summary examples and documentation --- R/sse-model.R | 15 ++++++++++++++- man/initial_estimates_compare.Rd | 12 ++++++++++++ man/summarize_sse.Rd | 10 +++++++++- 3 files changed, 35 insertions(+), 2 deletions(-) diff --git a/R/sse-model.R b/R/sse-model.R index e07b7101b..839dfd0c5 100644 --- a/R/sse-model.R +++ b/R/sse-model.R @@ -196,8 +196,16 @@ setup_sse_run <- function( #' \dontrun{ #' #' .sse_run <- read_model(file.path(MODEL_DIR, "1-sse")) -#' boot_sum <- summarize_sse_run(.sse_run) #' +#' # Create full summary object and save results +#' sse_sum <- summarize_sse_run(.sse_run) +#' +#' # Read in just the parameter estimates +#' sse_estimates(.sse_run) +#' +#' +#' # Optionally compare to initial estimates of "based on" model +#' initial_estimates_compare(sse_sum) #' #' } #' @@ -323,6 +331,11 @@ cleanup_sse_run <- function(.sse_run, .force = FALSE){ #' Compare SSE results to initial (or "true") estimates. +#' +#' @param .sse_sum A `bbi_nmsse_summary` object. +#' @inheritParams param_estimates_compare +#' @param .orig_mod `bbi_model` object to compare `.sse_sum` against. This will +#' be automatically set if passing in a `bbi_nmsse_summary` object. #' @export initial_estimates_compare <- function( .sse_sum, diff --git a/man/initial_estimates_compare.Rd b/man/initial_estimates_compare.Rd index 3543c5b9e..3bf6898ad 100644 --- a/man/initial_estimates_compare.Rd +++ b/man/initial_estimates_compare.Rd @@ -11,6 +11,18 @@ initial_estimates_compare( na.rm = FALSE ) } +\arguments{ +\item{.sse_sum}{A \code{bbi_nmsse_summary} object.} + +\item{.orig_mod}{\code{bbi_model} object to compare \code{.sse_sum} against. This will +be automatically set if passing in a \code{bbi_nmsse_summary} object.} + +\item{probs}{Numeric vector with values between 0 and 1 to be passed through to +\code{\link[stats:quantile]{stats::quantile()}}. Represents the quantiles to calculate for parameter +estimates in \code{.boot_sum}.} + +\item{na.rm}{Logical scalar, passed through to \code{\link[stats:quantile]{stats::quantile()}}.} +} \description{ Compare SSE results to initial (or "true") estimates. } diff --git a/man/summarize_sse.Rd b/man/summarize_sse.Rd index 93479ce35..83cd5d792 100644 --- a/man/summarize_sse.Rd +++ b/man/summarize_sse.Rd @@ -66,8 +66,16 @@ submission in an SSE run \dontrun{ .sse_run <- read_model(file.path(MODEL_DIR, "1-sse")) -boot_sum <- summarize_sse_run(.sse_run) +# Create full summary object and save results +sse_sum <- summarize_sse_run(.sse_run) + +# Read in just the parameter estimates +sse_estimates(.sse_run) + + +# Optionally compare to initial estimates of "based on" model +initial_estimates_compare(sse_sum) } From e5b79a47cbefcdaf573e3d59e2a11064623021f7 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Wed, 5 Feb 2025 12:00:10 -0500 Subject: [PATCH 18/19] add initial_estimates_compare to pkgdown --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 8771e6a1e..5c27975c9 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -63,6 +63,7 @@ reference: - cleanup_sse_run - param_estimates_batch - param_estimates_compare + - initial_estimates_compare - title: Simulation contents: From 5d430dcd96bbefd43dfcfe62100e3c3e56c946b5 Mon Sep 17 00:00:00 2001 From: Kyle Barrett Date: Mon, 10 Feb 2025 16:43:50 -0500 Subject: [PATCH 19/19] fix: work with existing bootstrap models - The refactor caused previously executed bootstrap models to not load correctly because naming conventions changed in the spec file. We now set and fetch these names using the `analysis_spec_names` function. --- R/analysis-run-utils.R | 47 +++++++++++++----------- R/check-up-to-date.R | 5 +-- R/get-path-from-object.R | 22 +++++++++-- R/model-status.R | 6 ++- R/submit-model.R | 7 +--- tests/testthat/test-workflow-bootstrap.R | 4 +- 6 files changed, 52 insertions(+), 39 deletions(-) diff --git a/R/analysis-run-utils.R b/R/analysis-run-utils.R index 7cebb53d9..bc2df040d 100644 --- a/R/analysis-run-utils.R +++ b/R/analysis-run-utils.R @@ -361,10 +361,7 @@ make_analysis_model <- function(mod_path, metadata){ #' @param .run A `bbi_nmboot_model` or `bbi_nmsse_model` model object #' @keywords internal analysis_can_be_summarized <- function(.run){ - run_type <- dplyr::case_when( - .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", - .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" - ) + run_type <- analysis_run_type(.run, fmt = TRUE) # Check that runs can still be summarized (e.g, after cleanup) cleaned_up <- analysis_is_cleaned_up(.run) @@ -445,7 +442,7 @@ make_analysis_spec <- function(run_models, metadata){ spec_lst <- c( analysis_spec = list(analysis_spec), analysis_runs = list(analysis_runs) - ) + ) %>% stats::setNames(analysis_spec_names(metadata$run)) spec_lst_json <- jsonlite::toJSON( spec_lst, pretty = TRUE, simplifyVector = TRUE, null = "null" @@ -539,10 +536,11 @@ summarize_analysis_run <- function(.run, .bbi_args = NULL){ config_lst <- config_lst[[1]] # Update spec file with bbi config + spec_names <- analysis_spec_names(.run) spec_path <- get_spec_path(.run) analysis_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - analysis_spec$analysis_spec$bbi_version <- config_lst$bbi_version - analysis_spec$analysis_spec$configuration <- config_lst$configuration + analysis_spec[[spec_names[["spec"]]]]$bbi_version <- config_lst$bbi_version + analysis_spec[[spec_names[["spec"]]]]$configuration <- config_lst$configuration spec_lst_json <- jsonlite::toJSON(analysis_spec, pretty = TRUE, simplifyVector = TRUE) writeLines(spec_lst_json, spec_path) @@ -597,10 +595,7 @@ analysis_estimates <- function( param_ests <- get_from_summay_log(sum_log, "parameter_estimates") } }else{ - run_type <- dplyr::case_when( - model_type == "nmboot" ~ "bootstrap", - model_type == "nmsse" ~ "SSE" - ) + run_type <- analysis_run_type(.run, fmt = TRUE) verbose_msg( glue("Reading in {run_type} summary: {fs::path_rel(sum_path, getwd())}\n\n") @@ -635,10 +630,7 @@ get_analysis_models <- function(.run){ run_dir <- .run[[ABS_MOD_PATH]] output_dir <- get_output_dir(.run, .check_exists = FALSE) - run_type <- dplyr::case_when( - .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", - .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" - ) + run_type <- analysis_run_type(.run, fmt = TRUE) if(!fs::file_exists(output_dir)){ verbose_msg( @@ -655,7 +647,8 @@ get_analysis_models <- function(.run){ } spec <- get_analysis_spec(.run) - model_ids <- fs::path_ext_remove(basename(spec$analysis_runs$mod_path_abs)) + spec_names <- analysis_spec_names(.run) + model_ids <- fs::path_ext_remove(basename(spec[[spec_names[["runs"]]]]$mod_path_abs)) mods <- tryCatch({ find_models(.run[[ABS_MOD_PATH]], .recurse = FALSE, .include = model_ids) @@ -711,10 +704,7 @@ get_analysis_models <- function(.run){ #' @keywords internal cleanup_analysis_run <- function(.run, .force = FALSE){ check_model_object(.run, c(NMBOOT_MOD_CLASS, NMSSE_MOD_CLASS)) - run_type <- dplyr::case_when( - .run[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", - .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" - ) + run_type <- analysis_run_type(.run, fmt = TRUE) run_dir <- .run[[ABS_MOD_PATH]] sum_path <- get_analysis_sum_path(.run, .check_exists = FALSE) @@ -746,11 +736,13 @@ cleanup_analysis_run <- function(.run, .force = FALSE){ spec_path <- get_spec_path(.run) analysis_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) # Set cleaned up - impacts status checking - analysis_spec$analysis_spec$cleaned_up <- TRUE + spec_names <- analysis_spec_names(.run) + spec_names[["spec"]] + analysis_spec[[spec_names[["spec"]]]]$cleaned_up <- TRUE # Delete individual run specs # - dont need to store this information anymore since we wont be reading in # individual models anymore - analysis_spec$analysis_runs <- NULL + analysis_spec[[spec_names[["runs"]]]] <- NULL spec_lst_json <- jsonlite::toJSON(analysis_spec, pretty = TRUE, simplifyVector = TRUE) # Delete individual model files @@ -813,6 +805,17 @@ check_nm_data_filter <- function(.run, data, .bbi_args = NULL){ } +analysis_run_type <- function(.run, fmt = FALSE){ + run_type <- dplyr::case_when( + .run[[YAML_MOD_TYPE]] == "nmboot" ~ "Bootstrap", + .run[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE", + ) + + if(isFALSE(fmt)) run_type <- tolower(run_type) + return(run_type) +} + + pad_left <- function(x, padding = "0", max_char = 4){ n_pad <- max_char - nchar(x) checkmate::assert_true(n_pad >= 0) diff --git a/R/check-up-to-date.R b/R/check-up-to-date.R index 189ae95f1..fbcba5bc7 100644 --- a/R/check-up-to-date.R +++ b/R/check-up-to-date.R @@ -168,10 +168,7 @@ check_up_to_date_nonmem <- function(.mod) { #' @inheritParams check_up_to_date #' @keywords internal check_up_to_date_analysis <- function(.bbi_object){ - run_type <- dplyr::case_when( - .bbi_object[[YAML_MOD_TYPE]] == "nmboot" ~ "bootstrap", - .bbi_object[[YAML_MOD_TYPE]] == "nmsse" ~ "SSE" - ) + run_type <- analysis_run_type(.bbi_object, fmt = TRUE) output_dir <- get_output_dir(.bbi_object, .check_exists = FALSE) if (!fs::dir_exists(output_dir)) { diff --git a/R/get-path-from-object.R b/R/get-path-from-object.R index 60e6d4c9f..6db38a8e7 100644 --- a/R/get-path-from-object.R +++ b/R/get-path-from-object.R @@ -825,9 +825,12 @@ get_analysis_spec <- function(.run){ analysis_spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) run_dir <- .run[[ABS_MOD_PATH]] + spec_names <- analysis_spec_names(.run) + overall_spec <- analysis_spec[[spec_names[["spec"]]]] + # Format individual analysis model runs if not cleaned up - if(!is.null(analysis_spec$analysis_runs)){ - analysis_runs <- analysis_spec$analysis_runs + if(!is.null(analysis_spec[[spec_names[["runs"]]]])){ + analysis_runs <- analysis_spec[[spec_names[["runs"]]]] analysis_mod_files <- data.frame( matrix(unlist(analysis_runs), nrow=length(analysis_runs), byrow = TRUE), @@ -840,15 +843,26 @@ get_analysis_spec <- function(.run){ mod_path_abs = file.path(run_dir, fs::path_ext_remove(.data$mod_path)) ) %>% dplyr::relocate("run") - spec <- c(analysis_spec$analysis_spec, list(analysis_runs = spec_df)) + spec_runs <- list(spec_df) %>% stats::setNames(spec_names[["runs"]]) + spec <- c(overall_spec, spec_runs) }else{ - spec <- analysis_spec$analysis_spec + spec <- overall_spec } return(spec) } +analysis_spec_names <- function(.run){ + run_type <- analysis_run_type(.run) + + c( + "spec" = glue("{run_type}_spec"), + "runs" = glue("{run_type}_runs") + ) +} + + #' Read in and format the simulation specification file. #' #' @param .mod A `bbi_nonmem_model`, `bbi_nmsim_model`, or `bbi_nonmem_summary` diff --git a/R/model-status.R b/R/model-status.R index 25646eeec..1b3558e2f 100644 --- a/R/model-status.R +++ b/R/model-status.R @@ -75,7 +75,8 @@ bbi_nonmem_analysis_status <- function(.run){ status <- "Not Run" }else{ analysis_spec <- get_analysis_spec(.run) - for(output_dir.i in analysis_spec$analysis_runs$mod_path_abs){ + spec_names <- analysis_spec_names(.run) + for(output_dir.i in analysis_spec[[spec_names[["runs"]]]]$mod_path_abs){ if (dir.exists(output_dir.i)) { # Exit early as incomplete if any model cannot be read in for any reason .mod <- tryCatch({read_model(output_dir.i)}, error = function(e) NULL) @@ -144,7 +145,8 @@ analysis_is_cleaned_up <- function(.run){ if(!fs::file_exists(spec_path)) return(FALSE) spec <- jsonlite::read_json(spec_path, simplifyVector = TRUE) - cleaned_up <- spec$analysis_spec$cleaned_up + spec_names <- analysis_spec_names(.run) + cleaned_up <- spec[[spec_names[["spec"]]]]$cleaned_up if(!is.null(cleaned_up) && isTRUE(cleaned_up)){ return(TRUE) }else{ diff --git a/R/submit-model.R b/R/submit-model.R index 265fd0e37..6bb048274 100644 --- a/R/submit-model.R +++ b/R/submit-model.R @@ -214,11 +214,7 @@ submit_nonmem_analysis <- function( ){ checkmate::assert_number(.batch_size, null.ok = TRUE, lower = 1) - mod_type <- .mod[[YAML_MOD_TYPE]] - run_type <- dplyr::case_when( - mod_type == "nmboot" ~ "bootstrap", - mod_type == "nmsse" ~ "SSE" - ) + run_type <- analysis_run_type(.mod, fmt = TRUE) # Ensure bootstrap setup was done spec_path <- get_spec_path(.mod, .check_exists = FALSE) @@ -243,6 +239,7 @@ submit_nonmem_analysis <- function( # check overwrite and delete existing output, if requested if (!is.null(.bbi_args[["overwrite"]])) { + mod_type <- .mod[[YAML_MOD_TYPE]] cli::cli_warn(paste( "submit_model.bbi_{mod_type}_model does NOT respect setting `overwrite` via .bbi_args or a bbi.yaml config file.", "To overwrite an existing {run_type} run, use submit_model(..., .overwrite = TRUE)." diff --git a/tests/testthat/test-workflow-bootstrap.R b/tests/testthat/test-workflow-bootstrap.R index 5397e5824..6497dbdf5 100644 --- a/tests/testthat/test-workflow-bootstrap.R +++ b/tests/testthat/test-workflow-bootstrap.R @@ -186,7 +186,7 @@ withr::with_options( expect_true(is.null(boot_spec$cleaned_up)) expect_true(is.null(boot_spec$seed)) expect_true(is.null(boot_spec$strat_cols)) - expect_true(tibble::is_tibble(boot_spec$analysis_runs)) + expect_true(tibble::is_tibble(boot_spec$bootstrap_runs)) # Check helper functions after setup & before submission expect_no_message(boot_models <- get_boot_models(.boot_run)) @@ -481,7 +481,7 @@ withr::with_options( # Confirm boot spec alterations boot_spec <- get_analysis_spec(.boot_run) expect_true(boot_spec$cleaned_up) - expect_true(is.null(boot_spec$analysis_runs)) + expect_true(is.null(boot_spec$bootstrap_runs)) # Cannot be overwritten expect_error(