automation

DESCRIPTION

@@ -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"))

R/functions.R

@@ -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
 #' 

docs/reference/dot-simulate.html

@@ -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>
 

man/dot-simulate.Rd

@@ -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

tests/testthat/test.R

@@ -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"){