Commit a79a8bca authored by Armin Rauschenberger's avatar Armin Rauschenberger
Browse files

automation

parent 258b4761
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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))
sel <- which(x$sigma==x$sigma.min)
graphics::axis(side=1,at=c(1,sel,nsigma),labels=signif(x$sigma[c(1,sel,nsigma)],digits=2))
graphics::abline(v=nsigma,lty=2)
sel <- which(x$pi==x$pi.min)
graphics::axis(side=2,at=c(1,sel,npi),labels=signif(x$pi[c(1,sel,npi)],digits=2))
graphics::abline(h=npi)
graphics::title(xlab=expression(sigma),ylab=expression(pi))
#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()
}
plot(fit)
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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))
sel <- which(x$sigma==x$sigma.min)
graphics::axis(side=1,at=c(1,sel,nsigma),labels=signif(x$sigma[c(1,sel,nsigma)],digits=2))
graphics::abline(v=sel,lty=2)
sel <- which(x$pi==x$pi.min)
graphics::axis(side=2,at=c(1,sel,npi),labels=signif(x$pi[c(1,sel,npi)],digits=2))
graphics::abline(h=sel)
graphics::title(xlab=expression(sigma),ylab=expression(pi))
#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()
}
plot(fit)
plot.cornet(fit)
dev.off()
plot.cornet(fit)
#'
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2)
graphics::abline(h=spi,lty=2)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2,col="grey")
graphics::abline(h=spi,lty=2,col="grey")
}
plot.cornet(fit)
graphics::points(x=ssigma,y=spi)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2,col="grey")
graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,cex=3)
}
graphics::points(x=ssigma,y=spi)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2,col="grey")
graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,cex=3)
}
graphics::points(x=ssigma,y=spi)
dev.off()
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2,col="grey")
graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,cex=3)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2,col="grey")
graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,pch=3)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
graphics::abline(v=ssigma,lty=2,col="grey")
graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,pch=3,col="black",cex=1.5)
graphics::points(x=ssigma,y=spi,pch=3,col="white",cex=1)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#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="white",cex=1)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#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="white",cex=2)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#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="white",cex=1)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#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)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#graphics::abline(v=ssigma,lty=2,col="grey")
#graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,pch=16,col="black",cex=1)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#graphics::abline(v=ssigma,lty=2,col="grey")
#graphics::abline(h=spi,lty=2,col="grey")
graphics::points(x=ssigma,y=spi,pch=1,col="grey",cex=1)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#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="grey",cex=1)
}
plot.cornet(fit)
plot.cornet <- function(x,...){
if(length(list(...))!=0){warning("Ignoring arguments.")}
k <- 100
levels <- stats::quantile(x$cvm,probs=seq(from=0,to=1,length.out=k+1))
col <- colorspace::diverge_hsv(n=k)
nsigma <- length(x$sigma)
npi <- length(x$pi)
graphics::plot.new()
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::.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()
#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)
}
plot.cornet(fit)
rm(list=ls())
##############
### cornet ###
##############
#--- 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")
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")
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[[2]])))
fit <- cornet::cornet(y=Y$diff,cutoff=-1,X=x)
plot(fit)
plot(fit)
fit
names(fit)
predict(fit)
names(fit)
predict(fit,newdata=x)
plot(fit)
dev.off()
......@@ -303,17 +303,22 @@ 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))
sel <- which(x$sigma==x$sigma.min)
graphics::axis(side=1,at=c(1,sel,nsigma),labels=signif(x$sigma[c(1,sel,nsigma)],digits=2))
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))
sel <- which(x$pi==x$pi.min)
graphics::axis(side=2,at=c(1,sel,npi),labels=signif(x$pi[c(1,sel,npi)],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::.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()
#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)
}
#' @export
......@@ -552,6 +557,19 @@ predict.cornet <- function(object,newx,type="probability",...){
return(list(y=y,X=X))
}
#--- start trial ---
if(FALSE){
n <- 1000
y_hat <- runif(n)