-
Notifications
You must be signed in to change notification settings - Fork 0
/
data_generation_TTE_v2.R
144 lines (107 loc) · 4.75 KB
/
data_generation_TTE_v2.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
#v2 changes the scenario setting to define tox in terms of all cycles
#function to give cumulative sums of rows of matrix
matrix_cumulative_col_sums_function<-function(matrix_in){
nrows<-nrow(matrix_in)
ncols<-ncol(matrix_in)
matrix_out<-matrix(nrow=nrows,ncol=ncols)
for(i in 1:ncols){
matrix_out[,i]<-cumsum(matrix_in[,i])
}
return(matrix_out)
}
##find the parameters
find_lognormal_parms3<-function(p1,p3,int1=seq(-20,20,0.05),int2=seq(0.05,20,0.05)){
#p1=P(X<=1), p3=P(X<=3)
lognormal_cdf<-function(parms,quantile,prob){
mu<-parms[1]
sig<-parms[2]
prob_q<-pnorm(q=log(quantile),mean=mu,sd=sig)
return(abs(prob_q-prob))
}
mean_i<-0
matrix1<-matrix(0,nrow=length(int1),ncol=length(int2))
for(mean_val in int1){
mean_i<-mean_i+1
sd_i<-0
for(sd_val in int2){
sd_i<-sd_i+1
if(lognormal_cdf(parms=c(mean_val,sd_val),quantile = 1,prob=p1)<0.01){
matrix1[mean_i,sd_i]<-1
if(lognormal_cdf(parms=c(mean_val,sd_val),quantile = 3,prob=p3)<0.01){
matrix1[mean_i,sd_i]<-2
}
}
}
}
closes<-which(matrix1==2,arr.ind = T)
close_vals1<-close_vals3<-c()
for(closes_i in 1:nrow(closes)){
close_vals1[closes_i]<-lognormal_cdf(parms=c(int1[closes[closes_i,1]],int2[closes[closes_i,2]]),quantile = 1,prob=p1)
close_vals3[closes_i]<-lognormal_cdf(parms=c(int1[closes[closes_i,1]],int2[closes[closes_i,2]]),quantile = 3,prob=p3)
}
final_choice<-closes[which.min(close_vals1+close_vals3),]
return(c(int1[final_choice[1]],
int2[final_choice[2]]))
}
#generates a single patient's COMPLETE outcome as a data-frame
#patient: patient ID for index of rands
#efficacy_pars & tox_pars: means and sd for Efficacy and Toxicity lognormal distributions for each dose level
#corET: correlation between time to event for efficacy and toxicity
#ncycles: number of cycles
#thenextdose: dose level
#entry_time: time the patient enters the trial
single_patient_generation_TTE<-function(patient,efficacy_pars,tox_pars,corET,ncycles,thenextdose,entry_time){
meanE<-efficacy_pars[1,thenextdose]
meanT<-tox_pars[1,thenextdose]
sdE<-efficacy_pars[2,thenextdose]
sdT<-tox_pars[2,thenextdose]
#first element is Efficacy, second is Toxicity
mean_vec<-c(meanE,meanT)
var_mat<-matrix(c(sdE^2,sdE*sdT*corET,sdE*sdT*corET,sdT^2),nrow=2)
timesET<-exp(rmvnorm(1,mean=mean_vec,sigma=var_mat))
if(timesET[2]<timesET[1]){#if toxicity occurs before efficacy, we don't see the efficacy
timesET[1]<-ncycles+1
}
max_cycle_obs<-min(c(ncycles,ceiling(timesET[2])))
Eff.time<-DLT.time<-rep(NA,max_cycle_obs)
Eff.obs<-as.numeric(timesET[1]<c(1:max_cycle_obs))
DLT.obs<-as.numeric(timesET[2]<c(1:max_cycle_obs))
Eff.time[Eff.obs==1]<-timesET[1]+entry_time
DLT.time[DLT.obs==1]<-timesET[2]+entry_time
#browser()
out_data<-data.frame(patient_ID=rep(patient,max_cycle_obs),cycle_num=c(1:max_cycle_obs),dose_level=rep(thenextdose,max_cycle_obs),
entry_time=rep(entry_time,max_cycle_obs),time_of=entry_time+c(1:max_cycle_obs),
DLT=DLT.obs,Eff=Eff.obs,DLT.time=DLT.time,Eff.time=Eff.time)
return(out_data)
}
#generates multiple patients' COMPLETE outcome as a data-frame
multiple_patient_generation_TTE<-function(patient_ID1,efficacy_pars,tox_pars,corET,ncycles,thenextdose,entry_time,num_patients){
meanE<-efficacy_pars[1,thenextdose]
meanT<-tox_pars[1,thenextdose]
sdE<-efficacy_pars[2,thenextdose]
sdT<-tox_pars[2,thenextdose]
out_data<-single_patient_generation_TTE(patient=patient_ID1,efficacy_pars=efficacy_pars,tox_pars=tox_pars,corET=corET,ncycles=ncycles,thenextdose=thenextdose,entry_time=entry_time)
for(i in 2:num_patients){
out_data<-rbind(out_data,single_patient_generation_TTE(patient=patient_ID1+i-1,efficacy_pars=efficacy_pars,tox_pars=tox_pars,corET=corET,ncycles=ncycles,thenextdose=thenextdose,
entry_time=entry_time)
)
}
return(out_data)
}
## translate the all cycles true P(DLT) into a matrix with the 1st row for cycle 1
cyc_func_tox_v2<-function(cyc_all_vec,cyc1_prop){
cyc1_vec<-cyc_all_vec*cyc1_prop #cycle 1
out_mat<-matrix(c(cyc1_vec,cyc_all_vec),nrow=2,byrow=2)
return(out_mat)
}
##translate efficacy vector into matrix - cycle per row
cyc_func_eff_v2<-function(cyc_all_vec,split_vec){
if(sum(split_vec)!=1){
stop("Split of Efficacy probabilities does not sum to 1")
}
out_mat<-matrix(nrow=length(split_vec),ncol=length(cyc_all_vec))
for(i in 1:length(cyc_all_vec)){
out_mat[,i]<-split_vec*cyc_all_vec[i]
}
return(out_mat)
}