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)))
})
