--- a
+++ b/tests/testthat/test-fromParametersSystem.R
@@ -0,0 +1,317 @@
+context("fromParam_systemlevel")
+
+test_that("lag.should.equal.non.lag.in.these.cases",{
+  
+  l1 <- LagEffect(Lag.T=5,L.Ctr.median=3,L.HazardRatio=0.8)
+  l2 <- LagEffect(Lag.T=20,L.Ctr.median=3,L.HazardRatio=0.8)
+  
+  s1 <- Study(N=1000,study.duration=10,ctrl.median=3,k=1.2,acc.period=5,shape=2,
+                       power=0.9,alpha=0.05,r=1,HR=0.8,two.sided=TRUE,
+              lag.settings=l1)
+  
+  s1.nolag <- Study(N=1000,study.duration=10,ctrl.median=3,k=1.2,acc.period=5,shape=2,
+              power=0.9,alpha=0.05,r=1,HR=0.8,two.sided=TRUE)
+  
+  s2 <- Study(N=1000,study.duration=10,ctrl.median=6,k=1.2,acc.period=5,shape=2,
+              power=0.9,alpha=0.05,r=1,HR=0.75,two.sided=TRUE,
+              lag.settings=l2)
+  
+  a1 <- predict(s1.nolag,time.pred=c(5,8,10),event.pred=c(10,15))
+  
+  
+  
+  a2 <- predict(s1,time.pred=c(5,8,10),event.pred=c(10,15))
+  a3 <- predict(s2,time.pred=c(5,8,10),event.pred=c(10,15))
+  
+  #remove atrisk columns for check:
+  p1 <- a1@predict.data
+  p2 <- a2@predict.data
+  
+  p1$at.risk1 <- NULL
+  p1$at.risk2 <- NULL
+  p1$atrisk.tot <- NULL
+  p2$at.risk1 <- NULL
+  p2$at.risk2 <- NULL
+  p2$atrisk.tot <- NULL
+  
+  expect_equal(p1,p2) 
+  
+  #Then check atrisk columns
+  expect_equal(a1@predict.data$at.risk1,a2@predict.data$at.risk1,tol=1e-7)
+  expect_equal(a1@predict.data$at.risk2,a2@predict.data$at.risk2,tol=1e-7)
+  expect_equal(a1@predict.data$atrisk.tot,a2@predict.data$atrisk.tot,tol=1e-7)
+  
+  expect_equal(a1@grid,a2@grid)
+  
+  expect_equal(a1@av.hr,a2@av.hr)
+  expect_equal(a1@critical.events.req,a2@critical.events.req)
+  
+  
+  
+  expect_equal(a1@critical.data$at.risk1,a2@critical.data$at.risk1,tol=1e-7)
+  expect_equal(a1@critical.data$at.risk2,a2@critical.data$at.risk2,tol=1e-7)
+  expect_equal(a1@critical.data$atrisk.tot,a2@critical.data$atrisk.tot,tol=1e-7)
+  
+  
+  
+  expect_equal(a1@sfns[[1]]@lambda,a2@sfns[[1]]@lambda)
+  expect_equal(a1@sfns[[2]]@lambda,a2@sfns[[2]]@lambda)
+  expect_equal(a2@sfns[[1]]@lambda,a2@sfns[[1]]@lambdaot)
+  expect_equal(a2@sfns[[2]]@lambda,a2@sfns[[2]]@lambdaot)
+  
+  #remove atrisk columns for check:
+  p1 <- a1@predict.data
+  p2 <- a3@predict.data
+  
+  p1$at.risk1 <- NULL
+  p1$at.risk2 <- NULL
+  p1$atrisk.tot <- NULL
+  p2$at.risk1 <- NULL
+  p2$at.risk2 <- NULL
+  p2$atrisk.tot <- NULL
+  
+  expect_equal(p1,p2) 
+  
+  #Then check atrisk columns
+  expect_equal(a1@predict.data$at.risk1,a3@predict.data$at.risk1,tol=1e-7)
+  expect_equal(a1@predict.data$at.risk2,a3@predict.data$at.risk2,tol=1e-7)
+  expect_equal(a1@predict.data$atrisk.tot,a3@predict.data$atrisk.tot,tol=1e-7)
+  
+  expect_equal(a1@grid,a3@grid)
+  expect_equal(a1@av.hr,a3@av.hr)
+  expect_equal(a1@critical.events.req,a3@critical.events.req)
+  expect_equal(a1@critical.data,a3@critical.data)
+  
+  expect_equal(a1@sfns[[1]]@lambda,a3@sfns[[1]]@lambdaot)
+  expect_equal(a1@sfns[[2]]@lambda,a3@sfns[[2]]@lambdaot)
+})
+
+test_that("event.and.time.pred.have.symmetry",{
+  #Note due to rounding of events the 'symmetry' only works one way...
+  
+  s1 <- Study(N=1000,study.duration=10,ctrl.median=3,k=1.2,acc.period=5,shape=2,
+              power=0.9,alpha=0.05,r=1,HR=0.8,two.sided=TRUE)
+  
+  a1 <- predict(s1,event.pred=c(100,200,300,400))
+  
+  time.pred <- a1@predict.data[,"time"]
+  
+  a2 <- predict(s1,time.pred=time.pred)
+  
+  expect_true(all(a2@predict.data[,"time.pred"]))
+  expect_false(any(a1@predict.data[,"time.pred"]))
+  
+  a1@predict.data$time.pred <- rep(TRUE,4)
+  
+  expect_equal(a1@predict.data,a2@predict.data)  
+  
+})
+
+
+test_that("recruit",{
+  
+  k <- c(0.5,1,2)
+  
+  lapply(k,function(x){
+    s <- SingleArmStudy(N=1000,study.duration=10,ctrl.median=3,k=x,acc.period=5,shape=1.2)
+    a <- predict(s,time.pred=5/(2^(1/x)))
+    expect_equal(1/(2^x)*1000,a@grid[a@grid$time==2.5,]$recruit.tot)
+    expect_equal(500,a@predict.data[1,]$recruit.tot)
+  })
+  
+  lapply(k,function(x){
+    s <- Study(N=1000,study.duration=10,ctrl.median=3,k=x,acc.period=6,
+               shape=1.2,power=0.8,alpha=0.05,two.sided=TRUE,r=1.2,HR=0.8)
+    a <- predict(s,time.pred=6/(2^(1/x)))
+    expect_equal(1/(2^x)*1000,a@grid[a@grid$time==3,]$recruit.tot)
+    expect_equal(500,a@predict.data[1,]$recruit.tot)
+  })
+  
+})
+
+
+#this fails on versions < 1.0
+test_that("max.num.events",{
+  l <- LagEffect(Lag.T=5,L.Ctr.median=1,L.HazardRatio=0.5)
+  
+  s <- Study(N=800,study.duration=36,ctrl.median=3,k=1,acc.period=20,
+             shape=1,power=0.8,alpha=0.05,two.sided=TRUE,r=1.2,HR=0.5,lag.settings=l)
+  
+  a <- predict(s)
+  
+  expect_true(all(a@grid$events.tot <= 800))
+  
+  
+})
+
+test_that("median",{
+  
+  ctrl.median <- c(1:5)
+  lapply(ctrl.median,function(x){
+    s1 <- SingleArmStudy(N=2000,study.duration=20,ctrl.median=x,k=0.01,acc.period=0.000001,shape=1.5)
+    a <- predict(s1,event.pred=1000)
+    expect_equal(x,a@predict.data[1,]$time)
+    
+    })
+})
+
+test_that("single.arm.matches.2.arm",{
+   
+  s1 <- Study(N=2000,study.duration=10,ctrl.median=3,k=1.2,acc.period=5,shape=2,
+              power=0.9,alpha=0.05,r=1,HR=0.8,two.sided=TRUE)
+  
+  s2 <- SingleArmStudy(N=1000,study.duration=10,ctrl.median=3,k=1.2,acc.period=5,shape=2)
+  
+  s3 <- Study(N=2000,study.duration=10,ctrl.median=3*sqrt(0.8),k=1.2,acc.period=5,shape=2,
+              power=0.9,alpha=0.05,r=1,HR=0.8,two.sided=TRUE)
+  
+  a1 <- predict(s1)
+  a2 <- predict(s2)
+  a3 <- predict(s3)
+  
+  expect_equal(a1@grid$events1,a2@grid$events.tot)
+  expect_equal(a3@grid$events2,a2@grid$events.tot)
+})
+
+
+str1 <- "800 patients recruited, ratio nE/nC=1, 20 months accrual (non-uniform\naccrual, k=2). Lag time: T=4 months, Control for [0,T] median=3 months and\nfor [T,S] Control median=2 months. Exponential survival function.\nHR([0,T])=1 and HR([T,S])=0.5, which gives an average HR=0.77. For a study\nwith no lag and this HR: critical HR value=0.83, alpha(2-sided)=5%,\npower=80%, 466 events required and using the given lag settings: expected\nat time 18.9 months (Experimental/Control: 225/241)."
+str2 <- "120 patients recruited, ratio nE/nC=0.5, 20 months accrual (uniform\naccrual, k=1). Control median=2.5 months (lambda=0.29). Experimental\nmedian=4.11 months (lambda=0.18). Weibull survival function shape=1.2.\nHR(Experimental:Control)=0.55, critical HR value=0.71, alpha(1-sided)=5%,\npower=90%, 108 events required expected at time 22.6 months\n(Experimental/Control: 33/75). At (10, 3.2) months the predicted number of\nevents is (37, 5) [Experimental/Control: (10, 1)/(27, 4)]."
+str3 <- "100 patients recruited, 5 months accrual (non-uniform accrual, k=1.5). Lag\ntime: T=4 months, Control for [0,T] median=2.5 months and for [T,S]\nControl median=3 months. Weibull survival function shape=2.  At 10 months\nthe predicted number of events is 97."
+
+summary_check <- function(study,time.pred,event.pred,stringoutput){
+  prediction <- predict(study,time.pred=time.pred, event.pred=event.pred)
+  x <- eventPrediction:::getFromParameterText(prediction,DisplayOptions(text.width=75))
+  expect_equal(x,stringoutput)
+}
+
+test_that("summary_output",{
+  
+  lagged <- LagEffect(Lag.T = 4,L.Ctr.median = 3,  
+                      L.HazardRatio=1 )
+  
+  study <- Study(alpha = 0.05,power = 0.8,
+    HR = 0.5, r = 1,N = 800,
+    study.duration = 30,ctrl.median = 2,
+    k = 2,acc.period = 20,two.sided = TRUE,lag.settings=lagged)
+  
+  
+  summary_check(study,NULL,NULL,str1) 
+  
+  study <- Study(alpha = 0.05,power = 0.9,
+                 HR = 0.55, r = 0.5,N = 120,
+                 study.duration = 25,ctrl.median = 2.5,
+                 k = 1,acc.period = 20,two.sided = FALSE,shape=1.2)
+  
+  summary_check(study,10,5,str2)
+  lagged <- LagEffect(Lag.T = 4,L.Ctr.median = 2.5)
+  study <- SingleArmStudy(N=100,study.duration=10,ctrl.median=3,k=1.5,
+                          acc.period=5,shape=2,lag.settings=lagged)
+ 
+  summary_check(study,10,NULL,str3)
+})
+
+
+test_that("critical_hr",{
+  # this compares to the output from non-proportional hazards package
+  #there are slight differences in the rounding 
+  lagged <- LagEffect(Lag.T = 4,L.Ctr.median = 11,  
+                      L.HazardRatio=1 )
+  
+  study <- Study(alpha = 0.05,power = 0.8036576,
+                 HR = 0.6, r =1,N = 780,
+                 study.duration = 25.5,ctrl.median = 11,
+                 k = 2,acc.period = 18,two.sided = TRUE,shape=1,lag.settings=lagged)
+  
+  
+  prediction <- predict(study)
+  
+  nph.answer <- 0.8198656
+  
+  expect_equal(nph.answer,prediction@critical.HR,tol=5e-3)
+  
+  lagged <- LagEffect(Lag.T = 6,L.Ctr.median = 8,  
+                      L.HazardRatio=1 )
+  
+  study <- Study(alpha = 0.05,power = 0.9829889,
+                 HR = 0.5, r =1.5,N = 800,
+                 study.duration = 30,ctrl.median = 8,
+                 k = 0.5,acc.period = 18,two.sided = TRUE,shape=1,lag.settings=lagged)
+ 
+  
+  prediction <- predict(study)
+  
+  
+  nph.answer <- 0.8534732
+  expect_equal(nph.answer,prediction@critical.HR,tol=5e-3)
+  
+  lagged <- LagEffect(Lag.T = 5,L.Ctr.median = 8,  
+                      L.HazardRatio=1 )
+  
+  study <- Study(alpha = 0.05,power = 0.9989243,
+                 HR = 0.5, r =1.5,N = 800,
+                 study.duration = 30,ctrl.median = 8,
+                 k = 0.5,acc.period = 6,two.sided = TRUE,shape=1,lag.settings=lagged)
+  
+  
+  prediction <- predict(study)
+  
+  
+  nph.answer <- 0.8572458
+  expect_equal(nph.answer,prediction@critical.HR,tol=5e-3)
+  
+})
+
+test_that("average hazard ratio",{
+  # this compares to the output from non-proportional hazards package
+  #results do not match exactly: nph uses interval bisection to some tolerance
+  #whereas eventPrediction calculates the exact integral and is accruate up to 
+  #R's integrate functions accruacy  
+  #Also there are slight differences in the rounding of w1 and w2 (see eventPrediction vignette)
+  #which will cause small differences to the average HR
+  
+  lagged <- LagEffect(Lag.T = 4,L.Ctr.median = 11,  
+                      L.HazardRatio=1 )
+  
+  study <- Study(alpha = 0.05,power = 0.9,
+                 HR = 0.6, r =1,N = 780,
+                 study.duration = 25.5,ctrl.median = 11,
+                 k = 2,acc.period = 18,two.sided = FALSE,shape=1,lag.settings=lagged)
+ 
+  
+  prediction <- predict(study)
+  
+  nph.answer <- 0.7518394
+  expect_equal(nph.answer,prediction@av.hr,tol=1.1e-3)
+  
+  lagged <- LagEffect(Lag.T = 6,L.Ctr.median = 8,  
+                      L.HazardRatio=1 )
+  
+  study <- Study(alpha = 0.05,power = 0.9,
+                 HR = 0.5, r =1.5,N = 800,
+                 study.duration = 30,ctrl.median = 8,
+                 k = 0.5,acc.period = 18,two.sided = FALSE,shape=1,lag.settings=lagged)
+  
+  
+  prediction <- predict(study)
+  
+  
+  nph.answer <- 0.7190647
+  expect_equal(nph.answer,prediction@av.hr,tol=1.1e-3)
+  
+  lagged <- LagEffect(Lag.T = 5,L.Ctr.median = 8,  
+                      L.HazardRatio=1 )
+  study <- Study(alpha = 0.05,power = 0.5,
+                 HR = 0.75, r =1.5,N = 800,
+                 study.duration = 30,ctrl.median = 8,
+                 k = 0.5,acc.period = 6,two.sided = FALSE,shape=1,lag.settings=lagged)
+  
+  
+  prediction <- predict(study)
+  
+   
+  nph.answer <- 0.8417572
+  expect_equal(nph.answer,prediction@av.hr,tol=1.1e-3)
+  
+})
+
+