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

automation

parent 258b4761
This diff is collapsed.
...@@ -303,17 +303,22 @@ plot.cornet <- function(x,...){ ...@@ -303,17 +303,22 @@ plot.cornet <- function(x,...){
graphics::par(xaxs="i",yaxs="i") 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)) 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) ssigma <- 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::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) spi <- 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::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))
#graphics::.filled.contour(x=seq_along(x$sigma),y=seq_along(x$pi),z=x$cvm,levels=levels,col=col) #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::image(x=seq_along(x$sigma),y=seq_along(x$pi),z=x$cvm,breaks=levels,col=col,add=TRUE)
graphics::box() 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 #' @export
...@@ -552,6 +557,19 @@ predict.cornet <- function(object,newx,type="probability",...){ ...@@ -552,6 +557,19 @@ predict.cornet <- function(object,newx,type="probability",...){
return(list(y=y,X=X)) return(list(y=y,X=X))
} }
#--- start trial ---
if(FALSE){
n <- 1000
y_hat <- runif(n)
y <- y_hat > 0.9
y <- rbinom(n=n,size=1,prob=0.5)
foldid <- rep(1:10,length.out=n)
.loss(y=y,fit=y_hat,family="binomial",type.measure="auc",foldid=foldid)
}
#--- end trial ---
# Correct this function in the palasso package (search twice for "# typo"). # Correct this function in the palasso package (search twice for "# typo").
.loss <- function (y,fit,family,type.measure,foldid=NULL){ .loss <- function (y,fit,family,type.measure,foldid=NULL){
if (!is.list(fit)) { if (!is.list(fit)) {
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment