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