R/project_management.R

In LukasWallrich/rNuggets: Useful Helper Functions for (Academic) Data Analysis

#' Set up analysis project folder and script files
#'
#' Set up simple folder structure and template files for analysis project.
#'
#' @param folder Root folder of the project to be set up. Defaults to here::here()
#' @param analyses Character vector of analysis steps. R files will be set up in order.
#' @param pipeline_name Name of folder for outputs from each analysis step
#' @param code_folder Logical. Should code files be placed in /code subfolder.
#' Otherwise, are placed in root folder
#' @param standard_packages Character vector of packages to be loaded at start of each analysis file.
#' @param github_packages Character vector of packages to be loaded and installed from Github if needed at start of each analysis file.
#' @source The structure is based on https://towardsdatascience.com/how-to-keep-your-research-projects-organized-part-1-folder-structure-10bd56034d3a, with some simplifications and additions.
#' @export

setup_analysis_project <- function(folder = here::here(), analyses = c("data_prep", "analyses", "presentation"), pipeline_name = "outputs", code_folder = FALSE, standard_packages = c("magrittr", "here", "dplyr"), github_packages = NULL) {
  pipeline_folder <- paste0("3_", pipeline_name)
  folders <- paste0(folder, "/", c("0_data", "1_tools", (if (code_folder) "2_code" else NULL), pipeline_folder))

  purrr::map(folders, function(x) {
    if (!dir.exists(x)) {
      dir.create(x)
    }
  })

  files <- paste0(1:length(analyses), "_", analyses, ".R")
  if (code_folder) files <- paste0("2_code/", files)

  code_template <- glue::glue(code_template)

  for (i in seq_along(analyses)) {
    filename <- analyses[i]
    previous_name <- paste0(analyses[i - 1], "")
    code <- glue::glue(code_template)
    writeLines(code, file.path(folder, files[i]))
  }

  writeLines(glue::glue(management_functions_file), file.path(folder, "1_tools", "management_functions.R"))

  writeLines(glue::glue(run_all_file), file.path(folder, (if (code_folder) "2_code" else ""), "0_run_all.R"))
}


code_template <- ('

# ------------
# Introduction
# ------------

# !! Describe file purpose !!

NAME <- "{{filename}}"

# ------------
# Sources
# ------------

if (!require("pacman")) install.packages("pacman")
pacman::p_load({paste(standard_packages, collapse=", ")})
{if(is.null(github_packages)) "" else "pacman::p_load_gh("}\\
{if(is.null(github_packages)) "" else paste0(paste0("\'", github_packages, "\'"), collapse=", ")}\\
{if(is.null(github_packages)) "" else ")"}

source(here("1_tools/management_functions.R"))

#Set up pipeline folder if missing
pipeline <- create_pipeline_dir(NAME)
datadir <- "0_data"
pipelinedir <- "3_{pipeline_name}"

#df <- read_!!!(here(datadir, "!!!"))
#df <- read_!!!(here(pipelinedir, "{{previous_name}}", "!!!"))

notes <- character()
notes <- c(notes, "Note created:", timestamp(quiet = TRUE))


# ------------
# STEP 1
# ------------


# ------------
# Save outputs
# ------------

# readr::write_rds(df, here(pipeline, "XXX.RDS"))

writeLines(notes, here(pipeline, "notes.txt"))
                  ')

management_functions_file <- ("
  create_pipeline_dir <- function (NAME) {{
  pipeline <- here('3_{pipeline_name}', NAME)
  if (!dir.exists(pipeline)) {{
    dir.create(pipeline)
}}

  stringr::str_replace(stringr::str_replace(pipeline, here(), ''), '^/', '')
}}

                              ")

run_all_file <- ('
if (!require("pacman")) install.packages("pacman")
pacman::p_load(here, purrr)

files <- list.files(here({if(code_folder) "2_code" else ""}), pattern = "\\.R$")[-1]

map(here(files), source)

notes <- character()

notes <- c(notes, "Last complete run:", timestamp())

writeLines(notes, here("last_complete_run.txt"))

                 ')

#' @title Export package-specific R snippets
#'
#' @description \code{add_package_snippets} copies all (missing) snippet definitions
#'   in 'inst/rstudio/r.snippets' and 'rmd.snippets' (if not empty) to the RStudios user snippet location.
#'
#' @return boolean invisible(FALSE) if nothing was added, invisible(TRUE) if snipped definitions were added
#' @export
#'
#' @examples
#' \dontrun{
#' add_package_snippets()
#' }
#' @source https://stackoverflow.com/a/62223103/10581449

add_package_snippets <- function() {
  added <- FALSE

  # if not on RStudio or RStudioServer exit
  #
  if (!nzchar(Sys.getenv("RSTUDIO_USER_IDENTITY"))) {
    return(NULL)
  }

  # Name of files containing snippet code to copy
  #
  pckgSnippetsFiles <- c("r.snippets", "rmd.snippets")

  # Name of files to copy into. Order has to be the same
  # as in 'pckgSnippetsFiles'
  #
  rstudioSnippetsFiles <- c("r.snippets", "markdown.snippets")

  # Path to directory for RStudios user files depends on OS and RStudio version

  if (rstudioapi::versionInfo()$version < "1.3") {
    rstudioSnippetsPathBase <- file.path(path.expand("~"), ".R", "snippets")
  } else {
    if (.Platform$OS.type == "windows") {
      rstudioSnippetsPathBase <- file.path(Sys.getenv("APPDATA"), "RStudio", "snippets")
    } else {
      rstudioSnippetsPathBase <- file.path(path.expand("~"), ".config/rstudio", "snippets")
    }
  }

  # Read each file in pckgSnippetsFiles and add its contents
  #
  for (i in seq_along(pckgSnippetsFiles)) {

    # Try to get template, if template is not found skip it
    #
    pckgSnippetsFilesPath <- system.file("rstudio", pckgSnippetsFiles[i], package = "rNuggets")
    if (pckgSnippetsFilesPath == "") {
      next()
    }

    # load package snippets definitions
    #
    pckgSnippetsFileContent <- readLines(pckgSnippetsFilesPath, warn = FALSE)

    # Extract names of package snippets
    #
    pckgSnippetsFileDefinitions <- pckgSnippetsFileContent[grepl("^snippet (.*)", pckgSnippetsFileContent)]


    # Construct path for destination file
    #
    rstudioSnippetsFilePath <- file.path(rstudioSnippetsPathBase, rstudioSnippetsFiles[i])

    # If targeted RStudios user file does not exist, raise error (otherwise we would 'remove')
    # the default snippets from the 'user file'
    #
    if (!file.exists(rstudioSnippetsFilePath)) {
      stop(paste0(
        "'", rstudioSnippetsFilePath, "' does not exist yet\n.",
        "Use RStudio -> Tools -> Global Options -> Code -> Edit Snippets\n",
        "To initalize user defined snippets file by adding dummy snippet\n"
      ))
    }

    # Extract 'names' of already existing snippets
    #
    rstudioSnippetsFileContent <- readLines(rstudioSnippetsFilePath, warn = FALSE)
    rstudioSnippetDefinitions <- rstudioSnippetsFileContent[grepl("^snippet (.*)", rstudioSnippetsFileContent)]

    # replace two spaces with tab, ONLY at beginning of string
    #
    pckgSnippetsFileContentSanitized <- gsub("(?:^ {2})|\\G {2}|\\G\t", "\t", pckgSnippetsFileContent, perl = TRUE)

    # find definitions appearing in packageSnippets but not in rstudioSnippets
    # if no snippets are missing go to next file

    snippetsToCopy <- setdiff(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions))
    snippetsNotToCopy <- intersect(trimws(pckgSnippetsFileDefinitions), trimws(rstudioSnippetDefinitions))
    if (length(snippetsToCopy) == 0) {
      cat(paste0(
        "\n(", pckgSnippetsFiles[i], ": Following snippets will NOT be added because there is already a snippet with that name: ",
        paste0(snippetsNotToCopy, collapse = ", "), ")\n"
      ))
      next()
    }


    # Inform user about changes, ask to confirm action
    #
    if (interactive()) {
      cat(paste0(
        "You are about to add the following ", length(snippetsToCopy),
        " snippets to '", rstudioSnippetsFilePath, "':\n",
        paste0(paste0("-", snippetsToCopy), collapse = "\n")
      ))
      if (length(snippetsNotToCopy) > 0) {
        cat(paste0(
          "\n(The following snippets will NOT be added because there is already a snippet with that name:\n",
          paste0(snippetsNotToCopy, collapse = ", "), ")"
        ))
      }
      answer <- readline(prompt = "Do you want to procedd (y/n): ")
      if (substr(answer, 1, 1) == "n") {
        next()
      }
    }

    # Create list of line numbers where snippet definitions start
    # This list is used to determine the end of each definition block
    #
    allPckgSnippetDefinitonStarts <- grep("^snippet .*", pckgSnippetsFileContentSanitized)

    for (s in snippetsToCopy) {
      startLine <- grep(paste0("^", s, ".*"), pckgSnippetsFileContentSanitized)

      # Find last line of snippet definition:
      # First find start of next definition and return
      # previous line number or last line if already in last definition

      endLine <- allPckgSnippetDefinitonStarts[allPckgSnippetDefinitonStarts > startLine][1] - 1
      if (is.na(endLine)) {
        endLine <- length(pckgSnippetsFileContentSanitized)
      }

      snippetText <- paste0(pckgSnippetsFileContentSanitized[startLine:endLine], collapse = "\n")

      # Make sure there is at least one empty line between entries

      if (utils::tail(readLines(rstudioSnippetsFilePath, warn = FALSE), n = 1) != "") {
        snippetText <- paste0("\n", snippetText)
      }

      # Append snippet block, print message
      #
      cat(paste0(snippetText, "\n"), file = rstudioSnippetsFilePath, append = TRUE)
      #   cat(paste0("* Added '", s, "' to '", rstudioSnippetsFilePath, "'\n"))
      added <- TRUE
    }
  }

  if (added) {
    cat("Restart RStudio to use new snippets")
  }

  return(invisible(added))
}

#Copy Rproj filepath to clipboard - e.g., to set up local links
rproj_to_clip <- function() {
  here::here(list.files(here::here(), pattern =  "[.]Rproj$")) %>% clipr::write_clip()
}

#' @title Save ggplot-graph and show in folder
#'
#' @description This wraps \code{ggsave} and opens the folder where the graph was saved in a Shell.
#' From there, it can easily be dragged and dropped into the application where you want to use it.
#' It also changes the default units from in to cm, and defaults to saving temporary png files.
#'
#' @param filename File name with path. If not provided, only a temporary file is saved
#' @param units Unit for width and height, if provided. Defaults to "cm", can also be "in" or "mm"
#' @inheritParams ggplot2::ggsave
#' @inheritDotParams ggplot2::ggsave
#'
#' @export
#'
#' @examples
#' \dontrun{
#' ggsave_show(here::here("mtcars.pdf"))
#' }
#' @source https://stackoverflow.com/a/12135823/10581449

ggsave_show <- function(filename = tempfile("0_plot", fileext = ".png"), ..., device = "png",  units = "cm"){
  ggplot2::ggsave(filename, units = units, device = device, ...)
  if (.Platform['OS.type'] == "windows"){
    shell.exec(dirname(filename))
  } else {
    system(paste(Sys.getenv("R_BROWSER"), dirname(filename)))
  }
}