tests/testthat/test-fromDataDiagnostics.R

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

context("fromDataDiagnostics")

test_that("average_rec",{
  x <- as.numeric(as.Date("2014-01-01"))
  y <- as.numeric(as.Date("2014-01-02"))
  expect_equal(50, average.rec(100,x,y))
  expect_equal(100, average.rec(100,x,x))
  z <- 364+x
  expect_equal(0.6, average.rec(219,x,z))
})

test_that("LaggedSubjects",{
  data(event.data)

  e2 <- event.data
  e2$withdrawn[970] <- 1
  
  e <- EventData(data=e2,
                       subject="subject",
                       rand.date="randDate",
                       has.event="hasEvent",
                       withdrawn="withdrawn",
                       time="time",
                       site="site")
  
  f <- GetLaggedSubjects(e@subject.data,as.Date("2013-01-01"))
  expect_equal(0,nrow(f))
  
  f <- GetLaggedSubjects(e@subject.data,as.Date("2017-10-10"))
  expect_equal(subset(e@subject.data,withdrawn==0& has.event==0),f)
  
  f <- GetLaggedSubjects(e@subject.data,as.Date("2015-11-26"))
  expect_equal(c(298,344,313,794),f$subject)
})

test_that("Site_censor_Information",{
  data(event.data)
  
  e2 <- event.data
  e2$withdrawn[970] <- 1
  
  e <- EventData(data=e2,
                 subject="subject",
                 rand.date="randDate",
                 has.event="hasEvent",
                 withdrawn="withdrawn",
                 time="time")
  
  expect_error(siteInformation(e,ndays=as.Date("2014-10-01")))
  expect_error(siteInformation(e,ndays=-1))
  expect_error(siteInformation(e,ndays=10,analysis.date=34))
  expect_error(siteInformation(e,ndays=10))
  
  e <- EventData(data=e2,
                 subject="subject",
                 rand.date="randDate",
                 has.event="hasEvent",
                 withdrawn="withdrawn",
                 time="time",site="site")
  
  s <- siteInformation(e,ndays=10)
  expect_equal("data.frame",class(s))
  expect_equal(as.factor(c(4,3,8)),s$site)
  expect_equal(c(2,1,1),s$count)
  
  s <- siteInformation(e,ndays=10,analysis.date=as.Date("2015-11-28"))
  s2 <- siteInformation(e,ndays=10,analysis.date="2015-11-28")
  s3 <- siteInformation(e,ndays=11,analysis.date="2015-11-29")
      
  expect_equal(s,s2)
  expect_equal(s,s3)
  
  s4 <- siteInformation(e,ndays=10,analysis.date=as.Date("2015-11-28"))
  s5 <- siteInformation(e,ndays=10,analysis.date=NULL)
  expect_equal(s4,s5)
  
  
  expect_error(censorInformation(e,censor.date=2013-10-10))
  s <- censorInformation(e,censor.date=as.Date("2013-10-10"))             
  expect_equal("data.frame",class(s))
  expect_equal(0,nrow(s))
  
  s <- censorInformation(e,censor.date=as.Date("2017-10-10"))
  expect_equal(sort(s$subject),sort(e@subject.data$subject[e@subject.data$withdrawn==0&e@subject.data$censored.at.follow.up==0&
                                                             e@subject.data$has.event==0]))
  
  s <- censorInformation(e,censor.date=as.Date("2015-11-25"))
  expect_equal(c(313,344,298,794),s$subject)
  
  s1 <- censorInformation(e,censor.date="2015-11-28")  
  s2 <- censorInformation(e,censor.date=NULL)  
  expect_equal(s1,s2)
  
})


test_that("CutData",{
  data(event.data)
  e2 <- event.data
  
  e2$withdrawn[974:979] <- 1
  
  
  expect_warning(my.data <- EventData(data=e2,
                 subject="subject",
                 rand.date="randDate",
                 has.event="hasEvent",
                 withdrawn="withdrawn",
                 time="time",
                 followup=500))
  
  expect_error(CutData(my.data,"2013-12-31"))
  expect_that(suppressWarnings(cut1 <- CutData(my.data,"2014-01-01")), not(throws_error()))
  expect_equal(cut1@subject.data$subject,event.data$subject[event.data$randDate <= as.Date("2014-01-01")]) 

  expect_warning( CutData(my.data,"2016-01-01"))
  
  cut2 <- CutData(my.data,"2015-01-01")
  expect_true(all(eventPrediction:::LastDate(cut2@subject.data) <= as.Date("2015-01-01")))
  
  expect_equal(rep(0,6),tail(cut2@subject.data$withdrawn,6)) #last 6 subjects were not cut but are no longer withdrawn
  
  expect_equal(0,cut2@subject.data[cut2@subject.data$subject==251,"has.event"])
  expect_equal(as.Date("2015-01-01"),eventPrediction:::LastDate(cut2@subject.data)[cut2@subject.data$subject==251])  
})


test_that("event.type",{
  data(event.data)
  
  e2 <- event.data
  e2$eventType[1] <- ""
  #Warning if missing individual event.type
  expect_warning(
    x <- EventData(data=e2,
              subject="subject",
              rand.date="randDate",
              has.event="hasEvent",
              withdrawn="withdrawn",
              time="time",
              event.type="eventType")
  )
  
  expect_equal(c("Event type 1","Event type 2","Had Event"),levels(x@subject.data$event.type) )
  
  
  e2 <- event.data
  e2$eventType[979] <- "Had Event"
  expect_warning(
    x <- EventData(data=e2,
              subject="subject",
              rand.date="randDate",
              has.event="hasEvent",
              withdrawn="withdrawn",
              time="time",
              event.type="eventType")
  )
  
  expect_equal(c("Event type 1","Event type 2"),levels(x@subject.data$event.type) )
  
  expect_warning(z <- CutData(x,"15/01/2014"))
  expect_equal(character(0),levels(z@subject.data$event.type))
  
  z <- CutData(x,"22/01/2014")
  expect_equal(c("Event type 1"),levels(z@subject.data$event.type))
  
  
  y <- EventData(data=e2,
                 subject="subject",
                 rand.date="randDate",
                 has.event="hasEvent",
                 withdrawn="withdrawn",
                 time="time")
  expect_true(all(y@subject.data$has.event==1 | is.na(y@subject.data$event.type) ))
  expect_true(all(y@subject.data$has.event==0 | y@subject.data$event.type=="Has Event" ))
  
  
  
})