tests/testthat/testthat_glmFit.R

In POSTm: Phylogeny-Guided OTU-Specific Association Test for Microbiome Data

test_that("`.glmFit()` handles intercept only properly", {
  
  y <- withr::with_seed(1234L,
                        rbinom(1000, 1, 0.4))
  # logistic regression
  glmfit <- stats::glm(y ~ 1, family = "binomial")
  
  mu  <- glmfit$fitted.values
  res.wk <- glmfit$residuals
  res <- y - mu
  
  sqrtw <- {mu * {1.0 - mu}} |> sqrt()

  adj <- sum({sqrtw * res.wk}^2)
  
  DX12 <- sqrtw
  
  qrX <- qr(x = DX12, tol = 1e-7)
  Q <- qr.Q(qr = qrX)
  Q <- Q[, 1L:qrX$rank, drop = FALSE]
  
  P0 <- diag(1000L) - tcrossprod(x = Q)
  
  expected <- list("Q" = Q, 
               "sqrtw" = sqrtw,  
               "P0" = P0,  
               "res" = res,  
               "adj" = adj)
  
  expect_equal(.glmFit(y, matrix(1, 1000, 0)),
               expected)
})