Nothing
#' @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)
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.