Models:
Joseph Gordon
joseph-gordon/
eventPrediction
0
Downloads: 1
[f2e496]: / tests / testthat / test-fromDataSim.R

Download this file

198 lines (142 with data), 7.1 kB 

  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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
context("fromDataSim")



test_that("validateArgs",{

  data(event.data)

  my.data <- EventData(data=event.data,

                       subject="subject",

                       rand.date="randDate",

                       has.event="hasEvent",

                       withdrawn="withdrawn",

                       time="time",

                       site="site")

  

  my.fit <- fit(my.data)

  

  expect_error(simulate(my.fit,Nsim=-6))

  expect_error(simulate(my.fit,Nsim=0))

  expect_error(simulate(my.fit,Nsim="sd"))

  expect_error(expect_warning(simulate(my.fit,Nsim=10,seed="we")))

  expect_error(simulate(my.fit,Nsim=10,limit=0.51))

  expect_error(simulate(my.fit,Nsim=10,limit=-0.1))

  expect_error(simulate(my.fit,Nsim=10,limit=c(0.1,0.4)))



  expect_error(simulate(my.fit,Nsim=10,data=my.data@subject.data))

  expect_error(simulate(my.fit,Nsim=10,fix.rate=0.5))

  expect_error(simulate(my.fit,Nsim=10,fix.shape=1.0))

  expect_error(simulate(my.fit,Nsim=10,fix.rate=0.5,fix.shape=-1))

  expect_error(simulate(my.fit,Nsim=10,fix.rate=-0.5,fix.shape=1))

  expect_error(simulate(my.fit,Nsim=10,fix.rate=c(0.5,1.5),fix.shape=1))

  expect_error(simulate(my.fit,Nsim=10,fix.rate=0.5,fix.shape="gt"))

  expect_error(simulate(my.fit,Nsim=10,fix.rate=0.5,fix.shape=c(1,1.01)))

  expect_error(simulate(my.fit,Nsim=10,Naccrual=3))

  

  ag <- Generate.PoissonAccrual(start.date="2014-10-10",rate=1)

  expect_warning(simulate(my.fit,Nsim=10,accrualGenerator=ag))

  expect_warning(simulate(my.fit,Nsim=10,accrualGenerator=ag,Naccrual=0))

  expect_error(simulate(my.fit,Nsim=10,accrualGenerator="e",Naccrual=10))

  expect_error(simulate(my.fit,Nsim=10,accrualGenerator=ag,Naccrual=-4))

  expect_error(simulate(my.fit,Nsim=10,accrualGenerator=ag,Naccrual=c(1,4,5)))

  

  expect_error(simulate(my.fit,Nsim=10,longlagsettings="err"))

  expect_error(simulate(my.fit,Nsim=10,longlagsettings=ag))

  

  expect_error(simulate(my.fit,Nsim=10,HR=4,r=1))

  d <- my.data

  d@subject.data$time <- 0

  d@subject.data$withdrawn <- 0

  d@subject.data$has.event <- 0

  

  expect_error(simulate(my.fit,Nsim=10,data,d,r=1))

  expect_error(simulate(my.fit,Nsim=10,data,d,HR=1))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=1,HR=c(1,2,3)))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=1,HR="er"))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=1,HR=0))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=1,HR=-1))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=0,HR=1))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=-1,HR=1.2))

  expect_error(simulate(my.fit,Nsim=10,data,d,r=c("df",TRUE),HR=1))

  

  

})





test_that("CalculateAccrualTimes",{

  

  myf <- function(N){

    return(rep(as.Date(c("2016-01-01","2016-02-02")) ,N/2))

  }

  

  ac <- new("AccrualGenerator",f=myf,text="t",model="t")

 

  

  rand.dates <- as.Date(c(1:10,25:50,51:100,11:24),origin="2015-01-01")

  

  ans <- CalculateAccrualTimes(0,10,rand.dates,NULL)

  

  expect_equal("matrix",class(ans))

  expect_equal(10,nrow(ans))

  expect_equal(100,ncol(ans))

  

  expect_equal(ans[1,],ans[2,])

  expect_equal(ans[3,],ans[2,])

  expect_equal(16436+c(1:10,25:50,51:100,11:24),ans[2,])

  

  ans <- CalculateAccrualTimes(2,10,rand.dates,ac)

  expect_equal("matrix",class(ans))

  expect_equal(102,ncol(ans))

  expect_equal(10,nrow(ans))



  expect_equal(rep(16801,10),ans[,101])

  expect_equal(rep(16833,10),ans[,102])

  

  expect_equal(16436+c(1:10,25:50,51:100,11:24,365,397),ans[2,])

})



test_that("deterministic_bits",{

  

  set.seed(10)

  

  data(event.data)

  e <- event.data[event.data$hasEvent==1,]

  e <- rbind(e,event.data[700,])

  

  e$randDate[700] <- "2016-01-01"

  

  

  my.data <- EventData(data=e,

                       subject="subject",

                       rand.date="randDate",

                       has.event="hasEvent",

                       withdrawn="withdrawn",

                       time="time",

                       site="site") 

  

  my.fit <- fit(my.data)

    

  results <- simulate(my.fit,Nsim=50,limit=0.25)

  expect_equal(700,length(results@eventQuantiles@median))

  expect_equal(700,length(results@eventQuantiles@upper))

  expect_equal(700,length(results@eventQuantiles@lower))

  expect_equal(700,length(results@recQuantiles@median))

  expect_equal(700,length(results@recQuantiles@upper))

  expect_equal(700,length(results@recQuantiles@lower))

  expect_equal(my.data,results@event.data)

  

  expect_equal(0.25,results@limit)

  expect_equal(0,results@Naccrual)

  

  expect_equal(sort(my.data@subject.data$rand.date),results@recQuantiles@median)

  expect_equal(sort(my.data@subject.data$rand.date),results@recQuantiles@upper)

  expect_equal(sort(my.data@subject.data$rand.date),results@recQuantiles@lower)

  expect_equal(sort(as.Date(e$eventDate[1:699])),results@eventQuantiles@median[1:699])

  expect_equal(sort(as.Date(e$eventDate[1:699])),results@eventQuantiles@lower[1:699])

  expect_equal(sort(as.Date(e$eventDate[1:699])),results@eventQuantiles@upper[1:699])

  

  expect_true(e$time[700] < results@eventQuantiles@median[700])

  

  my.accrual <- Generate.PoissonAccrual(start.date="2015-11-29",rate=1)

  

  expect_warning(results <- simulate(my.fit,Nsim=50,limit=0.25,

                      accrualGenerator=my.accrual,Naccrual=99))

  

  expect_equal(799, length(results@eventQuantiles@median))

  expect_equal(799, length(results@eventQuantiles@lower))

  expect_equal(799, length(results@eventQuantiles@upper))

  

  expect_equal(799,length(results@recQuantiles@median))



  expect_equal(results@eventQuantiles@median,sort(results@eventQuantiles@median))

  expect_equal(results@recQuantiles@median,sort(results@recQuantiles@median))

  expect_true(all(results@eventQuantiles@median <= results@eventQuantiles@upper))

  expect_true(all(results@eventQuantiles@median >= results@eventQuantiles@lower))

})







test_that("GetHRs",{

  

  x <- GetHRs(HR=1,r=1,N=100)

  expect_equal(x,rep(1,100))

  

  set.seed(10)

  x <- GetHRs(HR=0.5,r=3,N=200)

  expect_equal(sort(x),c(rep(0.5,150),rep(1,50)))

  

  set.seed(11)

  y <- GetHRs(HR=0.5,r=3,N=200)

  

  expect_equal(sort(x),sort(y))

  expect_false(all(x==y))

  

  x <- GetHRs(HR=0.5,r=1/3,N=200)

  expect_equal(sort(x),c(rep(0.5,50),rep(1,150)))

})  





test_that("followup",{

  data(event.data)

  my.data <- EventData(data=event.data,

              subject="subject", rand.date="randDate",

              has.event="hasEvent", withdrawn="withdrawn",

              time="time", site="site")

  

  expect_true(is.infinite(my.data@followup))

  

  data.with.follow.up <- EventData(data=event.data,

                      subject="subject", rand.date="randDate",

                      has.event="hasEvent", withdrawn="withdrawn",

                      time="time", site="site",followup=1500)

  

  expect_equal(1500,data.with.follow.up@followup)

  

  my.fit <- fit(my.data)

  expect_warning(simulate(my.fit,Nsim=20,data=data.with.follow.up))

  

  

})