Commit 2e9401d0 authored by Armin Rauschenberger's avatar Armin Rauschenberger
Browse files

automation

parent b26321f2
......@@ -3,7 +3,7 @@ Version: 0.0.0
Title: Elastic Net for Dichotomised Outcomes
Description: Implements lasso and ridge regression for dichotomised outcomes.
Depends: R (>= 3.0.0)
Imports: glmnet, MASS, weights, palasso
Imports: glmnet, palasso
Suggests: knitr, testthat, RColorBrewer
Authors@R: person("Armin","Rauschenberger",email="a.rauschenberger@vumc.nl",role=c("aut","cre"))
VignetteBuilder: knitr
......
......@@ -470,6 +470,37 @@ predict.cornet <- function(object,newx,type="probability",...){
loss <- lapply(X=type,FUN=function(x) cornet:::.loss(y=z,fit=pred,family="binomial",type.measure=x,foldid=fold)[[1]])
names(loss) <- type
###################
### start trial ###
# squared deviance residuals
limit <- 1e-05
pred[pred < limit] <- limit
pred[pred > 1 - limit] <- 1 - limit
res <- -2 * (z * log(pred) + (1 - z) * log(1 - pred))
rxs <- res[,"binomial"]
rys <- res[,"grid"]
## examine differences per fold
loss$cv.diff <- loss$cv.size <- loss$cv.pval <- numeric()
for(i in seq_len(nfolds)){
cond <- fold==i
loss$cv.size[i] <- mean((rxs>rys)[cond])
loss$cv.diff[i] <- stats::median(((rys-rxs)/rxs)[cond])
loss$cv.pval[i] <- stats::wilcox.test(x=rxs[cond],y=rys[cond],paired=TRUE,
alternative="greater")$p.value
}
# examine all differences
loss$all.size <- mean(rxs>rys)
loss$all.diff <- stats::median((rys-rxs)/rxs)
loss$all.pval <- stats::wilcox.test(x=rxs,y=rys,paired=TRUE,
alternative="greater")$p.value
# The overall p-value is anti-conservative!
### end trial ###
#################
#if(trial){
# list <- list(diff=(pred-z)^2,fold=fold,loss=loss)
# return(list)
......@@ -512,7 +543,8 @@ predict.cornet <- function(object,newx,type="probability",...){
limit <- 1e-05
pred[pred < limit] <- limit
pred[pred > 1 - limit] <- 1 - limit
res <- -2 * (y[fold==1] * log(pred) + (1 - y[fold==1]) * log(1 - pred))
res <- -2 * (z[fold==1] * log(pred) + (1 - z[fold==1]) * log(1 - pred))
# Changed y to z (2019-02-08)
pvalue <- stats::wilcox.test(x=res[,"binomial"],y=res[,"grid"],paired=TRUE,alternative="greater")$p.value
return(pvalue)
......
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