Skip to content

Commit

Permalink
erased multi-split-test
Browse files Browse the repository at this point in the history
  • Loading branch information
@tagteam
tagteam committed Jun 5, 2024
1 parent 37dc073 commit b6ed48f
Show file tree
Hide file tree
Showing 12 changed files with 44 additions and 106 deletions.
12 changes: 2 additions & 10 deletions R/AUC.binary.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
## Author: Thomas Alexander Gerds
## Created: Jan 11 2022 (17:04)
## Version:
## Last-Updated: Jun 4 2024 (15:24)
## Last-Updated: Jun 5 2024 (07:25)
## By: Thomas Alexander Gerds
## Update #: 16
## Update #: 17
#----------------------------------------------------------------------
##
### Commentary:
Expand All @@ -21,7 +21,6 @@ AUC.binary <- function(DT,
cens.model="none",
keep.vcov=FALSE,
keep.iid=FALSE,
multi.split.test,
alpha,
N,
NT,
Expand All @@ -38,7 +37,6 @@ AUC.binary <- function(DT,
response,
cause,
alpha,
multi.split.test,
se.fit,
keep.vcov) {
cov=lower=upper=p=AUC=se=lower=upper=NULL
Expand Down Expand Up @@ -108,11 +106,6 @@ AUC.binary <- function(DT,
deltaAUC[,p:=2*pnorm(abs(delta.AUC)/se,lower.tail=FALSE)]
}
out <- list(score = score, contrasts = deltaAUC)
##if (se.fit[[1]]==TRUE||multi.split.test[[1]]==TRUE){
## deltaAUC <- data.table(model,reference,delta.AUC=as.vector(delta.AUC),se)
##}else{
## deltaAUC <- data.table(model,reference,delta.AUC=as.vector(delta.AUC))
##}
}else{
out <- list(score = score, contrasts = NULL)
}
Expand Down Expand Up @@ -210,7 +203,6 @@ AUC.binary <- function(DT,
response=aucDT[model==model[1],riskRegression_event],
cause="1",
alpha=alpha,
multi.split.test=multi.split.test,
se.fit=se.fit,
keep.vcov=keep.vcov)
output$score <- delong.res$score
Expand Down
12 changes: 5 additions & 7 deletions R/AUC.competing.risks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
## Author: Thomas Alexander Gerds
## Created: Jan 11 2022 (17:06)
## Version:
## Last-Updated: Jun 4 2024 (14:35)
## Last-Updated: Jun 5 2024 (07:24)
## By: Thomas Alexander Gerds
## Update #: 36
## Update #: 37
#----------------------------------------------------------------------
##
### Commentary:
Expand All @@ -23,7 +23,6 @@ AUC.competing.risks <- function(DT,
cens.model,
keep.vcov=FALSE,
keep.iid=FALSE,
multi.split.test,
alpha,
N,
NT,
Expand Down Expand Up @@ -213,7 +212,7 @@ AUC.competing.risks <- function(DT,
score <- aucDT[nodups,list(AUC=AireTrap(FPR,TPR)),by=list(model,times)]
data.table::setkey(score,model,times)
aucDT <- merge(score,aucDT,all=TRUE)
if (se.fit[[1]]==1L || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==1L){
aucDT[,nth.times:=as.numeric(factor(times))]

## compute influence function
Expand Down Expand Up @@ -252,20 +251,19 @@ AUC.competing.risks <- function(DT,
## add score to object
output <- c(list(score=score),output)
if (length(dolist)>0){
if (se.fit[[1]]==TRUE || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==TRUE){
contrasts.AUC <- aucDT[,getComparisons(data.table(x=AUC,IF=IF.AUC,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,multi.split.test=multi.split.test,
dolist=dolist,
se.fit=se.fit),by=list(times)]
}else{
contrasts.AUC <- score[,getComparisons(data.table(x=AUC,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=FALSE,
se.fit=FALSE),by=list(times)]
}
setnames(contrasts.AUC,"delta","delta.AUC")
Expand Down
12 changes: 5 additions & 7 deletions R/AUC.survival.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
## Author: Thomas Alexander Gerds
## Created: Jan 11 2022 (17:06)
## Version:
## Last-Updated: Jun 4 2024 (14:34)
## Last-Updated: Jun 5 2024 (07:23)
## By: Thomas Alexander Gerds
## Update #: 29
## Update #: 30
#----------------------------------------------------------------------
##
### Commentary:
Expand All @@ -23,7 +23,6 @@ AUC.survival <- function(DT,
cens.model,
keep.vcov=FALSE,
keep.iid=FALSE,
multi.split.test,
alpha,
N,
NT,
Expand Down Expand Up @@ -191,7 +190,7 @@ AUC.survival <- function(DT,

data.table::setkey(score,model,times)
aucDT <- merge(score,aucDT,all=TRUE)
if (se.fit[[1]]==1L || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==1L){
aucDT[,nth.times:=as.numeric(factor(times))]
## compute influence function
## data.table::setorder(aucDT,model,times,riskRegression_time,-riskRegression_status)
Expand Down Expand Up @@ -230,19 +229,18 @@ AUC.survival <- function(DT,
## add score to object
output <- c(list(score=score),output)
if (length(dolist)>0){
if (se.fit[[1]]==TRUE || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==TRUE){
contrasts.AUC <- aucDT[,getComparisons(data.table(x=AUC,IF=IF.AUC,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,multi.split.test=multi.split.test,se.fit=se.fit),by=list(times)]
dolist=dolist,se.fit=se.fit),by=list(times)]
}else{
contrasts.AUC <- score[,getComparisons(data.table(x=AUC,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=FALSE,
se.fit=FALSE),by=list(times)]
}
setnames(contrasts.AUC,"delta","delta.AUC")
Expand Down
9 changes: 3 additions & 6 deletions R/Brier.binary.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
## Author: Thomas Alexander Gerds
## Created: Jan 11 2022 (17:03)
## Version:
## Last-Updated: Jun 4 2024 (15:08)
## Last-Updated: Jun 5 2024 (07:25)
## By: Thomas Alexander Gerds
## Update #: 7
## Update #: 8
#----------------------------------------------------------------------
##
### Commentary:
Expand All @@ -21,7 +21,6 @@ Brier.binary <- function(DT,
cens.model="none",
keep.vcov=FALSE,
keep.iid=FALSE,
multi.split.test,
alpha,
N,
NT,
Expand Down Expand Up @@ -54,23 +53,21 @@ Brier.binary <- function(DT,
data.table::setkey(DT,model)
data.table::setkey(score,model)
DT <- DT[score]
if (se.fit[[1]]==TRUE || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==TRUE){
contrasts.Brier <- DT[,getComparisons(data.table(x=Brier,
IF=residuals,
model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=multi.split.test,
se.fit=se.fit)]
}else{
contrasts.Brier <- DT[,getComparisons(data.table(x=Brier,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=FALSE,
se.fit=FALSE)]
}
setnames(contrasts.Brier,"delta","delta.Brier")
Expand Down
11 changes: 4 additions & 7 deletions R/Brier.competing.risks.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
## Author: Thomas Alexander Gerds
## Created: Jan 11 2022 (17:04)
## Version:
## Last-Updated: Jun 4 2024 (19:08)
## Last-Updated: Jun 5 2024 (07:24)
## By: Thomas Alexander Gerds
## Update #: 8
## Update #: 9
#----------------------------------------------------------------------
##
### Commentary:
Expand All @@ -22,7 +22,6 @@ Brier.competing.risks <- function(DT,
cens.model,
keep.vcov=FALSE,
keep.iid=FALSE,
multi.split.test,
alpha,
N,
NT,
Expand All @@ -43,7 +42,7 @@ Brier.competing.risks <- function(DT,
DT[riskRegression_time>times,residuals:=(risk)^2/Wt]
## deal with censored observations before
DT[riskRegression_time<=times & riskRegression_status==0,residuals:=0]
if (se.fit[[1]]==1L || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==1L){
## data.table::setorder(DT,model,times,riskRegression_time,-riskRegression_status)
data.table::setorder(DT,model,times,riskRegression_ID)
DT[,nth.times:=as.numeric(factor(times))]
Expand Down Expand Up @@ -73,21 +72,19 @@ Brier.competing.risks <- function(DT,
## merge with Brier score
DT <- DT[score]
data.table::setkey(score,model,times)
if (se.fit[[1]]==TRUE || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==TRUE){
contrasts.Brier <- DT[,getComparisons(data.table(x=Brier,IF=IF.Brier,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=multi.split.test,
se.fit=se.fit),by=list(times)]
}else{
contrasts.Brier <- DT[,getComparisons(data.table(x=Brier,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=FALSE,
se.fit=FALSE),by=list(times)]
}
setnames(contrasts.Brier,"delta","delta.Brier")
Expand Down
11 changes: 4 additions & 7 deletions R/Brier.survival.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,9 +3,9 @@
## Author: Thomas Alexander Gerds
## Created: Jan 11 2022 (17:04)
## Version:
## Last-Updated: Jun 4 2024 (14:11)
## Last-Updated: Jun 5 2024 (07:24)
## By: Thomas Alexander Gerds
## Update #: 8
## Update #: 9
#----------------------------------------------------------------------
##
### Commentary:
Expand All @@ -22,7 +22,6 @@ Brier.survival <- function(DT,
cens.model,
keep.vcov=FALSE,
keep.iid=FALSE,
multi.split.test,
alpha,
N,
NT,
Expand All @@ -37,7 +36,7 @@ Brier.survival <- function(DT,
DT[riskRegression_time<=times & status==0,residuals:=0]
DT[riskRegression_time>times,residuals:=(risk)^2/Wt]

if (se.fit[[1]]==1L || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==1L){
## data.table::setorder(DT,model,times,time,-status)
data.table::setorder(DT,model,times,riskRegression_ID)
DT[,nth.times:=as.numeric(factor(times))]
Expand Down Expand Up @@ -65,21 +64,19 @@ Brier.survival <- function(DT,
data.table::setkey(DT,model,times)
## data.table::setkey(score,model,times)
DT <- DT[score]
if (se.fit[[1]]==TRUE || multi.split.test[[1]]==TRUE){
if (se.fit[[1]]==TRUE){
contrasts.Brier <- DT[,getComparisons(data.table(x=Brier,IF=IF.Brier,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=multi.split.test,
se.fit=se.fit),by=list(times)]
}else{
contrasts.Brier <- DT[,getComparisons(data.table(x=Brier,model=model),
NF=NF,
N=N,
alpha=alpha,
dolist=dolist,
multi.split.test=FALSE,
se.fit=FALSE),by=list(times)]
}
setnames(contrasts.Brier,"delta","delta.Brier")
Expand Down
Loading

0 comments on commit b6ed48f

Please sign in to comment.