R/new.r

In rchallenge: A Simple Data Science Challenge System

#' Install a new challenge.
#' @param path         string. install path of the challenge (should be somewhere in your Dropbox).
#' @param out_rmdfile  string. name of the output R Markdown file.
#' @param recursive    logical. should elements of the path other than the last be created? see \code{\link{dir.create}}.
#' @param overwrite    logical. should existing destination files be overwritten? see \code{\link{file.copy}}.
#' @param quiet        logical. deactivate text output.
#' @param showWarnings logical. should the warnings on failure be shown? see \code{\link{dir.create}}.
#' @param data_dir     string. subdirectory of the data.
#' @param submissions_dir string. subdirectory of the submissions. see \code{\link{store_new_submissions}}.
#' @param hist_dir     string. subdirectory of the history. see \code{\link{store_new_submissions}}.
#' @param install_data logical. activate installation of the data files of the template challenge.
#' @param baseline     string. name of the team considered as the baseline.
#' @param add_baseline logical. activate installation of baseline submission files of the template challenge.
#' @param clear_history logical. activate deletion of the existing history folder.
#' @param template     string. name of the template R Markdown script to be installed.
#'   Two choices are available: \code{"en"} (english) and \code{"fr"} (french).
#' @param title        string. title displayed on the webpage.
#' @param author       string. author displayed on the webpage.
#' @param date         string. date displayed on the webpage.
#' @param email        string. email of the challenge administrator.
#' @param date_start   string. start date of the challenge.
#' @param deadline     string. deadline of the challenge.
#' @param data_list    list with members \code{train}, \code{test}, \code{y_test} and
#'   \code{ind_quiz} such as returned by the \code{\link{data_split}} function.
#' @return The path of the created challenge is returned.
#' @export
#' @examples
#' path <- tempdir()
#' wd <- setwd(path)
#' # english version
#' new_challenge()
#' # french version
#' new_challenge(template = "fr")
#' setwd(wd)
#' unlink(path)
new_challenge <- function(path = ".", out_rmdfile = "challenge.rmd", 
                          recursive = FALSE, overwrite = recursive, 
                          quiet = FALSE, showWarnings = FALSE,
                          template = c("en", "fr"),
                          data_dir = "data", 
                          submissions_dir = "submissions",
                          hist_dir = "history", 
                          install_data = TRUE, 
                          baseline = "baseline",
                          add_baseline = install_data,
                          clear_history = overwrite,
                          title = "Challenge",
                          author = "",
                          date = "",
                          email = "EDIT_EMAIL@DOMAIN.com",
                          date_start = format(Sys.Date(), "%d %b %Y"),
                          deadline = paste(Sys.Date()+90, "23:59:59"),
                          data_list = data_split(get_data("german"))) {
  
  dir.create(path, recursive = recursive, showWarnings = showWarnings)
  if (!file.exists(path))
    stop("could not create directory ", path)
  
  stopifnot(is.character(out_rmdfile), length(out_rmdfile)==1, nzchar(out_rmdfile))
  
  stopifnot(is.character(template), nzchar(template))
  template = match.arg(template, c("en", "fr"))
  # currently "challenge_en.rmd" and "challenge_fr.rmd" are available
  
  dir.create(file.path(path, "data"), recursive = recursive, showWarnings = showWarnings)
  
  if (install_data) {
    data_train <- data_list$train
    data_test <- data_list$test
    y_test <- data_list$y_test
    ind_quiz <- data_list$ind_quiz
    
    tmpdir = tempdir()
    
    save('data_train', file = file.path(tmpdir, 'data_train.rda'))
    file.copy(file.path(tmpdir, 'data_train.rda'), file.path(path, data_dir),
              overwrite=overwrite, recursive=recursive)
    
    save('data_test', file = file.path(tmpdir, 'data_test.rda'))
    file.copy(file.path(tmpdir, 'data_test.rda'), file.path(path, data_dir),
              overwrite=overwrite, recursive=recursive)
    
    save('y_test', file = file.path(tmpdir, 'y_test.rda'))
    file.copy(file.path(tmpdir, 'y_test.rda'), file.path(path, data_dir),
              overwrite=overwrite, recursive=recursive)
    
    save('ind_quiz', file = file.path(tmpdir, 'ind_quiz.rda'))
    file.copy(file.path(tmpdir, 'ind_quiz.rda'), file.path(path, data_dir),
              overwrite=overwrite, recursive=recursive)
    
    unlink(tmpdir)
  }
  
  dir.create(file.path(path, submissions_dir), recursive = recursive, showWarnings = showWarnings)
  
  if (install_data && add_baseline) {
    team_dir = new_team(baseline, path=path, submissions_dir = submissions_dir,
                        quiet = TRUE, showWarnings = showWarnings)
    
    # Predict all Good
    y_pred <- rep("Good", nrow(data_test))
    tmpfile = tempfile()
    write(y_pred, file = tmpfile)
    file.copy(tmpfile, file.path(team_dir, 'all_good.csv'), overwrite=overwrite)
    
    # Predict all Bad
    y_pred <- rep("Bad", nrow(data_test))
    write(y_pred, file = tmpfile)
    file.copy(tmpfile, file.path(team_dir, 'all_bad.csv'), overwrite=overwrite)
    
    unlink(tmpfile)
  }
  
  if (clear_history)
    unlink(file.path(path, hist_dir), recursive = TRUE)
  
  dir.create(file.path(path, hist_dir), recursive = recursive, showWarnings = showWarnings)
  
  expr = list(title = title, author = author, date = date, email = email, 
              date_start = date_start, deadline = deadline, baseline = baseline,
              data_dir = data_dir, submissions_dir = submissions_dir,
              hist_dir = hist_dir)
  
  # template files are in "template/challenge_<template>.rmd"
  tpl = system.file('template', paste0("challenge_", template, ".rmd"), package = 'rchallenge')
  if (!nzchar(tpl))
    stop("could not find template ", template)
  
  text = readLines(tpl)
  
  for (n in names(expr))
    text = gsub(paste0("@", toupper(n), "@"), expr[[n]], text)
  
  tmpfile = tempfile()
  
  writeLines(text, tmpfile)
  
  file.copy(tmpfile, file.path(path, out_rmdfile), overwrite=overwrite)
  
  unlink(tmpfile)
  
  if (!quiet) {
    cat('New challenge installed in: "', normalizePath(path), '"\n', sep='')
    cat('Next steps to complete the installation:\n')
    step <- 0
    if (install_data) {
      step <- step + 1
      cat(step, '. Replace the data files in the "data" subdirectory.\n', sep='')
    }
    if (add_baseline) {
      step <- step + 1
      cat(step, '. Replace the baseline predictions in "', file.path(submissions_dir, baseline),'".\n', sep='')
    }
    step <- step + 1
    cat(step, '. Customize the template R Markdown file "', out_rmdfile, '" as needed.\n', sep='')
    step <- step + 1
    cat(step, '. Create and share subdirectories in "', submissions_dir, '" for each team:\n', sep='')
    cat('    rchallenge::new_team("team_foo", "team_bar", path="', path, '", submissions_dir="', submissions_dir, '")\n', sep='')
    step <- step + 1
    cat(step, '. Render the HTML page:\n', sep='')
    cat('    rchallenge::publish("', file.path(path, out_rmdfile), '")\n', sep='')
    step <- step + 1
    template_html <- paste0(sub("([^.]+)\\.[[:alnum:]]+$", "\\1", basename(out_rmdfile)), ".html")
    cat(step, '. Give the URL to "', template_html, '" to the participants.\n', sep='')
    step <- step + 1
    cat(step, '. Automate the updates of the webpage.\n', sep='')
    if (.Platform$OS.type == "unix") {
      cat('   On Unix systems, you can setup the following line to your crontab using "crontab -e":\n', sep='')
      cat('    0 * * * * Rscript -e \'rchallenge::publish("', normalizePath(file.path(path, out_rmdfile)), '")\'\n', sep='')
    }
    if (.Platform$OS.type == "windows") {
      cat('   On Windows systems, you can use the Task Scheduler to create a new task with a "Start a program" action with the settings:')
      cat('   - Program/script: Rscript.exe\n')
      cat('   - options: -e rchallenge::publish(\'', normalizePath(file.path(path, out_rmdfile)), '\')\n', sep='')
    }
  }
  
  invisible(normalizePath(path))
}

#' Create new teams submission folders in your challenge.
#' @param ...          strings. names of the team subdirectories.
#' @param path         string. root path of the challenge. see \code{\link{new_challenge}}.
#' @param submissions_dir string. subdirectory of the submissions. see \code{\link{new_challenge}}.
#' @param quiet        logical. deactivate text output.
#' @param showWarnings logical. should the warnings on failure be shown? see \code{\link{dir.create}}.
#' @return The paths of the created teams are returned.
#' @export
#' @examples
#' path <- tempdir()
#' wd <- setwd(path)
#' new_challenge()
#' new_team("team_foo", "team_bar")
#' setwd(wd)
#' unlink(path)
new_team <- function(..., path = ".", submissions_dir = "submissions", 
                     quiet = FALSE, showWarnings = FALSE) {
  names <- c(...)
  stopifnot(is.character(names))
  if (!file.exists(file.path(path, submissions_dir)))
    stop("could not find submissions directory:", normalizePath(file.path(path, submissions_dir)))
  for (i in seq_along(names)) {
    if (!quiet) cat("Creating team subdirectory:", file.path(submissions_dir, names[i]), "\n")
    dir.create(file.path(path, submissions_dir, names[i]), recursive = FALSE, showWarnings = showWarnings)
  }
  if (!quiet) cat("Next step: share the Dropbox folders with the corresponding teams.\n")
  
  invisible(normalizePath(file.path(path, submissions_dir, names)))
}

#' Render your challenge R Markdown script to a HTML page.
#' @param input string. name of the R Markdown input file
#' @param output_file string. output file. If \code{NULL} then a default based on the name 
#'   of the input file is chosen.
#' @param output_dir string. output directory. Defaults to the directory of the input file.
#'   make sure that the output HTML file will be published online.
#' @param quiet      logical. deactivate text output.
#' @param ...        further arguments to pass to \code{\link[rmarkdown]{render}}.
#' @return The compiled document is written into the output file, and the path 
#'   of the output file is returned.
#' @note The rendering of HTML content provided by Dropbox will be discontinued 
#' from the 3rd October 2016 for Basic users and the 1st September 2017 for Pro 
#' and Business users. See \url{https://help.dropbox.com/fr-fr/files-folders/share/public-folder}. Alternatively, 
#' \href{https://pages.github.com/}{GitHub Pages} provide an easy HTML web publishing 
#' solution via a simple GitHub repository.
#' @export
#' @seealso \code{\link[rmarkdown]{render}}
#' @importFrom rmarkdown render
#' @examples
#' path <- tempdir()
#' wd <- setwd(path)
#' new_challenge()
#' outdir = tempdir()
#' if (rmarkdown::pandoc_available('1.12.3')) {
#'   publish(output_dir = outdir, output_options = list(self_contained = FALSE))
#' }
#' unlink(outdir)
#' setwd(wd)
#' unlink(path)
publish <- function(input="challenge.rmd", output_file = "index.html", 
                    output_dir = dirname(input), 
                    quiet = FALSE, ...) {
  wd <- getwd()
  setwd(dirname(input))
  out <- rmarkdown::render(input = basename(input), output_file = output_file,
                           output_dir = output_dir, quiet = quiet, ...)
  setwd(wd)
  
  if (!quiet)
    cat('Next step: give the URL to "', file.path(output_dir, basename(out)), '" to the participants.\n', sep='')
  
  invisible(out)
}