Check if model can be passed to nm_join()

[barrettk]

The function can_be_nm_joined() was previously used in setup_bootstrap_run(). It was originally updated to the function below in #707, became obsolete in #711, and then finally removed in #707.

There has been some consideration about calling this within nm_join() ahead of joining, as this performs additional checks. However without an explicit need/request for doing so, the above has not been implemented.

#' Helper to determine if `nm_join()` can be called on a `bbi_nonmem_model`
#' object
#' @inheritParams nm_tables
#' @inheritParams nm_join
#' @noRd
can_be_nm_joined <- function(.mod, .join_col = "NUM"){
  check_model_object(.mod, c(NM_MOD_CLASS, NM_SUM_CLASS))
  if(inherits(.mod, NM_SUM_CLASS)){
    .mod <- read_model(.mod[[ABS_MOD_PATH]])
  }

  # Model submission status checks
  is_finished <- model_is_finished(.mod)

  # Check for presence of table records
  has_tables <- mod_has_record(.mod, "table")

  reasons <- c()
  if(isFALSE(is_finished)){
    reasons <- c(reasons, "Model has not finished executing")
  }

  if(isFALSE(has_tables)){
    reasons <- c(reasons, "Model has no table records. Nothing to join to `nm_data()`")
  }

  # Check for .join_col or "ID" in all tables
  # - We dont specifically check if the table is FIRSTONLY (n_recs = nrows),
  #   as that requires reading in the model summary and fully reading in the
  #   tables, and the goal here is to do a quicker check ahead of time
  # - A `$TABLE` record must contain either the .join_col and/or "ID" to join
  #   properly
  if(isTRUE(is_finished) && isTRUE(has_tables)){
    all_table_cols <- get_table_columns(.mod, from_data = TRUE)
    has_join_col_or_id <- purrr::map_lgl(all_table_cols, function(tab_cols){
      any(c(.join_col, "ID") %in% tab_cols)
    })
    bad_join <- !all(has_join_col_or_id)

    if(isTRUE(bad_join)){
      missing_cols <- which(has_join_col_or_id == FALSE)
      missing_cols_txt <- glue("Record {missing_cols} --> Names: {all_table_cols[missing_cols]}")
      msg <- c(
        paste(
          glue("`$TABLE` records must include the provided .join_col ('{.join_col}') and/or 'ID' for FIRSTONLY tables."),
          "The following records do not have either:"
        ),
        missing_cols_txt
      )
      reasons <- c(reasons, msg)
    }
  }

  if(isFALSE(is_finished) || isFALSE(has_tables) || isTRUE(bad_join)){
    reasons_txt <- paste0(" - ", reasons, collapse = "\n")
    rlang::inform(
      c(
        "`nm_join()` cannot be used to join model output and input data",
        "i"="Reasons:",
        reasons_txt
      )
    )
    return(invisible(FALSE))
  }else{
    return(invisible(TRUE))
  }
}