reports/printResults.R

   1 # NOTE: discard top 2% of highest values
   2 prms <- function(name, idx)
   3 {
   4   load(name)
   5   d <- nrow(mr[[1]][[1]])-2
   6     if (idx > length(mr))
   7         mr[[idx]] = mr[[1]]
   8   p <- colMeans(do.call(rbind, lapply(mr[[idx]], function(m) m[1,])))
   9     bVects <- lapply(mr[[idx]], function(m) m[2+d,])
  10     q98 <- Inf #quantile(sapply(bVects, function(bv) sum(abs(bv))), 0.98)
  11     bFiltered <- Filter(function(bv) sum(abs(bv)) < q98, bVects)
  12   b <- colMeans(do.call(rbind, bFiltered))
  13     betaMatrices <- lapply(mr[[idx]], function(m) m[2:(d+1),])
  14     q98 <- Inf #quantile(sapply(betaMatrices, function(bm) sum(abs(bm))), 0.98)
  15     bmFiltered <- Filter(function(bm) sum(abs(bm)) < q98, betaMatrices)
  16     beta <- (1/length(bmFiltered)) * Reduce("+", bmFiltered)
  17   list(p, beta, b, mr_params)
  18 }
  19
  20 pprms <- function(link, prefix="./")
  21 {
  22   toprint <- matrix(nrow=0, ncol=13) #13=1+2+1 + 1+2+1 + 1+3+1
  23     for (n in c("5000", "10000", "100000", "500000", "1000000"))
  24   {
  25     for (method in 1:2)
  26     {
  27             row <- c()
  28       for (d in c(2,5,10))
  29       {
  30         name <- paste0(prefix, "res_", n, "_", d, "_", link, ".RData")
  31         params <- prms(name, method)
  32         row <- c( row,
  33           sum(abs(params[[1]] - params[[4]]$p)),
  34           colSums(abs(params[[2]] - params[[4]]$beta)),
  35           sum(abs(params[[3]] - params[[4]]$b)) )
  36       }
  37       toprint <- rbind(toprint, row)
  38     }
  39   }
  40     print(formatC(toprint, format="e", digits=1)) #for reporting
  41     return (toprint)
  42 }