tests/testthat/test-savvy_glm2.R

In savvyGLM: Generalized Linear Models with Slab and Shrinkage Estimators

library(testthat)
library(savvyGLM)

test_that("Logistic regression with intercept", {
  set.seed(123)
  n <- 100
  p <- 5
  x1 <- matrix(rnorm(n * p), n, p)
  y1 <- rbinom(n, 1, prob = 0.5)
  data1 <- data.frame(y1, x1)
  fit1 <- suppressWarnings(savvy_glm2(y1 ~ ., family = binomial(link = "logit"), data = data1,  model_class = c("St", "LW")))

  expect_true(is.numeric(fit1$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit1$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit1$converged, info = "Model should converge")
})

test_that("Logistic regression without intercept", {
  set.seed(123)
  n <- 100
  p <- 5
  x2 <- matrix(rnorm(n * p), n, p)
  y2 <- rbinom(n, 1, prob = 0.5)
  data2 <- data.frame(y2, x2)
  fit2 <- suppressWarnings(savvy_glm2(y2 ~ . - 1, family = binomial(link = "logit"), data = data2, model_class = "QIS"))

  expect_true(is.numeric(fit2$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit2$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit2$converged, info = "Model should converge")
})

test_that("Gaussian family with intercept", {
  set.seed(123)
  n <- 100
  p <- 5
  x3 <- matrix(rnorm(n * p), n, p)
  y3 <- rnorm(n)
  data3 <- data.frame(y3, x3)
  fit3 <- suppressWarnings(savvy_glm2(y3 ~ ., family = gaussian(), data = data3, model_class = "GSR"))

  expect_true(is.numeric(fit3$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit3$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit3$converged, info = "Model should converge")
})

test_that("Poisson family with intercept", {
  set.seed(123)
  n <- 100
  p <- 5
  x4 <- matrix(rnorm(n * p), n, p)
  y4 <- rpois(n, lambda = 2)
  data4 <- data.frame(y4, x4)
  fit4 <- suppressWarnings(savvy_glm2(y4 ~ ., family = poisson(), data = data4, model_class = c("LW", "QIS")))

  expect_true(is.numeric(fit4$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit4$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit4$converged, info = "Model should converge")
})

test_that("Gaussian family without intercept", {
  set.seed(123)
  n <- 100
  p <- 5
  x5 <- matrix(rnorm(n * p), n, p)
  y5 <- rnorm(n)
  data5 <- data.frame(y5, x5)
  fit5 <- suppressWarnings(savvy_glm2(y5 ~ . - 1, family = gaussian(), data = data5))

  expect_true(is.numeric(fit5$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit5$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit5$converged, info = "Model should converge")
})

test_that("Handling missing data", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  x[sample(length(x), 10)] <- NA
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, na.action = na.omit))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Different control parameters", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data,
                                     model_class = c("SR", "St"), control = glm.control(epsilon = 1e-8, maxit = 100)))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Large dataset", {
  set.seed(123)
  n <- 10000
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, model_class = c("LW", "SR")))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Small dataset", {
  set.seed(123)
  n <- 10
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, model_class = "QIS"))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Different link functions for Gaussian family", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)

  y_id <- rnorm(n)
  fit_identity <- suppressWarnings(savvy_glm2(y_id ~ ., family = gaussian(link = "identity"), data = data.frame(y_id, x), model_class = "QIS"))
  expect_true(is.numeric(fit_identity$coefficients), info = "Coefficients should be numeric for identity link")
  expect_true(fit_identity$converged, info = "Model should converge for identity link")

  y_pos <- exp(rnorm(n, mean = 1, sd = 0.5))
  fit_log <- suppressWarnings(savvy_glm2(y_pos ~ ., family = gaussian(link = "log"), data = data.frame(y_pos, x), use_robust_start = TRUE))
  expect_true(is.numeric(fit_log$coefficients), info = "Coefficients should be numeric for log link")
  expect_true(fit_log$converged, info = "Model should converge for log link")

  fit_inverse <- suppressWarnings(savvy_glm2(y_pos ~ ., family = gaussian(link = "inverse"), data = data.frame(y_pos, x), use_robust_start = TRUE))
  expect_true(is.numeric(fit_inverse$coefficients), info = "Coefficients should be numeric for inverse link")
})

test_that("Different link functions for Binomial family", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  links <- c("logit", "probit", "cauchit", "cloglog")
  for (l in links) {
    fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = l), data = data, model_class = "LW", use_robust_start = TRUE))
    expect_true(is.numeric(fit$coefficients), info = paste("Coefficients should be numeric for", l, "link"))
  }
})

test_that("Different link functions for Gamma family", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(abs(rnorm(n * p)), n, p)
  true_beta <- c(1, rep(0.1, p))
  eta <- drop(cbind(1, x) %*% true_beta)

  links <- c("inverse", "identity", "log")
  for (l in links) {
    if (l == "inverse") mu <- 1 / eta
    else if (l == "identity") mu <- eta
    else if (l == "log") mu <- exp(eta)

    y <- rgamma(n, shape = 2, rate = 2 / mu)
    data <- data.frame(y, x)

    fit <- suppressWarnings(savvy_glm2(y ~ ., family = Gamma(link = l), data = data, model_class = "QIS", use_robust_start = TRUE))
    expect_true(is.numeric(fit$coefficients), info = paste("Coefficients should be numeric for", l, "link"))
  }
})

test_that("Different link functions for Inverse Gaussian family", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(abs(rnorm(n * p)), n, p)
  true_beta <- c(1, rep(0.1, p))
  eta <- drop(cbind(1, x) %*% true_beta)

  links <- c("1/mu^2", "inverse", "log", "identity")
  for (l in links) {
    if (l == "1/mu^2") mu <- 1 / sqrt(eta)
    else if (l == "inverse") mu <- 1 / eta
    else if (l == "log") mu <- exp(eta)
    else if (l == "identity") mu <- eta

    y <- abs(mu + rnorm(n, 0, 0.05 * mean(mu))) + 0.01
    data <- data.frame(y, x)

    fit <- suppressWarnings(savvy_glm2(y ~ ., family = inverse.gaussian(link = l), data = data, model_class = "St", use_robust_start = TRUE))
    expect_true(is.numeric(fit$coefficients), info = paste("Coefficients should be numeric for", l, "link"))
  }
})

test_that("Custom Power link function handling via Quasi family", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(abs(rnorm(n * p)), n, p)
  y <- rpois(n, lambda = 5) + 1
  data <- data.frame(y, x)

  custom_family <- quasi(link = stats::power(-2), variance = "mu")
  fit <- suppressWarnings(savvy_glm2(y ~ ., data = data, model_class = "LW", family = custom_family, use_robust_start = TRUE))
  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric for custom power(-2) link")
})

test_that("Offset handling", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rpois(n, lambda = 2)
  offset <- rep(0.5, n)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = poisson(), data = data, offset = offset))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
  expect_true(all(fit$offset == offset), info = "Offset should be correctly handled")
})

test_that("Valideta and Validmu functions", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  family <- binomial(link = "logit")
  family$valideta <- function(eta) FALSE

  expect_error(
    savvy_glm2(y ~ ., family = family, data = data),
    "cannot find valid starting values"
  )
})

test_that("Initialization with mustart", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)

  mustart <- rep(mean(y), n)
  fit <- suppressWarnings(savvy_glm2(y ~ ., data = data, mustart = mustart, family = gaussian()))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Handling of empty model", {
  n <- 100
  y <- rnorm(n)
  data <- data.frame(y)
  fit <- suppressWarnings(savvy_glm2(y ~ 0, data = data, family = gaussian()))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_equal(length(fit$coefficients), 0, info = "Coefficients should be empty for an empty model")
  expect_true(fit$converged, info = "Empty model should converge")
})

test_that("Valideta and validmu functions in empty model", {
  n <- 100
  y <- rnorm(n)
  data <- data.frame(y)

  family <- gaussian()
  family$valideta <- function(eta) all(eta > -1)
  family$validmu <- function(mu) all(mu < 2)

  fit <- suppressWarnings(savvy_glm2(y ~ 0, data = data, family = family))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_equal(length(fit$coefficients), 0, info = "Coefficients should be empty for an empty model")
  expect_true(fit$converged, info = "Empty model should converge")
})

test_that("Invalid eta in empty model", {
  n <- 100
  y <- rnorm(n)
  data <- data.frame(y)

  family <- gaussian()
  family$valideta <- function(eta) FALSE

  expect_error(
    savvy_glm2(y ~ 0, data = data, family = family),
    "invalid linear predictor values in empty model"
  )
})

test_that("Invalid mu in empty model", {
  n <- 100
  y <- rnorm(n)
  data <- data.frame(y)

  family <- gaussian()
  family$validmu <- function(mu) FALSE

  expect_error(
    savvy_glm2(y ~ 0, data = data, family = family),
    "invalid fitted means in empty model"
  )
})

test_that("NA values in varmu", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)

  family <- gaussian()
  family$variance <- function(mu) {
    res <- rep(1, length(mu))
    res[1] <- NA
    res
  }

  expect_error(
    savvy_glm2(y ~ ., data = data, family = family),
    "NAs in V\\(mu\\)"
  )
})

test_that("Zero values in varmu", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)

  family <- gaussian()
  family$variance <- function(mu) {
    res <- rep(1, length(mu))
    res[1] <- 0
    res
  }

  expect_error(
    savvy_glm2(y ~ ., data = data, family = family),
    "0s in V\\(mu\\)"
  )
})

test_that("NA values in mu.eta.val", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)

  family <- gaussian()
  family$mu.eta <- function(eta) {
    res <- rep(1, length(eta))
    res[1] <- NA
    res
  }

  expect_error(
    savvy_glm2(y ~ ., data = data, family = family),
    "NAs in d\\(mu\\)/d\\(eta\\)"
  )
})

capture_warnings <- function(expr) {
  warnings <- NULL
  withCallingHandlers(expr, warning = function(w) {
    warnings <<- c(warnings, conditionMessage(w))
    invokeRestart("muffleWarning")
  })
  warnings
}

test_that("Trace output for deviance and iterations", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)

  family <- gaussian()
  family$valideta <- function(eta) TRUE
  family$validmu <- function(mu) TRUE
  control <- list(trace = TRUE, maxit = 1, epsilon = 1e-8)
  trace_output <- capture.output({
    suppressWarnings(savvy_glm2(y ~ ., data = data, family = family, control = control))
  })

  expect_true(any(grepl("Deviance =", trace_output)), info = "Trace output should contain deviance information")
  expect_true(any(grepl("Iterations -", trace_output)), info = "Trace output should contain iteration information")
})

test_that("No valid set of coefficients", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)

  family <- gaussian()
  family$dev.resids <- function(y, mu, wt) {
    res <- (y - mu)^2
    res[1] <- Inf
    res
  }
  expect_error(
    savvy_glm2(y ~ ., data = data, family = family, control = list(maxit = 5)),
    "No valid set of coefficients found for any fitting function")
})

test_that("Algorithm stopped at boundary value", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rnorm(n)
  data <- data.frame(y, x)
  family <- gaussian()
  family$linkinv <- function(eta) {
    eta[eta > 1] <- 1e10
    eta
  }

  warnings <- capture_warnings({
    savvy_glm2(y ~ ., data = data, family = family, control = list(maxit = 5))
  })
  found_truncation <- any(grepl("step size truncated", warnings))
  expect_true(found_truncation, info = "Warning about step size truncation expected")
})

test_that("Rank-deficient matrix handling", {
  set.seed(123)
  n <- 10
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  x[, 2] <- x[, 1]
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
})

test_that("All zeros in response variable", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rep(0, n)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, model_class = "St"))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
})

test_that("All ones in response variable", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rep(1, n)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, model_class = "GSR"))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
})

test_that("Convergence with different starting values", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  start_values <- rep(0.5, p + 1)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, start = start_values))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Family argument as a string", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = "binomial", data = data))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(is.character(fit$chosen_fit), info = "Chosen fitting method should be character")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Invalid family argument string", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  expect_error(
    savvy_glm2(y ~ ., family = "invalid_family", data = data),
    "object 'invalid_family' of mode 'function' was not found"
  )
})

test_that("Using model.frame method", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  mf <- savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, method = "model.frame")
  expect_true(is.data.frame(mf), info = "model.frame should return a data frame")
  expect_equal(nrow(mf), n, info = "model.frame should return correct number of rows")
  expect_equal(ncol(mf), p + 1, info = "model.frame should return correct number of columns")
})

test_that("Handling response vector dimensions", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- matrix(rbinom(n, 1, prob = 0.5), n, 1)
  data <- data.frame(y, x)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data))

  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(fit$converged, info = "Model should converge")
})

test_that("Handling weights argument validation", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  weights <- runif(n, 0, 1)
  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, weights = weights))
  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(fit$converged, info = "Model should converge")

  weights <- runif(n, -1, 0)
  expect_error(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, weights = weights),
               "negative weights not allowed")

  weights <- rep("a", n)
  expect_error(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, weights = weights),
               "'weights' must be a numeric vector")
})

test_that("Offset length mismatch", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  offset <- runif(n + 1)
  expect_error(
    savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, offset = offset),
    "variable lengths differ \\(found for '\\(offset\\)'\\)"
  )
})

test_that("Invalid family object", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  invalid_family <- list(family = "invalid")
  expect_error(
    savvy_glm2(y ~ ., family = invalid_family, data = data),
    "'family' argument seems not to be a valid family object"
  )
})

test_that("Unrecognized family with NULL family argument and suppresses print output", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  expect_error(
    capture.output(suppressMessages(savvy_glm2(y ~ ., family = NULL, data = data))),
    "'family' not recognized"
  )
})

test_that("Exclude x and y from the fit object", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, x = FALSE, y = FALSE))
  expect_false(is.null(fit$x), info = "x matrix should not be included in the fit object")
  expect_true(is.null(fit$y), info = "y vector should not be included in the fit object")
})

test_that("Include x and y in the fit object", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, x = TRUE, y = TRUE))
  expect_true(!is.null(fit$x), info = "x matrix should be included in the fit object")
  expect_true(!is.null(fit$y), info = "y vector should be included in the fit object")
})

test_that("Non-convergence in null deviance fit", {
  set.seed(123)
  n <- 100
  p <- 5
  x <- matrix(rnorm(n * p), n, p)
  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)
  offset <- rep(10, n)

  captured_warnings <- list()
  fit <- withCallingHandlers(
    savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data, control = list(maxit = 1), offset = offset),
    warning = function(w) {
      captured_warnings <<- c(captured_warnings, list(w))
      invokeRestart("muffleWarning")
    }
  )

  warning_messages <- sapply(captured_warnings, function(w) w$message)
  null_deviance_warning <- any(grepl("fitting to calculate the null deviance did not converge -- increase maxit?", warning_messages))

  expect_true(null_deviance_warning, info = "Warning expected for non-convergence in null deviance fit")
  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
})

test_that("Handling response matrix Y", {
  set.seed(123)
  n <- 100
  p <- 5

  x <- matrix(rnorm(n * p), n, p)
  y <- matrix(rbinom(n, 1, prob = 0.5), n, 1)
  rownames(y) <- paste0("obs", 1:n)
  data <- data.frame(y = y[,1], x)

  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data))
  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(!is.null(fit$y), info = "Response variable should be included in the fit object")
  expect_true(all(names(fit$y) == paste0("obs", 1:n)), info = "Response variable names should be correctly set")

  y <- matrix(rbinom(n, 1, prob = 0.5), n, 1)
  rownames(y) <- NULL
  data <- data.frame(y = y[,1], x)

  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data))
  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(!is.null(fit$y), info = "Response variable should be included in the fit object")
  expect_true(is.null(rownames(fit$y)), info = "Response variable rownames should be NULL when not set")

  y <- rbinom(n, 1, prob = 0.5)
  data <- data.frame(y, x)

  fit <- suppressWarnings(savvy_glm2(y ~ ., family = binomial(link = "logit"), data = data))
  expect_true(is.numeric(fit$coefficients), info = "Coefficients should be numeric")
  expect_true(!is.null(fit$y), info = "Response variable should be included in the fit object")
})

test_that("savvy_glm2 handles invalid method argument", {
  set.seed(123)
  x <- matrix(rnorm(100), ncol = 2)
  y <- rpois(50, lambda = exp(x %*% c(0.5, -0.2)))
  data <- data.frame(y, x1 = x[,1], x2 = x[,2])

  expect_error(
    savvy_glm2(y ~ x1 + x2, family = poisson(), data = data, method = 123),
    "invalid 'method' argument"
  )
})

test_that("savvy_glm2 handles one-dimensional array response Y correctly", {
  set.seed(123)
  x <- matrix(rnorm(100), ncol = 2)
  colnames(x) <- c("x1", "x2")
  y <- array(rpois(50, lambda = exp(x %*% c(0.5, -0.2))), dim = c(50))
  rownames_y <- as.character(1:length(y))

  y_matrix <- as.matrix(y)
  rownames(y_matrix) <- rownames_y
  dim(y_matrix) <- c(50, 1)

  data <- data.frame(y = y_matrix, x)
  fit <- suppressWarnings(savvy_glm2(y ~ x1 + x2, family = poisson(), data = data))

  expect_true(is.null(dim(fit$y)))
  expect_true(!is.null(names(fit$y)))
  expect_equal(names(fit$y), rownames_y)
  expect_true(!is.null(fit$coefficients))
})

test_that("savvy_glm2 processes valid method argument and control options", {
  set.seed(123)
  x <- matrix(rnorm(100), ncol = 2)
  colnames(x) <- c("x1", "x2")
  y <- rpois(50, lambda = exp(x %*% c(0.5, -0.2)))
  data <- data.frame(y, x)

  fit <- suppressWarnings(savvy_glm2(y ~ x1 + x2, family = poisson(),
                                     data = data, model_class = "DSh", method = "savvy_glm.fit2"))

  expect_s3_class(fit, "glm")
  expect_equal(fit$method, "savvy_glm.fit2")
})

test_that("savvy_glm2 handles missing data argument correctly", {
  set.seed(123)
  x <- matrix(rnorm(100), ncol = 2)
  colnames(x) <- c("x1", "x2")
  y <- rpois(50, lambda = exp(x %*% c(0.5, -0.2)))

  formula <- y ~ x1 + x2
  x1 <- x[, 1]
  x2 <- x[, 2]

  fit <- suppressWarnings(savvy_glm2(formula, family = poisson()))

  expect_s3_class(fit, "glm")
  expect_true(!is.null(fit$coefficients))
  expect_true("y" %in% names(fit$model))
  expect_true("x1" %in% names(fit$model))
  expect_true("x2" %in% names(fit$model))
})