| 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 | } |