Switch to side-by-side view

--- a
+++ b/tests/testthat/test-singleSimDetails.R
@@ -0,0 +1,128 @@
+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)
+  
+})