jaredhuling / oem

Penalized least squares estimation using the Orthogonalizing EM (OEM) algorithm

Home Page:http://jaredhuling.org/oem

Geek Repo:Geek Repo

Github PK Tool:Github PK Tool

Mean Squared Error - OEM

Henrik54 opened this issue · comments

Hi Jared,

We have constructed a model for Adaptive Group Lasso, and we are going to run an out-of-sample prediction.
We are struggling to make an out-of-sample prediction, where we want to measure the corresponding MSE.

Please find the codes below, hope this is something you can help us with!

second lasso step

m2 <- oem(x=Z[,-1], y=y, intercept=T, penalty="grp.lasso", groups=group.ind.lasso, group.weights=lasso.weights, ncores=8)
B <- m2$beta[[1]]
n.nonzeros <- colSums(abs(B)>0)
lssr <- log(colSums(((Z %*% B)-YY)**2))
lssr[!is.finite(lssr)] <- 1e10

information criterion

b_np <- solve(crossprod(Z), crossprod(Z,y))
group.norm.ols <- sapply(1:p2, function(idx) sqrt(sum((b_np[-1][group.ind.lasso==idx])**2)))
group.norm.ols <- matrix(rep(group.norm.ols,times=dim(B)[2]),ncol=dim(B)[2],nrow=p2)
group.norm.lasso <- sapply(1:dim(B)[2],function(i) sapply(1:p2, function(idx) sqrt(sum((B[-1,][group.ind.lasso==idx,i])**2))))
df <- (Kn+1) * colSums((group.norm.lasso / group.norm.ols)) + n.nonzeros / (Kn+2)
bic <- lssr + df * log(n)/n
min.ic <- which(bic==min(bic))

if(n.nonzeros[min.ic]>1) {
selected.chars.final <- unique(sapply(strsplit(names(B[abs(B[,min.ic])>0,min.ic])[-1],"[.]"),function(x) x[1]))
}
else { selected.chars.final <- NA }