Commit 3f48678c authored by Armin Rauschenberger's avatar Armin Rauschenberger
Browse files

automation

parent 71948291
......@@ -4,3 +4,4 @@
^docs$
^cran-comments\.md$
^appveyor\.yml$
^\.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
......@@ -4,4 +4,5 @@ S3method(coef,cornet)
S3method(plot,cornet)
S3method(predict,cornet)
export(.compare)
export(.test)
export(cornet)
......@@ -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)