In metrumresearchgroup/bbr: R package for bbi

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
is_pdf <- knitr::is_latex_output()
if(isTRUE(is_pdf)){
  # takes screenshot of rendered plots and converts it into a static image
  # only needed if this vignette is rendered to PDF
  library(webshot)
  webshot::install_phantomjs() %>% suppressMessages()
}

# NOTE: if running chunks interactively we need to load the package first
#   because renv isolation prevents us from finding an bbr installation
if (interactive()) {
  devtools::load_all()
}

library(glue)
library(bbr)
library(dplyr)
library(purrr)

MODEL_DIR <- system.file("model", "nonmem", "basic", package = "bbr", mustWork = TRUE)
source("../tests/testthat/helpers-create-example-model.R")

# set bbi execution path
if (Sys.which("bbi") == "") {
  options('bbr.bbi_exe_path' = read_bbi_path())
}

# Get bbi version: we cant build this vignette when bbi is less than 3.2.0
# since model_summary() is required for the tooltip
eval_model_tree <- bbr:::test_bbi_version(read_bbi_path(), "3.2.0")

# Create fake runs
copy_output_dir <- function(orig_mod, new_mod) {
  new_dir_path <- new_mod[["absolute_model_path"]]
  fs::dir_copy(orig_mod[["absolute_model_path"]], new_dir_path)

  # replace file names with new model ID
  orig_mod_id <- get_model_id(orig_mod)
  new_mod_id <- basename(new_dir_path)
  purrr::walk(fs::dir_ls(new_dir_path), ~ {
    if (stringr::str_detect(basename(.x), glue::glue("^{orig_mod_id}"))) {
      mod_name <- stringr::str_replace(basename(.x), glue::glue("^{orig_mod_id}"), new_mod_id)
      fs::file_move(.x, file.path(dirname(.x), mod_name))
    }
  })
}

# Create example working directory
create_tree_models <- function(MODEL_DIR){
  MOD1_PATH <- file.path(MODEL_DIR, 1)
  tags <- c("new tag 1", "new tag 2")
  # copy models before creating model tree
  mod1 <- read_model(MOD1_PATH)
  mod2 <- copy_model_from(mod1, "2", .overwrite = TRUE, .add_tags = tags) %>% 
    update_model_id() %>% add_star()
  mod3 <- copy_model_from(mod2, "3", .overwrite = TRUE, .add_tags = "DV: nmol") %>% 
    update_model_id()
  mod4 <- copy_model_from(mod2, "4", .overwrite = TRUE) %>% update_model_id()
  mod5 <- copy_model_from(mod4, "5", .overwrite = TRUE) %>% update_model_id()

  # Multiple based_on
  mod6 <- copy_model_from(
    mod5, "6", .overwrite = TRUE, .based_on_additional = c("1", "3"),
    .star = TRUE, .description = "final model"
  ) %>% update_model_id() %>% suppressWarnings()
  mod7 <- copy_model_from(
    mod6, "7", .overwrite = TRUE, .based_on_additional = c("2")
  ) %>% update_model_id() %>% suppressWarnings()

  # Fake runs
  copy_output_dir(mod1, mod2)
  copy_output_dir(mod1, mod3)
  copy_output_dir(mod1, mod4)
  copy_output_dir(mod1, mod5)
  copy_output_dir(mod1, mod6)

  # Fake Bootstrap run
  boot_run <- make_fake_boot(mod6, n = 10)

  # Fake simulation (creates a new model)
  mod_sim <- make_fake_sim(mod3, n = 10, mod_id = "8")

  # Return mods to delete (dont return mod1)
  return(list(mod2, mod3, mod4, mod5, mod6, mod7, boot_run, mod_sim))
}

# delete old files
cleanup <- function(mods) {
  delete_models(mods, .tags = NULL, .force = TRUE) %>% 
    suppressMessages()
}

Create a model tree diagram

While the run_log(), summary_log(), and config_log() are helpful for summarizing the model development process, model_tree() provides a convenient way to visualize and track any of these tabulated parameters. You can create a tree diagram using a modeling directory or run log.

MODEL_DIR <- "../nonmem"

mods <- create_tree_models(MODEL_DIR) %>% suppressMessages()

By default, models will be colored by their run number, and basic summary statistics will display as a tooltip when hovered over.

model_tree(MODEL_DIR)

# you dont need to specify the width when rendering in Rstudio viewer, but it makes a difference when rendered in Rmarkdown 
# - relying on auto-sizing leads to a plot with a small width
model_tree(MODEL_DIR, width = 800, font_size = 12)

Adjust the coloring and tooltip

If coloring by a logical column, FALSE and TRUE values will correspond to white and red coloring respectively. Numeric or character columns will be colored as a gradient. NA values will appear grey regardless of the column type.

model_tree(MODEL_DIR, color_by = "star")

model_tree(MODEL_DIR, color_by = "star", width = 800, font_size = 12)

Specific columns can be added to the tooltip via the include_info argument. Though you are limited to the default run_log() columns when passing a model directory, you can pass any available columns when passing a run log dataframe (must inherit the class bbi_log_df). The examples below to illustrate cases where you may want to do that.

log_df <- run_log(MODEL_DIR)
log_df

log_df <- run_log(MODEL_DIR) %>% add_summary() %>% add_config() %>% suppressWarnings()
ofv_nas <- which(is.na(log_df$ofv))
# Overwrite ofv to reflect a typical modeling workflow
set.seed(1234)
log_df$ofv <- sort(abs(rnorm(nrow(log_df), mean = 2600, sd = 500)), decreasing = TRUE)
# Make the "final model" the smallest ofv instead of the last one in the run log
log_df$ofv[log_df$description == "final model"] <- min(log_df$ofv, na.rm = TRUE)
log_df$ofv[nrow(log_df)] <- min(log_df$ofv, na.rm = TRUE)*1.1
# retain existing NAs of objective function (mainly for bootstrap example)
log_df$ofv[ofv_nas] <- NA 

In this example we define a new column, out_of_date, to denote whether the model or data has changed since the last run. We can color by this new column to determine if any of the models need to be re-run:

log_df %>% add_config() %>%
  dplyr::mutate(out_of_date = model_has_changed | data_has_changed) %>%
  model_tree(
    include_info = c("model_has_changed", "data_has_changed"),
    color_by = "out_of_date"
  )

# Since using fake model runs (appearing out of date), set most to FALSE
log_df2 <- log_df
log_df2$model_has_changed[2:7] <- FALSE
log_df2 <- log_df2 %>% dplyr::mutate(
  out_of_date = model_has_changed | data_has_changed
)

model_tree(
  log_df2,
  include_info = c("model_has_changed", "data_has_changed", "nm_version"),
  color_by = "out_of_date",
  width = 800,
  font_size = 12
)

The model tree can also be helpful for quickly determine if any heuristics were found during any model submissions, as well as displaying specific model summary output in the tooltip.

log_df %>% add_summary() %>%
  model_tree(
    include_info = c("tags", "param_count", "eta_pval_significant"),
    color_by = "any_heuristics"
  )

# Since using fake models (all inheriting the same issues), set some to FALSE
log_df2 <- log_df
log_df2$any_heuristics[c(5, 7, 9)] <- FALSE

model_tree(
  log_df2,
  include_info = c("tags", "param_count", "eta_pval_significant"),
  color_by = "any_heuristics",
  width = 800,
  font_size = 12
)

Size the nodes by a particular column

Controlling the node size can be helpful for quickly determining the trend of a particular numeric column. Here, we use color_by and size_by to show the objective function value decreasing with each new model.

• Note: Like the color_by argument, only columns included in log_df can be passed. We have to call add_summary() to use "ofv" even though this is included in the tooltip when add_summary = TRUE.
• If size_by is not specified, the nodes are sized based on how many other models/nodes stem from it (i.e. the "final model" will be smaller than the "base model").

log_df %>% add_summary() %>%
  model_tree(color_by = "ofv", size_by = "ofv")

model_tree(
  log_df,
  color_by = "ofv", size_by = "ofv",
  width = 800,
  font_size = 12
)

# delete old files
cleanup(mods)

metrumresearchgroup/bbr documentation built on March 29, 2025, 1:08 p.m.