.print_export_msg <- function(path) {
message(sprintf("Saving as %s.", path))
}
.print_guessggplot_msg <- function() {
parent.call <- sys.call(sys.nframe() - 1L)
message("Guessing that `x` is the most recent ggplot2 plot.")
}
.print_autoexport_msg <- function(ext = NULL) {
parent.call <- sys.call(sys.nframe() - 1L)
message(sprintf("Exporting as `%s`.", ext))
}
.get_path_backup_safely <-
function(path = NULL,
path_backup = NULL,
backup = FALSE) {
if(!backup) {
# .print_argfalse_msg("overwrite")
return(invisible())
}
if(is.null(path_backup) & is.null(path)) {
.print_isnull_msg()
return(invisible())
} else if (is.null(path_backup) & !is.null(path)) {
ext <- .file_ext(path)
path_noext <- tools::file_path_sans_ext(path)
path_backup <- file.path(paste0(
path_noext,
"-",
strftime(Sys.time(), "%Y-%m-%d@%H-%M-%S"),
".",
ext
))
} else if(!is.null(path_backup)) {
}
invisible(path_backup)
}
.create_backup <-
function(path = NULL,
path_backup = NULL,
backup = NULL,
overwrite = FALSE) {
if (!backup) {
# .print_argfalse_msg("backup")
return(invisible())
}
path_backup <-
.get_path_backup_safely(path = path,
path_backup = path_backup,
backup = backup)
if (file.exists(path_backup) & !overwrite) {
.print_argfalse_msg("overwrite")
return(invisible())
}
file.copy(from = path, to = path_backup)
.print_export_msg(path_backup)
invisible(path_backup)
}
# #' @details A straight "copy-paste" of the `.file_ext()` function.
# #' @seealso `.file_ext`
.file_ext <-
function (x) {
pos <- regexpr("\\.([[:alnum:]]+)$", x)
ifelse(pos > -1L, substring(x, pos + 1L), "")
}
.guess_ext <-
function(x = NULL, path = NULL, ...) {
if (is.null(x)) {
res <- try({
ggplot2::last_plot()
}, silent = TRUE)
.print_guessggplot_msg()
if (is.null(res)) {
.print_isnull_msg()
return(invisible(NULL))
}
} else if(!is.null(path)) {
res <- .file_ext(path)
} else if (ggplot2::is.ggplot(x)) {
res <- "png"
} else if (is.data.frame(x)) {
res <- "csv"
}
.print_autoexport_msg(res)
invisible(res)
}
.export_ggplot <-
function(x = NULL, path = NULL, ...) {
ggplot2::ggsave(
filename = path,
plot = x,
...
)
invisible(path)
}
.export_readr_or_rio <-
function(x,
path,
ext,
...,
verbose = FALSE) {
fun_readr <- sprintf("readr::write_%s", ext)
# browser()
res <- try({
.do_call_with(fun_readr, list(x = x, path = path, ...))
}, silent = TRUE)
if (inherits(res, "try-error")) {
res <- rio::export(x, path, ...)
if (!inherits(res, "try-error")) {
.print_nonreadr_msg("rio", verbose = verbose)
}
}
invisible(path)
}
.export_ext <-
function(x = NULL,
path = NULL,
ext = NULL,
overwrite = TRUE,
backup = FALSE,
path_backup = NULL,
export = TRUE,
return = TRUE,
...) {
if (!export & return) {
return(invisible(path))
}
if (file.exists(path) & !overwrite) {
.print_argfalse_msg("overwrite")
return(invisible())
}
# Don't overwrite the directory, even if overwrite == TRUE for this function.
# message("Ignoring `overwrite == TRUE` to prevent an accidental overwrite.\n",
# "The user should rename the existing directory explicitly.")
# browser()
dir <- dirname(path)
create_dir(dir, overwrite = FALSE, backup = backup)
if (ext %in% c("png")) {
# .print_nonreadr_msg("ggplot2", verbose = verbose)
if (is.null(x)) {
x <- ggplot2::last_plot()
}
res <- .export_ggplot(x = x, path = path, ...)
} else if (grepl("rda", tolower(ext))) {
# x <- ls(parent.frame())
# path <- gsub(ext, "rdata", path)
# rio::export(x, path, ...)
res <-
suppressWarnings(utils::capture.output(session::save.session(path)))
res <- path
} else {
res <- .export_readr_or_rio(x = x, path = path, ext = ext, ...)
}
.print_export_msg(res, ...)
path_backup <-
.create_backup(
path = path,
path_backup = path_backup,
backup = backup,
overwrite = overwrite
)
invisible(res)
}
#' Export an object
#'
#' @description Saves data given a directory, file name, and extension, or a full path directly.
#' @details Object to save must be a data.frame (or matrix) for most formats.
#'
#' This function is intended to be used in a NSE manner, where the file name
#' is derived from the name of the object passed to the function (via `deparse(substitute(x))`).
#' `export_path()` may be a suitable alternative if the user wants to specify
#' the path name directly, although such an action can also be done with this function.
#'
#' Note that the user may not typically be concerned several arguments, including
#' `overwrite`, `backup`, `path_backup`, `export`, and `return`.
#' Nonetheless, these are provided in order to facilitate usage
#' with scripts run using "meta"-parameters that determine what data to export, whether or not
#' to overwrite, etc.
#'
#' Internally, a distinct method (`session::save.session`)
#' is used for the RData-type file extension in order
#' to allow for importing of packages. Also, `ggplot2` objects are treated in
#' a special manner.
#'
#' Many supplementary functions, using the format `export_ext_*()` are provided
#' for convenience. (e.g. `export_ext_csv()` instead of `export_ext(..., ext = 'csv').`
#'
#' @inheritParams create_dir
#' @param x data.frame (or matrix) for most formats.
#' @param file character. Bare file (i.e. without folderor extension),
#' @param ext character. Bare extension (i.e. without a dot). Must be one of valid formats.
#' @param path character. Concatenation of `file`, `dir`, and `ext`,
#' @param overwrite logical.
#' @param backup logical.
#' @param path_backup like `path`,
#' @param export logical. Indicates whether to actually carry res action. Intended to be used as a "catch all".
#' @param return logical. Relevant ONLY if `export == FALSE`.
#' Set to `TRUE` in order to preview what would be rendered.
#' @param ... dots. Parameters to pass directly to the internally used export function.
#' Important for explicitly specifying non-default `ggplot2::ggsave()` parameters,
#' as well as specifying worksheets, etc. for an Excel-based export method.
#' @return character. Path.
#' @examples
#' \dontrun{
#' if(interactive()){
#' # These may be defined elsewhere in a project.
#' dir_csv <- "csvs/"
#' export_csv <- TRUE
#' # ...
#' export_ext(iris, ext = "csv", dir = dir_csv, export = export_csv)
#' # Or...
#' export_ext_csv(iris, dir = dir_csv, export = export_csv)
#' }
#' }
#' @export
#' @rdname export_ext
#' @importFrom rio export
#' @importFrom ggplot2 last_plot ggsave
#' @importFrom session save.session
#' @importFrom utils capture.output
export_ext <-
function(x = NULL,
file = deparse(substitute(x)),
dir = getwd(),
ext = .guess_ext(x),
path = file.path(dir, paste0(file, ".", ext)),
overwrite = TRUE,
backup = FALSE,
path_backup = NULL,
export = TRUE,
return = TRUE,
...) {
# browser()
if (!export & !return) {
.print_argfalse_msg("export")
return(invisible())
}
if (is.null(x) & is.null(ext)) {
.print_isnull_msg()
return(invisible())
}
path <-
.get_path_safely(dir = dir, file = file, ext = ext, path = path)
res <-
.export_ext(
x = x,
path = path,
ext = ext,
overwrite = overwrite,
backup = backup,
path_backup = path_backup,
export = export,
return = return,
...
)
invisible(res)
}
#' Export an object
#'
#' @description Saves data given a full path.
#' @details This function works similarly to `export_ext()` internally, but the
#' order of the arguments are presented in a different order because it is assumed
#' that `path` will be supplied. This not the assumption with the `export_ext()` function.
#' If for some reason `path` is not provided, the `dir`,
#' `file`, and `ext` defaults are used.
#'
#' Note that the difference between `export_path()` and `export_ext()`
#' is not as significant as it is for `import_path()` and `import_ext()`.
#'
#' Also, `export_path()` does not have an analogue to `import_path_cleanly()`.
#'
#' @inheritParams export_ext
#' @return object.
#' @export
export_path <-
function(x = NULL,
path = NULL,
overwrite = TRUE,
backup = FALSE,
path_backup = NULL,
export = TRUE,
return = TRUE,
dir = getwd(),
file = deparse(substitute(x)),
ext = .guess_ext(x, path),
...) {
if (!export & !return) {
.print_argfalse_msg("export")
return(invisible())
}
if (is.null(x)) {
.print_isnull_msg()
return(invisible())
}
# if (is.null(ext)) {
# .print_isnull_msg()
# return(invisible())
# }
if(is.null(path)) {
path <-
.get_path_safely(dir = dir, file = file, ext = ext, path = path)
}
if (!export & return) {
return(invisible(path))
}
if (file.exists(path) & !overwrite) {
.print_argfalse_msg("overwrite")
return(invisible())
}
res <-
.export_ext(
x = x,
path = path,
ext = ext,
overwrite = overwrite,
backup = backup,
path_backup = path_backup,
export = export,
return = return,
...
)
invisible(res)
}
#' @export
#' @rdname export_ext
export_ext_csv <- function(...)
export_ext(ext = "csv", ...)
#' @export
#' @rdname export_ext
export_ext_rdata <- function(...)
export_ext(ext = "RData", ...)
#' @export
#' @rdname export_ext
export_ext_rda <- export_ext_rdata
#' @export
#' @rdname export_ext
export_ext_rds <- function(...)
export_ext(ext = "rds", ...)
#' @export
#' @rdname export_ext
export_ext_png <- function(...)
export_ext(ext = "png", ...)
#' @export
#' @rdname export_ext
export_gg <- export_ext_png
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.