##
## demo.R - examples used in the microbenchmark presentation at useR! 2011
##
## This should run through without any interaction. For the
## presentation it was run as follows:
##
##   R CMD SHLIB native.c
##   R CMD BATCH demo.R
##
## on an Intel(R) Xeon(R) CPU E7340 @ 2.40GHz with 64GB of memory. The
## R process was bound to one core and no frequency scaling was
## on. You should be able to obtain qualitativly similar results on
## any other platform. If not, feel free to ask me for assistance.
##
## Many more microbenchmark examples are available in its git
## repository which you can access using the following URL:
##
##  http://git.p-value.net/microbenchmark.git/tree/examples
##
library("microbenchmark")
library("reshape")
library("plyr")
library("ggplot2")

##> block0.tex
f_nothing <- function() NULL
f_something <- function() 1 + 1
n <- 1000000L
(tr1 <- system.time(replicate(n, f_nothing())) / n)
(tr2 <- system.time(replicate(n, f_something())) / n)
(tr3 <- system.time(replicate(n, NULL)) / n)
(tr4 <- system.time(replicate(n, 1 + 1)) / n)
##<

##> block1.tex
s <- seq_len(n)
(tf1 <- system.time(for(i in s) f_nothing()) / n)
(tf2 <- system.time(for(i in s) f_something()) / n)
(tf3 <- system.time(for(i in s) NULL) / n)
(tf4 <- system.time(for(i in s) 1 + 1) / n)
##<

r <- rbind(data.frame(method="replicate",
                      expr=c("f_nothing()", "f_something()", "NULL", "1 + 1"),
                      time=c(tr1[1], tr2[1], tr3[1], tr4[1])),
           data.frame(method="for",
                      expr=c("f_nothing()", "f_something()", "NULL", "1 + 1"),
                      time=c(tf1[1], tf2[1], tf3[1], tf4[1])))

##> timings.tex
cast(expr ~ method, data=r, value="time")
##<

##> block2.tex
res <- microbenchmark(f_nothing(), f_something(), NULL, 1 + 1,
                      times=200L)

print(res, unit="s")
##<

tmp <- res
tmp$run <- 1:nrow(tmp)
plt <- qplot(run, time / 1e9, data=tmp,
             xlab="", ylab="Time [s]")
plt <- plt + scale_y_log10()
plt <- plt + facet_grid(expr ~ .)

png("run.png", width=1024, height=700, bg="transparent", res=96)
theme_set(theme_bw(18))
print(plt)
dev.off()

## We could also look at histograms:
## plt <- qplot(time, data=tmp, geom="histogram")
## plt <- plt + facet_grid(expr ~ .)
## plt <- plt + scale_x_log10()

res$method <- "microbenchmark"
rr <- rbind(r, ddply(res, .(method, expr), summarize, time=mean(time) / 1e9))
##> timings2.tex
cast(expr ~ method, data=rr, value="time")
##<

## Compile using R CMD SHLIB native.c
dyn.load(sprintf("native%s", .Platform$dynlib.ext))
##> call.tex
r_do_nothing <- function(x) x
do_nothing <- getNativeSymbolInfo("do_nothing")

## Added pkgstring variant after talk based on a comment by
## Prof. Brian Ripley:
res <- microbenchmark(r=r_do_nothing(NULL),
                      symbol=.Call(do_nothing, NULL),
                      string=.Call("do_nothing", NULL),
                      pkgstring=.Call("do_nothing", NULL, PACKAGE="native"),
                      times=100L,
                      control=list(warmup=2^16))
print(res, unit="eps")
##<

## Clean up.
rm(list=ls())
for (i in seq_len(10)) gc()

##> gc.tex
x <- runif(100)
res <- microbenchmark(x + 1, times=50000L)
print(res, unit="us")
##<
png("gc.png", width=1024, height=700, bg="transparent", res=96)
res$run <- 1:nrow(res)
plt <- qplot(run, time/1e6, data=res, xlab="Run", ylab="Time [us]")
plt <- plt + scale_y_log10()
theme_set(theme_bw(18))
print(plt)
dev.off()

##> consnig.tex
x <- NULL
res <- microbenchmark(x <- c(x, 1), times=10000L)
print(res)
##<

png("consing.png", width=1024, height=700, bg="transparent", res=96)
res$run <- 1:nrow(res)
plt <- qplot(run, time/1e6, data=res, xlab="Run", ylab="Time [us]")
plt <- plt + scale_y_log10()
theme_set(theme_bw(18))
print(plt)
dev.off()