R/create.R

In simulator: An Engine for Running Simulations

#' @include utils.R
NULL

#' Create template for a new set of simulations
#'
#' This function is the fastest way to get started.  Creates the skeleton of a
#' simulation.
#'
#' @export
#' @param dir where to create the skeleton of a new set of simulations
#' @examples
#' \dontrun{
#'  create("./examples")
#'  }
create <- function(dir = "./my_sims") {
  dir <- remove_slash(dir)
  if (dir.exists(dir))
    stop ("This directory already exists.  Choose a new directory name.")
  else
    dir.create(dir)
  write_models(file.path(dir, "model_functions.R"))
  write_methods(file.path(dir, "method_functions.R"))
  write_evals(file.path(dir, "eval_functions.R"))
  write_main(file.path(dir, "main.R"))
  write_rmd(file.path(dir, "writeup.Rmd"))
  catsim(sprintf("New simulation template created!  Go to %s to get started.",
              file.path(dir, "main.R")), fill = TRUE)
}

write_models <- function(filename) {
  str <- '## @knitr models

make_my_model <- function(n, prob) {
  new_model(name = "contaminated-normal",
            label = sprintf("Contaminated normal (n = %s, prob = %s)", n, prob),
            params = list(n = n, mu = 2, prob = prob),
            simulate = function(n, mu, prob, nsim) {
              # this function must return a list of length nsim
              contam <- runif(n * nsim) < prob
              x <- matrix(rep(NA, n * nsim), n, nsim)
              x[contam] <- rexp(sum(contam))
              x[!contam] <- rnorm(sum(!contam))
              x <- mu + x # true mean is mu
              return(split(x, col(x))) # make each col its own list element
            })
}'
  dcat(str, outfile = filename, append = FALSE)
}

write_methods <- function(filename) {
  str <- '## @knitr methods

my_method <- new_method("my-method", "My Method",
                        method = function(model, draw) {
                          list(fit = median(draw))
                        })

their_method <- new_method("their-method", "Their Method",
                           method = function(model, draw) {
                             list(fit = mean(draw))
                           })'
  dcat(str, outfile = filename, append = FALSE)
}

write_evals <- function(filename) {
  str <- '## @knitr metrics

his_loss <- new_metric("hisloss", "His loss function",
                        metric = function(model, out) {
                          return((model$mu - out$fit)^2)
})

her_loss <- new_metric("herloss", "Her loss function",
                        metric = function(model, out) {
                          return(abs(model$mu - out$fit))
                        })'
    dcat(str, outfile = filename, append = FALSE)
}


write_main <- function(filename) {

  str <- '# This is the main simulator file

library(simulator) # this file was created under simulator version %s

source("model_functions.R")
source("method_functions.R")
source("eval_functions.R")

## @knitr init

name_of_simulation <- "normal-mean-estimation-with-contamination"

## @knitr main

sim <- new_simulation(name = name_of_simulation,
                      label = "Mean estimation under contaminated normal") %s
  generate_model(make_my_model, seed = 123,
                 n = 50,
                 prob = as.list(seq(0, 1, length = 6)),
                 vary_along = "prob") %s
  simulate_from_model(nsim = 10) %s
  run_method(list(my_method, their_method)) %s
  evaluate(list(his_loss, her_loss))

## @knitr plots

plot_eval_by(sim, "hisloss", varying = "prob")

## @knitr tables

tabulate_eval(sim, "herloss", output_type = \"markdown\",
              format_args = list(digits = 1))'
  dcat(sprintf(str, installed.packages()["simulator", "Version"],
       "%>%", "%>%", "%>%", "%>%"),
       outfile = filename, append = FALSE)
}

write_rmd <- function(filename) {
  str <- '---
title: "My Simulation"
author: "My Name"
date: "`r Sys.Date()`"
output: rmarkdown::html_vignette
---

```{r setup, include=FALSE}
library(knitr)
code <- c("model_functions.R",
          "method_functions.R",
          "eval_functions.R",
          "main.R")
code_lastmodified <- max(file.info(code)$mtime)
sapply(code, read_chunk)
```

This is a `knitr` report generated by the `simulator` to describe your simulation.
Knitting this file will rerun the simulation if any of the code files have been
modified since the `simulation` object was last created.

# Main simulation

```{r}
library(simulator)
```

```{r, echo = FALSE, results = \'hide\', warning = FALSE, message = FALSE}
<<models>>
<<methods>>
<<metrics>>
```

```{r, eval = FALSE}
<<init>>
<<main>>
```

```{r, echo = FALSE, results = \'hide\', message = FALSE, warning = FALSE}
<<init>>
sim_lastmodified <- file.info(sprintf("files/sim-%s.Rdata",
                              name_of_simulation))$mtime
if (is.na(sim_lastmodified) || code_lastmodified > sim_lastmodified) {
  <<main>>
} else{
  sim <- load_simulation(name_of_simulation)
}
```

We can make plots.

```{r, fig.width = 6, fig.height = 4, results = \'hide\', warning = FALSE, message = FALSE}
<<plots>>
```

And tables too.

```{r, results = \'asis\'}
<<tables>>
```

# Components

## Models

```{r, eval = FALSE}
<<models>>
```

## Methods

```{r, eval = FALSE}
<<methods>>
```

## Metrics

```{r, eval = FALSE}
<<metrics>>
```


# Conclusion

To cite the `simulator`, please use

```{r, results=\'asis\'}
citation("simulator")
```'
  dcat(str, outfile = filename, append = FALSE)
}


dcat <- function(..., append, outfile = "") {
  if (missing(append)) append <- TRUE
  cat(..., file = outfile, fill = TRUE, sep = "", append = append)
}

hline <- function(..., append=TRUE) dcat(..., rep("#", 80), append=append)