Merge pull request #3 from qtalr/save-functions

Save functions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: qtkit
 Title: Quantitative Text Kit
-Version: 0.10.0
+Version: 0.11.0
 Authors@R:
     person("Jerid", "Francom", , "[email protected]",
     role = c("aut", "cre"),
@@ -13,10 +13,14 @@ URL: https://qtalr.github.io/qtkit/, https://github.com/qtalr/qtkit
 BugReports: https://github.com/qtalr/qtkit/issues
 Depends:
     R (>= 3.6)
+Imports:
+    ggplot2,
+    kableExtra,
+    knitr
 Suggests:
-    knitr,
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    webshot2
 Config/testthat/edition: 3
 Encoding: UTF-8
 Language: en-US

NAMESPACE

@@ -2,6 +2,12 @@
 
 export(create_data_origin)
 export(get_archive_data)
+export(write_gg)
+export(write_kbl)
+export(write_obj)
+importFrom(ggplot2,ggsave)
+importFrom(kableExtra,save_kable)
+importFrom(knitr,opts_current)
 importFrom(tools,file_ext)
 importFrom(utils,download.file)
 importFrom(utils,untar)

NEWS.md

@@ -1,3 +1,10 @@
+# qtkit 0.11.0
+
+* Added `write_*()` functions to aid in publishing results to a variety of formats.
+  * `write_gg()` writes a ggplot object to a file.
+  * `write_kbl()` writes a knitr::kable object to a file.
+  * `write_obj()` writes an R object to a file.
+
 # qtkit 0.10.0
 
 # qtkit 0.9.5

R/write_gg.R

@@ -0,0 +1,79 @@
+#' Write a ggplot object to a file
+#'
+#' @description This function is a wrapper around `ggsave` from the
+#' `ggplot2` package that allows you to write a ggplot object as part of
+#' a knitr document as an output for later use. It is designed to be used
+#' in a code block. The file name, if not specified, will be the label of
+#' the code block.
+#'
+#' @param gg_obj The ggplot to be written. If not specified, the last
+#' ggplot created will be written.
+#' @param file The name of the file to be written. If not specified, the
+#' label of the code block will be used.
+#' @param target_dir The directory where the file will be written. If not
+#' specified, the current working directory will be used.
+#' @param device The device to be used for saving the ggplot. Options
+#' include "pdf" (default), "png", "jpeg", "tiff", and "svg".
+#' @param theme The ggplot2 theme to be applied to the ggplot. Default is
+#' the theme specified in the ggplot2 options.
+#' @param ... Additional arguments to be passed to the `ggsave`
+#' function from the `ggplot2` package.
+#'
+#' @return The path of the written file.
+#'
+#' @examples
+#' \dontrun{
+#' # Write a ggplot object as a PDF file
+#' p <- ggplot(mtcars, aes(x = wt, y = mpg)) +
+#'   geom_point()
+#' write_gg(p, file = "mtcars_ggplot", device = "pdf")
+#' }
+#'
+#' @importFrom ggplot2 ggsave
+#' @importFrom knitr opts_current
+#'
+#' @export write_gg
+#' @keywords publishing
+write_gg <- function(gg_obj = NULL, file = NULL, target_dir = NULL,
+                     device = "pdf", theme = NULL, ...) {
+  # Retrieve the label of the current code chunk
+  block_label <- knitr::opts_current$get("label")
+  # If ggplot is not specified, use the last ggplot created
+  if (is.null(gg_obj)) {
+    gg_obj <- ggplot2::last_plot()
+  }
+  # If file name is not specified, use the block label as the file name
+  if (is.null(file)) {
+    if (is.null(block_label)) {
+      # Stop execution and throw an error if both file name
+      # and block label are not specified
+      stop("file must be specified")
+    }
+    # Use the block label as the file name
+    file <- block_label
+  }
+  # If target directory is not specified, use the current working directory
+  if (is.null(target_dir)) {
+    target_dir <- getwd()
+  }
+  # If the target directory does not exist, create it
+  if (!dir.exists(target_dir)) {
+    dir.create(target_dir, recursive = TRUE)
+    # Output a message indicating that the directory has been created
+    message("Directory created: ", target_dir)
+  }
+  # Construct the full file path
+  extension <- switch(device,
+    "pdf" = ".pdf",
+    "png" = ".png",
+    "jpeg" = ".jpeg",
+    "tiff" = ".tiff",
+    "svg" = ".svg"
+  )
+  file <- paste0(file, extension)
+  file <- file.path(target_dir, file)
+  # Write the ggplot to the specified file
+  ggplot2::ggsave(file, gg_obj, device = device, ...)
+  # Return the file path, invisibly
+  return(invisible(file))
+}

R/write_kbl.R

@@ -0,0 +1,79 @@
+#' Write a kable object to a file
+#'
+#' @description This function is a wrapper around `save_kable` from the
+#' `kableExtra` package that allows you to write a kable object as part of
+#' a knitr document as an output for later use. It is designed to be used
+#' in a code block. The file name, if not specified, will be the label of
+#' the code block.
+#'
+#' @param kbl_obj The knitr_kable object to be written.
+#' @param file The name of the file to be written. If not specified,
+#' the name will be based on the current knitr code block label.
+#' @param target_dir The directory where the file will be written. If not
+#' specified, the current working directory will be used.
+#' @param device The device to be used for saving the file. Options
+#' include "pdf" (default), "html", "latex", "png", and "jpeg".
+#' @param bs_theme The Bootstrap theme to be applied to the kable object
+#' (only applicable for HTML output). Default is "bootstrap".
+#' @param ... Additional arguments to be passed to the `save_kable`
+#' function from the `kableExtra` package.
+#'
+#' @return The path of the written file.
+#'
+#' @examples
+#' \dontrun{
+#' # Write a kable object as a PDF file
+#' mtcars_kbl <- knitr::kable(mtcars[1:5, ], format = "html")
+#' write_kbl(mtcars_kbl, file = "mtcars_kable", device = "pdf")
+#'
+#' # Write a kable as an HTML file with a custom Bootstrap theme
+#' write_kbl(mtcars_kbl, file = "mtcars_kable", device = "html",
+#' bs_theme = "flatly")
+#' }
+#'
+#' @importFrom kableExtra save_kable
+#' @importFrom knitr opts_current
+#'
+#' @export write_kbl
+#' @keywords publishing
+write_kbl <-
+  function(kbl_obj, file = NULL, target_dir = NULL,
+           device = "pdf", bs_theme = "bootstrap", ...) {
+    # Retrieve the label of the current code chunk
+    block_label <- knitr::opts_current$get("label")
+    # If file name is not specified, use the block label as the file name
+    if (is.null(file)) {
+      if (is.null(block_label)) {
+        # Stop execution and throw an error if both file name
+        # and block label are not specified
+        stop("file must be specified")
+      }
+      # Use the block label as the file name
+      file <- block_label
+    }
+    # If target directory is not specified, use the current working directory
+    if (is.null(target_dir)) {
+      target_dir <- getwd()
+    }
+    # If the target directory does not exist, create it
+    if (!dir.exists(target_dir)) {
+      dir.create(target_dir, recursive = TRUE)
+      # Output a message indicating that the directory has been created
+      message("Directory created: ", target_dir)
+    }
+    # Construct the full file path
+    extension <- switch(device,
+      "html" = ".html",
+      "pdf" = ".pdf",
+      "latex" = ".tex",
+      "png" = ".png",
+      "jpeg" = ".jpeg"
+    )
+    file <- paste0(file, extension)
+    file <- file.path(target_dir, file)
+
+    # Save the kable to the specified file
+    kableExtra::save_kable(kbl_obj, file, bs_theme, ...)
+    # Return the file path, invisibly
+    return(invisible(file))
+  }

R/write_obj.R

@@ -0,0 +1,55 @@
+#' Write an R object as a file
+#'
+#' @description This function is a wrapper around `dput` that allows you
+#' to write an R object as part of a knitr document as an output for
+#' later use. It is designed to be used in a code block. The file name, if
+#' not specified, will be the label of the code block.
+#'
+#' @param obj The R object to be written.
+#' @param file The name of the file to be written. If not specified, the
+#' label of the code block will be used.
+#' @param target_dir The directory where the file will be written. If not
+#' specified, the current working directory will be used.
+#' @param ... Additional arguments to be passed to `dput`.
+#'
+#' @return The path of the written file.
+#'
+#' @examples
+#' \dontrun{
+#' # Write a data frame as a file
+#' write_obj(mtcars, file = "mtcars_data")
+#' }
+#' @importFrom knitr opts_current
+#'
+#' @export write_obj
+#' @keywords publishing
+write_obj <- function(obj, file = NULL, target_dir = NULL, ...) {
+  # Retrieve the label of the current code chunk
+  block_label <- knitr::opts_current$get("label")
+  # If file name is not specified, use the block label as the file name
+  if (is.null(file)) {
+    if (is.null(block_label)) {
+      # Stop execution and throw an error if both file name
+      # and block label are not specified
+      stop("file must be specified")
+    }
+    # Use the block label as the file name
+    file <- block_label
+  }
+  # If target directory is not specified, use the current working directory
+  if (is.null(target_dir)) {
+    target_dir <- getwd()
+  }
+  # If the target directory does not exist, create it
+  if (!dir.exists(target_dir)) {
+    dir.create(target_dir, recursive = TRUE)
+    # Output a message indicating that the directory has been created
+    message("Directory created: ", target_dir)
+  }
+  # Construct the full file path
+  file <- file.path(target_dir, file)
+  # Save the object to the specified file
+  dput(obj, file, ...)
+  # Return the file path, invisibly
+  return(invisible(file))
+}

_pkgdown.yml

@@ -34,6 +34,12 @@ reference:
     contents:
       - create_data_origin
       - get_archive_data
+  - title: "Publishing functions"
+    desc: "Functions to aid in publishing research"
+    contents:
+      - write_gg
+      - write_kbl
+      - write_obj
 
 footer:
   structure: