tests/testthat/test-singleSimDetails.R

In scientific-computing-solutions/eventPrediction: Event Prediction in Clinical Trials with Time-to-Event Outcomes

context("singlesimdetails")

test_that("simplecase",{
  data(event.data)
   
  data <- EventData(data=event.data,
                                   subject="subject", rand.date="randDate",
                                   has.event="hasEvent", withdrawn="withdrawn",
                                   time="time", site="site")
  
  my.fit <- fit(data)  

  res <- simulate(my.fit,Nsim=500,seed=123)
  ssD <- res@singleSimDetails

  #Corret dimensions
  expect_equal(500,ncol(ssD@event.type))
  expect_equal(979,nrow(ssD@event.times))
  
  #No dropouts or withdrawn
  expect_true(all(ssD@event.type==0))  
  
  #First 699 rows are subjects who had events
  expect_equal(1,length(unique(ssD@event.times[1,])))
  expect_equal(1,length(unique(ssD@event.times[698,])))
  expect_equal(1,length(unique(ssD@event.times[699,])))
  
  expect_equal(ssD@event.times[1:699,1],as.numeric(LastDate(data@subject.data)[1:699],origin="1970-01-01") )
  
  #All simulated event times are after Last Date for other subjects
  expect_true(all(ssD@event.times[700:979,1] >= as.numeric(LastDate(data@subject.data)[700:979],origin="1970-01-01") ))
  expect_true(all(ssD@event.times[700:979,41] >= as.numeric(LastDate(data@subject.data)[700:979],origin="1970-01-01") ))
  expect_true(all(ssD@event.times[700:979,401] >= as.numeric(LastDate(data@subject.data)[700:979],origin="1970-01-01") ))
  expect_true(all(ssD@event.times[700:979,500] >= as.numeric(LastDate(data@subject.data)[700:979],origin="1970-01-01") ))
  
})

test_that("subject_withdrawn_and_accrual",{
  
  data(event.data)
  e <- event.data
  e$hasEvent[1:4] <- 0
  e$withdrawn[1:4] <- 1
  
  data <- EventData(data=e,
                    subject="subject", rand.date="randDate",
                    has.event="hasEvent", withdrawn="withdrawn",
                    time="time", site="site")
  
  my.fit <- fit(data)  
  
  Naccrual <- 21
  my.accrual <- Generate.PoissonAccrual("2015-11-29",rate=1)
    
  res <- simulate(my.fit,Nsim=500,seed=123,Naccrual=Naccrual,accrualGenerator=my.accrual)
  ssD <- res@singleSimDetails
  
  
  #Corret dimensions
  expect_equal(500,ncol(ssD@event.type))
  expect_equal(1000,nrow(ssD@event.times))
  
  #correct withdrawn
  expect_true(all(ssD@event.type[5:1000,]==0))  
  expect_true(all(ssD@event.type[1:4,]==1))  
  
  
})

test_that("fixed_follow_up",{
  data(event.data)
  e <- event.data
      
  expect_warning(data <- EventData(data=e,
                    subject="subject", rand.date="randDate",
                    has.event="hasEvent", withdrawn="withdrawn",
                    time="time", site="site",followup=50))
  
  my.fit <- fit(data)  
  
  res <- simulate(my.fit,Nsim=500,seed=123)
  ssD <- res@singleSimDetails
  
  timematrix <- matrix(rep(as.numeric(data@subject.data$rand.date,origin="1970-01-01"),500),ncol=500)
  timematrix <- ssD@event.times - timematrix + 1
  
  expect_true(all(ssD@event.type[700:979,]==2 | timematrix[700:979,]<=50    ))
  expect_true(all(ssD@event.type[700:979,]==0 | timematrix[700:979,]==50    ))
  
})

test_that("dropout",{
  
  my.data <- EmptyEventData()
  
  Naccrual <- 1000
  
 
  f <- function(N){
    return(rep(as.Date("2015-01-01"),N))
  }
  
  my.a <- new("AccrualGenerator",f=f,model="temp",text="temp")
  
  #small enough rate so no events with this seed
  res <- simulate(data=my.data,Nsim=500,seed=123,Naccrual=Naccrual,accrualGenerator=my.a,
                  SimParams=FromDataParam(type="weibull",rate=0.00000002,shape=1),
                  dropout=list(proportion=0.5,time=10))
  ssD <- res@singleSimDetails
  
  expect_true(all(ssD@event.type==1))
    
})


test_that("calculate.at.risk",{
  
  rec.times <- matrix(c(rep(16436,4),rep(16500,4),17000,17025,17050,17025),nrow=3,byrow=TRUE)
  event.times <- matrix(c(rep(16750,4),17000,16750,16750,17250,18000,17400,17600,17125),nrow=3,byrow=TRUE)
  event.type <- matrix(c(rep(0,4),1,2,0,0,1,2,0,0),nrow=3,byrow=TRUE)
  ssD <- SingleSimDetails(event.type,event.times,rec.times)
  
  retVal <- CalculateDaysAtRisk(ssD,c(16000,16436,16437,16500,16750,16751,17020,17030,18000,20000))
  answer <- c(0,1,2,66,566,566.5,701,709.5,1142,1142)
  
  expect_equal(retVal,answer)
  
})