Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit94573bc

Browse files
committed
Improved likelihood based assigned event and multiple strata for cox
1 parent06e5171 commit94573bc

34 files changed

+687
-1100
lines changed

‎R/BasicRun.R‎

Lines changed: 67 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -147,8 +147,14 @@ CoxRun <- function(model, df, a_n = list(c(0)), keep_constant = c(0), control =
147147
model_control[["gmix_theta"]]<-coxmodel$gmix_theta
148148
}
149149
}
150-
if (coxmodel$strata!="NONE") {
150+
if (all(coxmodel$strata!="NONE")) {
151151
model_control[["strata"]]<-TRUE
152+
#
153+
df$"_strata_col"<- format(df[,strat_col[1],with=FALSE])# defining a strata column
154+
for (iin seq_len(length(strat_col)-1)) {
155+
df$"_strata_col"<- paste(df$"_strata_col", format(df[,strat_col[i+1],with=FALSE]),sep="_")# interacting with any other strata columns
156+
}
157+
df$"_strata_col"<-factor(df$"_strata_col")# converting to a factor
152158
}
153159
if (coxmodel$weight!="NONE") {
154160
model_control[["cr"]]<-TRUE
@@ -198,7 +204,7 @@ CoxRun <- function(model, df, a_n = list(c(0)), keep_constant = c(0), control =
198204
}
199205
}
200206
# ------------------------------------------------------------------------------ #
201-
res<- RunCoxRegression_Omnibus(df,time1,time2,event0,names,term_n,tform,keep_constant,a_n,modelform,control,strat_col,cens_weight,model_control,cons_mat,cons_vec)
207+
res<- RunCoxRegression_Omnibus(df,time1,time2,event0,names,term_n,tform,keep_constant,a_n,modelform,control,"_strata_col",cens_weight,model_control,cons_mat,cons_vec)
202208
if (int_count>0) {
203209
control$thres_step_max<-control$thres_step_max* (int_avg_weight/int_count)
204210
}
@@ -734,8 +740,14 @@ CaseControlRun <- function(model, df, a_n = list(c(0)), keep_constant = c(0), co
734740
model_control[["gmix_theta"]]<-caseconmodel$gmix_theta
735741
}
736742
}
737-
if (caseconmodel$strata!="NONE") {
743+
if (all(caseconmodel$strata!="NONE")) {
738744
model_control[["strata"]]<-TRUE
745+
#
746+
df$"_strata_col"<- format(df[,strat_col[1],with=FALSE])# defining a strata column
747+
for (iin seq_len(length(strat_col)-1)) {
748+
df$"_strata_col"<- paste(df$"_strata_col", format(df[,strat_col[i+1],with=FALSE]),sep="_")# interacting with any other strata columns
749+
}
750+
df$"_strata_col"<-factor(df$"_strata_col")# converting to a factor
739751
}
740752
if (time1!=time2) {
741753
model_control[["time_risk"]]<-TRUE
@@ -786,7 +798,7 @@ CaseControlRun <- function(model, df, a_n = list(c(0)), keep_constant = c(0), co
786798
}
787799
}
788800
# ------------------------------------------------------------------------------ #
789-
res<- RunCaseControlRegression_Omnibus(df,time1,time2,event0,names,term_n,tform,keep_constant,a_n,modelform,control,strat_col,cens_weight,model_control,cons_mat,cons_vec)
801+
res<- RunCaseControlRegression_Omnibus(df,time1,time2,event0,names,term_n,tform,keep_constant,a_n,modelform,control,"_strata_col",cens_weight,model_control,cons_mat,cons_vec)
790802
if (int_count>0) {
791803
control$thres_step_max<-control$thres_step_max* (int_avg_weight/int_count)
792804
}
@@ -1207,9 +1219,15 @@ plot.coxres <- function(x, df, plot_options, a_n = c(), ...) {
12071219
}else {
12081220
stop("Error: control argument must be a list")
12091221
}
1210-
if (coxmodel$strata!="NONE") {
1222+
if (all(coxmodel$strata!="NONE")) {
12111223
plot_options[["strat_haz"]]<-TRUE
1212-
plot_options$strat_col<-strat_col
1224+
plot_options$strat_col<-"_strata_col"
1225+
#
1226+
df$"_strata_col"<- format(df[,strat_col[1],with=FALSE])# defining a strata column
1227+
for (iin seq_len(length(strat_col)-1)) {
1228+
df$"_strata_col"<- paste(df$"_strata_col", format(df[,strat_col[i+1],with=FALSE]),sep="_")# interacting with any other strata columns
1229+
}
1230+
df$"_strata_col"<-factor(df$"_strata_col")# converting to a factor
12131231
}
12141232
RunCoxPlots(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,control=control,plot_options=plot_options,model_control=model_control)
12151233
}
@@ -1352,8 +1370,14 @@ CoxRunMulti <- function(model, df, a_n = list(c(0)), keep_constant = c(0), reali
13521370
model_control[["gmix_theta"]]<-coxmodel$gmix_theta
13531371
}
13541372
}
1355-
if (coxmodel$strata!="NONE") {
1373+
if (all(coxmodel$strata!="NONE")) {
13561374
model_control[["strata"]]<-TRUE
1375+
#
1376+
df$"_strata_col"<- format(df[,strat_col[1],with=FALSE])# defining a strata column
1377+
for (iin seq_len(length(strat_col)-1)) {
1378+
df$"_strata_col"<- paste(df$"_strata_col", format(df[,strat_col[i+1],with=FALSE]),sep="_")# interacting with any other strata columns
1379+
}
1380+
df$"_strata_col"<-factor(df$"_strata_col")# converting to a factor
13571381
}
13581382
if (coxmodel$weight!="NONE") {
13591383
model_control[["cr"]]<-TRUE
@@ -1389,7 +1413,7 @@ CoxRunMulti <- function(model, df, a_n = list(c(0)), keep_constant = c(0), reali
13891413
}
13901414
}
13911415
# ------------------------------------------------------------------------------ #
1392-
res<- RunCoxRegression_Omnibus_Multidose(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,realization_columns=realization_columns,realization_index=realization_index,control=control,strat_col=strat_col,cens_weight=cens_weight,model_control=model_control,cons_mat=cons_mat,cons_vec=cons_vec)
1416+
res<- RunCoxRegression_Omnibus_Multidose(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,realization_columns=realization_columns,realization_index=realization_index,control=control,strat_col="_strata_col",cens_weight=cens_weight,model_control=model_control,cons_mat=cons_mat,cons_vec=cons_vec)
13931417
res$model<-coxmodel
13941418
res$modelcontrol<-model_control
13951419
res$control<-control
@@ -1696,6 +1720,15 @@ LikelihoodBound.coxres <- function(x, df, curve_control = list(), control = list
16961720
}
16971721
}
16981722
#
1723+
if (all(strat_col!="NONE")) {
1724+
#
1725+
df$"_strata_col"<- format(df[,strat_col[1],with=FALSE])# defining a strata column
1726+
for (iin seq_len(length(strat_col)-1)) {
1727+
df$"_strata_col"<- paste(df$"_strata_col", format(df[,strat_col[i+1],with=FALSE]),sep="_")# interacting with any other strata columns
1728+
}
1729+
df$"_strata_col"<-factor(df$"_strata_col")# converting to a factor
1730+
}
1731+
#
16991732
norm_res<- apply_norm(df,norm,names,TRUE,list("a_n"=a_n,"cons_mat"=cons_mat,"tform"=tform),model_control)
17001733
a_n<-norm_res$a_n
17011734
cons_mat<-norm_res$cons_mat
@@ -1719,10 +1752,10 @@ LikelihoodBound.coxres <- function(x, df, curve_control = list(), control = list
17191752
}
17201753
#
17211754
if ("bisect"%in% names(model_control)) {
1722-
res<- CoxCurveSolver(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,control=control,strat_col=strat_col,cens_weight=cens_weight,model_control=model_control,cons_mat=cons_mat,cons_vec=cons_vec)
1755+
res<- CoxCurveSolver(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,control=control,strat_col="_strata_col",cens_weight=cens_weight,model_control=model_control,cons_mat=cons_mat,cons_vec=cons_vec)
17231756
res$method<-"bisection"
17241757
}else {
1725-
res<- RunCoxRegression_Omnibus(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,control=control,strat_col=strat_col,cens_weight=cens_weight,model_control=model_control,cons_mat=cons_mat,cons_vec=cons_vec)
1758+
res<- RunCoxRegression_Omnibus(df,time1=time1,time2=time2,event0=event0,names=names,term_n=term_n,tform=tform,keep_constant=keep_constant,a_n=a_n,modelform=modelform,control=control,strat_col="_strata_col",cens_weight=cens_weight,model_control=model_control,cons_mat=cons_mat,cons_vec=cons_vec)
17261759
res$method<-"Venzon-Moolgavkar"
17271760
}
17281761
res$model<-coxmodel
@@ -1735,6 +1768,15 @@ LikelihoodBound.coxres <- function(x, df, curve_control = list(), control = list
17351768
}elseif (tolower(norm)%in% c("max","mean")) {
17361769
# weight by the maximum value
17371770
res$Parameter_Limits<-res$Parameter_Limits/norm_weight[model_control$para_number]
1771+
for (iin seq_along(names)) {
1772+
if (grepl("_int",tform[i])) {
1773+
res$Lower_Values[i]<-res$Lower_Values[i]*norm_weight[i]
1774+
res$Upper_Values[i]<-res$Upper_Values[i]*norm_weight[i]
1775+
}else {
1776+
res$Lower_Values[i]<-res$Lower_Values[i]/norm_weight[i]
1777+
res$Upper_Values[i]<-res$Upper_Values[i]/norm_weight[i]
1778+
}
1779+
}
17381780
}else {
17391781
stop(gettextf(
17401782
"Error: Normalization arguement '%s' not valid.",
@@ -1876,6 +1918,15 @@ LikelihoodBound.poisres <- function(x, df, curve_control = list(), control = lis
18761918
}elseif (tolower(norm)%in% c("max","mean")) {
18771919
# weight by the maximum value
18781920
res$Parameter_Limits<-res$Parameter_Limits/norm_weight[model_control$para_number]
1921+
for (iin seq_along(names)) {
1922+
if (grepl("_int",tform[i])) {
1923+
res$Lower_Values[i]<-res$Lower_Values[i]*norm_weight[i]
1924+
res$Upper_Values[i]<-res$Upper_Values[i]*norm_weight[i]
1925+
}else {
1926+
res$Lower_Values[i]<-res$Lower_Values[i]/norm_weight[i]
1927+
res$Upper_Values[i]<-res$Upper_Values[i]/norm_weight[i]
1928+
}
1929+
}
18791930
}else {
18801931
stop(gettextf(
18811932
"Error: Normalization arguement '%s' not valid.",
@@ -2207,8 +2258,9 @@ EventAssignment.poisresbound <- function(x, df, assign_control = list(), control
22072258
}
22082259
}
22092260
# Start with low
2210-
a_n<-object$beta_0
2211-
a_n[check_num]<-Parameter_Limits[1]
2261+
a_n<-x$Lower_Values
2262+
# a_n <- object$beta_0
2263+
# a_n[check_num] <- Parameter_Limits[1]
22122264
# Get the new optimum values
22132265
if (model_control[["constraint"]]) {
22142266
low_res<- PoisRun(object,df,control=control,norm=norm,cons_mat=cons_mat,cons_vec=cons_vec,keep_constant=keep_constant,a_n=a_n)
@@ -2223,8 +2275,9 @@ EventAssignment.poisresbound <- function(x, df, assign_control = list(), control
22232275
model_control
22242276
)
22252277
# Now the high
2226-
a_n<-object$beta_0
2227-
a_n[check_num]<-Parameter_Limits[2]
2278+
a_n<-x$Upper_Values
2279+
# a_n <- object$beta_0
2280+
# a_n[check_num] <- Parameter_Limits[2]
22282281
# Get the new optimum values
22292282
if (model_control[["constraint"]]) {
22302283
high_res<- PoisRun(object,df,control=control,norm=norm,cons_mat=cons_mat,cons_vec=cons_vec,keep_constant=keep_constant,a_n=a_n)

‎R/CaseControl_Regression.R‎

Lines changed: 12 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -57,10 +57,10 @@ RunCaseControlRegression_Omnibus <- function(df, time1 = "%trunc%", time2 = "%tr
5757
if (class(df)[[1]]!="data.table") {
5858
tryCatch(
5959
{
60-
df<- setDT(df)
60+
df<- setDT(df)# nocov
6161
},
62-
error=function(e) {
63-
df<- data.table(df)
62+
error=function(e) {# nocov
63+
df<- data.table(df)# nocov
6464
}
6565
)
6666
}
@@ -145,6 +145,15 @@ RunCaseControlRegression_Omnibus <- function(df, time1 = "%trunc%", time2 = "%tr
145145
}
146146
}else {
147147
if (model_control$strata==TRUE) {
148+
if (!is.null(levels(df[[strat_col]]))) {
149+
# The column is a factor, so we can convert to numbers
150+
factor_lvl<- levels(df[[strat_col]])
151+
df[[strat_col]]<- as.integer(factor(df[[strat_col]],levels=factor_lvl))-1
152+
}elseif (is(typeof(df[[strat_col]]),"character")) {
153+
df[[strat_col]]<-factor(df[[strat_col]])
154+
factor_lvl<- levels(df[[strat_col]])
155+
df[[strat_col]]<- as.integer(factor(df[[strat_col]],levels=factor_lvl))-1
156+
}
148157
dfend<-df[get(event0)==1, ]
149158
uniq<- sort(unlist(unique(df[,strat_col,with=FALSE]),
150159
use.names=FALSE

‎R/Cox_Regression.R‎

Lines changed: 25 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -57,10 +57,10 @@ RunCoxRegression_Omnibus <- function(df, time1 = "%trunc%", time2 = "%trunc%", e
5757
if (class(df)[[1]]!="data.table") {
5858
tryCatch(
5959
{
60-
df<- setDT(df)
60+
df<- setDT(df)# nocov
6161
},
62-
error=function(e) {
63-
df<- data.table(df)
62+
error=function(e) {# nocov
63+
df<- data.table(df)# nocov
6464
}
6565
)
6666
}
@@ -290,10 +290,10 @@ Cox_Relative_Risk <- function(df, time1 = "%trunc%", time2 = "%trunc%", event0 =
290290
if (class(df)[[1]]!="data.table") {
291291
tryCatch(
292292
{
293-
df<- setDT(df)
293+
df<- setDT(df)# nocov
294294
},
295-
error=function(e) {
296-
df<- data.table(df)
295+
error=function(e) {# nocov
296+
df<- data.table(df)# nocov
297297
}
298298
)
299299
}
@@ -338,10 +338,10 @@ RunCoxPlots <- function(df, time1 = "%trunc%", time2 = "%trunc%", event0 = "even
338338
if (class(df)[[1]]!="data.table") {
339339
tryCatch(
340340
{
341-
df<- setDT(df)
341+
df<- setDT(df)# nocov
342342
},
343-
error=function(e) {
344-
df<- data.table(df)
343+
error=function(e) {# nocov
344+
df<- data.table(df)# nocov
345345
}
346346
)
347347
}
@@ -395,6 +395,16 @@ RunCoxPlots <- function(df, time1 = "%trunc%", time2 = "%trunc%", event0 = "even
395395
if ("strat_col"%in% names(plot_options)) {
396396
if (plot_options$strat_col%in% names(df)) {
397397
# fine
398+
strat_col<-plot_options$strat_col
399+
if (!is.null(levels(df[[strat_col]]))) {
400+
# The column is a factor, so we can convert to numbers
401+
factor_lvl<- levels(df[[strat_col]])
402+
df[[strat_col]]<- as.integer(factor(df[[strat_col]],levels=factor_lvl))-1
403+
}elseif (is(typeof(df[[strat_col]]),"character")) {
404+
df[[strat_col]]<-factor(df[[strat_col]])
405+
factor_lvl<- levels(df[[strat_col]])
406+
df[[strat_col]]<- as.integer(factor(df[[strat_col]],levels=factor_lvl))-1
407+
}
398408
}else {
399409
stop("Error: Stratification Column not in dataframe")
400410
}
@@ -611,10 +621,10 @@ RunCoxRegression_Omnibus_Multidose <- function(df, time1 = "%trunc%", time2 = "%
611621
if (class(df)[[1]]!="data.table") {
612622
tryCatch(
613623
{
614-
df<- setDT(df)
624+
df<- setDT(df)# nocov
615625
},
616-
error=function(e) {
617-
df<- data.table(df)
626+
error=function(e) {# nocov
627+
df<- data.table(df)# nocov
618628
}
619629
)
620630
}
@@ -788,10 +798,10 @@ CoxCurveSolver <- function(df, time1 = "%trunc%", time2 = "%trunc%", event0 = "e
788798
if (class(df)[[1]]!="data.table") {
789799
tryCatch(
790800
{
791-
df<- setDT(df)
801+
df<- setDT(df)# nocov
792802
},
793-
error=function(e) {
794-
df<- data.table(df)
803+
error=function(e) {# nocov
804+
df<- data.table(df)# nocov
795805
}
796806
)
797807
}

‎R/LogitRegression.R‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -50,10 +50,10 @@ RunLogisticRegression_Omnibus <- function(df, trial0 = "CONST", event0 = "event"
5050
if (class(df)[[1]]!="data.table") {
5151
tryCatch(
5252
{
53-
df<- setDT(df)
53+
df<- setDT(df)# nocov
5454
},
55-
error=function(e) {
56-
df<- data.table(df)
55+
error=function(e) {# nocov
56+
df<- data.table(df)# nocov
5757
}
5858
)
5959
}

‎R/Poisson_Regression.R‎

Lines changed: 15 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -52,10 +52,10 @@ RunPoissonRegression_Omnibus <- function(df, pyr0 = "pyr", event0 = "event", nam
5252
if (class(df)[[1]]!="data.table") {
5353
tryCatch(
5454
{
55-
df<- setDT(df)
55+
df<- setDT(df)# nocov
5656
},
57-
error=function(e) {
58-
df<- data.table(df)
57+
error=function(e) {# nocov
58+
df<- data.table(df)# nocov
5959
}
6060
)
6161
}
@@ -181,10 +181,10 @@ RunPoissonEventAssignment <- function(df, pyr0 = "pyr", event0 = "event", names
181181
if (class(df)[[1]]!="data.table") {
182182
tryCatch(
183183
{
184-
df<- setDT(df)
184+
df<- setDT(df)# nocov
185185
},
186-
error=function(e) {
187-
df<- data.table(df)
186+
error=function(e) {# nocov
187+
df<- data.table(df)# nocov
188188
}
189189
)
190190
}
@@ -308,10 +308,10 @@ RunPoissonRegression_Residual <- function(df, pyr0 = "pyr", event0 = "event", na
308308
if (class(df)[[1]]!="data.table") {
309309
tryCatch(
310310
{
311-
df<- setDT(df)
311+
df<- setDT(df)# nocov
312312
},
313-
error=function(e) {
314-
df<- data.table(df)
313+
error=function(e) {# nocov
314+
df<- data.table(df)# nocov
315315
}
316316
)
317317
}
@@ -399,10 +399,10 @@ PoissonCurveSolver <- function(df, pyr0 = "pyr", event0 = "event", names = c("CO
399399
if (class(df)[[1]]!="data.table") {
400400
tryCatch(
401401
{
402-
df<- setDT(df)
402+
df<- setDT(df)# nocov
403403
},
404-
error=function(e) {
405-
df<- data.table(df)
404+
error=function(e) {# nocov
405+
df<- data.table(df)# nocov
406406
}
407407
)
408408
}
@@ -511,10 +511,10 @@ RunPoisRegression_Omnibus_Multidose <- function(df, pyr0 = "pyr", event0 = "even
511511
if (class(df)[[1]]!="data.table") {
512512
tryCatch(
513513
{
514-
df<- setDT(df)
514+
df<- setDT(df)# nocov
515515
},
516-
error=function(e) {
517-
df<- data.table(df)
516+
error=function(e) {# nocov
517+
df<- data.table(df)# nocov
518518
}
519519
)
520520
}

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp