Nothing
context("Consistency between sparse/non-sparse encoding")
test_that("Consistency of quadrupen between sparse/non-sparse encoding of the predictors", {
## data generation
rlm.sparse <- function(n, p, reg="low", mu=3, size=5, prob=0.01) {
s <- switch(reg,
low = floor(0.50 * min(n,p)),
med = floor(0.10 * min(n,p)),
high = floor(0.01 * min(n,p)))
w <- rep(0,p)
w[sample(1:p,s)] <- sample(c(-1,1),s,replace=TRUE)*runif(s,1,2)
X <- matrix(rbinom(n*p, size, prob),n,p)
Xw <- crossprod(t(X),w)
sigma <- sum(Xw^2) * 0.01/n
epsilon <- rnorm(n) * sigma
y <- mu + Xw + epsilon
r2 <- 1 - sum(epsilon^2) / sum((y-mean(y))^2)
return(list(y=y, x=X, r2=r2, w=w, mu=mu))
}
n <- 500
p <- 10000
lambda2 <- 0.05
data <- rlm.sparse(n, p, prob=0.01, reg="med")
s <- sum(data$w !=0)
y <- data$y
x.ns <- as.matrix(data$x)
x.sp <- Matrix(data$x, sparse=TRUE)
max.feat <- s * 10
cat("\n\tProblem with",p, "predictors and",n,"samples,",s,"true nonzeros in beta.star.")
cat("\n\tThe densely encoded design matrix weights" , round(object.size(x.ns) /(1024^2),2), "Mo.")
cat("\n\tThe sparsely encoded design matrix weights", round(object.size(x.sp) /(1024^2),2), "Mo.")
cat("\n\tdense coding...")
out.enet.ns <- elastic.net(x.ns, y, lambda2=lambda2, max.feat=max.feat, min.ratio=1e-3, control=list(timer=TRUE))
cat(" took", out.enet.ns@monitoring$external.timer, "seconds to activate",
rowSums(out.enet.ns@active.set)[length(out.enet.ns@lambda1)],"variables.")
cat("\n\tsparse coding...")
out.enet.sp <- elastic.net(x.sp, y, lambda2=lambda2, max.feat=max.feat, min.ratio=1e-3, control=list(timer=TRUE))
cat(" took", out.enet.sp@monitoring$external.timer, "seconds to activate",
rowSums(out.enet.sp@active.set)[length(out.enet.sp@lambda1)],"variables.")
## remove monitoring for fair comparison!!!
out.enet.sp@monitoring <- list()
out.enet.ns@monitoring <- list()
expect_equivalent(out.enet.sp, out.enet.ns)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.