Switch to side-by-side view

--- a
+++ b/tests/testthat/test-predictFromParameters.R
@@ -0,0 +1,238 @@
+context("predictFromParameters")
+
+test_that("test_lag",{
+  l1 <- LagEffect(Lag.T=3,L.Ctr.median=6.5,L.HazardRatio=0.7)
+  
+  expect_equal(3,l1@Lag.T)
+  expect_equal(6.5,l1@ctrlSpec@median)
+  expect_equal(0.7,l1@L.HazardRatio)
+  
+  expect_error(LagEffect(Lag.T=-5,L.Ctr.median=6.5,L.HazardRatio=0.7))
+  expect_error(LagEffect(Lag.T=5,L.Ctr.median=-4,L.HazardRatio=0.7))
+  expect_error(LagEffect(Lag.T=5,L.Ctr.median=4,L.HazardRatio=1.3))
+  expect_error(LagEffect(Lag.T=5,L.Ctr.median=4,L.HazardRatio=-0.4))
+  expect_error(LagEffect(Lag.T=5,L.Ctr.median=4,L.HazardRatio="sedf"))
+  expect_warning(LagEffect(Lag.T=c(1,5),L.Ctr.median=4,L.HazardRatio=0.4))
+  
+  l4 <- LagEffect(Lag.T=5.2,L.Ctr.median=4)
+  expect_true(is.na(l4@L.HazardRatio))
+  expect_error(LagEffect(Lag.T=5,L.Ctr.median=as.numeric(NA),L.HazardRatio=as.numeric(NA)))
+  
+  l2 <- NullLag()
+  l3 <- LagEffect(Lag.T=0)
+
+  expect_true(isNullLag(l2))
+  expect_true(isNullLag(l3))
+  expect_false(isNullLag(l1))
+  
+  expect_output(print(l2),"No Lag")
+  expect_output(print(l4),"5.2 months of lag during which\ncontrol group survival median=4 months")
+  expect_output(print(l1),"3 months of lag during which\ncontrol group survival median=6.5 months\nand the hazard ratio is 0.7 ")
+})
+
+
+
+test_that("valid_single_arm_study",{
+  s1 <- SingleArmStudy(N=100,study.duration=10,ctrl.median=3,k=1.5,acc.period=5,shape=2)
+  
+  expect_equal(NullLag(),s1@lag.settings)
+  expect_equal(100,s1@N)
+  expect_equal(10,s1@study.duration)
+  expect_equal(3,s1@ctrlSpec@median)
+  expect_equal(1.5,s1@k)
+  expect_equal(5,s1@acc.period)
+  expect_equal(2,s1@shape)
+  
+  expect_true(is.na(s1@HR))
+  expect_true(is.na(s1@alpha))
+  expect_true(is.na(s1@power))
+    
+  expect_true(isSingleArm(s1))
+  
+  
+  l1 <- LagEffect(Lag.T=5,L.Ctr.median=3)
+  s2 <- SingleArmStudy(N=100,study.duration=20,ctrl.median=10.2,k=0.5,acc.period=10.5,lag.settings=l1)
+  expect_equal(1,s2@shape)
+  expect_equal(5,s2@lag.settings@Lag.T)
+})
+
+
+test_that("invalid_single_arm_study",{
+  expect_error(SingleArmStudy(N=0,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N="as",study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=c(3,4),study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=0,ctrl.median=3,k=1.5,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=-1,ctrl.median=3,k=1.5,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=100,ctrl.median=-1,k=1.5,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=100,ctrl.median=10,k=0,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=100,ctrl.median=10,k=-2,acc.period=10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=100,ctrl.median=10,k=2,acc.period=10.5,shape=0))
+  expect_error(SingleArmStudy(N=100,study.duration=100,ctrl.median=10,k=2,acc.period=-10.5,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=100,ctrl.median=10,k=2,acc.period=0,shape=2))
+  expect_error(SingleArmStudy(N=100,study.duration=2.5,ctrl.median=10,k=2,acc.period=5))
+  expect_error(SingleArmStudy(N=100.5,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=2))
+  
+  expect_error(SingleArmStudy(N=100,study.duration=20,ctrl.median=10.2,k=0.5,acc.period=10.5,lag.settings=4))
+  
+  l1 <- LagEffect(Lag.T=5,L.Ctr.median=3,L.HazardRatio=0.8)
+  #cannot have HR in single arm study
+  expect_error(SingleArmStudy(N=100,study.duration=20,ctrl.median=10.2,k=0.5,acc.period=10.5,lag.settings=l1))
+  
+  
+})
+
+
+test_that("valid_two_arm",{
+  #Note only the extra arguments not used in SingleArm study are tested here 
+  
+  s1 <- Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3)
+  
+  expect_equal(0.05,s1@alpha)
+  expect_equal(0.6,s1@power)
+  expect_equal(0.75,s1@HR)
+  expect_equal(1.3,s1@r)
+  expect_equal(1.2,s1@shape)
+  expect_true(s1@two.sided)
+  
+  
+  s2 <- Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,
+              alpha=0.95,power=0.1,two.sided=FALSE,HR=0.9,r=0.85)
+  
+  expect_false(s2@two.sided)
+  expect_equal(1,s2@shape)
+  
+  expect_equal(s2@dropout.shape,1)
+  expect_true(is.infinite(s2@dropout[[1]]@median))
+  expect_true(is.infinite(s2@dropout[[2]]@median))
+  
+})
+
+test_that("invalid_two_arm",{
+  #Note only the extra arguments not used in SingleArm study are tested here  
+  
+  #cannot have lag without HR in 2 arm study
+  l1 <- LagEffect(Lag.T=5,L.Ctr.median=3)
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,
+                     alpha=0.95,power=0.1,two.sided=FALSE,HR=0.9,r=0.85,lag.settings=l1))
+  
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=1.2,power=0.6,two.sided=TRUE,HR=0.75,r=1.3))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0,power=0.6,two.sided=TRUE,HR=0.75,r=1.3))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=-1,two.sided=TRUE,HR=0.75,r=1.3))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=1.0,two.sided=TRUE,HR=0.75,r=1.3))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=0.6,two.sided=TRUE,HR=1,r=1.3))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=0.6,two.sided=TRUE,HR=0,r=1.3))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=0))
+  
+  expect_error(Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+              alpha=0.05,power=0.6,two.sided=TRUE,HR=-0.75,r=1.3))
+})
+
+
+test_that("invalid_arguments_to_predict",{
+  
+  s <- Study(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,
+              alpha=0.95,power=0.1,two.sided=FALSE,HR=0.9,r=0.85)
+  
+  expect_error(predict(s,time.pred=NA))
+  expect_error(predict(s,time.pred="awe"))
+  expect_error(predict(s,time.pred=c(-3,5)))
+  expect_warning(predict(s,time.pred=c(12,15))) #critical number of events too high
+  expect_error(predict(s,event.pred="ef"))
+  expect_error(predict(s,event.pred=-4))  
+  expect_error(predict(s,event.pred=c(NA,10)))
+  expect_warning(predict(s,event.pred=101)) 
+  expect_error(predict(s,event.pred=12.5))
+  
+  expect_error(predict(s,step.size=0))
+  expect_error(predict(s,step.size=-2))
+  expect_warning(predict(s,step.size=11)) #critical number of events too high
+  expect_error(predict(s,step.size=c(0.1,3)))
+  expect_error(predict(s,step.size="gre"))
+})
+
+
+test_that("CRGI_study",{
+  #focusing testing on arguments which differ from Study constructor
+  #see tests on ctrlSpec for validity tests on  ctrl.median type arguments
+  
+  #give ctrl.median
+  expect_error( CRGIStudy(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=1.2,
+                      alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3))
+  #no follow up
+  expect_error( CRGIStudy(N=100,study.duration=100,ctrl.time=8,ctrl.proportion=0.5,k=1.5,acc.period=10.5,shape=1.2,
+                          alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3))
+  
+  #follow up negative
+  expect_error( CRGIStudy(N=100,study.duration=100,ctrl.time=8,ctrl.proportion=0.5,k=1.5,acc.period=10.5,shape=1.2,
+                          alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,followup=-5))
+  
+  expect_error( CRGIStudy(N=100,study.duration=100,ctrl.time=8,ctrl.proportion=0.5,k=1.5,acc.period=10.5,shape=1.2,
+                          alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,followup=c(4,5,6)))
+  
+
+  expect_error(SingleArmCRGIStudy(N=100,study.duration=100,ctrl.median=3,k=1.5,acc.period=10.5,shape=2)  )
+  expect_error(SingleArmCRGIStudy(N=100,study.duration=100,ctrl.time=8,ctrl.proportion=0.5,k=1.5,acc.period=10.5,shape=2)  )
+  
+ 
+  
+})
+
+
+test_that("valid_dropout_input",{
+  
+  dropout=list(time=-2,proportion=c(0.05,0.05))
+  expect_error(CRGIStudy(N=100,study.duration=100,ctrl.time=8,ctrl.proportion=0.5,k=1.5,acc.period=10.5,shape=1.2,
+            alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,followup=10,dropout=dropout))
+  
+  dropout="boo"
+  expect_error(CRGIStudy(N=100,study.duration=100,ctrl.time=8,ctrl.proportion=0.5,k=1.5,acc.period=10.5,shape=1.2,
+                         alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,followup=10,dropout=dropout))
+  
+  dropout=list(atimes=2,proportion=c(0.05,0.05))
+  expect_error(Study(N=100,study.duration=100,ctrl.median=4,k=1.5,acc.period=10.5,shape=1.2,
+                         alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,dropout=dropout))
+  
+  dropout=list(times=2,proportion=c(1.0,0.5))
+  expect_error(Study(N=100,study.duration=100,ctrl.median=4,k=1.5,acc.period=10.5,shape=1.2,
+                     alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,dropout=dropout))
+  
+  
+  dropout=list(times=2,proportion=c(0.8,0.8),shape=-3)
+  expect_error(Study(N=100,study.duration=100,ctrl.median=4,k=1.5,acc.period=10.5,shape=1.2,
+                     alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,dropout=dropout))
+  
+  
+  dropout=list(times=2,proportion=c(0.5,0.5),shape=3)
+  s <- Study(N=100,study.duration=100,ctrl.median=4,k=1.5,acc.period=10.5,shape=1.2,
+             alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,dropout=dropout)
+  
+  expect_equal(3,s@dropout.shape)
+  expect_equal(2,s@dropout[[1]]@median)
+  
+  
+  dropout=list(times=2,proportion=c(0.75,0.75))
+  s <- Study(N=100,study.duration=100,ctrl.median=4,k=1.5,acc.period=10.5,shape=1.2,
+             alpha=0.05,power=0.6,two.sided=TRUE,HR=0.75,r=1.3,dropout=dropout)
+  
+  expect_equal(1,s@dropout.shape)
+  expect_equal(1,s@dropout[[1]]@median)
+  
+  
+  
+})
+