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