R/targets.R

In jasenfinch/projecttemplates: Project Templates for Reproducible Research and Analyses

#' Add targets infrastructure
#' @description Add targets infrastructure to a project directory
#' @param project_directory the project directory file path
#' @param type project type. Should be one returned by `projectTypes()`.
#' @param targets_config a list containing the targets configuration to be written to YAML format
#' @param renv interface the use of an renv package cache
#' @examples
#' \dontrun{
#' projectSkeleton(paste0(tempdir(),'/test_project'))
#' targets(paste0(tempdir(),'/test_project'),type = 'report') 
#' }
#' @export

targets <- function(project_directory,
                    type = projectTypes(),
                    targets_config = list(
                      main = list(
                        reporter_make = 'timestamp_positives'
                      )
                    ),
                    renv = TRUE){
  
  if (missing(type)) {
    type <- 'report'
  }
  
  type <- match.arg(type)
  
  message('Adding targets infrastructure')
  
  targetsScript(project_directory,type)
  targetsConfig(project_directory,targets_config)
  targetsPipeline(project_directory,type)
  targetsRun(project_directory,renv = renv)
}

scriptHeader <- function(){
  version <- packageVersion('projecttemplates') %>% 
    as.character()
  
  glue('## Generated by projecttemplates (https://jasenfinch.github.io/projecttemplates/) v{version}')
}

#' Add a targets script
#' @description Add a _targets.R script to a project directory
#' @param project_directory the project directory file path
#' @param type project type. Should be one returned by \code{projectTypes()}
#' @examples 
#' \dontrun{
#' projectSkeleton(paste0(tempdir(),'/test_project'))
#' targetsPipeline(paste0(tempdir(),'/test_project'),type = 'report')
#' }
#' @export

targetsScript <- function(project_directory,type = projectTypes()){
  if (missing(type)) {
    type <- 'report'
  }
  
  type <- match.arg(type)
  
  template <- glue('
{scriptHeader()}

## Source utilities
source("R/utils.R")

## Load functions
"R/functions/" %>%
  list.files(full.names = TRUE) %>%
  purrr::walk(source)

')
  
  file_path <- str_c(project_directory,'_targets.R',sep = '/')
  writeLines(template,file_path)
}

#' Add a targets pipeline
#' @description Add a targets pipeline to a project directory.
#' @param project_directory the project directory file path
#' @param type project type. Should be one returned by \code{projectTypes()}.
#' @examples
#' \dontrun{
#' projectSkeleton(paste0(tempdir(),'/test_project'))
#' targetsPipeline(paste0(tempdir(),'/test_project'),type = 'report')
#' }
#' @importFrom glue glue
#' @importFrom styler style_file
#' @importFrom utils capture.output
#' @export

targetsPipeline <- function(project_directory,type = projectTypes()){
  
  if (missing(type)) {
    type <- 'report'
  }
  
  type <- match.arg(type)
  
  if (type == 'manuscript') {
    formats <- ',output_format = "all"'
  } else {
    formats <- ''
  }
  
  cmd <- glue('
  ## render {type}
  tarchetypes::tar_render(
                          {type},
                          "{type}/{type}.Rmd",
                          output_dir = "exports",
                          quiet = TRUE{formats}
  )
              ')
  
  if (type == 'manuscript') {
    cmd <- str_c('
  ## render tables
  tarchetypes::tar_render(tables,
                          "manuscript/tables.Rmd",
                          output_dir = "exports",
                          quiet = TRUE),
  
  ## render figures
  tarchetypes::tar_render(figures,
                          "manuscript/figures.Rmd",
                          output_dir = "exports",
                          quiet = TRUE),
  
  ## render supplementary information
  tarchetypes::tar_render(supplementary,
                          "manuscript/supplementary.Rmd",
                          output_dir = "exports",
                          quiet = TRUE),
                 ',
                 cmd)
  }
  
  file_path <- str_c(project_directory,'/_targets.R')
  
  p <- glue('
  
  list(
  {cmd}
  )
  ') %>%
    write(file = file_path,
          append = TRUE)
  
  out <- capture.output(style_file(file_path))
}

#' Add a targets run script to a project directory
#' @description Add a run.R script to a project directory that can be used to trigger building a targets workflow.
#' @param project_directory the project directory file path
#' @param renv add line to script restore package environment using renv
#' @examples 
#' \dontrun{
#' projectSkeleton(paste0(tempdir(),'/test_project'))
#' targetsRun(paste0(tempdir(),'/test_project'))
#' }
#' @export

targetsRun <- function(project_directory,renv = TRUE){
  if (isTRUE(renv)) {
    restore <- 'renv::restore()'
  } else {
    restore <- ''
  }
  script <- glue('
{scriptHeader()}
## Execute this script to run the project analysis
{restore}
targets::tar_make()

pipeline_graph <- targets::tar_visnetwork(label = c("time", "size"))
visNetwork::visSave(pipeline_graph,
                    file = "exports/pipeline_graph.html")

message("Complete!")
')
  
  writeLines(script,str_c(project_directory,'/misc/run.R'))
}

#' Add a targets configuration file to a project directory
#' @description Add a _targets`.yaml` configuration file to a project directory.
#' @param project_directory the project directory file path
#' @param targets_config a list containing the targets configuration to be written to YAML format
#' @examples 
#' \dontrun{
#' projectSkeleton(paste0(tempdir(),'/test_project'))
#' targetsConfig(paste0(tempdir(),'/test_project'))
#' }
#' @importFrom yaml write_yaml
#' @export

targetsConfig <- function(project_directory,
                          targets_config = list(
                            main = list(
                              reporter_make = 'timestamp_positives'
                            )
                          )){
  write_yaml(
    targets_config,
    glue('{project_directory}/_targets.yaml')
  )
}