Commit 1d4041f6 authored by Armin Rauschenberger's avatar Armin Rauschenberger

automation

parent ed6ea472
......@@ -3,7 +3,7 @@ Version: 0.0.1
Title: Stacked Elastic Net
Description: Implements stacked elastic net regression. 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
Imports: glmnet, survival, palasso, cornet, joinet, CVXR, Matrix, mvtnorm
Suggests: knitr, testthat, MASS
Enhances: RColorBrewer
Authors@R: person("Armin","Rauschenberger",email="armin.rauschenberger@uni.lu",role=c("aut","cre"))
......
......@@ -568,11 +568,13 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
}
#' @name
#' .simulate
#' @title
#' Simulation
#'
#' @description
#' Prints object of class \link[starnet]{starnet}.
#' Functions for simulating data
#'
#' @param n
#' sample size\strong{:}
......@@ -583,20 +585,21 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
#' positive integer
#'
#' @param mode
#' character \code{"sparse"}, \code{"dense"} or \code{"blocks"}
#' character \code{"sparse"}, \code{"dense"} or \code{"mixed"}
#'
#' @param family
#' \code{"gaussian"}, \code{"binomial"} or \code{"poisson"}
#' character \code{"gaussian"}, \code{"binomial"} or \code{"poisson"}
#'
#' @examples
#' NA
#'
.simulate <- function(n,p,mode,family="gaussian"){
q <- 3
Z <- matrix(data=stats::rnorm(n*q),nrow=n,ncol=q)
.simulate.block <- function(n,p,mode,family="gaussian"){
Z <- matrix(data=stats::rnorm(n*3),nrow=n,ncol=3)
y <- rowSums(Z)
if(family=="binomial"){y <- round(1/(1+exp(-y)))}
if(family=="poisson"){y <- round(exp(y))}
#if(family=="binomial"){y <- round(1/(1+exp(-y)))}
#if(family=="poisson"){y <- round(exp(y))}
y <- switch(family,gaussian=y,binomial=round(1/(1+exp(-y))),
poisson=round(exp(y)),stop("Invalid."))
X <- matrix(data=stats::rnorm(n*p),nrow=n,ncol=p)
if(mode=="sparse"){
X[,1] <- sqrt(0.1)*X[,1] + sqrt(0.9)*Z[,1]
......@@ -604,14 +607,53 @@ cv.starnet <- function(y,X,family="gaussian",nalpha=21,alpha=NULL,nfolds.ext=10,
} else if(mode=="dense"){
X[,1:250] <- sqrt(0.9)*X[,1:250] + sqrt(0.1)*Z[,1]
X[,(p-250+1):p] <- sqrt(0.9)*X[,(p-250+1):p] + sqrt(0.1)*Z[,2]
} else if(mode=="blocks"){
# was 25 instead of 20
} else if(mode=="mixed"){
X[,1:25] <- sqrt(0.5)*X[,1:25] + sqrt(0.5)*Z[,1]
X[,(p-25+1):p] <- sqrt(0.5)*X[,(p-25+1):p] + sqrt(0.5)*Z[,2]
} else {
stop("Invalid.",.call=FALSE)
}
return(list(y=y,X=X))
}
#' @describeIn .simulate.block
#' @param rho
#' correlation\strong{:}
#' numeric between \eqn{0} and \eqn{1}
#' @param pi
#' effects\strong{:}
#' numeric between \eqn{0} (sparse) and \eqn{1} (dense)
#'
.simulate.grid <- function(n,p,rho,pi,family="gaussian"){
mean <- rep(x=0,times=p)
sigma <- matrix(data=NA,nrow=p,ncol=p)
sigma <- rho^abs(row(sigma)-col(sigma))
diag(sigma) <- 1
X <- mvtnorm::rmvnorm(n=n,mean=mean,sigma=sigma)
nzero <- round(pi*p)
beta <- abs(stats::rnorm(p))*sample(x=rep(x=c(0,1),times=c(p-nzero,nzero)))
eta <- as.numeric(X %*% beta)
y <- eta + stats::rnorm(n=n,sd=0.5*stats::sd(eta))
y <- switch(family,gaussian=y,binomial=round(1/(1+exp(-y))),stop("Invalid."))
return(list(y=y,X=X,beta=beta))
}
#' @describeIn .simulate.block
#'
.simulate.mode <- function(n,p,mode,family="gaussian"){
mean <- rep(x=0,times=p)
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))
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))
y <- switch(family,gaussian=y,binomial=round(1/(1+exp(-y))),stop("Invalid."))
return(list(y=y,X=X,beta=beta))
}
#' @title
#' Loss
#'
......
......@@ -36,7 +36,7 @@
<meta property="og:title" content="Simulation — .simulate" />
<meta property="og:description" content="Prints object of class starnet." />
<meta property="og:description" content="Functions for simulating data" />
<meta name="twitter:card" content="summary" />
......@@ -120,10 +120,10 @@
</div>
<div class="ref-description">
<p>Prints object of class <a href='starnet.html'>starnet</a>.</p>
<p>Functions for simulating data</p>
</div>
<pre class="usage"><span class='fu'>.simulate</span>(<span class='no'>n</span>, <span class='no'>p</span>, <span class='no'>mode</span>, <span class='kw'>family</span> <span class='kw'>=</span> <span class='st'>"gaussian"</span>)</pre>
<pre class="usage"><span class='fu'>.simulate.block</span>(<span class='no'>n</span>, <span class='no'>p</span>, <span class='no'>mode</span>, <span class='kw'>family</span> <span class='kw'>=</span> <span class='st'>"gaussian"</span>)</pre>
<h2 class="hasAnchor" id="arguments"><a class="anchor" href="#arguments"></a>Arguments</h2>
<table class="ref-arguments">
......@@ -140,11 +140,11 @@ positive integer</p></td>
</tr>
<tr>
<th>mode</th>
<td><p>character <code>"sparse"</code>, <code>"dense"</code> or <code>"blocks"</code></p></td>
<td><p>character <code>"sparse"</code>, <code>"dense"</code> or <code>"mixed"</code></p></td>
</tr>
<tr>
<th>family</th>
<td><p><code>"gaussian"</code>, <code>"binomial"</code> or <code>"poisson"</code></p></td>
<td><p>character <code>"gaussian"</code>, <code>"binomial"</code> or <code>"poisson"</code></p></td>
</tr>
</table>
......
......@@ -2,9 +2,10 @@
% Please edit documentation in R/functions.R
\name{.simulate}
\alias{.simulate}
\alias{.simulate.block}
\title{Simulation}
\usage{
.simulate(n, p, mode, family = "gaussian")
.simulate.block(n, p, mode, family = "gaussian")
}
\arguments{
\item{n}{sample size\strong{:}
......@@ -13,12 +14,12 @@ positive integer}
\item{p}{dimensionality\strong{:}
positive integer}
\item{mode}{character \code{"sparse"}, \code{"dense"} or \code{"blocks"}}
\item{mode}{character \code{"sparse"}, \code{"dense"} or \code{"mixed"}}
\item{family}{\code{"gaussian"}, \code{"binomial"} or \code{"poisson"}}
\item{family}{character \code{"gaussian"}, \code{"binomial"} or \code{"poisson"}}
}
\description{
Prints object of class \link[starnet]{starnet}.
Functions for simulating data
}
\examples{
NA
......
......@@ -7,7 +7,7 @@ for(family in c("gaussian","binomial","poisson")){
event=rbinom(n=n,size=1,prob=0.2))
list$X <- matrix(rnorm(n*p),nrow=n,ncol=p)
} else {
list <- .simulate(n=n,p=p,mode="sparse",family=family)
list <- .simulate.block(n=n,p=p,mode="sparse",family=family)
}
foldid <- palasso:::.folds(y=list$y,nfolds=5)
......@@ -80,7 +80,7 @@ for(family in c("gaussian","binomial","poisson")){
for(family in c("gaussian","binomial")){
n <- 100; p <- 5
list <- .simulate(n=n,p=p,mode="sparse")
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"){
......
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