Possible Enhancement: Saving to folder rather than file

Hi Seb,

Again sorry for the multiple issues - feel free to ignore this one as really more of a feature request that may only be useful to me.

I have been using Libbi off and on for a while and been finding that in general RBI is great. However, when it comes to saving and loading bigger models they are often larger than the GitHub max. This in itself is fine but can cause a bit of a workflow issue. To get around this I coded up slightly altered versions of your save_libbi and read_libbi functions that save and load respectively to and from a folder rather than a file. Having done this I have also found that having the models saved as seperate components is quite useful when not working interactively, which is quite often due to some of the long run times.

The code for these is below and feel free to update/use etc if useful.

Thanks,

Sam

Read a libbi model from a folder.

#' @title Read a LiBbi Model
#'  
#' @description
#' Read results of a \code{LibBi} run from a folder. This completely reconstructs the saved \code{LibBi} object
#' This reads all options, files and outputs of a \code{LibBi} run from a specified folder
#'
#' @param folder Name of the folder containing the Libbi output as formated by \code{save_libbi}.
#' @param ... any extra options to pass to \code{\link{read_libbi}} when creating the new object
#' @return a \code{\link{libbi}} object#'
#' @importFrom rbi attach_file bi_write get_name
#' @importFrom purrr map
#' @importFrom stringr str_replace
#' @export
#' @examples
#' 
read_libbi <- function(folder, ...) {
  if (missing(folder)) {
    stop("Need to specify a folder to read")
  }

  files <- list.files(folder)

  read_obj <- map(files, function(x) {
    if (x == "output") {
      files <- list.files(file.path(folder, x))
      file <- map(files, ~readRDS(file.path(folder, x, .)))
      names(file) <-  str_replace(files,".rds", "")

    }else{
      file <- readRDS(file.path(folder, x))
      file <- file[[1]]
    }

    return(file)
  })

  names(read_obj) <- str_replace(files,".rds", "")

  libbi_options <- list(...)

  pass_options <- c("model", "dims", "time_dim", "coord_dims", "options",
                    "thin", "init", "input", "obs")

  for (option in pass_options) {
    if (!(option %in% names(libbi_options)) &&
        option %in% names(read_obj)) {
      libbi_options[[option]] <- read_obj[[option]]
    }
  }

  output_file_name <-
    tempfile(pattern=paste(get_name(read_obj$model), "output", sep = "_"),
             fileext=".nc")
  bi_write(output_file_name, read_obj$output,
           time_dim=libbi_options$time_dim)

  new_obj <- do.call(libbi, libbi_options)
  new_obj <- attach_file(new_obj, file="output", data=output_file_name)
  new_obj$supplement <- read_obj$supplement

  return(new_obj)
}

Save a libbi model to a folder. The folder creation step here may be an issue (breaks CRAN guidelines etc).

#' @title Save a LiBbi Model
#' @description
#' Write results of a \code{LibBi} run to a folder as a series of RDS files.
#' This saves all options, files and outputs of a \code{LibBi} run to a specified folder.
#'
#' @param x a \code{\link{libbi}} object
#' @param folder A character string indicating the folder name under which to save the model.
#' @param supplement any supplementary data to save
#' @importFrom rbi bi_read
#' @importFrom purrr walk2
#' @export
#' @examples 
#'
#' ## Function code 
#' ModelTBBCGEngland::save_libbi
save_libbi <- function(x, folder, supplement) {
  if (missing(folder)) {
    stop("Need to specify a folder name")
  }

  if (!dir.exists(folder)) {
    dir.create(folder)
    dir.create(file.path(folder, "output"))
  }

  save_obj <- list(model=x$model,
                   dims=x$dims,
                   time_dim=x$time_dim,
                   coord_dims=x$coord_dims,
                   thin=1,
                   supplement=x$supplement
  )

  options <- x$options

  for (file_type in c("init", "input", "obs")) {
    file_option <- paste(file_type, "file", sep="-")
    if (file_option %in% names(x$options)) {
      save_obj[[file_type]] <- bi_read(x, file=file_type)
      options[[file_option]] <- NULL
    }
  }

  save_obj[["options"]] <- options

  if (!missing(supplement)) save_obj[["supplement"]] <- supplement

  walk2(save_obj, names(save_obj), ~ saveRDS(list(.x), file.path(folder, paste0(.y, ".rds"))))

  output <- bi_read(x)

  walk2(output, names(output), ~ saveRDS(.x, file.path(folder, "output", paste0(.y, ".rds"))))

}

sbfnk / rbi

Possible Enhancement: Saving to folder rather than file #17