tests/testthat/testthat_ciDists.R

## Test Messages ----
test_that("binCI() messages",{
  expect_error(binCI(-1,10),"must be non-negative")
  expect_error(binCI(1,-10),"must be non-negative")
  expect_error(binCI(11,10),"must not be greater than")
  expect_error(binCI("a",10),"must be whole numbers")
  expect_error(binCI(1,"a"),"must be whole numbers")
  expect_error(binCI(c(-1,2),10),"must be non-negative")
  expect_error(binCI(1,c(-1,10)),"must be non-negative")
  expect_error(binCI(1.1,10),"must be whole numbers")
  expect_error(binCI(1,10.1),"must be whole numbers")
  expect_error(binCI(c(1,1.1),10),"must be whole numbers")
  expect_error(binCI(1,c(9.1,10)),"must be whole numbers")
  expect_error(binCI(c(1,10),5),"must not be greater than")
  expect_error(binCI(c(1,10),c(5,9)),"must not be greater than")
  expect_error(binCI(6,c(5,9)),"must not be greater than")
  expect_error(binCI(6,10,type="derek"),"should be one of")
  expect_error(binCI(6,10,conf.level=0),"must be between 0 and 1")
  expect_error(binCI(6,10,conf.level=1),"must be between 0 and 1")
  expect_error(binCI(6,10,conf.level="R"),"must be numeric")
  expect_warning(binCI(6:9,10),"Can't use multiple 'type's with multiple 'x's")
  expect_error(binCI(data.frame(d=6:9),10),"'x' must be a single or vector")
  expect_error(binCI(2,data.frame(d=6:9)),"'n' must be a single or vector")
})

test_that("hyperCI() messages",{
  expect_error(hyperCI(-1,10,5),"must all be non-negative")
  expect_error(hyperCI(1,-10,5),"must all be non-negative")
  expect_error(hyperCI(1,10,-5),"must all be non-negative")
  expect_error(hyperCI(1,10,5),"'m' must be less than 'M'")
  expect_error(hyperCI(15,5,10),"'m' must be less than 'n'")
  expect_error(hyperCI("a",10,5),"must all be whole numbers")
  expect_error(hyperCI(15,"a",5),"must all be whole numbers")
  expect_error(hyperCI(15,10,"a"),"must all be whole numbers")
  expect_error(hyperCI(20.1,10,5),"must be a whole number")
  expect_error(hyperCI(15,10.1,5),"must be a whole number")
  expect_error(hyperCI(15,10,5.1),"must be a whole number")
  expect_error(hyperCI(c(15,15),10,5),"be a single value")
  expect_error(hyperCI(15,c(10,10),5),"be a single value")
  expect_error(hyperCI(15,10,c(5,5)),"be a single value")
  expect_error(hyperCI(c(15,15),c(10,10),c(5,5)),"be a single value")
  expect_error(hyperCI(15,10,5,conf.level=0),"must be between 0 and 1")
  expect_error(hyperCI(15,10,5,conf.level=1),"must be between 0 and 1")
  expect_error(hyperCI(15,10,5,conf.level="R"),"must be numeric")
})

test_that("poiCI() messages",{
  expect_error(poiCI(6,type="derek"),"should be one of")
  expect_error(poiCI(-1),"must be non-negative")
  expect_error(poiCI(c(-1,1:3)),"must be non-negative")
  expect_error(poiCI("a"),"must be a whole number")
  expect_error(poiCI(1.1),"must be a whole number")
  expect_error(poiCI(6,conf.level=0),"must be between 0 and 1")
  expect_error(poiCI(6,conf.level=1),"must be between 0 and 1")
  expect_error(poiCI(6,conf.level="R"),"must be numeric")
  expect_warning(poiCI(6:9),"Can't use multiple 'type's with multiple 'x's")
  expect_error(poiCI(data.frame(d=6:9)),"'x' must be a single or vector")
})


## Test Output Types ----
test_that("binCI() output types",{
  res <- binCI(7,10)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),3)
  expect_equal(ncol(res),2)  
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  expect_equal(rownames(res),c("Exact","Wilson","Asymptotic"))
  res <- binCI(c(3,7),10,type="wilson")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)  
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- binCI(c(3,7),10,type="exact")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)  
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- binCI(c(3,7),10,type="asymptotic")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)  
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  
  res <- binCI(7,10,verbose=TRUE)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),3)
  expect_equal(ncol(res),5)
  expect_equal(colnames(res),c("x","n","proportion","95% LCI","95% UCI"))
  expect_equal(rownames(res),c("Exact","Wilson","Asymptotic"))
  res <- binCI(c(3,7),10,type="wilson",verbose=TRUE)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),5)  
  expect_equal(colnames(res),c("x","n","proportion","95% LCI","95% UCI"))
  res <- binCI(c(3,7),10,type="exact",verbose=TRUE)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),5)  
  expect_equal(colnames(res),c("x","n","proportion","95% LCI","95% UCI"))
  res <- binCI(c(3,7),10,type="asymptotic",verbose=TRUE)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),5)  
  expect_equal(colnames(res),c("x","n","proportion","95% LCI","95% UCI"))
})

test_that("hyperCI() output types",{
  res <- hyperCI(20,20,10)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),1)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
})

test_that("poiCI() output types",{
  res <- poiCI(10)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),4)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  expect_equal(rownames(res),c("Exact","Daly","Byar","Asymptotic"))
  res <- poiCI(10,type="exact")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),1)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10,type="daly")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),1)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10,type="byar")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),1)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10,type="asymptotic")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),1)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10,type=c("exact","daly"))
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  expect_equal(rownames(res),c("Exact","Daly"))
  res <- poiCI(10,type="exact",verbose=TRUE)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),1)
  expect_equal(ncol(res),3)
  expect_equal(colnames(res),c("x","95% LCI","95% UCI"))
  expect_equal(rownames(res),"Exact")
  res <- poiCI(10,type=c("exact","daly"),verbose=TRUE)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),3)
  expect_equal(colnames(res),c("x","95% LCI","95% UCI"))
  expect_equal(rownames(res),c("Exact","Daly"))
  
  res <- poiCI(10:11,type="exact")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10:11,type="daly")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10:11,type="byar")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  res <- poiCI(10:11,type="asymptotic")
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),2)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  
  res <- poiCI(0)
  expect_is(res,"matrix")
  expect_true(is.numeric(res))
  expect_equal(nrow(res),4)
  expect_equal(ncol(res),2)
  expect_equal(colnames(res),c("95% LCI","95% UCI"))
  expect_equal(rownames(res),c("Exact","Daly","Byar","Asymptotic"))
})


## Validate Results ----
test_that("binCI() compared to epitools functions",{
  res <- binCI(7,10,verbose=TRUE)
  res[,4:5] <- round(res[,4:5],7)
  ### These are hand-entered results from old epitools package
  resepi <- matrix(c(7,10,0.7,0.3475471,0.9332605,
                     7,10,0.7,0.3967781,0.8922087,
                     7,10,0.7,0.4159742,0.9840258),nrow=3,byrow=TRUE)
  rownames(resepi) <- c("Exact","Wilson","Asymptotic")
  colnames(resepi) <- c("x","n","proportion","lower","upper")
  expect_equivalent(res,resepi)
  
  res <- binCI(5:7,10,type="wilson",verbose=TRUE)
  res[,4:5] <- round(res[,4:5],7)
  ### These are hand-entered results from old epitools package
  resepi <- matrix(c(5,10,0.5,0.2365931,0.7634069,
                     6,10,0.6,0.3126738,0.8318197,
                     7,10,0.7,0.3967781,0.8922087),nrow=3,byrow=TRUE)
  colnames(resepi) <- c("x","n","proportion","lower","upper")
  expect_equivalent(res,resepi)
})

test_that("poiCI() compared to epitools functions",{
  res <- poiCI(10,verbose=TRUE)
  res[,2] <- round(res[,2],6)
  res[,3] <- round(res[,3],5)
  ### These are hand-entered results from old epitools package
  resepi <- matrix(c(10,4.795389,18.39036,
                     10,4.795389,18.39036,
                     10,5.133753,17.74048,
                     10,3.802050,16.19795),nrow=4,byrow=TRUE)
  rownames(resepi) <- c("Exact","Daly","Byar","Asymptotic")
  colnames(resepi) <- c("x","lower","upper")
  expect_equivalent(res,resepi)
  
  res <- poiCI(5:7,type="exact",verbose=TRUE)
  res[,2] <- round(res[,2],6)
  res[,3] <- round(res[,3],5)
  ### These are hand-entered results from old epitools package
  resepi <- matrix(c(5,1.623486,11.66832,
                     6,2.201891,13.05948,
                     7,2.814358,14.42268),nrow=3,byrow=TRUE)
  colnames(resepi) <- c("x","lower","upper")
  expect_equivalent(res,resepi)
})

Try the FSA package in your browser

Any scripts or data that you put into this service are public.

FSA documentation built on Aug. 27, 2023, 1:06 a.m.