automation

.Rbuildignore

@@ -4,3 +4,4 @@
 ^docs$
 ^cran-comments\.md$
 ^appveyor\.yml$
+^\.Rhistory$

.Rhistory

-## abline(v=sd(y),col="grey",lty=2)
-list[[i]] <- colasso::bilasso_compare(y=y,cutoff=0,X=X)
-}
-save(list,file="C:/Users/armin.rauschenberger/Desktop/trial.RData")
-loss <- list()
-name <- names(list[[1]])
-for(i in seq_along(name)){
-loss[[name[i]]] <- t(sapply(X=list,FUN=function(x) x[[name[i]]]))
-}
-t(sapply(loss,colMeans))
-t(sapply(X=loss,FUN=function(x) apply(x,2,median)))
-list
-loss <- list()
-name <- names(list[[1]])
-for(i in seq_along(name)){
-loss[[name[i]]] <- t(sapply(X=list,FUN=function(x) x[[name[i]]]))
-}
-t(sapply(loss,colMeans))
-t(sapply(X=loss,FUN=function(x) apply(x,2,median)))
-names(list[[1]])
-set.seed(1)
-grid <- expand.grid(prob=seq(from=0.1,to=0.2,length.out=101),
-fac=seq(from=0.5,to=2,length.out=101))
-grid <- grid[sample(seq_len(nrow(grid))),]
-list <- list()
-for(i in 1:nrow(grid)){
-cat(i," ")
-temp <- colasso:::.simulate(n=100,p=200,prob=grid$prob[i],fac=grid$fac[i])
-y <- temp$y; X <- temp$X
-if(sd(y)==0){next}
-fit <- colasso::bilasso(y=y,cutoff=0,X=X)
-## plot(fit)
-## plot(x=fit$sigma,y=fit$sigma.cvm)
-## abline(v=fit$sigma.min,col="red",lty=2)
-## abline(v=sd(y),col="grey",lty=2)
-list[[i]] <- colasso::bilasso_compare(y=y,cutoff=0,X=X)
-}
-loss <- list()
-name <- names(list[[1]])
-for(i in seq_along(name)){
-loss[[name[i]]] <- t(sapply(X=list,FUN=function(x) x[[name[i]]]))
-}
-t(sapply(loss,colMeans))
-t(sapply(X=loss,FUN=function(x) apply(x,2,median)))
-set.seed(2)
-grid <- expand.grid(prob=seq(from=0.1,to=0.2,length.out=101),
-fac=seq(from=0.5,to=2,length.out=101))
-grid <- grid[sample(seq_len(nrow(grid))),]
-list <- list()
-for(i in 1:nrow(grid)){
-cat(i," ")
-temp <- colasso:::.simulate(n=100,p=200,prob=grid$prob[i],fac=grid$fac[i])
-y <- temp$y; X <- temp$X
-if(sd(y)==0){next}
-#fit <- colasso::bilasso(y=y,cutoff=0,X=X)
-## pred <- colasso:::predict.bilasso(fit,newx=X)
-## colasso:::plot.bilasso(fit)
-list[[i]] <- colasso::bilasso_compare(y=y,cutoff=0,X=X)
-}
-save(list,file="C:/Users/armin.rauschenberger/Desktop/trial.RData")
-?glmnet
-?glmnet::glmnet
-colasso:::bilasso()
-colasso:::bilasso
-?glmnet
-?glmnet::glmnet
-y <- rpois(100,lambda=4)
-x <- rnorm(x)
-x <- rnorm(100)
-mod <- glm(y~x,family="poisson")
-predict(mod)
-install.packages("available")
-available::avaiable("available")
-library(available)
-available("available")
-available("palasso")
-#--- generate toydata ----------------------------------------------------------
-set.seed(1)
-#toydata <- NULL
-#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/cornet/data/toydata.R"))
-#--- compile package -----------------------------------------------------------
-rm(list=ls())
-name <- "cornet"
-#load("D:/cornet/package/toydata.RData")
-pkg <- "C:/Users/armin.rauschenberger/Desktop/cornet/cornet"
-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::install(pkg=pkg,upgrade=FALSE)
-set.seed(1)
-devtools::install_github("rauschenberger/cornet")
-rm(list=ls(all.names=TRUE))
-#devtools::install_github("rauschenberger/decline")
-.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
-.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
-project <- "ppmi" # "luxpark" or "ppmi"
-if(project=="luxpark"){
-load(file.path(.source,"luxpark_2018-12-04.RData"))
-if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
-if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
-} else if(project=="ppmi"){
-load(file.path(.source,"ppmi_2018-11-20.RData"))
-if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
-} else if(project=="trial"){
-load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
-}
-if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
-temp <- decline:::response(x=Y,type="average")
-Y$sign <- temp$sign; Y$diff <- temp$diff
-# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
-# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
-cond <- !is.na(Y$diff)
-Y <- Y[cond,]; X <- X[cond,]
-if(project=="trial"){
-seq <- seq[cond,]
-}
-# Xs <- Xs[cond,] # selected set
-X <- decline::curate_missing(X)
-X <- decline::curate_hidden(X)
-X <- decline::curate_levels(X)
-X <- decline::curate_constant(X)
-set.seed(1)
-X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
-#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
-#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
-#library(mice)
-#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
-# refit
-x <- scale(decline::curate_dummies(as.data.frame(X_imp[[2]])))
-# refit
-x <- scale(decline::curate_dummies(as.data.frame(X_imp[[1]])))
-fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
-plot(fit)
-predict(fit)
-predict(fit,newx=x)
-pred <- predict(fit,newx=X)
-pred <- predict(fit,newx=x)
-plot(pred$binomial,pred$grid)
-hist(pred$binomial)
-pred <- predict(fit,newx=x)
-plot(pred$binomial,pred$grid)
-plot(pred$binomial,pred$grid); abline(a=0,b=1,lty=2)
-plot(pred$binomial,pred$grid,ylim=c(0,1),xlim=c(0,1)); abline(a=0,b=1,lty=2)
-fit$trial.min
-fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
-cornet::plot.cornet(fit)
-cornet:::plot.cornet(fit)
-fit$sigma.min
-fit$pi.min
-fit$pi.min
-fit$sigma.min
-fit$pi.min
-fit$sigma.min
-cornet:::plot.cornet(fit)
-fit$pi.min
-fit$sigma.min
-coef(fit)
-coef <- cornet:::coef.cornet(fit)
-dim(coef)
-coef==0
-rowMeans(coef==0)
-rowMeans(as.matrix(coef)==0)
-coef <- as.matrix(cornet:::coef.cornet(fit))
-coef[rowMeans(coef==0),]
-coef <- as.matrix(cornet:::coef.cornet(fit))
-head(coef)
-coef[which(rowMeans(coef==0)),]
-coef[rowMeans(coef==0)==1,]
-coef[rowMeans(coef==0)!=1,]
-coef <- as.matrix(cornet:::coef.cornet(fit))
-coef[rowMeans(coef==0)!=1,]
-sel <- coef[rowMeans(coef==0)!=1,]
-dim(sel)
-head(sel)
-coef <- as.matrix(cornet:::coef.cornet(fit))
-coef <- coef[rowMeans(coef==0)!=1,]
-plot(coef)
-plot(coef$beta,coef$gamma)
-plot(coef)
-plot(log(coef))
-beta <- coef["beta",]
-beta <- coef[,"beta"]
-gamma <- coef[,"gamma"]
-beta
-gamma
-plot(beta,gamma)
-range(beta)
-range(gamma)
-plot(beta+gamma)
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
-graphics::box()
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
-graphics::box()
-graphics::abline(side=1)
-graphics::abline(side=2)
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
-graphics::box()
-graphics::axis(side=1)
-graphics::axis(side=2)
-barplot(table(beta,gamma),col=c("darkblue","red")
-barplot(table(beta,gamma),col=c("darkblue","red"))
-barplot(table(beta,gamma),col=c("darkblue","red"))
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
-graphics::box()
-graphics::axis(side=1)
-graphics::axis(side=2)
-counts <- table(mtcars$vs, mtcars$gear)
-barplot(counts, main="Car Distribution by Gears and VS",
-xlab="Number of Gears", col=c("darkblue","red"),
-legend = rownames(counts), beside=TRUE)
-counts
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
-graphics::box()
-graphics::axis(side=1)
-graphics::axis(side=2)
-graphics::point(beta)
-graphics::points(beta)
-graphcis::points(gamma)
-graphics::points(gamma)
-graphics::points(gamma,col="red")
-graphics::points(beta,col="blue")
-graphics::points(gamma,col="red")
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma)))
-graphics::box()
-graphics::axis(side=1)
-graphics::axis(side=2)
-graphics::points(abs(beta),col="blue")
-graphics::points(-abs(gamma),col="red")
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma,-beta,-gamma)))
-graphics::box()
-graphics::axis(side=1)
-graphics::axis(side=2)
-graphics::points(abs(beta),col="blue")
-graphics::points(-abs(gamma),col="red")
-plot(beta,gamma)
-plot(rank(beta),rank(gamma))
-order(beta)
-plot(order(beta),order(gamma))
-plot(rank(beta),rank(gamma))
-graphics::plot.new()
-graphics::plot.window(xlim=c(0,length(beta)),ylim=range(c(beta,gamma,-beta,-gamma)))
-graphics::box()
-graphics::axis(side=1)
-graphics::axis(side=2)
-graphics::points(abs(beta),col="blue")
-graphics::points(-abs(gamma),col="red")
-sign(beta)==sign(gamma)
-mean(sign(beta)==sign(gamma))
-sign(beta)
-sign(gamma)
-sum(beta==)
-sum(beta==0)
-sum(gamma==0)
-# number of improvements (lasso, cutoff -1)
-dev1 <- sapply(lasso1,function(x) x$deviance)
-sum(dev1["binomial",]>dev1["grid",])
-auc1 <- sapply(lasso1,function(x) x$auc)
-sum(auc1["binomial",]<auc1["grid",])
-set.seed(1)
-devtools::install_github("rauschenberger/cornet")
-rm(list=ls(all.names=TRUE))
-#devtools::install_github("rauschenberger/decline")
-.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
-.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
-project <- "ppmi" # "luxpark" or "ppmi"
-if(project=="luxpark"){
-load(file.path(.source,"luxpark_2018-12-04.RData"))
-if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
-if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
-} else if(project=="ppmi"){
-load(file.path(.source,"ppmi_2018-11-20.RData"))
-if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
-} else if(project=="trial"){
-load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
-}
-if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
-temp <- decline:::response(x=Y,type="average")
-Y$sign <- temp$sign; Y$diff <- temp$diff
-# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
-# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
-cond <- !is.na(Y$diff)
-Y <- Y[cond,]; X <- X[cond,]
-if(project=="trial"){
-seq <- seq[cond,]
-}
-# Xs <- Xs[cond,] # selected set
-X <- decline::curate_missing(X)
-X <- decline::curate_hidden(X)
-X <- decline::curate_levels(X)
-X <- decline::curate_constant(X)
-set.seed(1)
-X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
-#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
-#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
-#library(mice)
-#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
-rm(list=ls())
-set.seed(1)
-devtools::install_github("rauschenberger/cornet")
-rm(list=ls(all.names=TRUE))
-#devtools::install_github("rauschenberger/decline")
-.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
-.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
-project <- "ppmi" # "luxpark" or "ppmi"
-if(project=="luxpark"){
-load(file.path(.source,"luxpark_2018-12-04.RData"))
-if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
-if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
-} else if(project=="ppmi"){
-load(file.path(.source,"ppmi_2018-11-20.RData"))
-if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
-} else if(project=="trial"){
-load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
-}
-if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
-temp <- decline:::response(x=Y,type="average")
-Y$sign <- temp$sign; Y$diff <- temp$diff
-# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
-# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
-cond <- !is.na(Y$diff)
-Y <- Y[cond,]; X <- X[cond,]
-if(project=="trial"){
-seq <- seq[cond,]
-}
-# Xs <- Xs[cond,] # selected set
-X <- decline::curate_missing(X)
-X <- decline::curate_hidden(X)
-X <- decline::curate_levels(X)
-X <- decline::curate_constant(X)
-set.seed(1)
-X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
-#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
-#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
-#library(mice)
-#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
-load(file.path(.target,"temporary.RData"))
-# number of improvements (lasso, cutoff -1)
-dev1 <- sapply(lasso1,function(x) x$deviance)
-sum(dev1["binomial",]>dev1["grid",])
-auc1 <- sapply(lasso1,function(x) x$auc)
-sum(auc1["binomial",]<auc1["grid",])
-# AUC change
-rowMeans(sapply(lasso1,function(x) x$auc))
-rowMeans(sapply(ridge1,function(x) x$auc))
-rowMeans(sapply(lasso0,function(x) x$auc))
-# refit
-x <- scale(decline::curate_dummies(as.data.frame(X_imp[[1]])))
-fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
-cornet:::plot.cornet(fit)
-fit$pi.min
-fit$sigma.min
-rm(list=ls())
-set.seed(1)
-devtools::install_github("rauschenberger/cornet")
-rm(list=ls(all.names=TRUE))
-#devtools::install_github("rauschenberger/decline")
-.source <- "C:/Users/armin.rauschenberger/Desktop/package/data"
-.target <- "C:/Users/armin.rauschenberger/Desktop/package/decline/data"
-project <- "ppmi" # "luxpark" or "ppmi"
-if(project=="luxpark"){
-load(file.path(.source,"luxpark_2018-12-04.RData"))
-if(any(Y$visit0!=X$question113_113,na.rm=TRUE)){stop("Mismatch.")}
-if(any(rownames(Y)!=rownames(Xs))){stop("Mismatch!")}
-} else if(project=="ppmi"){
-load(file.path(.source,"ppmi_2018-11-20.RData"))
-if(any(Y[,"visit0"]!=X$"MOCA-MCATOT",na.rm=TRUE)){stop("Mismatch.")}
-} else if(project=="trial"){
-load(file.path(.source,"ppmi_trial_2019-11-01.RData"))
-}
-if(any(rownames(Y)!=rownames(X))){stop("Mismatch.")}
-temp <- decline:::response(x=Y,type="average")
-Y$sign <- temp$sign; Y$diff <- temp$diff
-# y <- 1*(Y[,"visit1"] - Y[,"visit0"] < - 5) # alternative
-# y <- 1*(Y[,"visit1"] > Y[,"visit0"]) # original (but wrong)
-cond <- !is.na(Y$diff)
-Y <- Y[cond,]; X <- X[cond,]
-if(project=="trial"){
-seq <- seq[cond,]
-}
-# Xs <- Xs[cond,] # selected set
-X <- decline::curate_missing(X)
-X <- decline::curate_hidden(X)
-X <- decline::curate_levels(X)
-X <- decline::curate_constant(X)
-set.seed(1)
-X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_random(X))
-#X_imp <- lapply(X=seq_len(10),FUN=function(x) expr=decline::miss_mean(X))
-#X_imp <- VIM::kNN(data=X)[,1:ncol(x)/2]) # worse
-#library(mice)
-#X_imp <- mice::complete(data=mice::mice(Xs,m=5,maxit=5,method="pmm",seed=1),action="all")
-load(file.path(.target,"temporary.RData"))
-objects()
-x <- scale(decline::curate_dummies(as.data.frame(X_imp[[1]])))
-set.seed(1)
-fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
-save(lasso0,lasso1,ridge0,ridge1,fit,
-file=file.path(.target,"temporary.RData"))
-load(file.path(.target,"temporary.RData"))
-# number of improvements (lasso, cutoff -1)
-dev1 <- sapply(lasso1,function(x) x$deviance)
-sum(dev1["binomial",]>dev1["grid",])
-auc1 <- sapply(lasso1,function(x) x$auc)
-sum(auc1["binomial",]<auc1["grid",])
-# AUC change
-rowMeans(sapply(lasso1,function(x) x$auc))
-rowMeans(sapply(ridge1,function(x) x$auc))
-rowMeans(sapply(lasso0,function(x) x$auc))
-# refit
-cornet:::plot.cornet(fit)
-fit$pi.min
-fit$sigma.min
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-n <- 100
-p <- 200
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-n <- 100
-p <- 200
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-fit <- cornet::cornet(y,cutoff=0,X=X)
-n <- 100
-p <- 50
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-fit <- cornet::cornet(y,cutoff=0,X=X)
-n <- 100
-p <- 50
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-fit <- cornet::cornet(y,cutoff=0,X=X)
-cornet:::plot.cornet(fit)
-n <- 100
-p <- 50
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-fit <- cornet::cornet(y,cutoff=0,X=X)
-cornet:::plot.cornet(fit)
-# Replace simulation ...
-set.seed(1)
-n <- 100; p <- 50
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-fit <- cornet::cornet(y,cutoff=0,X=X)
-# ... by true values!
-graphics::par(mar=c(4,4,0.5,0.5))
-cornet:::plot.cornet(fit)
-# Replace simulation ...
-set.seed(0)
-n <- 100; p <- 50
-y <- stats::rnorm(n)
-X <- matrix(stats::rnorm(n*p),nrow=n,ncol=p)
-fit <- cornet::cornet(y,cutoff=0,X=X)
-# ... by true values!
-graphics::par(mar=c(4,4,0.5,0.5))
-cornet:::plot.cornet(fit)
-?edgeR
-?edge::calculateNormFactors
-?edgeR::calculateNormFactors
-edgeR::calcNormFactors()
-?edgeR::calcNormFactors
-rm(list=ls())
-#--- generate toydata ----------------------------------------------------------
-set.seed(1)
-#toydata <- NULL
-#save(toydata,file=file.path("C:/Users/armin.rauschenberger/Desktop/package/cornet/data/toydata.R"))
-#--- compile package -----------------------------------------------------------
-rm(list=ls())
-name <- "cornet"
-#load("D:/cornet/package/toydata.RData")
-pkg <- "C:/Users/armin.rauschenberger/Desktop/cornet/cornet"
-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::install(pkg=pkg,upgrade=FALSE)
-setwd(pkg)
-system("git remote set-url origin https://rauschenberger:Eu57Rom!@github.com/rauschenberger/cornet.git")
-system("git remote -v")
-system("git add --all")
-system("git commit -m \"automation\"")
-system("git push origin master") # GitHub

NAMESPACE

@@ -4,4 +4,5 @@ S3method(coef,cornet)
 S3method(plot,cornet)
 S3method(predict,cornet)
 export(.compare)
+export(.test)
 export(cornet)

R/functions.R

@@ -303,13 +303,7 @@ plot.cornet <- function(x,...){
   graphics::par(xaxs="i",yaxs="i")
   graphics::plot.window(xlim=c(1-0.5,nsigma+0.5),ylim=c(1-0.5,npi+0.5))
   
-  ssigma <- which(x$sigma==x$sigma.min)
-  graphics::axis(side=1,at=c(1,ssigma,nsigma),labels=signif(x$sigma[c(1,ssigma,nsigma)],digits=2))
-  
-  spi <- which(x$pi==x$pi.min)
-  graphics::axis(side=2,at=c(1,spi,npi),labels=signif(x$pi[c(1,spi,npi)],digits=2))
-  
-  graphics::title(xlab=expression(sigma),ylab=expression(pi))
+  graphics::title(xlab=expression(sigma),ylab=expression(pi),cex.lab=2)
   #graphics::.filled.contour(x=seq_along(x$sigma),y=seq_along(x$pi),z=x$cvm,levels=levels,col=col)
   graphics::image(x=seq_along(x$sigma),y=seq_along(x$pi),z=x$cvm,breaks=levels,col=col,add=TRUE)
   graphics::box()
@@ -317,7 +311,23 @@ plot.cornet <- function(x,...){
   #graphics::abline(v=ssigma,lty=2,col="grey")
   #graphics::abline(h=spi,lty=2,col="grey")
   
-  graphics::points(x=ssigma,y=spi,pch=4,col="black",cex=1)
+  ssigma <- which(x$sigma %in% x$sigma.min)
+  spi <- which(x$pi %in% x$pi.min)
+  
+  if(length(ssigma)==1 & length(spi)==1){
+    graphics::axis(side=1,at=c(1,ssigma,nsigma),labels=signif(x$sigma[c(1,ssigma,nsigma)],digits=2))
+    graphics::axis(side=2,at=c(1,spi,npi),labels=signif(x$pi[c(1,spi,npi)],digits=2))
+    graphics::points(x=ssigma,y=spi,pch=4,col="black",cex=1)
+  } else {
+    at <- seq(from=1,to=nsigma,length.out=5)
+    graphics::axis(side=1,at=at,labels=signif(x$sigma,digits=2)[at])
+    at <- seq(from=1,to=nsigma,length.out=5)
+    graphics::axis(side=2,at=at,labels=signif(x$pi,digits=2)[at])
+  }
+  
+  #a <- sapply(x$sigma.min,function(y) which(x$sigma==y))
+  #b <- sapply(x$pi.min,function(y) which(x$pi==y))
+  #graphics::points(x=a,y=b,pch=4,col="black",cex=1)
   
 }
 
@@ -395,7 +405,7 @@ predict.cornet <- function(object,newx,type="probability",...){
   return(as.data.frame(frame))
 }
 
-#--- Internal functions --------------------------------------------------------
+#--- Application ---------------------------------------------------------------
 
 #' @export
 #' @title
@@ -406,13 +416,10 @@ predict.cornet <- function(object,newx,type="probability",...){
 #'
 #' @inheritParams  cornet
 #' 
-#' @param trial
-#' logical
-#'
 #' @examples
 #' NA
 #' 
-.compare <- function(y,cutoff,X,alpha=1,nfolds=5,foldid=NULL,type.measure="deviance",trial=FALSE){
+.compare <- function(y,cutoff,X,alpha=1,nfolds=5,foldid=NULL,type.measure="deviance"){
   
   z <- 1*(y > cutoff)