Commit 4aab0c20 authored by Armin Rauschenberger's avatar Armin Rauschenberger

automation

parent 1d4041f6
......@@ -169,7 +169,7 @@ starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds=10,foldid=
s=base[[i]]$glmnet.fit$lambda)
link[[i]][foldid==k,seq_len(ncol(temp))] <- temp
}
}
}
#--- tune base lambdas ---
for(i in seq_len(nalpha)){
......@@ -393,6 +393,8 @@ coef.starnet <- function(object,nzero=NULL,...){
foldid=object$info$foldid,nzero=nzero)
coef <- stats::coef(model,s="lambda.min")
return(list(alpha=coef[1],beta=coef[-1]))
# alternatives: lasso-like elastic net (alpha=0.95);
# logistic regression of predicted probabilities on X
}
return(pool)
......@@ -479,7 +481,7 @@ print.starnet <- function(x,...){
#' vector of length \eqn{n} with entries between \eqn{1} and \code{nfolds},
#' or \code{NULL},
#' for hold-out (single split) instead of cross-validation (multiple splits)\strong{:}
#' set to \eqn{0} for training and to \eqn{1} for testing samples
#' set \code{foldid.ext} to \eqn{0} for training and to \eqn{1} for testing samples
#'
#' @param ...
#' further arguments (not applicable)
......@@ -645,7 +647,8 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
sigma <- matrix(data=0.1,nrow=p,ncol=p)
diag(sigma) <- 1
X <- mvtnorm::rmvnorm(n=n,mean=mean,sigma=sigma)
q <- switch(mode,sparse=5,dense=50,mixed=15,stop("Invalid.",.call=FALSE))
q <- switch(mode,sparse=5,dense=50,mixed=20,stop("Invalid.",.call=FALSE))
# mixed: 15 is too lasso-friendly
beta <- sample(rep(c(0,1),times=c(p-q,q)))
eta <- as.numeric(X %*% beta)
y <- eta + stats::rnorm(n=n,sd=0.5*stats::sd(eta))
......@@ -689,7 +692,7 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
#'
.loss <- function(y,x,family,type.measure,foldid=NULL,grouped=TRUE){
if(family=="cox" & grouped){stop("Implement \"grouped Cox\"!",call.=FALSE)}
if(family=="cox" & grouped){stop("Implement \"grouped Cox\"! See unit tests.",call.=FALSE)}
if(is.null(foldid)&(family=="cox"|type.measure=="auc")){
stop("Missing foldid.",call.=FALSE)
......@@ -726,7 +729,7 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
cvraw <- numeric()
for(i in seq_along(unique(foldid))){
if(grouped){
warning("Invalid \"grouped Cox\"!",call.=FALSE)
stop("Invalid \"grouped Cox\"! See unit tests!",call.=FALSE)
full <- glmnet::coxnet.deviance(pred=x,y=y)
mink <- glmnet::coxnet.deviance(pred=x[foldid!=i],y=y[foldid!=i])
cvraw[i] <- full-mink
......
......@@ -20,6 +20,8 @@ navbar:
href: articles/starnet.html
- text: "article"
href: articles/article.html
- text: "script"
href: articles/script.html
- text: "news"
href: news/index.html
right:
......
......@@ -82,6 +82,9 @@
<li>
<a href="articles/article.html">article</a>
</li>
<li>
<a href="articles/script.html">script</a>
</li>
<li>
<a href="news/index.html">news</a>
</li>
......
......@@ -46,6 +46,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -82,6 +82,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......@@ -121,6 +124,7 @@
<ul>
<li><a href="article.html">Stacked Elastic Net</a></li>
<li><a href="script.html">Stacked Elastic Net</a></li>
<li><a href="starnet.html">Stacked Elastic Net</a></li>
</ul>
</div>
......
This source diff could not be displayed because it is too large. You can view the blob instead.
......@@ -46,6 +46,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -82,6 +82,9 @@
<li>
<a href="articles/article.html">article</a>
</li>
<li>
<a href="articles/script.html">script</a>
</li>
<li>
<a href="news/index.html">news</a>
</li>
......
......@@ -46,6 +46,9 @@
<li>
<a href="articles/article.html">article</a>
</li>
<li>
<a href="articles/script.html">script</a>
</li>
<li>
<a href="news/index.html">news</a>
</li>
......
......@@ -82,6 +82,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -3,5 +3,6 @@ pkgdown: 1.4.1
pkgdown_sha: ~
articles:
article: article.html
script: script.html
starnet: starnet.html
......@@ -85,6 +85,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......@@ -166,7 +169,7 @@ fold identifiers (<code>foldid</code>)<strong>:</strong>
vector of length \(n\) with entries between \(1\) and <code>nfolds</code>,
or <code>NULL</code>,
for hold-out (single split) instead of cross-validation (multiple splits)<strong>:</strong>
set to \(0\) for training and to \(1\) for testing samples</p></td>
set <code>foldid.ext</code> to \(0\) for training and to \(1\) for testing samples</p></td>
</tr>
<tr>
<th>type.measure</th>
......
......@@ -85,6 +85,9 @@ with different handling of sparsity constraints." />
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -82,6 +82,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -87,6 +87,9 @@ we combine multiple alphas by stacked generalisation." />
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -84,6 +84,9 @@
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -85,6 +85,9 @@ i.e. the weights for the base learners." />
<li>
<a href="../articles/article.html">article</a>
</li>
<li>
<a href="../articles/script.html">script</a>
</li>
<li>
<a href="../news/index.html">news</a>
</li>
......
......@@ -33,7 +33,7 @@ fold identifiers (\code{foldid})\strong{:}
vector of length \eqn{n} with entries between \eqn{1} and \code{nfolds},
or \code{NULL},
for hold-out (single split) instead of cross-validation (multiple splits)\strong{:}
set to \eqn{0} for training and to \eqn{1} for testing samples}
set \code{foldid.ext} to \eqn{0} for training and to \eqn{1} for testing samples}
\item{type.measure}{loss function\strong{:}
character "deviance", "class", "mse" or "mae"
......
......@@ -108,7 +108,7 @@ for(family in c("gaussian","binomial")){
#--- testing the loss function ---
set.seed(1)
for(family in c("gaussian","binomial","poisson","cox","mgaussian","multinomial")){
for(family in c("gaussian","binomial","poisson","mgaussian","multinomial","cox")){
for(type.measure in c("deviance","mse","mae","class","auc")){
if(type.measure=="class" & !family %in% c("binomial","multinomial")){next}
......@@ -208,13 +208,19 @@ if(FALSE){
all(abs(old-new)<1e-06)
### Cox: averaging
cvraw <- old # choose one "old" or "new" from above
# choose one from above
# old
cvraw <- old
status = y[, "status"]
weights = as.vector(tapply(status, foldid, sum))
temp = as.matrix(cvraw/weights,ncol=1)
apply(temp, 2, weighted.mean, w = weights, na.rm = TRUE)
# new
cvraw <- new
weights <- tapply(X = y[, "status"], INDEX = foldid, FUN = sum)
stats::weighted.mean(x = cvraw/weights, w = weights, na.rm = TRUE)
grouped <- TRUE # FALSE or TRUE
glmnet::cv.glmnet(y=y,x=X,alpha=alpha,lambda=c(lambda,0.5*lambda),foldid=foldid,family="cox",grouped=grouped)$cvm[1]
}
This diff is collapsed.
This diff is collapsed.
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment