Commit 06811263 authored by Armin Rauschenberger's avatar Armin Rauschenberger

automation

parent 6316eb9e
......@@ -3,9 +3,9 @@ Version: 0.0.1
Title: Stacked Elastic Net
Description: Implements stacked elastic net regression (Rauschenberger 2020). The elastic net generalises ridge and lasso regularisation (Zou 2005, <doi:10.1111/j.1467-9868.2005.00503.x>). Instead of fixing or tuning the mixing parameter alpha, we combine multiple alpha by stacked generalisation (Wolpert 1992 <doi:10.1016/S0893-6080(05)80023-1>).
Depends: R (>= 3.0.0)
Imports: glmnet, survival, palasso, cornet, joinet, CVXR, Matrix, mvtnorm
Suggests: knitr, testthat, MASS, rmarkdown
Enhances: RColorBrewer
Imports: glmnet, survival, cornet, joinet, Matrix
Suggests: knitr, testthat, rmarkdown
Enhances: CVXR, mvtnorm
Authors@R: person("Armin","Rauschenberger",email="armin.rauschenberger@uni.lu",role=c("aut","cre"))
VignetteBuilder: knitr
License: GPL-3
......
......@@ -79,10 +79,14 @@
#' n <- 30; p <- 50
#' y <- rnorm(n=n)
#' X <- matrix(rnorm(n*p),nrow=n,ncol=p)
#' object <- starnet::starnet(y=y,X=X,family="gaussian")
#' object <- starnet(y=y,X=X,family="gaussian")
#'
starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds=10,foldid=NULL,type.measure="deviance",alpha.meta=1,penalty.factor=NULL,intercept=NULL,upper.limit=NULL,unit.sum=NULL,...){
if(is.na(alpha.meta) & (!"CVXR" %in% .packages(all.available=TRUE))){
stop("Install CVXR from CRAN for alpha.meta=NA.",call.=FALSE)
}
#--- temporary ---
# family <- "gaussian"; nalpha <- 21; alpha <- NULL; nfolds <- 10; foldid <- NULL; type.measure <- "deviance"; alpha.meta <- 0; penalty.factor <- NULL; intercept <- TRUE; upper.limit=TRUE; unit.sum=FALSE
......@@ -627,6 +631,9 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
#' numeric between \eqn{0} (sparse) and \eqn{1} (dense)
#'
.simulate.grid <- function(n,p,rho,pi,family="gaussian"){
if(!"mvtnorm" %in% .packages(all.available=TRUE)){
stop("Install mvtnorm from CRAN for simulation.",call.=FALSE)
}
mean <- rep(x=0,times=p)
sigma <- matrix(data=NA,nrow=p,ncol=p)
sigma <- rho^abs(row(sigma)-col(sigma))
......@@ -642,6 +649,9 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
#' @rdname .simulate
#'
.simulate.mode <- function(n,p,mode,family="gaussian"){
if(!"mvtnorm" %in% .packages(all.available=TRUE)){
stop("Install mvtnorm from CRAN for simulation.",call.=FALSE)
}
mean <- rep(x=0,times=p)
sigma <- matrix(data=0.1,nrow=p,ncol=p)
diag(sigma) <- 1
......
This diff is collapsed.
......@@ -136,7 +136,7 @@
<colgroup><col class="name" /><col class="desc" /></colgroup>
<tr>
<th>object</th>
<td><p><a href='starnet.html'>starnet</a> object</p></td>
<td><p>starnet object</p></td>
</tr>
<tr>
<th>nzero</th>
......@@ -155,7 +155,7 @@ positive integer, or <code>NULL</code></p></td>
<span class='no'>n</span> <span class='kw'>&lt;-</span> <span class='fl'>30</span>; <span class='no'>p</span> <span class='kw'>&lt;-</span> <span class='fl'>50</span>
<span class='no'>y</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='kw'>n</span><span class='kw'>=</span><span class='no'>n</span>)
<span class='no'>X</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/matrix.html'>matrix</a></span>(<span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='no'>n</span>*<span class='no'>p</span>),<span class='kw'>nrow</span><span class='kw'>=</span><span class='no'>n</span>,<span class='kw'>ncol</span><span class='kw'>=</span><span class='no'>p</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='starnet.html'>starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'>starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>coef</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/coef.html'>coef</a></span>(<span class='no'>object</span>)</div></pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="sidebar">
......
......@@ -134,7 +134,7 @@
<colgroup><col class="name" /><col class="desc" /></colgroup>
<tr>
<th>object</th>
<td><p><a href='starnet.html'>starnet</a> object</p></td>
<td><p>starnet object</p></td>
</tr>
<tr>
<th>newx</th>
......@@ -163,7 +163,7 @@ positive integer, or <code>NULL</code></p></td>
<span class='no'>n</span> <span class='kw'>&lt;-</span> <span class='fl'>30</span>; <span class='no'>p</span> <span class='kw'>&lt;-</span> <span class='fl'>50</span>
<span class='no'>y</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='kw'>n</span><span class='kw'>=</span><span class='no'>n</span>)
<span class='no'>X</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/matrix.html'>matrix</a></span>(<span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='no'>n</span>*<span class='no'>p</span>),<span class='kw'>nrow</span><span class='kw'>=</span><span class='no'>n</span>,<span class='kw'>ncol</span><span class='kw'>=</span><span class='no'>p</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='starnet.html'>starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'>starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>y_hat</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/predict.html'>predict</a></span>(<span class='no'>object</span>,<span class='kw'>newx</span><span class='kw'>=</span><span class='no'>X</span>[<span class='fu'><a href='https://rdrr.io/r/base/c.html'>c</a></span>(<span class='fl'>1</span>),,<span class='kw'>drop</span><span class='kw'>=</span><span class='fl'>FALSE</span>])</div></pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="sidebar">
......
......@@ -123,7 +123,7 @@
</div>
<div class="ref-description">
<p>Prints object of class <a href='starnet.html'>starnet</a>.</p>
<p>Prints object of class starnet.</p>
</div>
<pre class="usage"><span class='co'># S3 method for starnet</span>
......@@ -134,7 +134,7 @@
<colgroup><col class="name" /><col class="desc" /></colgroup>
<tr>
<th>x</th>
<td><p><a href='starnet.html'>starnet</a> object</p></td>
<td><p>starnet object</p></td>
</tr>
<tr>
<th>...</th>
......@@ -148,7 +148,7 @@
<span class='no'>n</span> <span class='kw'>&lt;-</span> <span class='fl'>30</span>; <span class='no'>p</span> <span class='kw'>&lt;-</span> <span class='fl'>20</span>
<span class='no'>y</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='kw'>n</span><span class='kw'>=</span><span class='no'>n</span>)
<span class='no'>X</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/matrix.html'>matrix</a></span>(<span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='no'>n</span>*<span class='no'>p</span>),<span class='kw'>nrow</span><span class='kw'>=</span><span class='no'>n</span>,<span class='kw'>ncol</span><span class='kw'>=</span><span class='no'>p</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='starnet.html'>starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'>starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='fu'><a href='https://rdrr.io/r/base/print.html'>print</a></span>(<span class='no'>object</span>)</div><div class='output co'>#&gt; stacked "gaussian" elastic net </div><div class='input'>
</div></pre>
</div>
......
......@@ -136,8 +136,8 @@ we combine multiple alphas by stacked generalisation.</p>
<h2 class="hasAnchor" id="details"><a class="anchor" href="#details"></a>Details</h2>
<p>Use function <code><a href='starnet.html'>starnet</a></code> for model fitting.
Type <code><a href='https://rdrr.io/r/base/library.html'>library(starnet)</a></code> and then <code><a href='starnet.html'>?starnet</a></code> or
<p>Use function <code>starnet</code> for model fitting.
Type <code><a href='https://rdrr.io/r/base/library.html'>library(starnet)</a></code> and then <code>?starnet</code> or
<code>help("starnet)"</code> to open its help file.</p>
<p>See the vignette for further examples.
Type <code><a href='../articles/starnet.html'>vignette("starnet")</a></code> or <code><a href='https://rdrr.io/r/utils/browseVignettes.html'>browseVignettes("starnet")</a></code>
......@@ -157,7 +157,7 @@ Predictive and interpretable models via the stacked elastic net".
<span class='co'># n samples, p features</span>
<span class='co'>#--- model fitting ---</span>
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='starnet.html'>starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'>starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='co'># "base": one model for each alpha</span>
<span class='co'># "meta": model for stacking them </span>
......@@ -173,7 +173,7 @@ Predictive and interpretable models via the stacked elastic net".
<span class='co'>#--- model comparison ---</span>
<span class='kw'>if</span> (<span class='fl'>FALSE</span>) {
<span class='no'>loss</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='cv.starnet.html'>cv.starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)}
<span class='no'>loss</span> <span class='kw'>&lt;-</span> <span class='fu'>cv.starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)}
<span class='co'># cross-validated loss for different alpha,</span>
<span class='co'># and for tuning and stacking</span></div></pre>
</div>
......
......@@ -232,7 +232,7 @@ argument <code>nzero</code> in functions
<span class='no'>n</span> <span class='kw'>&lt;-</span> <span class='fl'>30</span>; <span class='no'>p</span> <span class='kw'>&lt;-</span> <span class='fl'>50</span>
<span class='no'>y</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='kw'>n</span><span class='kw'>=</span><span class='no'>n</span>)
<span class='no'>X</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/matrix.html'>matrix</a></span>(<span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='no'>n</span>*<span class='no'>p</span>),<span class='kw'>nrow</span><span class='kw'>=</span><span class='no'>n</span>,<span class='kw'>ncol</span><span class='kw'>=</span><span class='no'>p</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='kw pkg'>starnet</span><span class='kw ns'>::</span><span class='fu'><a href='https://rdrr.io/pkg/starnet/man/starnet.html'>starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>,<span class='kw'>family</span><span class='kw'>=</span><span class='st'>"gaussian"</span>)</div></pre>
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'>starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>,<span class='kw'>family</span><span class='kw'>=</span><span class='st'>"gaussian"</span>)</div></pre>
</div>
<div class="col-md-3 hidden-xs hidden-sm" id="sidebar">
<h2>Contents</h2>
......
......@@ -136,7 +136,7 @@ i.e. the weights for the base learners.</p>
<colgroup><col class="name" /><col class="desc" /></colgroup>
<tr>
<th>object</th>
<td><p><a href='starnet.html'>starnet</a> object</p></td>
<td><p>starnet object</p></td>
</tr>
<tr>
<th>...</th>
......@@ -150,7 +150,7 @@ i.e. the weights for the base learners.</p>
<span class='no'>n</span> <span class='kw'>&lt;-</span> <span class='fl'>30</span>; <span class='no'>p</span> <span class='kw'>&lt;-</span> <span class='fl'>50</span>
<span class='no'>y</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='kw'>n</span><span class='kw'>=</span><span class='no'>n</span>)
<span class='no'>X</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='https://rdrr.io/r/base/matrix.html'>matrix</a></span>(<span class='fu'><a href='https://rdrr.io/r/stats/Normal.html'>rnorm</a></span>(<span class='no'>n</span>*<span class='no'>p</span>),<span class='kw'>nrow</span><span class='kw'>=</span><span class='no'>n</span>,<span class='kw'>ncol</span><span class='kw'>=</span><span class='no'>p</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'><a href='starnet.html'>starnet</a></span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='no'>object</span> <span class='kw'>&lt;-</span> <span class='fu'>starnet</span>(<span class='kw'>y</span><span class='kw'>=</span><span class='no'>y</span>,<span class='kw'>X</span><span class='kw'>=</span><span class='no'>X</span>)
<span class='fu'><a href='https://rdrr.io/r/stats/weights.html'>weights</a></span>(<span class='no'>object</span>)</div><div class='output co'>#&gt; (Intercept) V1 V2 V3 V4 V5
#&gt; 0.08245817 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
#&gt; V6 V7 V8 V9 V10 V11
......
......@@ -79,7 +79,7 @@ set.seed(1)
n <- 30; p <- 50
y <- rnorm(n=n)
X <- matrix(rnorm(n*p),nrow=n,ncol=p)
object <- starnet::starnet(y=y,X=X,family="gaussian")
object <- starnet(y=y,X=X,family="gaussian")
}
\references{
......
......@@ -10,7 +10,7 @@ for(family in c("gaussian","binomial","poisson")){
list <- .simulate.block(n=n,p=p,mode="sparse",family=family)
}
foldid <- palasso:::.folds(y=list$y,nfolds=5)
foldid <- .folds(y=list$y,nfolds=5)
glmnet <- glmnet::cv.glmnet(y=list$y,x=list$X,family=family,foldid=foldid,alpha=0.5)
object <- starnet(y=list$y,X=list$X,family=family,foldid=foldid)
......@@ -77,34 +77,35 @@ for(family in c("gaussian","binomial","poisson")){
#--- testing the convex combination ---
for(family in c("gaussian","binomial")){
n <- 100; p <- 5
list <- .simulate.block(n=n,p=p,mode="sparse")
if(family=="binomial"){
list$y <- stats::rbinom(n=n,size=1,prob=1/(1+exp(-list$y)))
} else if(family=="poisson"){
list$y <- stats::rpois(n=n,lambda=exp(list$y))
}
glm0 <- .glm(y=list$y,X=list$X,family=family)
if(family=="gaussian"){
glm1 <- stats::glm(y~X,family=gaussian,data=list)
} else if(family=="binomial"){
glm1 <- stats::glm(y~X,family=binomial,data=list)
} else if(family=="poisson") {
glm1 <- stats::glm(y~X,family=poisson,data=list)
if("CVXR" %in% .packages(all.available=TRUE)){
for(family in c("gaussian","binomial")){
n <- 100; p <- 5
list <- .simulate.block(n=n,p=p,mode="sparse")
if(family=="binomial"){
list$y <- stats::rbinom(n=n,size=1,prob=1/(1+exp(-list$y)))
} else if(family=="poisson"){
list$y <- stats::rpois(n=n,lambda=exp(list$y))
}
glm0 <- .glm(y=list$y,X=list$X,family=family)
if(family=="gaussian"){
glm1 <- stats::glm(y~X,family=gaussian,data=list)
} else if(family=="binomial"){
glm1 <- stats::glm(y~X,family=binomial,data=list)
} else if(family=="poisson") {
glm1 <- stats::glm(y~X,family=poisson,data=list)
}
testthat::test_that("same coefficients",{
change <- (c(glm0$alpha,glm0$beta)-glm1$coefficients)/glm1$coefficients
testthat::expect_true(all(change<0.001))
})
}
testthat::test_that("same coefficients",{
change <- (c(glm0$alpha,glm0$beta)-glm1$coefficients)/glm1$coefficients
testthat::expect_true(all(change<0.001))
})
}
#--- testing the loss function ---
set.seed(1)
......
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