develop: switch from testthat to tinytest for unit testing of R package

Makefile

@@ -89,7 +89,7 @@ r_build: r_clean
 	@$(R) CMD INSTALL R-package/${pkg}
 
 r_test:
-	@$(R) -e 'testthat::test_package("./R-package/${pkg}/")'
+	@echo 'devtools::load_all("R-package/${pkg}"); tinytest::test_all("R-package/${pkg}/")' | $(R)
 
 r_lint:
 	@echo 'devtools::lint("./R-package/$(pkg)")' | $(R)

R-package/targeted/DESCRIPTION

@@ -46,7 +46,7 @@ Suggests:
     hal9001,
     mgcv,
     nnls,
-    testthat (>= 0.11),
+    tinytest,
     rmarkdown,
     scatterplot3d,
     SuperLearner (>= 2.0-28),

R-package/targeted/NAMESPACE

@@ -93,7 +93,9 @@ importFrom(graphics,points)
 importFrom(lava,IC)
 importFrom(lava,Inverse)
 importFrom(lava,estimate)
+importFrom(lava,expit)
 importFrom(lava,getoutcome)
+importFrom(lava,logit)
 importFrom(lava,na.pass0)
 importFrom(lava,score)
 importFrom(optimx,optimx)

R-package/targeted/R/targeted-package.R

@@ -9,7 +9,7 @@
 ##' @import Rcpp methods
 ##' @importFrom graphics plot points abline lines
 ##' @importFrom grDevices nclass.Sturges
-##' @importFrom lava IC getoutcome estimate Inverse na.pass0 score
+##' @importFrom lava IC getoutcome estimate Inverse na.pass0 score logit expit
 ##' @importFrom stats approxfun as.formula update binomial deriv density
 ##'  	glm.fit lm.wfit lm.fit glm lm coef vcov
 ##'     model.frame model.matrix na.pass nlminb predict

R-package/targeted/inst/tinytest/test-utils.R

@@ -0,0 +1,31 @@
+library("tinytest")
+
+test_softmax <- function() {
+  X <- cbind(1, 1)
+  expect_equivalent(softmax(X, ref = FALSE), cbind(.5, .5))
+
+  X <- rnorm(10)
+  expect_equivalent(softmax(X), expit(X))
+
+  X <- cbind(1, 2, 3)
+  expect_equivalent(softmax(X), exp(cbind(0, X)) / sum(exp(c(0, X))))
+}
+test_softmax()
+
+test_nondom <- function() {
+  x <- rbind(
+    c(1.0, 0.5),
+    c(0.0, 1.0),
+    c(1.0, 0.0),
+    c(0.5, 1.0),
+    c(1.0, 1.0),
+    c(0.8, 0.8)
+  )
+  y <- nondom(x)
+
+  res <- apply(y, 1, identity, simplify = FALSE)
+  true <- list(c(0, 1), c(0.8, 0.8), c(1, 0.5))
+  expect_true(nrow(y) == 3)
+  expect_true(length(setdiff(res, true)) == 0)
+}
+test_nondom()

R-package/targeted/tests/testthat/test-cate.R → R-package/targeted/inst/tinytest/test_cate.R

@@ -1,12 +1,11 @@
-context("CATE")
+library("tinytest")
 
 n <- 1000
 x <- rnorm(n)
 a <- rbinom(n, 1, expit(1 + x))
-y <- 1 + a + x -a*x + rnorm(n)
+y <- 1 + a + x - a * x + rnorm(n)
 d <- data.frame(y = y, a = a, x = x)
 
-
 simcate <- function(qmod) {
   q1 <- predict(lm(qmod, data = d),
     newdata = transform(d, a = 1)
@@ -19,7 +18,7 @@ simcate <- function(qmod) {
   dlinkinv <- g$family$mu.eta
   b <- a / pi^2 * (q1 - y)
   D <- dlinkinv(logit(pi)) * b
-  E1 <- colMeans(cbind(D, D*x))
+  E1 <- colMeans(cbind(D, D * x))
   ic1 <- IC(g) %*% E1
   ic <- ic0 + ic1
   e1 <- estimate(coef = est, IC = ic)
@@ -34,13 +33,6 @@ simcate <- function(qmod) {
     parameter(e1)[1:2],
     parameter(aa)["E[y(1)]", 1:2]
   )
-
 }
-
-testthat::test_that("cate: correct q-model", {
-  simcate(y ~ a*x)
-})
-
-testthat::test_that("cate: misspecified q-model", {
-  simcate(y ~ a + x)
-})
+simcate(y ~ a * x) # cate: correct q-model
+simcate(y ~ a + x) # cate: mis-specified q-model

R-package/targeted/inst/tinytest/test_pava.R

@@ -0,0 +1,10 @@
+n <- 10
+x <- runif(n, -4, 4)
+y <- rbinom(n, 1, lava::expit(-1 + x))
+ord <- order(x)
+pv <- targeted::pava(y[ord])
+xx <- x[ord[pv$index]]
+yy <- pv$value
+af <- stepfun(c(xx), c(yy, max(yy)), f = 0, right = TRUE)
+af2 <- as.stepfun(stats::isoreg(x, y))
+expect_equal(sum((af(x) - af2(x))^2), 0, tol = 1e-1)

R-package/targeted/inst/tinytest/test_riskreg.R

@@ -0,0 +1,14 @@
+set.seed(1)
+m <- lava::lvm(
+  a[-2] ~ 1 * x + z,
+  linpred.target[1] ~ 1,
+  linpred.nuisance[-1] ~ 2 * x + z
+)
+lava::distribution(m, ~a) <- lava::binomial.lvm("logit")
+m <- lava::binomial.rr(m, "y", "a", "linpred.target", "linpred.nuisance")
+d <- lava::sim(m, 1e3)
+
+fit <- targeted::riskreg(y ~ a | 1 | x + z | 1, data = d, type = "rr")
+influ <- lava::IC(fit)
+val <- colMeans(influ)^2
+expect_true(val < 1e-3)

R-package/targeted/tests/tinytest.R

@@ -0,0 +1,3 @@
+if (requireNamespace("tinytest", quietly = TRUE)) {
+  tinytest::test_package("targeted")
+}