R/project-analysis-component.r

In kaneplusplus/aframe: Create, Manage, and Use Data Analysis Frameworks

# PROJECT PRINCIPLES
#
# 1. A project consists of a set of analyses. 
#
# 2. An analysis consists of a set of components.
#
# 3. A component is stored as a directory and consists of either 
#      1. Data from other components, and an R script. Data generated by the 
#         run script must be stored in the same component directory where the 
#         data were created.
#      2. data only.
#
# 4. A component can depend on other components but dependencies cannot be
#    circular.
#
# 5. An analysis can depend on other analyses but dependencies cannot be
#    circular
#
# 6. A directory named "util" can be stored alongside component directories or
#    in a component directory and can hold R functions and data needed by 
#    components.

af_create_proj_yaml <- function() {
  list(version = verbatim("0.1"))
}

#' @importFrom rprojroot root_criterion
af_proj_root <- function() {
  root_criterion(
    function(path) length(find_files(file.path(path), ".afproj")) > 0, 
    "has an .afproj file.")
}

#' @title Get the Path of the Current Project
#' @export
af_project_dir <- function(path = ".") {
  af_proj_root()$find_file(path = path)
}

#' @title Get the Path of the Current Analysis
#' @export
af_analysis_dir <- function(path = ".") {
  af_analysis_root()$find_file(path = path)
}


#' @importFrom rprojroot root_criterion
af_analysis_root <- function() {
  root_criterion(
    rproj_test_fun,
    "has a .Rproj file.")
}

is_error <- function(expr) {
  tryCatch({
      expr
      FALSE
    },
    error = function(e) TRUE)
}

#' @importFrom checkmate check_class
has_rproj_root <- function(rc, path = ".") {
  assert(check_class(rc, "root_criterion"))
  !is_error(rc$find_file(path = path))
}

af_is_proj <- function(path = ".") {
  has_rproj_root(af_proj_root(), path = path)
}

af_is_analysis <- function(path = ".") {
  has_rproj_root(af_analysis_root(), path = path)
}

#' @title Create a New Analysis Project
#'
#' @param proj_path the path to the new analyis project directory.
#' A file with the project name and .afproj extension will be created in the
#' directory.
#' @param setwd should the working directory be set to the new analysis
#' project directory? The default is FALSE.
#' @param ... other options passed to fs::dir_create.
#' @param verbose should extra information be put out to the console? The
#' default is `TRUE`?
#' @param proj_yaml the function to create the project yaml file. The
#' default is `af_create_proj_yaml()`.
#' @importFrom fs dir_create path path_file
#' @importFrom yaml write_yaml
#' @export
af_create_project <- 
  function(proj_path, setwd = FALSE, ..., verbose = TRUE, 
           proj_yaml = af_create_proj_yaml()) {

  dir_create(proj_path, ...)
  write_yaml(proj_yaml, 
             path(proj_path, ".afproj"))
  if (setwd) {
    if (verbose) {
      cat("\nSetting the directory to", proj_path, "\n\n")
    }
    setwd(proj_path)
  }
  invisible(TRUE)
}

#' @title The Analysis Project Tree
#'
#' @param path the path to look for the analysis. The default is the current 
#' working directory.
#' @aliases af_ptree 
#' @importFrom fs dir_tree
#' @export
af_project_tree <- function(path = ".") {
  dir_tree(af_project_dir(path = path), all = FALSE)
}

#' @export
af_ptree <- af_project_tree

#' @title The Analysis Tree
#'
#' @param path the path to look for the analysis. The default is the current 
#' working directory.
#' @aliases af_atree 
#' @importFrom fs dir_tree
#' @export
af_analysis_tree <- function(path = ".") {
  dir_tree(af_analysis_dir(path = path), all = FALSE)
}

#' @export
af_atree <- af_analysis_tree

#' @importFrom checkmate assert check_character
verbatim <- function(s) {
  assert(check_character(s))
  class(s) <- "verbatim"
  s
}

#' @title the Default RStudio Project YAML file.
#' @export
af_create_rproj_yaml <- function() {
  list(
    Version = verbatim("1.0"),
    RestoreWorkspace = verbatim("No"),
    SaveWorkspace = verbatim("No"),
    AlwaysSaveHistory = verbatim("No"),
    EnableCodeIndexing = verbatim("Yes"),
    UseSpacesForTab = verbatim("Yes"),
    NumSpacesForTab = verbatim("2"),
    Encoding = verbatim("UTF-8"),
    RnwWeave = verbatim("Sweave"),
    LaTeX = verbatim("pdfLaTeX"))
}

#' @title Get the Current Project
#' @aliases af_get_proj
#' @export
af_get_project <- function() {
  basename(af_project_dir())
}

af_get_proj <- af_get_project

#' @title Get the Current Analysis
#' @export
af_get_analysis <- function() {
  basename(af_analysis_dir())
}

#' @title Create a New Analysis/Study
#' 
#' @param name the name of the analysis/study. This may be a path but a 
#' warning is generated if it is a path and it is called from within an
#' analysis project.
#' @param name the name of the new analysis.
#' @param setwd should the working directory be set to the new analysis
#' project directory? The default is FALSE.
#' @param ... other options passed to fs::dir_create.
#' @param verbose should extra information be put out to the console? The
#' default is `TRUE`?
#' @param rproj_yaml the function to create the R Studio project yaml file. The
#' default is `af_create_rproj_yaml()`.
#' @importFrom fs dir_create path path_file path_dir
#' @importFrom yaml write_yaml
#' @aliases af_create_study
#' @export
af_create_analysis <- function(name, setwd = FALSE, ..., verbose = TRUE,
                               rproj_yaml = af_create_rproj_yaml()) {

  # If create_analysis is called from inside an analysis project, then 
  # make sure the analysis is a subdirectory of the project.
  if (af_is_proj() && path_dir(name) == ".") {
    name <- path(af_project_dir(), name)
  }
  cat("\nCreating analysis: ", basename(name), "\n",
      "In directory: ", dirname(path_abs(name)), "\n\n", sep = "")
  dir_create(name, ...)
  write_yaml(rproj_yaml,
             path(name, path_file(name), ext = "rproj"))
  if (setwd) {
    if (verbose) {
      cat("Setting working directory to", path(name), "\n\n")
    }
    setwd(name)
  }
  invisible(TRUE)
}

#' @export
af_create_study <- af_create_analysis

#' @title Create a New Analysis Component
#'
#' @param name the name of the new component. This parameter can be a path to
#' location where the new component should be added. A component must
#' be a subdirectory of an analysis.
#' @param bare should the bare path be used to create the component. The
#' default is `FALSE` meaning you if you specify "component" in an
#' analysis or "analysis/component" in a project, the component
#' will be installed in the proper location. Bare allows you to provide
#' a relative or absolute path to the analysis where the component will be
#' installed.
#' is being added to an analysis. The default is FALSE.
#' @param ... options to pass to `fs::dir_create()` in order to create the 
#' directory.
#' @param setwd should the working directory be set to the new component
#' directory? The default is FALSE.
#' @param verbose should extra information be printed. The default is `TRUE`.
#' @seealso fs::dir_create
#' @importFrom fs dir_create path_split path_abs
#' @importFrom checkmate assert check_character
#' @export
af_create_component <- 
  function(name, bare = FALSE, ..., setwd = FALSE, verbose = TRUE) {

  assert(
    check_character(name)
  )

  nv <- unlist(path_split(name))
 
  if (!bare) { 
    if (length(nv) == 1) {
      name <- path(af_analysis_dir(), name)
      # Make sure an af anaysis is being referenced.
    } else if (length(nv) == 2) {
      name <- path(af_project_dir(), name)
    } else {
      stop("You must specify either a component or an analysis/component\n",
           "  path relative to the current analysis or project.")
    }
  }
  name <- path_abs(name)
  if (!af_is_analysis(path_dir(name))) {
    stop("A component must be created in a subdirectory of an analysis.")
  }
 
  if (verbose) { 
    cat("\nCreating component: ", basename(name), "\n",
        "In directory: ", dirname(path_abs(name)), "\n\n", sep = "")
  }
  dir_create(name, ...)
  # .Rproj extension.
  if (setwd) {
    setwd(name)
  }
  invisible(TRUE)
}

# Put this off for now. Focus on project creation.
# Need to get everyone on board before implementing these.

#' @title Read a .rds File in an Analysis
#'
#' @param file a connection or the name of the file where the R object is
#' saved to or read from.
#' @param refhook a hook function for handling reference objects.
#' @seealso readRDS
#' @export
af_read_rds <- function(file, refhook = NULL) {
  readRDS(file, refhook)
}

#' @title Save a .rds File in an Analysis
#'
#' @param object R object to serialize.
#' @param file a connection or the name of the file where the R object is
#' saved to or read from.
#' @param ascii a logical.  If ‘TRUE’ or ‘NA’, an ASCII representation is
#' written; otherwise (default), a binary one is used.  See the
#' comments in the help for ‘save’.
#' @param version the workspace format version to use.  ‘NULL’ specifies the
#' current default version (3). The only other supported value
#' is 2, the default from R 1.4.0 to R 3.5.0.
#' @param compress a logical specifying whether saving to a named file is to use
#' ‘"gzip"’ compression, or one of ‘"gzip"’, ‘"bzip2"’ or ‘"xz"’
#' to indicate the type of compression to be used.  Ignored if
#' ‘file’ is a connection.
#' @param refhook a hook function for handling reference objects.
#' @seealso saveRDS
#' @export
af_save_rds <- function(object, file = "", ascii = FALSE, version = NULL,
                        compress = TRUE, refhook = NULL) {
  saveRDS(object, file, ascii, version, compress, refhook)
}

#' Source a File in an Analysis
#'
#' @param ... options to pass to the `source()` function.
#' @seealso source
#' @export
af_source <- function(...) {
  source(...)
}

# The following could be implemented.
#af_switch_analysis <- function(analysis_name) {
#}

#af_exit_analysis <- function() {
#}

#af_switch_project <- function(proj_name) {
#}

#af_switch_proj

#af_exit_project <- function() {
#}

#af_exit_proj <- function() {
#}

#af_pushd <- function(path <- ".") {
#}

#af_popd <- function() {
#}