Commit 5d243b58 authored by Armin Rauschenberger's avatar Armin Rauschenberger
Browse files

automation

parent 41b1c645
40/5
8+8+1
#pkg <- "E:/colasso/package/colasso"
setwd(pkg)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::build(pkg=pkg)
n <- 100; p <- 20; q <- 10
X <- matrix(rnorm(n*p),nrow=n,ncol=p)
Y <- matrix(rnorm(n*q),nrow=n,ncol=q)
#y <- rbinom(n=n,size=1,prob=0.2)
alpha <- 1
nfolds <- 10
family <- "gaussian"
type.measure <- "deviance"
# properties
n <- nrow(X); p <- ncol(X)
if(length(y)!=n){stop("sample size")}
#foldid <- sample(x=rep(x=seq_len(nfolds),length.out=n))
foldid <- palasso:::.folds(y=y,nfolds=nfolds)
# weights
pi <- seq(from=0,to=1,by=0.2) # adapt this
y <- rnorm(n=n)
# properties
n <- nrow(X); p <- ncol(X)
if(length(y)!=n){stop("sample size")}
#foldid <- sample(x=rep(x=seq_len(nfolds),length.out=n))
foldid <- palasso:::.folds(y=y,nfolds=nfolds)
# weights
pi <- seq(from=0,to=1,by=0.2) # adapt this
# model fitting
fit <- list()
ym <- colasso::colasso_moderate(Y=Y) # trial
for(i in seq_along(pi)){
weights <- rep(c(1-pi[[i]],pi[[i]]),each=n)
fit[[i]] <- glmnet::glmnet(y=c(y,ym),x=rbind(X,X),weights=weights,family=family,alpha=alpha)
}
names(fit) <- paste0("pi",pi)
# inner cross-validation
pred <- lapply(pi,function(x) matrix(data=NA,nrow=length(y),ncol=100))
for(k in sort(unique(foldid))){
y0 <- y[foldid!=k]
y1 <- y[foldid==k]
Y0 <- Y[foldid!=k,,drop=FALSE]
Y1 <- Y[foldid==k,,drop=FALSE]
X0 <- X[foldid!=k,,drop=FALSE]
X1 <- X[foldid==k,,drop=FALSE]
y0m <- colasso_moderate(Y=Y0)
for(i in seq_along(pi)){
weights <- rep(c(1-pi[[i]],pi[[i]]),each=sum(foldid!=k)) # trial
glmnet <- glmnet::glmnet(y=c(y0,y0m),x=rbind(X0,X0),weights=weights,family=family,alpha=alpha)
temp <- stats::predict(object=glmnet,newx=X1,type="response",s=fit[[i]]$lambda)
pred[[i]][foldid==k,seq_len(ncol(temp))] <- temp
}
}
# loss sequence
for(i in seq_along(pi)){
# WATCH OUT: adapt to all loss fuctions
#fit[[i]]$cvm <- apply(X=pred[[i]],MARGIN=2,FUN=function(x) mean((x-y)^2))
fit[[i]]$cvm <- palasso:::.loss(y=y,fit=pred[[i]],family=family,type.measure=type.measure,foldid=foldid)
# WATCH OUT: minimise or maximise
if(type.measure=="AUC"){
fit[[i]]$lambda.min <- fit[[i]]$lambda[which.max(fit[[i]]$cvm)]
} else {
fit[[i]]$lambda.min <- fit[[i]]$lambda[which.min(fit[[i]]$cvm)]
}
}
i
fit[[i]]$cvm
?palasso:::.loss
# loss sequence
cvm <- .loss(y=y,fit=fit,family=args$family,type.measure=args$type.measure,foldid=foldid)
# loss sequence
cvm <- palasso:::.loss(y=y,fit=fit,family=args$family,type.measure=args$type.measure,foldid=foldid)
# loss sequence
cvm <- palasso:::.loss(y=y,fit=fit,family=family,type.measure=type.measure,foldid=foldid)
# loss sequence
cvm <- palasso:::.loss(y=y,fit=pred,family=family,type.measure=type.measure,foldid=foldid)
cvm
cvm
#--- generate toydata ----------------------------------------------------------
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/colasso/data/toydata.R"))
......@@ -10,11 +90,32 @@ rm(list=ls())
name <- "colasso"
#load("D:/colasso/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/package/colasso"
system("git remote set-url origin https://rauschenberger:Merkel0517@github.com/rauschenberger/colasso.git")
getwd()
system("git init")
system("git add .")
getwd()
setwd(dir=pkg)
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::build(pkg=pkg)
stop("Family not implemented.")
rm(list=ls())
n <- 100; p <- 20; q <- 10
X <- matrix(rnorm(n*p),nrow=n,ncol=p)
Y <- matrix(rnorm(n*q),nrow=n,ncol=q)
#y <- rbinom(n=n,size=1,prob=0.2)
y <- rnorm(n=n)
test <- colasso(y=y,Y=Y,X=X)
test
#--- generate toydata ----------------------------------------------------------
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/colasso/data/toydata.R"))
......@@ -24,14 +125,334 @@ name <- "colasso"
#load("D:/colasso/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/package/colasso"
setwd(dir=pkg)
#pkg <- "E:/colasso/package/colasso"
setwd(pkg)
system("git remote set-url origin https://rauschenberger:Merkel0517@github.com/rauschenberger/colasso.git")
system("git remote -v")
system("git remote -v")
system("git add --all")
system("git commit -m \"automation\"")
system("git push origin master") # GitHub
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::build(pkg=pkg)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
colasso_compare <- function(y,Y,X,plot=TRUE,nfolds.int=10,family="gaussian",type.measure="deviance"){
fold <- sample(x=rep(x=seq_len(5),length.out=length(y)))
pred <- matrix(data=NA,nrow=length(y),ncol=8)
select <- list()
for(i in sort(unique(fold))){
cat("i =",i,"\n")
fit <- colasso(y=y[fold!=i],Y=Y[fold!=i,],X=X[fold!=i,],alpha=1,nfolds=nfolds.int,type.measure=type.measure)
for(j in seq_along(fit)){
pred[fold==i,j] <- glmnet::predict.glmnet(object=fit[[j]],
newx=X[fold==i,],
s=fit[[j]]$lambda.min,
type="response")
}
select[[i]] <- lapply(fit,function(x) which(x$beta[,x$lambda==x$lambda.min]!=0))
pred[fold==i,8] <- mean(y[fold!=i]) # intercept-only model
}
colnames(pred) <- c(names(fit),"intercept")
if(family=="gaussian" & type.measure=="deviance" | family=="binomial" & type.measure=="mse"){
loss <- apply(X=pred,MARGIN=2,FUN=function(x) sum((y-x)^2))
} else if(family=="binomial" & type.measure=="class"){
loss <- apply(X=pred,MARGIN=2,FUN=function(x) mean(y!=x))
} else {
warning("Implement other loss functions!")
}
### start temporary ###
#stability <- numeric()
#for(k in seq_along(fit)){
# matrix <- matrix(data=NA,nrow=5,ncol=5)
# for(i in seq_len(5)){
# for(j in seq_len(5)){
# a <- select[[i]][[k]]
# b <- select[[j]][[k]]
# matrix[i,j] <- length(intersect(a,b))/length(union(a,b))
# }
# }
# diag(matrix) <- NA
# stability[k] <- mean(matrix,na.rm=TRUE)
#}
#cat(stability)
### end temporary ###
if(plot){
graphics::par(mar=c(3,3,1,1))
col <- rep(x=0,times=length(loss)-1)
col[1] <- col[length(col)] <- 1
graphics::plot.new()
graphics::plot.window(xlim=c(1,length(loss)-1),ylim=range(loss))
graphics::axis(side=1,at=seq_len(length(loss)-1),labels=names(loss)[-length(loss)])
graphics::axis(side=2)
graphics::points(y=loss[-length(loss)],
x=seq_len(length(loss)-1),
col=col+1,pch=col)
graphics::abline(v=c(1.5,length(loss)-1.5),lty=2)
graphics::grid()
graphics::abline(h=loss[length(loss)],lty=2,col="red")
}
return(loss)
}
colasso_compare(y=y,Y=Y,X=X)
graphics::box()
#################
### colasso ###
#################
#--- generate toydata ----------------------------------------------------------
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/colasso/data/toydata.R"))
#--- compile package -----------------------------------------------------------
rm(list=ls())
name <- "colasso"
#load("D:/colasso/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/package/colasso"
setwd(dir=pkg)
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::build(pkg=pkg)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
X <- MASS::mvrnorm(n=n,mu=rep(0,p),Sigma=Sigma)
# X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
beta <- rep(1,times=p)
beta[stats::rbinom(n=p,size=1,prob=0.95)==1] <- 0
mu <- X %*% beta
Y <- replicate(n=10,expr=stats::rnorm(n=n,mean=mu,sd=10))
plot(mu,rowMeans(Y))
cor <- cor(Y)
cor[row(cor)>=col(cor)] <- NA
median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
#################
### colasso ###
#################
#--- generate toydata ----------------------------------------------------------
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/colasso/data/toydata.R"))
#--- compile package -----------------------------------------------------------
rm(list=ls())
name <- "colasso"
#load("D:/colasso/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/package/colasso"
setwd(dir=pkg)
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::build(pkg=pkg)
#pkg <- "E:/colasso/package/colasso"
setwd(pkg)
system("git remote set-url origin https://rauschenberger:Merkel0517@github.com/rauschenberger/colasso.git")
......@@ -39,8 +460,8 @@ system("git remote -v")
system("git add --all")
system("git commit -m \"automation\"")
system("git push origin master") # GitHub
colasso::colasso_compare
devtools::install_github("rauschenberger/colasso")
# Apply to simulated data.
set.seed(1)
n <- 100
p <- 300
Sigma <- matrix(data=0.05,nrow=p,ncol=p)
......@@ -57,6 +478,35 @@ median(cor,na.rm=TRUE)
y <- scale(Y[,1])
ym <- scale(rowMeans(Y[,-1]))
Y <- scale(Y)
# consider scaling of responses!
colasso:::colasso_compare(y=y,Y=Y,X=X)
devtools::install_github("rauschenberger/colasso")
set.seed(1)
#toydata <- NULL
#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/colasso/data/toydata.R"))
#--- compile package -----------------------------------------------------------
rm(list=ls())
name <- "colasso"
#load("D:/colasso/package/toydata.RData")
pkg <- "C:/Users/armin.rauschenberger/Desktop/package/colasso"
setwd(dir=pkg)
devtools::as.package(x=pkg,create=FALSE)
devtools::load_all(path=pkg)
#usethis::use_data(toydata,overwrite=TRUE)
devtools::document(pkg=pkg)
unlink(file.path(pkg,"vignettes","figure"),recursive=TRUE)
all <- dir(file.path(pkg,"vignettes"))
#delete <- "..."
#sapply(delete,function(x) file.remove(file.path(pkg,"vignettes",x)))
setwd(dir=pkg)
unlink(file.path(pkg,"docs"),recursive=TRUE)
pkgdown::build_site(pkg=pkg)
file.remove(file.path(pkg,".Rbuildignore"))
usethis::use_build_ignore(files=c("Readme.Rmd",".travis.yml","_pkgdown.yml","docs","cran-comments.md","appveyor.yml"))
devtools::check(pkg=pkg,quiet=FALSE,manual=TRUE)
devtools::build(pkg=pkg)
setwd(pkg)
system("git remote set-url origin https://rauschenberger:Merkel0517@github.com/rauschenberger/colasso.git")
system("git remote -v")
system("git add --all")
system("git commit -m \"automation\"")
system("git push origin master") # GitHub
rm(list=ls())
# Generated by roxygen2: do not edit by hand
export(bilasso)
export(colasso)
export(colasso_compare)
export(colasso_moderate)
export(colasso_simulate)
export(moderate)
#' @export
#' @title
#' bilasso
#'
#' @description
#' Implements penalised regression with response duality.
#' \code{pi=0} represents binomial regression,
#' \code{pi=1} represents linear regression
#'
#' @param y
#' continuous response\strong{:}
#' vector of length \eqn{n}
#'
#' @param z
#' binary response\strong{:}
#' vector of length \eqn{n}
#'
#' @param cutoff
#' value between \code{min(y)} and \code{max(y)}
#'
#' @param X
#' covariates\strong{:}
#' matrix with \eqn{n} rows (samples) and \eqn{p} columns (variables)
#'
#' @param alpha
#' elastic net parameter\strong{:}
#' numeric between \eqn{0} and \eqn{1};
#' \eqn{alpha=1} for lasso,
#' \eqn{alpha=0} for ridge
#'
#' @param nfolds
#' number of folds
#'
#' @examples
#' NA
#'
bilasso <- function(y,cutoff,X,alpha=1,nfolds=10){
z <- 1*(y > cutoff)
# alpha <- 1; nfolds <- 10
# properties
n <- nrow(X); p <- ncol(X)
if(length(y)!=n){stop("sample size")}
foldid <- palasso:::.folds(y=z,nfolds=nfolds)
if(cutoff < min(y) | max(y) < cutoff){stop("Cutoff outside.")}
# model fitting
fit <- list()
fit$gaussian <- glmnet::glmnet(y=y,x=X,family="gaussian",alpha=alpha)
fit$binomial <- glmnet::glmnet(y=z,x=X,family="binomial",alpha=alpha)
# weights
fit$pi <- seq(from=0,to=1,length.out=101) # adapt this