setwd("home directory")
library(bcrm)
library(zoo)


set.seed(2018)
ttox1<-list(c(0.1,0.2,0.3,0.4,0.5),c(0.1,0.2,0.25,0.3,0.4),c(0.1,0.15,0.2,0.25,0.3),
            c(0.05,0.1,0.12,0.15,0.2),c(0.05, 0.15, 0.3, 0.5,0.7))
# true toxicity / DLT rates for simulations 

dose<-1:5 # 5 dose levels
ptox<-c(0.1,0.15,0.2,0.25,0.3) # prior estimate of toxicity
target.tox<-0.3 # target toxicity or TTL


alltabs<-list()
nsims<-10 # no of simulations '
for(dltno in 1:4) {  #loop over DLT timing scenarios
  print("DLTNO")
  print(dltno)
  
tab<-matrix(nc=8)

for(sim in 1:5) {
  ttox<-ttox1[[sim]] # select "true" toxicity probs from  alternatives 
  datas<-list()
  alltimes<-list()

  mtds0<-c()
  mtds1<-c()
  npats<-c()
  npats1<-c()
  npats2<-c()
  ntox<-rep(0,5)
  ndose<-rep(0,5)
  atimes1<-list()
  dlttimes1<-list()
 miss<-numeric(nsims)
studylength<-numeric(nsims)


  cd4_lt_14<-numeric(nsims)
  
  
  
  ########################
  for(i in 1:nsims) {
    print(dltno)
    print(sim)
     print(i)
    
    cd4_lt_14[i]<-0
    crmbreak<-0
    term<-0
    
    (times<-rexp(1000,1)) # inter arrival times of 24 patients as exponential (weeks) , 1 a week
      # can be changed to faster
    
    
    atimes<-cumsum(times) # actual arrival times from start 
   
    if(dltno==1) {
      dlt_start<-1
      dlt_end<-3
      dlttimes<-runif(24,dlt_start,dlt_end) # allow general window for DLTs
    }
    if(dltno==2) {
      dlt_start<-1.5
      dlt_end<-4
      dlttimes<-runif(24,dlt_start,dlt_end) 
    }
    if(dltno==3) {
      components <- sample(1:2,prob=c(0.25,0.75),size=24,replace=TRUE)
      mus <- c(1.5,3.5)
      sds <- sqrt(c(.5,.5))
      dlttimes <- rnorm(n=24,mean=mus[components],sd=sds[components])
      dlttimes <- pmax(dlttimes,0)
      dlttimes <- pmin(dlttimes,3.99)
    }
    if(dltno==4) {
      components <- sample(1:2,prob=c(0.7,0.3),size=24,replace=TRUE)
      mus <- c(1.5,3.5)
      sds <- sqrt(c(.5,.5))
      dlttimes <- rnorm(n=24,mean=mus[components],sd=sds[components])
      dlttimes <- pmax(dlttimes,0)
      dlttimes <- pmin(dlttimes,3.99)
    }
    
    ##############################################################
 

    
     atimes2<-atimes
     atimes0<-atimes
     
     ii<-3
     while(ii < 25) {
       while( (atimes2[ii]-atimes2[ii-2])<1.9999999) {
         if( (atimes2[ii-2]+2-atimes2[ii])<1 ) atimes2[ii:100]<-pmax(atimes2[ii:100],atimes2[ii-2]+2)
         else atimes2<-atimes2[-ii]
       }
       ii<-ii+1
     }
     atimes<-atimes2[1:24]
   
    #(only used for those patients who have a DLT)
    dlttimes2<-dlttimes+atimes # actual DLT times from start of study
    dlttimes2
    
    atimes1[[i]]<-atimes ; dlttimes1[[i]]<-dlttimes2 #store sim i
 
    nmtd<-0 ############
    data<-data.frame(patient=1:24,dose=NA,tox=NA) ##########skeleton for bcrm package 
    data$dose[1]<-2 
    data$tox[1]<-rbinom(1,1,ttox[data$dose[1]]) # DLT status based on ttox (position data$dose[1]]==2)
    pt<-1 # 1 patient so far
    data0<-data[!is.na(data$dose),] 
    dltoccur<-((max(data$tox[1:pt])==1)&(min(dlttimes2[data$tox[1:pt]==1]) < atimes[pt+1])) # has a DLT occured before the next patients arrival time

   # pt ; data[1:10,] ; max(data$tox[1:pt])
    #START STAGE 1 
    while(pt<24) {
      #print(data)
      #if((i==9)&(pt>5)) browser()
      if((max(data$tox[1:pt])==1)&(min(dlttimes2[data$tox[1:pt]==1]) < atimes[pt+1])) crmbreak<-1
      # tests if  a DLT occured before the next patients arrival time and then sets crmbreak to switch to stage 2 for next dose calc
      # ie tests if min of the DLT times of those patients with DLTS ie min(dlttimes2[data$tox[1:pt]==1]) is less than
      # next patients arrival time ie  atimes[pt+1] 
      if(crmbreak==1)  break # breaks out of stage 1 loop if a DLT has occured
      cdose<-data$dose[pt] # current dose (of "last" patient 'pt'
      nmtd<-sum(data$dose[1:pt]==cdose) # number on current dose 
      
      if((nmtd==6)&(cdose==5)) term==1
      if(term==1) break # breaks out of stage 1 loop if we have 6 patients on top dose
      
      # calculates dose for next patient : BVN <= changed from < due to 3 pts in 2 weeks restriction 22APR2017
      if(min((atimes[1:pt])[data$dose[1:pt]==cdose])<=(atimes[pt+1]-2)) data$dose[pt+1]=min(5,cdose+1)
      # above says if the min (earliest) arrival time of patients on cdose is 
      # more than 2 weeks before the current patients arival time ie <(atimes[pt+1]-2
      # then increase cdose unless cdose=5 (max dose) min(5,cdose+1)

      if(min((atimes[1:pt])[data$dose[1:pt]==cdose])>(atimes[pt+1]-2)) data$dose[pt+1]=cdose
      # but if we don[t have 2 weeks FU on some patients then the next patients gets the current dose cdose
      # and this should trigger the PS4 clause
      #if(min((atimes[1:pt])[data$dose[1:pt]==cdose])>(atimes[pt+1]-2)) cd4_lt_14[i]<-pt
      
      
      if ( ( length(atimes[pt+1]-atimes[1:pt][data$dose[1:pt]==cdose]) >2 )&
           ( max(atimes[pt+1]-atimes[1:pt][data$dose[1:pt]==cdose]) <2 )) cd4_lt_14[i]<-pt
      
      min((atimes[1:pt])[data$dose[1:pt]==cdose])
      atimes[1:pt][data$dose[1:pt]==cdose] #  times on current dose
      atimes[pt+1]
      atimes[pt+1]-atimes[1:pt][data$dose[1:pt]==cdose]
      #BVN - PS4: a fourth patient should not be recruited if we already have three patients on the current 
      #dose for less than 14 days (we expect to have -most-  DLTs within 14 days). 
      #The fourth patient will not be recruited to a higher or a lower dose. 
      #The same approach should be adopted for PS1 and it is more relevant for Stage 1. 
      
      # wrong code if( (min((atimes[1:pt])[data$dose[1:pt]==cdose])) & (sum(data$dose[1:pt]==cdose)>3) ) cd4_lt_14[i]<-pt
      if(pt<3) data$dose[pt+1]=cdose
      # make first 3 D2 unless DLT, 
      # this overrides the 2 lines above for the first 3 patients (unless a DLT has occured 
      # in which case we'd  have already gone to stage 2 due to crmbreak
      
      data$tox[pt+1]<-rbinom(1,1,ttox[data$dose[pt+1]])
      #now we have a dose for patients 'pt+1' we can generate their toxicity status
      #if a patient has a DLT it won't necessarily mean we switch to stage 2 before the next patient
      #as we need to examine the DLT time dlttimes2 to see if the DLT occurs before the next patient arrival time (in atimes)
      data
      (pt<-pt+1)
    }
    #END STAGE 1
    
    
    # we are now out of stage 1 either due to a DLT (if crmbreak=1) or 6 patients on D5 (if term=1) or 24 patients recruited (if pt=25)
    
    
    mtds0[i]<-cdose
    if(term) b1<-bcrm(stop=list(nmax=pt),dose=dose,data=data[1:pt,],cohort=1,
                      p.tox0=ptox,ff="power",prior.alpha=list(3,0,1.34^2),target.tox=target.tox,constrain=TRUE,pointest="plugin",simulate=F)
    if(term) mtds1[i]<-as.numeric(b1[[5]][[1]][1])
    # if 6 patients on highest dose do a CRM 
    
    if(pt==25)pt0<-24
    if(pt==25) b1<-bcrm(stop=list(nmax=pt0),dose=dose,data=data[1:pt0,],cohort=1,
                        p.tox0=ptox,ff="power",prior.alpha=list(3,0,1.34^2),target.tox=target.tox,constrain=TRUE,pointest="plugin",simulate=F)
    if(term  | (pt==25)) mtds1[i]<-as.numeric(b1[[5]][[1]][1])
    # if 6 patients or 24 patients on highest dose do a CRM 
    
    np<-npats1[i]<-pt # change patient counter to np, no real reason to do this 
  
    #START STAGE 2
    if(term==0) {
      while(np<24) {
        cdose<-data$dose[np]
        nmtd<-sum(data$dose[1:np]==cdose)
        if(nmtd==6) break # if total patients on current dose is 6 then break
      
        #obtain data set for CRM
        dltoccured<-data$tox[1:np]==1 & (dlttimes2[1:np]<atimes[np+1])
        data1<-data[1:np,]
        data1<-data1[dltoccured,] #DLT data for these patients
        data1<-rbind(data1,data[1:np,][!dltoccured & (atimes[1:np]<(atimes[np+1]-3)),]) #no DLT  patients with >3 weeks FU

        data1$patient<-1:(nrow(data1))
        
        #run CRM
        b0<-bcrm(stop=list(nmax=nrow(data1)),dose=dose,data=data1,cohort=1,
                 p.tox0=ptox,ff="power",prior.alpha=list(3,0,1.34^2),
                 target.tox=target.tox,constrain=TRUE,pointest="plugin",simulate=F)
        # assign next dose to patient np+1
        
        if ( ( length(atimes[np+1]-atimes[1:np][data$dose[1:np]==cdose]) >2 )&
             ( max(atimes[np+1]-atimes[1:np][data$dose[1:np]==cdose]) <2 )) cd4_lt_14[i]<-np
        
        (data$dose[np+1]<-cdose<-as.numeric(b0[[5]][[1]][1]))
        (data$tox[np+1]<-rbinom(1,1,ttox[data$dose[np+1]]))
        
        data0<-data[!is.na(data$dose),] 
        data0<-data[1:np,] 
        (dltoccur<-as.numeric(((data$tox[1:np])==1)&((dlttimes2[1:np]) < atimes[np+1])))
        data0<-data.frame(data0,DLT=dltoccur,finish= as.numeric((atimes[np+1]-atimes[1:np])>4),time=atimes[np+1]-atimes[1:np])
        #######
        np<-np+1
        
      }
    }#end stage 2
    
    #finished sim - store results 

    datas[[i]]<-data<-data[1:np,]
    alltimes[[i]]<-atimes
    ptox
    target.tox 
    dose
    data

    b0<-bcrm(stop=list(nmax=nrow(data)),dose=dose,data=data,cohort=1,
             p.tox0=ptox,ff="power",prior.alpha=list(3,0,1.34^2),
             target.tox=target.tox,constrain=TRUE,pointest="plugin",simulate=F)
    b0
    
    mtds1[i]<-as.numeric(b0[[5]][[1]][1])
    pt<-np
    studylength[i]<-atimes[pt]
miss[i]<-sum(atimes0<(0.0000001+atimes[pt]))-pt
  
    datas[[i]]
    ##final crm with all data and store mtdmiss
    ndose[as.numeric(names(table(datas[[i]][,2])))]<-ndose[as.numeric(names(table(datas[[i]][,2])))]+ table(datas[[i]][,2])
     #store doses
    if(sum(datas[[i]][,3])>0) ntox[as.numeric(names(table(datas[[i]][,2],datas[[i]][,3])[,2]))]<-ntox[as.numeric(names(table(datas[[i]][,2],datas[[i]][,3])[,2]))]+ table(datas[[i]][,2],datas[[i]][,3])[,2]
    #store DLTs
    npats2[i]<-np #store number of patients
   }#end sims
  
  cd4_lt_14

  names(ntox)<-names(ndose)<-1:5
  
  sum(npats2)
  sum(npats2)/nsims
  
  sum(ntox)
  sum(ntox)/nsims
  
  table(mtds1)
  table(mtds1)/sum(table(mtds1))
  
  ndose
  ndose/sum(ndose)
  

tab<-rbind(tab,
           cbind(ttox,ptox,
                 c(sum(npats2),sum(npats2)/nsims,sum(ntox),sum(ntox)/nsims,NA),
                 c(min(studylength),mean(studylength),max(studylength),mean(miss),max(miss)),
                 table(mtds1),table(mtds1)/sum(table(mtds1)),ndose,ndose/sum(ndose)) 
           )
print(tab)
}

print("dltno")
print(dltno)
alltabs[[dltno]]<-tab

}
alltabs

# A File is produce for each DLT timing scenario
#output is
#Col 1 an Col 2 true toxicity and prior
#Col 3 is total and average number of patients, total and average DLTs
#Col 4 is the minimum, mean and maximum of study length and the mean and maximum of patients declined from study 
#Col 5 is number of MTD estimates at each dose over all simulations
#Col 6 is propn of MTD estimates at each dose over all simulations
#Col 7 is number of patients treated at each dose over all simulations
#Col 8 is proportion of patients treated at each dose over all simulations
for(i in 1:4)
  colnames(alltabs[[i]])<-c("truetox","prior","patients/DLTs","Length/missing","MTDestimate","MTDestimate%","NumDose","NumDose%")
alltabs
write.csv(alltabs[[1]],file="starpac1000_2019V1DLT1.csv")
write.csv(alltabs[[2]],file="starpac1000_2019V1DLT2.csv")
write.csv(alltabs[[3]],file="starpac1000_2019V1DLT3.csv")
write.csv(alltabs[[4]],file="starpac1000_2019V1DLT4.csv")
####
save.image("~/starpac1000_2019V1.RData")