CTUtemplate: Example RStudio Project Templates

# This function showcases how one might write a function to be used as an
# RStudio project template. This function will be called when the user invokes
# the New Project wizard using the project template defined in the template file
# at:
#
#   inst/rstudio/templates/project/hello_world.dcf
#
# The function itself just echos its inputs and outputs to a file called INDEX,
# which is then opened by RStudio when the new project is opened.
#' @importFrom glue glue
CTUtemplate <- function(path, ...) {

  # ensure path exists
  dir.create(path, recursive = TRUE, showWarnings = FALSE)

  lf <- list.files(path, include.dirs = TRUE)
    if(length(lf) > 2){
    msgBox <- svDialogs::ok_cancel_box(message = "WARNING! There are already folders here!\nCheck that you aren't overwriting anything before proceeding\n\n OK to proceed\ncancel to stop (RStudio will give an error - that's expected)")
    if(!msgBox) {
      opt <- options(show.error.messages = FALSE)
      on.exit(options(opt))
      stop()
    }
  }


  # collect inputs
  dots <- list(...)
  text <- lapply(seq_along(dots), function(i) {
    key <- names(dots)[[i]]
    val <- dots[[i]]
    paste0(key, ": ", val)
    # assign(key, val, envir = parent.frame())
  })


  # create new folders
  folderend_r <- ifelse(dots$rFiles, dots$projNum, "xx")
  folderend_s <- ifelse(dots$stataFiles, dots$projNum, "xx")

  folders <- c(od =  glue("01_Original_data_{dots$projNum}"),
               sa =  glue("02_1_Stata_ado_{folderend_s}"),
               ss =  glue("02_2_Stata_scripts_{folderend_s}"),
               rs =  glue("03_R_scripts_{folderend_r}"),
               pd =  glue("04_prepared_data_{dots$projNum}"),
               fd =  glue("05_Figures_{dots$projNum}"),
               td =  glue("06_Tables_{dots$projNum}"),
               ld =  glue("07_Log_files_{dots$projNum}"),
               rd =  glue("08_Reports_{dots$projNum}"),
               qc =  glue("09_QualityControl_xx"),
               pub = glue("10_Publication_xx"),
               doc = glue("11_Documents_{dots$projNum}"),
               tmp = "xx_temporary")


  lapply(file.path(path, folders), dir.create, showWarnings = FALSE)

  # generate header
  header <- c(
    "# This file was generated by a call to 'CTUtemplate::CTUtemplate()'.",
    "# The following inputs were received:",
    ""
  )

  # collect into single text string
  contents <- paste(
    paste(header, collapse = "\n"),
    paste(text, collapse = "\n"),
    paste(folders, collapse = "\n"),
    sep = "\n", collapse = "\n"
  )

  # write to index file
  writeLines(contents, con = file.path(path, "INDEX"))

  # header


  if(dots$rFiles){
    # R ----
    # masterfile
    paths <- mapply(function(x, y){
      x <- function(...) file.path(path, y, ...)
    }, names(folders), folders)

    lines <- readLines(system.file("extdata", "R", "master.R", package = "CTUtemplate"))
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "MASTERFILE",
                             short = FALSE),
                      'options(stringsAsFactors = FALSE)\n',
                      # glue('pp <- here::here() # change if necessary'),
                      # "setwd(pp)", "",
                      "pathsdf <- tibble::tribble(",
                      "                  ~short, ~full,",
                      glue('                  "{names(folders)[1]}", "{folders[1]}",'),
                      glue('                  "{names(folders)[2]}", "{folders[2]}",'),
                      glue('                  "{names(folders)[3]}", "{folders[3]}",'),
                      glue('                  "{names(folders)[4]}", "{folders[4]}",'),
                      glue('                  "{names(folders)[5]}", "{folders[5]}",'),
                      glue('                  "{names(folders)[6]}", "{folders[6]}",'),
                      glue('                  "{names(folders)[7]}", "{folders[7]}",'),
                      glue('                  "{names(folders)[8]}", "{folders[8]}",'),
                      glue('                  "{names(folders)[9]}", "{folders[9]}",'),
                      glue('                  "{names(folders)[10]}", "{folders[10]}",'),
                      glue('                  "{names(folders)[11]}", "{folders[11]}",'),
                      glue('                  "{names(folders)[12]}", "{folders[12]}",'),
                      glue('                  "{names(folders)[13]}", "{folders[13]}")'),
                      paste0('paths <- mapply(function(x, y){
                            x <- function(...) here::here(y, ...)
                            },
                            pathsdf$short,
                            pathsdf$full)'),
                      paste(lines, collapse = "\n"),
                      sep = "\n")
    writeLines(contents, con = paths$rs("00_MASTERFILE.R"))

    # packages
    lines <- readLines(system.file("extdata", "R", "packages_funs.R", package = "CTUtemplate"))
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "Load necessary packages",
                             short = TRUE),
                      "\n\n\n",
                      paste(lines, collapse = "\n"),
                      sep = "\n")
    writeLines(contents, con = paths$rs("01_packages_functions.R"))

    # data prep
    lines <- readLines(system.file("extdata", "R", "dataprep.R", package = "CTUtemplate"))
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "Data preparation",
                             short = TRUE),
                      "\n\n\n",
                      paste(lines, collapse = "\n"),
                      sep = "\n")
    writeLines(contents, con = paths$rs("02_dataprep.R"))

    # baseline
    lines <- readLines(system.file("extdata", "R", "baseline.R", package = "CTUtemplate"))
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "Baseline Tables",
                             short = TRUE),
                      paste(lines, collapse = "\n"),
                      sep = "\n")
    writeLines(contents, con = paths$rs("03_baseline.R"))

    # analysis
    lines <- readLines(system.file("extdata", "R", "analysis.R", package = "CTUtemplate"))
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "Main analysis",
                             short = TRUE),
                      "\n\n\n",
                      paste(lines, collapse = "\n"),
                      sep = "\n")
    writeLines(contents, con = paths$rs("04_analysis.R"))



    # blank
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "XXXXX",
                             short = TRUE),
                      "\n\n\n",

                      sep = "\n")
    writeLines(contents, con = paths$rs("xx_template.R"))

  }
  if(dots$stataFiles){
    # stata ----
    # masterfile
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "MASTERFILE",
                             short = FALSE,
                             R = FALSE),
                      'clear all',
                      'set more off, permanently',
                      'set type double, permanently',
                      'set scheme s2mono, permanently',
                      'version 16.1', '', '',
                      '**** paths ****',
                      glue('global pp "{getwd()}"'),
                      "cd $pp", "",
                      glue('global od "$pp/{folders["od"]}"    // original data'),
                      glue('global sa "$pp/{folders["sa"]}"      // stata ADO'),
                      glue('global ss "$pp/{folders["ss"]}"  // stata do'),
                      glue('global rs "$pp/{folders["rs"]}"        // R scripts'),
                      glue('global pd "$pp/{folders["pd"]}"    // prepped data'),
                      glue('global fd "$pp/{folders["fd"]}"          // figures'),
                      glue('global td "$pp/{folders["td"]}"           // tables'),
                      glue('global ld "$pp/{folders["ld"]}"        // log files'),
                      glue('global rd "$pp/{folders["rd"]}"          // reports'),
                      glue('global qc "$pp/{folders["qc"]}"   // Quality control'),
                      glue('global tmp = "$pp/{folders["tmp"]}        // temporary files'),

                      '', '', '',
                      '**** ado path ****',
                      'adopath ++ "$sa"',
                      '', '', '',
                      '**** install btable ****',
                      'net install github, from("https://haghish.github.io/github/")',
                      'github install CTU-Bern/btable',
                      '', '', '',
                      '**** run do files ****',
                      'cap log close',
                      'log using "$ld/01_data_prep", text, replace',
                      'do "$ss/01_data_prep"',
                      'cap log close',
                      '* see also $ss/01_REDCap_export for REDCap import via the API',
                      '* see also https://github.com/CTU-Bern/stata_secutrial for secuTrial import code',
                      '',
                      'cap log close',
                      'log using "$ld/02_baseline", text, replace',
                      'do "$ss/02_baseline"',
                      'cap log close',
                      '',
                      'cap log close',
                      'log using "$ld/03_analysis", text, replace',
                      'do "$ss/03_analysis"',
                      'cap log close',


                      sep = "\n")
    writeLines(contents, con = paths$ss("00_MASTERFILE.do"))

    lf <- list.files(system.file("extdata", "Stata", package = "CTUtemplate"),
                     pattern = "\\.(ado|hlp)$")

    lapply(lf, function(x){
      file.copy(
        system.file("extdata", "Stata", x, package = "CTUtemplate"),
        paths$sa(x)
        )
    })

    lf <- list.files(system.file("extdata", "Stata", package = "CTUtemplate"),
                     pattern = "\\.(do)$")

    lapply(lf, function(x){
      file.copy(
        system.file("extdata", "Stata", x, package = "CTUtemplate"),
        paths$ss(x)
        )
    })



    # data prep
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "Data preparation",
                             short = TRUE, R = FALSE),
                      "\n\n\n",
                      '**** Load data ****',
                      'import delimited $od/raw_data.csv, replace',
                      '** apply labels ',
                      'label var var1 "Label of var1"',
                      '** save prepped data',
                      'save "$pd/prepped_data", replace',

                      sep = "\n")
    writeLines(contents, con = paths$ss("01_data_prep.do"))


    # baseline
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "Baseline Tables",
                             short = TRUE, R = FALSE),
                      "\n\n\n",
                      '**** Load data ****',
                      'use "$pd/prepped_data", clear',
                      '** make baseline table',
                      'btable var1-var5, saving("$tmp/btab") ',
                      'btable_format using "$tmp/btab", clear',
                      'export delimited "$td/btab.csv"',
                      sep = "\n")
    writeLines(contents, con = paths$ss("02_baseline.do"))


    # blank
    contents <- paste(header(dots$projNum,
                             dots$projName,
                             dots$au,
                             "XXXXX",
                             short = TRUE, R = FALSE),
                      "\n\n\n",

                      sep = "\n")
    writeLines(contents, con = paths$ss("xx_template.do"))
  }
}

# funs <- mapply(function(x, y){
#   assign(x, function(z) file.path(path, y, z))
# },
# c("od", "fd", "td", "ld", "rd", "sd"), c("", ""))