BenchSort.R

library(rbenchmark)

sort.q <- function(m) {
  sort(m, method='quick')
}
sort.p <- function(m) {
  mm <- sort(m, partial=TOP)[1:TOP]
  sort(mm)
}

sort.all.g <- function(f) {
  function(m) {
    o <- matrix(rep(seq_len(SIZE), rep(SIZE, SIZE)), nrow=SIZE)
    matrix(f(m+o), nrow=SIZE)[1:TOP,]-o[1:TOP,]
  }
}
sort.all <- sort.all.g(sort)
sort.all.q <- sort.all.g(sort.q)

apply.sort.g <- function(f) {
  function(m) {
    apply(m, 2, f)[1:TOP,]
  }
}
apply.sort <- apply.sort.g(sort)
apply.sort.p <- apply.sort.g(sort.p)
apply.sort.q <- apply.sort.g(sort.q)

bb <- NULL

SIZE_LIMITS <- 3:9
TOP_LIMITS <- 2:5

for (SIZE in floor(sqrt(10)^SIZE_LIMITS)) {
  for (TOP in floor(sqrt(10)^TOP_LIMITS)) {
    print(c(SIZE, TOP))
    TOP <- min(TOP, SIZE)
    m <- matrix(runif(SIZE*SIZE), floor(SIZE))
    if (SIZE < 1000) {
      mr <- apply.sort(m)
      stopifnot(apply.sort.q(m) == mr)
      stopifnot(apply.sort.p(m) == mr)
      stopifnot(sort.all(m) == mr)
      stopifnot(sort.all.q(m) == mr)
    }
    
    b <- benchmark(apply.sort(m),
                   apply.sort.q(m),
                   apply.sort.p(m),
                   sort.all(m),
                   sort.all.q(m),
                   columns= c("test", "elapsed", "relative",
                              "user.self", "sys.self"),
                   replications=1,
                   order=NULL)
    b$SIZE <- SIZE
    b$TOP <- TOP
    b$test <- factor(x=b$test, levels=b$test)
    
    bb <- rbind(bb, b)
  }
}

ftable(xtabs(user.self ~ SIZE+test+TOP, bb))