Code For Distribution of Determinants Timing Tests

# dist-of-dets.R
# Ra timing tests using the distribution of the determinant
# of a 2x2 matrix from V and R "S Programming" p154.
# To compare R times to R times, you need to run this twice, once under
# R and once under Ra.  You can then manually compare the R to Ra times.

library(jit)
JIT.FLAG <- 1
TRACE.FLAG <- 0
QUICK.FLAG <- FALSE   # FALSE for full test, TRUE for quick test
NREPEATS <- 5         # for calculating time stddev
jit.flag <- 0

test <- function(f, N) # compare jitted to non jitted version of function f
{
    # na.rm=TRUE is needed when testing with very short times
    percent.relative.sd <- function(x) 100 * sd(x, na.rm=TRUE) / mean(x)

    cat(sprintf("%-22.22s %9.0f   ", paste(substitute(f)), N))

    time.jit <- time.no.jit <- double(NREPEATS)

    N <- as.integer(N)  # use an integer index in for loops

    for (i in 1:NREPEATS) {
        if (i %/% 2) { # alternate test order, probably unnecessary
            if (is.ra) {
                jit.flag <<- JIT.FLAG
                time.jit[i] <- system.time(no.jit.result <- f(N))[3]
            }
            jit.flag <<- 0
            time.no.jit[i]  <- system.time(jit.result    <- f(N))[3]
        } else {
            jit.flag <<- 0
            time.no.jit[i]  <- system.time(jit.result    <- f(N))[3]
            if (is.ra) {
                jit.flag <<- JIT.FLAG
                time.jit[i] <- system.time(no.jit.result <- f(N))[3]
            }
        }
    }
    cat(sprintf("%6.2f %3.1f%%      ",
        mean(time.no.jit),
        percent.relative.sd(time.no.jit)))

    if (is.ra)
        cat(sprintf("%6.2f %3.1f%%     %5.3f %3.1f%%",
            mean(time.jit),
            percent.relative.sd(time.jit),
            mean(time.jit / time.no.jit),
            percent.relative.sd(time.jit / time.no.jit)))

    cat("\n")

    if (is.ra)
        stopifnot(identical(no.jit.result, jit.result))
}
dd.for.c.jit <- function()
{
    jit(JIT.FLAG, TRACE.FLAG)
    val <- NULL
    nojit(val)  # allow "c" below to change len of val
    for (a in 0:9)
      for (b in 0:9)
        for (d in 0:9)
          for (e in 0:9)
            val <- c(val, a*b - d*e)
    table(val)
}
dd.for.c.nojit <- function()
{
    val <- NULL
    for (a in 0:9)
      for (b in 0:9)
        for (d in 0:9)
          for (e in 0:9)
            val <- c(val, a*b - d*e)
    table(val)
}
dd.for.c <- function(N)
{
    if (jit.flag)
        for (i in 1:N)
            dd.for.c.jit()
    else
        for (i in 1:N)
            dd.for.c.nojit()
}
dd.for.prealloc.jit <- function()
{
    jit(JIT.FLAG, TRACE.FLAG)
    val <- double(10000)
    nval <- 0
    for (a in 0:9)
      for (b in 0:9)
        for (d in 0:9)
          for (e in 0:9)
            val[nval <- nval + 1] <- a*b - d*e
    table(val)
}
dd.for.prealloc.nojit <- function()
{
    val <- double(10000)
    nval <- 0
    for (a in 0:9)
      for (b in 0:9)
        for (d in 0:9)
          for (e in 0:9)
            val[nval <- nval + 1] <- a*b - d*e
    table(val)
}
dd.for.prealloc <- function(N)
{
    if (jit.flag)
        for (i in 1:N)
            dd.for.prealloc.jit()
    else
        for (i in 1:N)
            dd.for.prealloc.nojit()
}
dd.for.tabulate.jit <- function()
{
    jit(JIT.FLAG, TRACE.FLAG)
    val <- double(10000)
    nval <- 0
    for (a in 0:9)
      for (b in 0:9)
        for (d in 0:9)
          for (e in 0:9)
            val[nval <- nval + 1] <- a*b - d*e
    tabulate(val)
}
dd.for.tabulate.nojit <- function()
{
    val <- double(10000)
    nval <- 0
    for (a in 0:9)
      for (b in 0:9)
        for (d in 0:9)
          for (e in 0:9)
            val[nval <- nval + 1] <- a*b - d*e
    tabulate(val)
}
dd.for.tabulate <- function(N)
{
    if (jit.flag)
        for (i in 1:N)
            dd.for.tabulate.jit()
    else
        for (i in 1:N)
            dd.for.tabulate.nojit()
}
dd.fast.jit <- function()
{
    jit(JIT.FLAG, TRACE.FLAG)
    val <- outer(0:9, 0:9, "*")
    val <- outer(val, val, "-")
    table(val + 82)
}
dd.fast.nojit <- function()
{
    val <- outer(0:9, 0:9, "*")
    val <- outer(val, val, "-")
    table(val + 82)
}
dd.fast <- function(N)
{
    if (jit.flag)
        for (i in 1:N)
            dd.fast.jit()
    else
        for (i in 1:N)
            dd.fast.nojit()
}
dd.fast.tabulate.jit <- function()
{
    jit(JIT.FLAG, TRACE.FLAG)
    val <- outer(0:9, 0:9, "*")
    val <- outer(val, val, "-")
    tabulate(val)
}
dd.fast.tabulate.nojit <- function()
{
    val <- outer(0:9, 0:9, "*")
    val <- outer(val, val, "-")
    tabulate(val)
}
dd.fast.tabulate <- function(N)
{
    if (jit.flag)
        for (i in 1:N)
            dd.fast.tabulate.jit()
    else
        for (i in 1:N)
            dd.fast.tabulate.nojit()
}
cat("is.ra", is.ra, "NREPEATS", NREPEATS, "QUICK.FLAG", QUICK.FLAG)
cat(" JIT.FLAG", JIT.FLAG, "\n\n")

cat("testname                       N     time rsd     ")
cat("jit-time rsd    reltime rsd\n\n")

test(dd.for.c,         if (QUICK.FLAG) 3 else 1000)
test(dd.for.prealloc,  if (QUICK.FLAG) 3 else 1000)
test(dd.for.tabulate,  if (QUICK.FLAG) 3 else 1000)
test(dd.fast,          if (QUICK.FLAG) 3 else 1000)
test(dd.fast.tabulate, if (QUICK.FLAG) 3 else 1000)