library(testthat) test_that("rss.sampling works as expected",{ data(iris) id=1:nrow(iris) result <- rss.sampling(ID=id, Y=iris$Sepal.Length, X=iris$Petal.Length, H=3, nsamp=c(3,5,7)) expect_s3_class(result,"data.frame") expect_equal(colnames(result), c("rank","ID","y")) expect_equal(dim(result), c(15,3)) result.lth <- as.numeric(tapply(result$y,result$rank,length)) expect_equal(result.lth, c(3,5,7)) }) test_that("rss.sampling handles wrong input with error",{ data(iris) id=1:nrow(iris) expect_error(rss.sampling(ID=id, Y=iris$Sepal.Length, X=iris$Petal.Length, H=5, nsamp=c(3,5,7)), "Set size are different with the length of sample allocations") expect_error(rss.sampling(ID=id, Y=iris$Sepal.Length, X=iris$Petal.Length, H=2, nsamp=c(3,5,7)), "Set size are different with the length of sample allocations") # Mismatched lengths of ID, X, Y expect_error(rss.sampling(ID = id[-1], Y = iris$Sepal.Length, X = iris$Petal.Length, H = 3, nsamp = c(3, 5, 7)), "ID and X must have the same length.") expect_error(rss.sampling(ID = id, Y = iris$Sepal.Length[-1], X = iris$Petal.Length, H = 3, nsamp = c(3, 5, 7)), "ID and Y must have the same length if Y is provided.") # Non-unique IDs expect_error(rss.sampling(ID = c(id, id), Y = c(iris$Sepal.Length, iris$Sepal.Length), X = c(iris$Petal.Length, iris$Petal.Length), H = 3, nsamp = c(3, 5, 7)), "ID must be unique.") })