delete model helper

[seth127]

It might be nice to have a delete_model() helper, in part for our test suite, but also for users. This function would take a model object and delete (on disk)

• the bbr-created YAML file
• the control stream
• the output directory

Probably also remove the model object from memory? Kind of a weird idea, but probably right.

[seth127]

Related, an idea from @barrettk of wanting to loop over and delete all models with a certain tag. This was relevant to testing #473 originally, but could have other use cases.

... It could be generalized further, but it also adds another purpose to add tags if we wanted to add another tags argument to the function:

cleanup_mods <- function(mods){
  # Only remove mods with correct tag
  mod_paths <- lapply(mods, function(mod.x){mod.x$absolute_model_path})# %>% unlist()
  mod_threads <- lapply(mods, function(mod.x){mod.x$bbi_args$threads})
  mod_tags <- lapply(mods, function(mod.x){mod.x$tags})

  mods_remove <- map2(mod_tags, mod_threads, function(tag.x, thread.y){
    grepl(paste("test", thread.y, "threads"), tag.x)
  }) %>% unlist()

  mod_paths <- mod_paths[mods_remove] %>% unlist()

  for (m in mod_paths) {
    if (fs::file_exists(yaml_ext(m))) fs::file_delete(yaml_ext(m))
    if (fs::file_exists(ctl_ext(m))) fs::file_delete(ctl_ext(m))
    if (fs::dir_exists(m)) fs::dir_delete(m)
  }
  message("Removed models with the following tags:\n", paste("-",unlist(mod_tags), collapse = "\n"))
}

This function works because I modified the mods call to add those tags:

  .mods <- map(threads, ~ copy_model_from(.mod, paste0(get_model_id(.mod), "_", .x, "_threads")) %>%
                 add_bbi_args(.bbi_args = c(threads = .x,
                                            .bbi_args,
                                            parallel = TRUE,
                                            overwrite = TRUE)) %>%
                 add_tags(paste("test",.x,"threads")))

[kylebaron]

@seth127 This could work for models in a git repository but would create problems with subversion. I know we're heading that direction but caution as long as subversion is in the mix.

[seth127]

hmmm, I'm not sure what you mean @kylebaron, though admittedly I don't know much about SVN. We're just talking about deleting the files on disk, not touching anything about how they're version controlled. Is there some subtlety I'm missing though?

[kylebaron]

If you delete the file before adding it to the repository, then it's fine. But if you add a file (or directory) to the repository and then delete it file_delete() it will come back the next time you run svn update. It can cause a lot of headaches if you run rm 1001.ctl rather than svn rm 1001.ctl. You could make it honor system ... "don't run this on models that have already been added"; but it seems like chances are high it won't work as expected.

[barrettk]

Would probably be overkill, but we could add a remove_svn argument (T/F), that wraps a system call in a trycatch if set to TRUE. Im not sure we'd want to do that though, given we want to migrate from SVN at some point

[seth127]

ok, this makes sense @kylebaron. Similar issue in git, though we could theoretically build in a git rm under the hood. That's probably dangerous though, and I don't know if there's even an analogous thing in SVN.

Honestly, this probably is most useful for testing and demos. In most cases it seems like people keep around all of the models they run, even if they didn't end up being "good" models. At least once they've checked them in.

[barrettk]

FYI @seth127 I modified that function (for use in the test_threads PR) to have a .tags argument: Ill paste some examples in that PR once the other functions are finalized (see https://github.com/metrumresearchgroup/bbr/pull/473)

cleanup_mods <- function(.mods, .tags = "test threads", .force = FALSE){
  if(!is.null(.tags)) check_character(.tags)

  if(!inherits(.mods, "bbi_nonmem_model")){
    check_model_object_list(.mods)
  }else{
    check_model_object(.mods)
    .mods <- list(.mods)
  }

  mod_info <- map_dfr(.mods, function(mod.x){
    mod_tags <- mod.x$tags
    mod_tags <- paste(mod_tags, collapse = ", ")
    mod_tags <- ifelse(mod_tags == "", "NA", mod_tags)
    tibble::tibble(
      mod_paths = mod.x$absolute_model_path,
      mod_thread = mod.x$bbi_args$threads,
      mod_tags = mod_tags
    )
  })

  tag_groups <- if(is.null(.tags)){
    crossing(mod_tags = mod_info$mod_tags, .tags = "NA", found = TRUE) %>% left_join(mod_info, by = "mod_tags")
  }else{
    tag_levels <- unique(.tags) # message in order of tags
    tag_groups <- crossing(mod_tags = mod_info$mod_tags, .tags) %>% left_join(mod_info, by = "mod_tags") %>%
      mutate(.tags = ordered(.tags, levels = tag_levels)) %>% arrange(.tags)
    found <- map2(tag_groups$mod_tags, tag_groups$.tags, function(tag.x, .tag){
      grepl(.tag, tag.x)
    }) %>% unlist()

    tag_groups$found <- found

    if(any(tag_groups$found==FALSE)){
      not_found <- c()
      for(tag.x in .tags){
        tag.found <- tag_groups$found[tag_groups$.tags==tag.x]
        if(all(tag.found==FALSE)){
          not_found <- c(not_found, tag.x)
        }
      }
      if(length(not_found) > 0){
        message("The following tags were not found:\n",
                paste("-",unique(not_found),"\n"))
      }
    }
    tag_groups[found,]
  }

  mod_paths <- unique(tag_groups$mod_paths)

  if(length(mod_paths)==0){
    stop("None of specified tags were found")
  }

  mods_removed <- unique(tag_groups$mod_tags)

  msg_remove <- paste0(
    paste("Removed", length(mod_paths), "models with the following tags:\n"),
    paste("-",mods_removed, collapse = "\n")
  )

  if(.force){
    for (m in mod_paths) {
      if (fs::file_exists(yaml_ext(m))) fs::file_delete(yaml_ext(m))
      if (fs::file_exists(ctl_ext(m))) fs::file_delete(ctl_ext(m))
      if (fs::dir_exists(m)) fs::dir_delete(m)
    }
    message(msg_remove)
  }else{
    msg_prompt <- paste0(
      paste("Are you sure you want to remove", length(mod_paths), "models with the following tags?: "),
      paste0("`",mods_removed,"`", collapse = ", ")
    )
    delete_prompt <- askYesNo(msg_prompt)
    if(delete_prompt){
      for (m in mod_paths) {
        if (fs::file_exists(yaml_ext(m))) fs::file_delete(yaml_ext(m))
        if (fs::file_exists(ctl_ext(m))) fs::file_delete(ctl_ext(m))
        if (fs::dir_exists(m)) fs::dir_delete(m)
      }
      message(msg_remove)
    }

  }
}

[seth127]

Will be closed by #473

[barrettk]

Mentioned these stories/requirements here, but reposting the delete_model specifics again here

Stories:

MGMT-S016:
  name: Cleanup model files
  description: As a user, I want to be able to easily delete all model files associated
       the identified model objects.
  ProductRisk: Medium
  Requirements:
    - MGMT-R001
    - MGMT-R002
    - MGMT-R003

Requirements:

MGMT-R001:
  description: delete_models() should work for test_threads() by default
  tests: 
     - BBR-CLM-001
MGMT-R002:
  description: delete_models() should only delete models with the specified .tags by default
  tests:
     - BBR-CLM-002
     - BBR-CLM-003
MGMT-R003:
  description: delete_models() should delete all specified models if .tags = NULL
  tests:
     - BBR-CLM-004