tests/testthat/test-fromDataInput.R

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

context("dataInput")

data(event.data)

test_that("remove.0.time",{
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time",
                         remove.0.time=c(TRUE,5)
  ))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time",
                         remove.0.time="TRUE"
  ))
  
  expect_error(EventData(data=event.data,
                         subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time="time", site="site",followup=-50)
  )
  
  expect_error(EventData(data=event.data,
                         subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time="time", site="site",followup=c(1,2,3))
  )
  
  e <- event.data
  e$time[1:25] <- NA
  e$time[26:50] <- 0
  
  expect_warning(r.false <- EventData(data=e,
                           subject="subject",
                           site="site",
                           rand.date="randDate",
                           has.event="hasEvent",
                           withdrawn="withdrawn",
                           time="time",
                           remove.0.time=FALSE
  ))

  expect_warning(r.true <- EventData(data=e,
                                    subject="subject",
                                    site="site",
                                    rand.date="randDate",
                                    has.event="hasEvent",
                                    withdrawn="withdrawn",
                                    time="time",
                                    remove.0.time=TRUE
  ))

  
  expect_warning(r.default <- EventData(data=e,
                                     subject="subject",
                                     site="site",
                                     rand.date="randDate",
                                     has.event="hasEvent",
                                     withdrawn="withdrawn",
                                     time="time"                                     
  ))
  
  expect_equal(r.false,r.default)
  expect_equal(nrow(r.false@subject.data),nrow(e))
  expect_equal(e[51:nrow(e),]$subject,r.true@subject.data$subject)
  
})


test_that("Column_names",{
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasevent",
                         withdrawn="withdrawn",
                         time="time"))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randdate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time=time))
  
  expect_error(EventData(data=event.data,
                         subject="sudbject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time"))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="sited",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time"))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="sited",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time"))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn"
                         ))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasEvent",
                         time="time"
                         ))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time"
  ))
  
  expect_error(EventData(subject="subject",
                         site="site",
                         rand.date="randDate",
                         has.event="hasEvent",
                         withdrawn="withdrawn",
                         time="time"
  ))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         withdrawn="withdrawn",
                         time="time"
  ))
  
  expect_error(EventData(data=event.data,
                         subject="subject",
                         site="site",
                         rand.date="randDate",
                         withdrawn="withdrawn",
                         time="time",
                         event.type="dfg"
  ))
  
  
})

test_that("Invalid_data_in_df",{
  e <- event.data
  e$hasEvent[5] <- "3"
  
  expect_error(expect_watning(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time")))
  e <- event.data
  e$withdrawn[15] <- "NO"
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  e <- event.data
  e$randDate[5] <- NA
  expect_warning(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  e <- event.data
  e$hasEvent <- rep(0,nrow(e))
  expect_warning(a <- EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  expect_error(fit(a))
  
  
  e <- event.data
  e$hasEvent <- rep(1,nrow(e))
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  e <- event.data
  e$withdrawn[1] <- 1
  expect_warning(EventData(data=e, subject="subject", rand.date="randDate",
                           has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  
  e <- event.data
  e$subject[1] <- 505
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  e <- event.data
  e$time[1] <- "refd"
  #also get a warning here as code thinks time is factor
  expect_error(expect_warning(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time")))
  
  e <- event.data
  e$time[1] <- 0
  expect_warning(EventData(data=e, subject="subject", rand.date="randDate",
                           has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
 
  
  e <- event.data
  e$time[1] <- -5
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))

  
  e <- event.data
  e$randDate[1] <- "15/10/2015"
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  
  e <- event.data
  e$randDate[1] <- "15 Jan 2015"
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  
  e <- event.data
  e$randDate[1] <- "15-10-31"
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
})


test_that("Derived_Time_Test",{
  
 test.data <- data.frame(Asubject=c(1:8,"",10:12),
             ArandDate=c("01/01/2015","01/01/2015","05/01/2015",
                         "08/01/2015","12/01/2015","15/01/2015",
                         "10/01/2015",          "","06/05/2015",
                         "04/02/2015","08/02/2015","12/03/2015"),
             Ahasevent=c(1,0,0,0,0,0,1,0,0,1,1,1),
             Awithdrawn=c(1,1,1,1,0,0,0,0,0,0,0,0),
             AprogDate=c("","","","10/01/2015","05/04/2015","",
                        "04/12/2015","","","","","05/08/2015"),
             AdthDate=c("04/05/2015","","","","","",
                       "03/05/2015","","","08/02/2015","",""),
             AlastDate=c("","06/06/2015","05/06/2015","",
               "04/04/2015","05/05/2015","","01/05/2015",
               "12/05/2015","05/02/2015","12/02/2015",""),
             AwithdrawnDate=c("01/10/2015","","06/06/2015","12/01/2015",
                             "","05/08/2015","","","","","","06/08/2015")
 )
 
 expect_warning(my.data <- EventData(data=test.data, subject="Asubject", rand.date="ArandDate",
           has.event="Ahasevent", withdrawn="Awithdrawn",
           time=list(last.date="AlastDate",prog.date="AprogDate",withdrawn.date="AwithdrawnDate",dth.date="AdthDate")))
 
 NA.fact <- as.factor(NA)
 
 indat <- data.frame(subject=c(1:7,10:12),
                     rand.date=FixDates(c("01/01/2015","01/01/2015","05/01/2015",
                                 "08/01/2015","12/01/2015","15/01/2015",
                                 "10/01/2015",
                                 "04/02/2015","08/02/2015","12/03/2015")),
                     time=c(124,157,153,5,83,111,114,5,5,147),
                     has.event=c(1,0,0,0,0,0,1,1,1,1),
                     withdrawn=c(0,1,1,1,0,0,0,0,0,0),
                     site=rep(NA,10),
                     event.type=c("Has Event",rep(NA.fact,5),"Has Event","Has Event",
                                  "Has Event","Has Event"),
                     censored.at.follow.up=rep(0,10))
 
  indat$subject <- factor(indat$subject,levels=levels(my.data@subject.data$subject)) 
  
  rownames(indat) <- NULL
  rownames(my.data@subject.data) <- NULL
  expect_equal(indat,my.data@subject.data)
})

test_that("Derived_Time",{
  e <- event.data
  
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time=list()))
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time=list(event.date="eD",last.date="lastDate")))
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time=list(event.date="eventDate")))
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time=list(last.date="lastDate",eventt.date="eventDate")))
  
  e$wDate <- rep(as.Date(NA),nrow(e))
  e$wDate[1] <-as.Date("2014-01-16")
  
  expect_warning(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",
                         time=list(last.date="lastDate",event.date="eventDate",withdrawn.date="wDate")))
  
  e <- event.data
  e$wDate <- rep(as.Date(NA),nrow(e))
  e$withdrawn[1] <- 1
  e$hasEvent[1] <- 0
  
  expect_warning(EventData(data=e, subject="subject", rand.date="randDate",
                           has.event="hasEvent", withdrawn="withdrawn",
                           time=list(last.date="lastDate",event.date="eventDate",withdrawn.date="wDate")))
  
})

test_that("CalculateDaysAtRisk",{
  e <- event.data
  e$time <- rep(4,nrow(e))
  my.data <- EventData(data=e,
                       subject="subject",
                       rand.date="randDate",
                       has.event="hasEvent",
                       withdrawn="withdrawn",
                       time="time",
                       site="site")
  
  expect_equal(4*nrow(e),CalculateDaysAtRisk(my.data))
  
})


test_that("Derived_Time_logic",{
  #this is a companion test to Derived_Time_Test above
  e <- event.data

  e$wDate <- rep(NA,nrow(e))
  e$dth.date <- rep(NA,nrow(e))
  e$prog.date <- rep(NA,nrow(e))
    
  e$hasEvent[1] <- 0
  e$eventDate[1] <- NA
  e$lastDate[1] <- "2014-01-14"
  e$hasEvent[2] <- 0
  e$eventDate[2] <- NA
  e$prog.date[2] <- "2014-02-01"
  e$lastDate[2] <- "2014-02-06"
  
  e$hasEvent[3:5] <- 0
  e$withdrawn[3:5] <- 1
  e$eventDate[3:4] <- NA
  e$lastDate[4] <- "2014-02-10"
  e$wDate[4] <- "2014-02-05"
  
  e$lastDate[5] <- "2014-02-20"
  e$wDate[5] <- "2014-03-05"
  
  e$lastDate[6] <- NA
  e$eventDate[7] <- NA
  e$dth.date[7] <- "2014-01-10"
  
  e$prog.date[8] <- "2014-12-03"
  e$eventDate[8] <- "2014-04-04"
  
  e$eventDate[9] <- NA
  e$wDate[9] <- "2014-02-28"
  
  e$withdrawn[10:11] <- 1
  e$eventDate[10:11] <- NA
  e$wdate[11] <- "2014-03-01"
  e$prog.date[11] <- "2014-05-05"
  
  
  expect_warning(a <- EventData(data=e, subject="subject", rand.date="randDate",
            has.event="hasEvent", withdrawn="withdrawn",
            time=list(last.date="lastDate",event.date="eventDate",withdrawn.date="wDate",dth.date="dth.date",
                      prog.date="prog.date")))
  
  expect_equal(c(4,17,45,28,37,41,1,76,26,42,94),a@subject.data$time[1:11])
  
  
})

test_that("prog_dth_warning",{
  
  #check if have both prog and dth date then get warning if dth is before prog
  e <- data.frame(subject=1:3,
                  has.event=c(1,1,0),
                  withdrawn=c(0,0,0),
                  rand.date=rep("2014-01-01",3),
                  last.date=c("","","2015-01-01"),
                  prog.date=c("2015-01-01","2015-01-01",""),
                  dth.date=c("2014-06-06","2015-01-01","")
                  )
  
  expect_warning(EventData(data=e, subject="subject", rand.date="rand.date",
                 has.event="has.event", withdrawn="withdrawn",
                 time=list(last.date="last.date",dth.date="dth.date",prog.date="prog.date")),
                 regexp ="Subjects 1 have progression date after death date. This is invalid and should be fixed" )
  
  
   
})


test_that("followup",{
  e <- data.frame(subject=1:6,
                  randDate=c("2015-01-01","2015-02-01","2015-03-01","2015-04-01","2015-05-01","2015-06-01"),
                  time=(1:6)*10,
                  hasEvent=c(1,1,1,0,1,0),
                  withdrawn=c(0,0,1,0,0,1))
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
            has.event="hasEvent", withdrawn="withdrawn",time="time",followup=0))
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time",followup=c(3,4)))
  
  expect_error(EventData(data=e, subject="subject", rand.date="randDate",
                         has.event="hasEvent", withdrawn="withdrawn",time="time",followup=-10))
  
  #warning for subject 3 having withdrawn and hasEvent=1
  expect_warning(inf.followup <- EventData(data=e, subject="subject", rand.date="randDate",
            has.event="hasEvent", withdrawn="withdrawn",time="time"))
  
  expect_equal(rep(0,6),inf.followup@subject.data$censored.at.follow.up)
  expect_true(is.infinite(inf.followup@followup))
  
  expect_warning(seventy.followup <- EventData(data=e, subject="subject", rand.date="randDate",
                                has.event="hasEvent", withdrawn="withdrawn",time="time",followup=70))
  
  expect_equal(70,seventy.followup@followup)
  expect_equal(inf.followup@subject.data,seventy.followup@subject.data)

  expect_warning(fifteen.followup <- EventData(data=e, subject="subject", rand.date="randDate",
                                               has.event="hasEvent", withdrawn="withdrawn",time="time",followup=15))

  expect_equal(c(1,0,0,0,0,0),fifteen.followup@subject.data$has.event)
  expect_equal(rep(0,6),fifteen.followup@subject.data$withdrawn)
  expect_equal(c(0,rep(1,5)),fifteen.followup@subject.data$censored.at.follow.up)
  
  expect_equal(c(10,rep(15,5)),fifteen.followup@subject.data$time)
  
  expect_warning(twenty.followup <- EventData(data=e, subject="subject", rand.date="randDate",
                                               has.event="hasEvent", withdrawn="withdrawn",time="time",followup=20))
  
  
  expect_equal(c(10,rep(20,5)),twenty.followup@subject.data$time)
  expect_equal(c(1,1,0,0,0,0),twenty.followup@subject.data$has.event)
  
})


test_that("CalculateProgEventTypes",{
  e <- c(0,1,1,1,1,1,1)
  p <- c("01/01/2015","01/01/2015","01/01/2015","01/01/2015","01/01/2015","","")
  d <- c("","","01/01/2014","01/01/2016","01/01/2015","02/01/2015","")  
  
  
  expect_equal(c(NA,"Progression (not death)","Death","Progression (not death)",
                 "Death","Death","Progression (unknown if death)"),
                 CalculateProgEventTypes(e,p,d))
  
  expect_error(CalculateProgEventTypes(c(e,1),p,d))
  expect_error(CalculateProgEventTypes(e,c(p,1),d))
  e[1] <- -3
  expect_error(CalculateProgEventTypes(e,p,d))
  e[1] <- 0
  p[1] <- 23
  expect_error(CalculateProgEventTypes(e,p,d))
  
}) 


test_that("EmptyEventData",{
  e <- EmptyEventData()
  expect_equal(Inf,e@followup)
  expect_equal(0,nrow(e@subject.data))
  e <- EmptyEventData(followup=10)
  expect_equal(10,e@followup)
  expect_error(EmptyEventData(followup=-10))
  expect_error(EmptyEventData(followup=c(1,2,3)))
})