Nothing
#' @name backup_object
#'
#' @title Make and load backups of R objects
#'
#' @description
#' When work with data becomes risky, the best practice is to produce backup
#' files.
#' The function of `backup_object` is a wrapper of [save()], adding a
#' time stamp and a suffix to the name of the resulting file (an R image file
#' with extension \bold{*.rda}).
#' The function `load_last` is adapted to this style, loading the newest
#' version to the session.
#'
#' @param ... Names of the objects to be saved (either symbols or character
#' strings) in `backup_object()`. In `load_last()`, arguments passed to
#' `sort_backups()`.
#' @param objects A character vector indicating the names of objects to be
#' included in the backup file.
#' @param file A character value indicating the name of the backup file, without
#' the extension.
#' @param stamp A logical value indicating whether time should be stamped in the
#' backup name or not.
#' @param sep A character value used to separate backup's name from stamp and
#' from the suffix.
#' @param date_format A character value indicating the format used for the
#' file stamp. See [strptime()].
#' @param time_format A character value indicating the format used for the
#' the time (not including the date), which will be used for the invisible
#' report in `backup_object()`. See [strptime()].
#' @param fext A character value indicating the file extension (including the
#' dot symbol).
#' @param overwrite A logical value indicating whether existing files must be
#' overwritten or not.
#' @param fext A character value indicating the file extension (including the
#' dot symbol).
#' @param name A character value indicating the root of the backup's name.
#' @param path A character value indicating the path to the folder containing
#' the backup files.
#' @param choice An integer value indicating the backup file to be used for
#' recovery. This value refers to the row in the output of `sort_backups()`.
#' If not provided, `load_last()` will select the newest backup.
#'
#' @details
#' In both functions the argument `file` may include either the path
#' relative to the working directory or the absolute path to the file, excluding
#' stamps and extension.
#' For `overwrite=FALSE` (the default), a numeric suffix will be added to
#' the backup's name, if another backup was produced at the same day.
#' For `overwrite=TRUE` no suffix will be included in the file and existing
#' files will be overwritten.
#'
#' The function `load_last()` will load the newest version among backups
#' stored in the same folder, provided that the backup name includes a time
#' stamp.
#'
#' @return
#' The function `backup_object()` writes an R-image with extension \bold{*.rda}
#' and an invisible vector with the name of the backup, its absolute path and
#' a time stamp.
#'
#' The function `sort_backups()` returns a data frame including the sorted names
#' of backup files from the oldest to the newest.
#'
#' @author Miguel Alvarez \email{kamapu78@@gmail.com}
#'
#' @seealso [save()], [load()].
#'
#' @example examples/backup_object.R
#'
#' @rdname backup_object
#'
#' @export
backup_object <- function(
..., objects = character(), file, stamp = TRUE,
sep = "_", date_format = "%Y-%m-%d", time_format = "%H:%M:%S",
overwrite = FALSE) {
file2 <- basename(file_path_sans_ext(file))
path <- dirname(file)
inFolder <- file_path_sans_ext(list.files(path = path, pattern = ".rda"))
if (stamp) {
file2 <- paste0(
file2, sep,
format(Sys.time(), format = date_format)
)
}
if (!overwrite) {
file2 <- id_solver(insert = file2, to = inFolder, sep = sep)
}
file3 <- file.path(path, paste0(file2, ".rda"))
save(..., list = objects, file = file.path(path, paste0(file2, ".rda")))
message(paste0("Backup saved as '", file3, "'"))
invisible(c(
filename = paste0(file2, ".rda"), path = file3,
abspath = file_path_as_absolute(file3),
timestamp = format(Sys.time(),
format = paste(date_format, time_format)
)
))
}
#' @rdname backup_object
#'
#' @export
sort_backups <- function(
name, path = ".", date_format = "%Y-%m-%d",
fext = ".rda", sep = "_") {
inFolder <- list.files(path = path, pattern = fext)
inFolder <- inFolder[grepl(name, inFolder, fixed = TRUE)]
if (length(inFolder) == 0) {
stop("The requested backup is missing.")
}
time_stamp <- gsub(paste0(name, sep), "", inFolder)
time_stamp <- as.Date(strptime(time_stamp, format = date_format))
suffix <- list()
for (i in 1:length(inFolder)) {
suffix[[i]] <- gsub(paste0(name, sep, time_stamp[i]), "", inFolder[i])
}
suffix <- do.call(c, suffix)
suffix <- gsub(sep, "", suffix)
suffix <- as.integer(gsub(fext, "", suffix))
suffix[is.na(suffix)] <- 0
# Output object
OUT <- data.frame(
date = time_stamp,
suffix = suffix,
filename = inFolder,
abspath = sapply(file.path(path, inFolder), file_path_as_absolute)
)
OUT <- OUT[order(OUT$date, OUT$suffix), ]
OUT$order <- c(seq_len(nrow(OUT)))
rownames(OUT) <- NULL
return(OUT)
}
#' @rdname backup_object
#' @export
load_last <- function(file, path, ..., choice) {
if (!missing(path)) {
file <- file.path(path, file)
}
path <- dirname(file)
file <- basename(file)
OUT <- sort_backups(name = file, path = path, ...)
if (missing(choice)) {
choice <- nrow(OUT)
}
load(OUT$abspath[choice], envir = .GlobalEnv)
message(paste0("Loading file '", OUT$filename[choice], "' to session."))
invisible(OUT[choice, ])
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.