API tools faq
paste
Spartrap

Simulation of timeline of death events in ONTX's INSPIRE CT

Spartrap
Mar 21st, 2019 (edited)
435
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
R 19.02 KB | None | 0 0
raw download clone embed print report
  1. # An R script to predict the timeline of death events in the INSPIRE PIII
  2. # trial run by Onconova Therapeutics (ONTX)
  3. # (c) 2019 Germain Garand <germain.garand@laposte.net>
  4. #
  5. # This is for information purposes only. Any calculation performed herein could be
  6. # wrong and/or misrepresent reality. Use at your own risk.
  7. #
  8. # License: Creative Commons BY-NC 2.0
  9. #
  10. # Version 1.08
  11. #
  12. # History:
  13. #   0.01 - 2019/03/20- .initial version
  14. #   0.02 - 2019/03/21- .added active clinical sites data
  15. #   0.03 - 2019/03/21- .added overlay of ad-hoc pts per month data
  16. #   0.05 - 2019/03/22- .some code factoring, commenting, adding some info on CT Sites graph
  17. #   0.06 - 2019/03/22- .redirected output to PNG images ; slightly reworked enrollment model to better fit the curve
  18. #   0.08 - 2019/03/22- .output 'Population' numbers alongside 'Events' numbers.
  19. #                      .Introduced an alternative "worst case" enrollment population (see comment in code)
  20. #   0.09 - 2019/03/23- .add a final date in the future in Active Trial Sites data,
  21. #                       so that the graphs are plotted up to that date.
  22. #   0.1  - 2019/03/24- .add graph of events and population over time.
  23. #                      .Use 'floor' instead of 'ceiling' aka a patient that is "half-dead" is still alive
  24. #                      .Store full accrual of a month into the first day of the following month. Easier to graph.
  25. #   0.14 -           - .adjust enrollment model accounting for a mid 2017 slowdown based on
  26. #                       Dr.Kumar's comment in Q3 2017 CC
  27. #                      .add explaining comment on graph
  28. #   0.15 -           - .also massage pessimistic enrollment model (see v.14 log)
  29. #                      .add other milestone from Q3 17 cc (full original accrual of 225 by mid 2018)
  30. #   0.17 - 2019/03/25- .updated enrollment model to match new datapoint: 75%+ of patients
  31. #                       enrolled as of today.
  32. #   0.18 - 2019/03/27- .added "FY2018 ER" milestone on accrual graph
  33. #   0.19 -           - .extend scale of possible time length, define new pessimistic scenario (see comment in code)
  34. #   0.2  - 2019/05/15- .add insight from Q1 2019 ER about active clinical sites (not reflected by clinicaltrials.gov)
  35. #                       "more than 140" active sites. 19 new sites recently added. 25 more anticipated.
  36. #   0.3  - 2019/07/01- .add VHR km curves. Plot them on ITT km graph in gray.
  37. #                      .compute and graph VHR Events and Population
  38. #   0.31 - 2019/07/03- .introduce an intermediate enrollment scenario based on the mean of 8 pts/month observed from Jan 2018 to March 2019
  39. #                       (uncomment relevant line to use)
  40. #   0.35 - 2019/08/13- .make switching between enrollment models easier and display that choice in the graphical and textual output
  41. #
  42. #   1.05 - 2019/08/16- .change the KM survival curves to use the unmodified ITT simulated curves from the Corporate Presentation.
  43. #                       chances are most of the +20% VHR we are seing in INSPIRE come from the more stringent criteria and are thus
  44. #                       already reflected in the original ITT simulation.
  45. #                      .change optimistic scenario to reflect advancement in time that makes previous scenario now unlikely.
  46. #   1.07 - 2019/08/16- .invariants were broken by KM curve change. Fix that by adjusting the enrollment curves
  47. #
  48.  
  49. # Accrual of Active Trial Sites
  50. # built from clinicaltrial.org's history of 'Locations' changes for NCT02562443
  51. trial_sites_data <- "Date    Num
  52. 2015/09/25    1
  53. 2015/11/04    2
  54. 2015/11/17    4
  55. 2016/02/01    5
  56. 2016/02/29    6
  57. 2016/03/04    8
  58. 2016/03/10    12
  59. 2016/03/24    13
  60. 2016/03/30    14
  61. 2016/04/02    20
  62. 2016/04/07    24
  63. 2016/04/13    30
  64. 2016/04/18    32
  65. 2016/04/20    33
  66. 2016/04/23    34
  67. 2016/04/29    37
  68. 2016/05/02    39
  69. 2016/05/04    41
  70. 2016/05/18    45
  71. 2016/05/19    50
  72. 2016/05/24    53
  73. 2016/05/26    55
  74. 2016/06/06    59
  75. 2016/06/13    60
  76. 2016/06/17    62
  77. 2016/06/28    63
  78. 2016/06/29    64
  79. 2016/07/01    65
  80. 2016/07/07    66
  81. 2016/07/19    95
  82. 2016/07/27    98
  83. 2016/07/28    100
  84. 2016/07/29    101
  85. 2016/08/04    104
  86. 2016/08/27    105
  87. 2016/08/30    107
  88. 2016/09/09    108
  89. 2016/09/14    110
  90. 2016/09/21    113
  91. 2016/09/26    114
  92. 2016/10/04    115
  93. 2016/10/12    117
  94. 2016/10/13    120
  95. 2016/10/20    122
  96. 2016/10/26    124
  97. 2016/10/28    125
  98. 2016/11/14    126
  99. 2016/11/28    128
  100. 2016/12/06    129
  101. 2016/12/09    130
  102. 2016/12/19    132
  103. 2017/01/19    138
  104. 2017/01/23    139
  105. 2017/01/31    140
  106. 2017/02/16    142
  107. 2017/02/23    144
  108. 2017/02/28    146
  109. 2017/03/02    148
  110. 2017/03/14    150
  111. 2017/03/17    151
  112. 2017/03/20    152
  113. 2017/03/28    156
  114. 2017/04/12    157
  115. 2017/04/21    159
  116. 2017/04/25    160
  117. 2017/05/09    162
  118. 2017/05/18    163
  119. 2017/05/22    164
  120. 2017/06/13    165
  121. 2017/07/03    166
  122. 2017/07/06    167
  123. 2017/07/11    168
  124. 2017/07/13    169
  125. 2017/07/15    170
  126. 2017/08/29    169
  127. 2017/09/11    170
  128. 2017/10/02    171
  129. 2017/10/09    172
  130. 2017/10/16    173
  131. 2017/10/25    171
  132. 2017/10/31    170
  133. 2017/11/28    172
  134. 2017/12/01    173
  135. 2017/12/22    174
  136. 2018/01/02    176
  137. 2018/01/16    174
  138. 2018/02/01    173
  139. 2018/02/05    172
  140. 2018/02/28    173
  141. 2018/03/01    172
  142. 2018/03/15    171
  143. 2018/03/21    169
  144. 2018/03/26    168
  145. 2018/03/29    165
  146. 2018/04/03    164
  147. 2018/04/05    163
  148. 2018/04/09    162
  149. 2018/04/12    161
  150. 2018/04/20    160
  151. 2018/04/30    156
  152. 2018/05/10    155
  153. 2018/05/15    154
  154. 2018/06/07    153
  155. 2018/06/18    154
  156. 2018/06/19    153
  157. 2018/07/02    152
  158. 2018/07/03    151
  159. 2018/07/18    152
  160. 2018/07/26    153
  161. 2018/08/16    152
  162. 2018/10/16    153
  163. 2019/05/14    142
  164. 2019/08/14    142
  165. 2019/12/01    162
  166. "
  167.  
  168. Sys.setlocale("LC_TIME", "C")
  169.  
  170. # The simulation might look as far ahead as (elapsed) February 2021
  171. d <- seq(as.Date('2016-01-01'), as.Date('2021-03-01'), by='months')
  172.  
  173. ## Define our enrollment model, expressed in patients recruited per month, starting December 2015
  174. ## This is starting to look like a proper fit on the CT Sites' curve:
  175. ## pts <- c(1,1,1,1,1,2,3,4,5,5,6,7,7,8,8,9,9,9,10,10,11,11,12,12,13,  12,12,11,11,10,10,10,10,10,11,11,11,11,11,11,11,11,10, rep(0,7))
  176. #
  177. ## Adjust the curve accounting for a mid 2017 slowdown in enrollment based on Dr.Kumar's comment in Q3 2017 CC of Nov. 9, 2017:
  178. ## "Since we experienced a slowdown in enrollment mid-year, we undertook measures just for enrollment including the addition
  179. ##    of trial sites in three new countries and changes within the CRO group.
  180. ##    These efforts are now paying off. I'm pleased to report that these actions led to a recent increase in the enrollment rate for
  181. ##    this trial."
  182. ## pts <- c(1,1,1,1,1,2,3,4,5,5,6,7,7,8,8,9,9,8,8,10,11,11,12,12,13,  13,12,12,11,11,10,10,10,10,11,11,11,11,11,11,11,11,10, rep(0,7))
  183. #
  184. ## Let's define also a pessimistic enrollment scenario (recruitment somewhat waning after Interim for whatever reason)
  185. ## pts <- c(1,1,1,1,1,2,3,4,5,5,6,7,7,8,8,9,9,8,8,10,11,11,12,12,13,  13,12,11,10,10,9,9,8,8,9,9,10,9,9,9,8,9,8,9,9,9, rep(0,4))
  186. ##
  187.  
  188. model <- c('optimistic', 'realistic', 'pessimistic')
  189.  
  190. # 18/03/25: 75%+ pts enrolled, means the recruitment rate experienced a big drop after the number of sites peaked out
  191. optimistic <- c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,8,8,    8,8,7,8,7,6,7,7,7,7,8,8, 7,8,8,8,8,8,8,9, 10,12,14,3,  rep(0,14))
  192.  
  193. # Here is our updated pessimistic scenario
  194. #pessimistic <-  c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,8,7,    6,6,5,5,6,5,6,7,8,10,12,9, 7,6,5,5,6,5,6,6, 7,6,10,15,15,8,0, 0)
  195. pessimistic <-  c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,8,7,    6,6,5,6,6,7,6,8,7,7,6,7, 7,11,10,8,7,7,6,7, 7,7,8,8,8,8,6,0, rep(0,10))
  196. #pessimistic <-  c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,7,7,    2,2,2,3,3,2,2,3,2,3,9,12, 20,20,20,8,7,7,7,7, 7,7,10,14,14,0,0, 0)
  197.  
  198. #pessimistic <-  c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,8,6,    2,2,1,2,1,2,1,2,2,2,1,2, 2,3,75,30,5,3,2,3, 5,6,6,15,20,8,0, 0)
  199. #pessimistic <-  c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,8,6,    3,2,3,3,4,3,4,3,4,5,8,10, 8,6,4,4,4,5,4,5, 5,6,5,8,8,8,0, 0)
  200.  
  201. # An interesting middleground is just to stick to 8 pts/months starting from March 2019
  202. # 8 pts/month is indeed the observed accrual mean from interim analysis to announcement of 75% accrual back in March.
  203. realistic <-  c(1,1,2,2,2,3,3,4,6,7,7,8,8,9,9,9,8,11,12,12,10,10,9,8,8,    8,8,7,8,7,6,7,7,7,7,8,8, 8,8,7,8,7,8,7,8,7,8,8,8, 8,3,0,0, rep(0,10))
  204.  
  205.  
  206. # Select your model here (default: realistic):
  207. # -------------------------------------------
  208. #   1) optimistic - this is the official target of the company, with enrollment ending before EOY 2019
  209. #   2) realistic - assumes the enrollment will be complete in February 2020, consistent with the historical enrollment rate
  210. #   3) pessimistic - assumes the enrollment will be complete in April 2020
  211.  
  212. model_choice <- 3
  213.  
  214. # -------------------------------------------
  215.  
  216. model_name <- model[ model_choice ]
  217. pts <- get( model_name )
  218.  
  219. message('Enrollment model: ', model_name)
  220.  
  221. message("Total accrual: ", sum(pts))
  222. message("----")
  223.  
  224. # Store in reverse, most recent patients first as it is how the survival curve will be applied
  225. e <- data.frame(rev(d),rev(pts))
  226. names(e) <- c("Date","Patients")
  227.  
  228. # Plot the CT Sites data to a file..
  229. png("INSPIRE_Active_CT_Sites_With_Enrollment_Rate_Estimate.png")
  230. ct_sites <- read.table(text = trial_sites_data, header = TRUE)
  231. ct_sites$Date <- as.Date(ct_sites$Date, "%Y/%m/%d")
  232. plot(Num ~ Date, ct_sites, xaxt = "n", type = "l", col="green",main="Active INSPIRE Clinical Trial Sites",
  233.      sub=paste("Enrollment model: ", model_name), col.sub="red",ylab="Total Number Of Sites", xlab="" )
  234. title(xlab="Registration Date", cex.lab=1.2, mgp=c(2,0,0))
  235. axis(1, ct_sites$Date, format(ct_sites$Date, "%y/%m/%d"), cex.axis = .7)
  236. abline(h=(seq(0,170,10)), col="lightgray", lty="dotted")
  237. abline(v=c(as.Date("2018/01/19")), col="blue", lty="dotted")
  238. text(x=as.Date("2018/03/05"),y=80, labels="Interim Analysis", cex=.8, srt=90, col="blue")
  239. abline(v=c(as.Date("2019/03/25")), col="darkgrey", lty="dotted")
  240. text(x=as.Date("2019/04/17"),y=80, labels="FY2018 ER", cex=.8, srt=90, col="darkgrey")
  241. abline(v=c(as.Date("2019/05/14")), col="green", lty="dotted")
  242. text(x=as.Date("2019/06/15"),y=80, labels="Q1 2019 ER", cex=.8, srt=90, col="green")
  243.  
  244.  
  245. # Overlay our ad-hoc model of enrollment (patients per month) on the Active Trial Sites graph
  246. # you might notice I introduced a slight inflexion in recruitment numbers as the number of sites climbs.
  247. # This matches the observations of http://www.appliedclinicaltrialsonline.com/forecast-enrollment-rate-clinical-trials-0
  248. # i.e. the efficacy of recruitment diminishes when the number of sites raises
  249.  
  250. par(new=TRUE)
  251.  
  252. plot( Patients ~ Date, e, axes=FALSE, ann=FALSE, col='red', xlim= c(head(ct_sites$Date,1), tail(ct_sites$Date,1)) )
  253. axis(4, e$Patients, col='red')
  254. legend("bottomright", inset=.05, title="Legend:", c("Num. of Active CT sites","Num. of Patients per Month"), fill=c("green","red"), cex=.8)
  255. #abline(v=c(as.Date("2018/01/19")), col="red", lty="longdash")
  256. text(x=as.Date("2017/05/01"), y=5, labels="Rate drop (cf.Q3 2017 CC)⇨", cex=.8, srt=90, col="red")
  257. dev.off()
  258.  
  259. # We may look at a maximum of 60 months after first patient recruited
  260. x <- 1:60
  261.  
  262. # Define our K-M curves, a bit steeper than in simulated ITT of Page 6 of Corporate Pres of January
  263. # because there were only 50% VHR pts in that simulation. We have 70%+ in INSPIRE.
  264. #
  265. # Note the curves were first built on good old graph paper as a medium term between ITT and VHR curves of corporate documents,
  266. # then converted to math functions using Eureqa - not really needed, but extremely fun!
  267. #
  268. # rig <- ifelse(x<25, 61.13 + 1.072*x + 38.95*exp(-0.058*x^2) + 0.03657*x*exp(2*log(x)) - 0.7058*x^2 - 0.000548*x^4 , 2)
  269. # bsc <- ifelse(x<16, 142 + 1.559*x^2 + 0.02612*exp(0.2872*x) - 25.67*x - 0.03251*x^3 - 41.99*exp(-0.9706*x) - 13.65*x^3*exp(-0.9706*x) , 0)
  270.  
  271. # revert to using unmodified ITT curves. Thinking more about it, the 20% difference in VHR population is probably already selected
  272. # by the more stringent criteria used to build those curves from ONTIME data..
  273.  
  274. rig <-c(99,95,89,82,72,62,57,51,44,44,39,37,35,31,29,26,21,15,9,7,7,7,rep(5,10),rep(2,15),rep(0,22))
  275. bsc <-c(98,85,65,54,40,38,35,35,29,23,20,14,14,14,9,9,rep(0,54))
  276. #bsc <- rig
  277.  
  278. # End of Sept 2019: only 75% of events have occured. Ouch. We need to use softer curves ;-(
  279. # We'll go for Garcia Manero 2016's ONTIME curves for Primary HMA failure patients,
  280. # just steepened a tad to account for other factors (VHR++, age). HR is probably ~0.68
  281. #### Wait! TANG.. this is steeper than INSPIRE simul ITT! Something's wrong..  
  282. #rig <- c(93,87,79,72,66,59,57,51,47.5,41.5,35.5,32,28,23,18.5,17.5,13,11,10,8,6.2,rep(5,4),rep(4.5,4),rep(3,6),rep(2,10),rep(0,15))
  283. #bsc <- c(93,80,64,51,42,34.5,32,29,27,25,23,21.5,20,18.5,17,13,9.7,9,8.2,5.5,5,rep(3.5,3),3,2,2,rep(0,33))
  284.  
  285. vhr_rig <- c(100,90,76,65,60,53,47,40,31,26,20,16,12,10,8,7,5,4,3,3,3,3,3,3,2,2,2,2,2,2,2,2,2,rep(1,37))
  286. vhr_bsc <- c(96,73,37,25,16,11,6,3,1,rep(0,61))
  287.  
  288. # Plot them to visually check consistency
  289. png("INSPIRE_ITT_simulated_km_survival_curves.png")
  290. plot( head(x,24), head(rig,24), col='blue', type='l',axes=FALSE, ylim=c(0,100),
  291.       ylab="Overall Survival (%)", xlab="Months from Randomization", main="Simulation of INSPIRE's ITT K-M Curves")
  292. par(new=TRUE)
  293. plot( head(x,24), head(vhr_rig,24), col='grey', type='l', ann=FALSE, axes=FALSE, ylim=c(0,100))
  294. par(new=TRUE)
  295. plot( head(x,24), head(bsc,24), col='red', type='l', ann=FALSE, axes=FALSE, ylim=c(0,100))
  296. par(new=TRUE)
  297. plot( head(x,24), head(vhr_bsc,24), col='gray', type='l', ann=FALSE, axes=FALSE, ylim=c(0,100))
  298. axis(side = 1, at = seq(1,24,1))
  299. axis(side = 2, at = seq(0,100,10))
  300. box()
  301. abline(h=(seq(0,100,10)), col="lightgray", lty="dotted")
  302. abline(v=(seq(0,24,.5)), col="lightgray", lty="dotted")
  303. legend("topright", inset=.05, title="MOS: BSC ~4.1 mo/ RIG ~7.9 mo", c("BSC","RIG"), fill=c("red","blue"), horiz=TRUE)
  304. legend("right", inset=.05, col="lightgray", box.col='gray', c("VHR K-M Curves"), fill=c("gray"), horiz=TRUE)
  305.  
  306. dev.off()
  307.  
  308. # Main computation function
  309. getEventsFor <- function(date) {
  310.   p <- e$Patients[ match(date, e$Date) : length(e$Patients) ]
  311.   n <- length(p)
  312.   ev <- p * ( 0.66*(1-(rig[1:n]/100)) + 0.33*(1-(bsc[1:n]/100)) )
  313.   ev <- list(ev, p)
  314.   names(ev) <- c("Events", "Population")
  315.   return(ev)
  316. }
  317.  
  318. getVHREventsFor <- function(date) {
  319.   p <- e$Patients[ match(date, e$Date) : length(e$Patients) ]
  320.   p <- p * .7
  321.   n <- length(p)
  322.   ev <- p * ( 0.66*(1-(vhr_rig[1:n]/100)) + 0.33*(1-(vhr_bsc[1:n]/100)) )
  323.   ev <- list(ev, p)
  324.   names(ev) <- c("Events", "Population")
  325.   return(ev)
  326. }
  327.  
  328.  
  329. # Let's see if our simulation can compute a number of events
  330. # close to what was observed at Interim Review:
  331. #
  332. # If we knew when exactly the Interim target of 88 events was reached, we could tune the model with more accuracy.
  333. # If you have this information, please contact me.
  334. # We know the Interim Report was published on January 19th 2018.
  335. # My estimate is that the target was hit about a month before that date
  336. # (more precisely: around the 6th of December,as there was a significant update on the CT site that day)
  337. # If you have experience on CT Interim Reviews, please tell me if this timeline is adequate.
  338. message("Checkpoints:")
  339. message("------------")
  340. ev <- getEventsFor(as.Date("2018-01-01"))
  341. message("Estimated # of events by end of December 2017 (should be 94 +/-5%): ", floor(sum(ev$Events)))
  342.  
  343. p <- e$Patients[ match(as.Date("2018-02-01"), e$Date) : length(pts) ]
  344. message("Estimated # of patients recruited at Interim Review (should be 175 +/-5): ", sum(p))
  345.  
  346. p <- e$Patients[ match(as.Date("2019-04-01"), e$Date) : length(pts) ]
  347. message('On 19/03/25 accrual "ha[s] passed the 75% completion" (should have 277 +/-4): ', sum(p))
  348. p <- e$Patients[ match(as.Date("2019-11-01"), e$Date) : length(pts) ]
  349. message('On 19/10/24 accrual is "approaching 90 percent or 324" (should have 320 +/-4): ', sum(p))
  350. message("")
  351. message("Simulation:")
  352. message("-----------")
  353.  
  354. # Now estimate the number of death events up to 1st of March 2021:
  355. toPredict <- seq(as.Date("2018-03-01"), as.Date("2021-03-01"), by="months")
  356. accEvents <- c()
  357. accPopulation <- c()
  358. accVHREvents <- c()
  359. accVHRPopulation <- c()
  360. original_full_acc=TRUE
  361. for (date in as.list(toPredict)) {
  362.     ev <- getEventsFor(date)
  363.     vhr_ev <- getVHREventsFor(date)
  364.     accEvents <- c(accEvents, floor(sum(ev$Events)))
  365.     accPopulation <- c(accPopulation, sum(ev$Population))
  366.     if (original_full_acc && tail(accPopulation,1) > 225) {
  367.         message('[ full original accrual of INSPIRE (225 pts) reached ]') # should have happened "in first half of 2018" according to Q3 2017cc
  368.         original_full_acc=FALSE
  369.     }
  370.     accVHREvents <- c(accVHREvents, floor(sum(vhr_ev$Events)))
  371.     accVHRPopulation <- c(accVHRPopulation, floor(sum(vhr_ev$Population)))
  372.     message("Estimated number of events by 1st of ", format(date, "%B %Y"), ": ", tail(accEvents, 1), " (Population: ", tail(accPopulation, 1),')',
  373.             " [VHR events: ", tail(accVHREvents, 1), " VHR population: ", tail(accVHRPopulation, 1), ']')
  374. }
  375. results <- data.frame(toPredict, accEvents, accPopulation)
  376. names(results) <- c("Date", "Events", "Population")
  377.  
  378. # Let's graph this
  379. png("INSPIRE_ITT_simulated_events_and_population.png")
  380. plot( Events ~ Date, results, col='blue', type='l', ylim=c(0,360), xaxt="n",
  381.       ylab="", xlab="Date", main="Simulation of INSPIRE's Events and Population Over Time", sub=paste("Enrollment model: ", model_name), col.sub="red")
  382. par(new=TRUE)
  383. plot( Population ~ Date, results, ylim=c(0,360), col='salmon', type='h', ann=FALSE, axes=FALSE)
  384. axis(1, results$Date, format(results$Date, "%b %y"), cex.axis = .7, las=2,)
  385. abline(h=(seq(0,360,10)), col="lightgray", lty="dotted")
  386. abline(h=c(288), col="blue", lty="longdash")
  387. abline(h=c(360), col="salmon",lty="longdash")
  388. legend("bottomleft", inset=.05, c("Number of Events","Number of Patients"), fill=c("blue","salmon"))
  389. text(x=as.Date("2018/12/01"),y=280, labels="Target for topline analysis", cex=.8, col="blue")
  390. text(x=as.Date("2018/12/01"),y=350, labels="Full accrual", cex=.8, col="salmon")
  391. dev.off()
  392.  
  393. results <- data.frame(toPredict, accVHREvents, accVHRPopulation)
  394. names(results) <- c("Date", "Events", "Population")
  395.  
  396. png("INSPIRE_VHR_simulated_events_and_population.png")
  397. plot( Events ~ Date, results, col='blue', type='l', ylim=c(0,252), xaxt="n",
  398.       ylab="", xlab="Date", main="Simulation of INSPIRE's VHR Events and Population Over Time", sub=paste("Enrollment model: ", model_name), col.sub="red")
  399. par(new=TRUE)
  400. plot( Population ~ Date, results, ylim=c(0,252), col='salmon', type='h', ann=FALSE, axes=FALSE)
  401. axis(1, results$Date, format(results$Date, "%b %y"), cex.axis = .7, las=2,)
  402. abline(h=(seq(0,252,10)), col="lightgray", lty="dotted")
  403. abline(h=c(139), col="blue", lty="longdash")
  404. abline(h=c(252), col="salmon",lty="longdash")
  405. legend("bottomleft", inset=.05, c("Number of Events","Number of Patients"), fill=c("blue","salmon"))
  406. text(x=as.Date("2018/12/01"),y=130, labels="Target for VHR topline analysis", cex=.8, col="blue")
  407. text(x=as.Date("2018/12/01"),y=245, labels="Full VHR accrual (observed)", cex=.8, col="salmon")
  408. dev.off()
Add Comment
Please, Sign In to add comment
Public Pastes
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!