tests/testthat/test-link.R

In neuralGAM: Interpretable Neural Network Based on Generalized Additive Models

library(testthat)
library(reticulate)

skip_if_no_keras <- function() {

  if (!tryCatch(
    reticulate::py_module_available("keras"),
    error = function(e) return(FALSE)
  )
  ) skip("keras not available for testing...")
}
test_that("Link function for gaussian family should be equal to muhat", {
  skip_if_no_keras()

  family <- "gaussian"
  muhat <- c(0.1, 0.5, 0.9)
  expected_output <- muhat
  actual_output <- link(family, muhat)
  expect_equal(actual_output, expected_output)
})

# Test case 2: Check the link function for binomial family
test_that("Link function for binomial family should be correctly calculated", {
  skip_if_no_keras()

  family <- "binomial"
  muhat <- c(0.2, 0.7, 0.99)
  expected_output <- exp(muhat) / (1 + exp(muhat))
  actual_output <- link(family, muhat)
  expect_equal(actual_output, expected_output)
})

# Test case 3: Check for missing 'muhat' argument
test_that("Function should throw an error for missing 'muhat' argument", {
  skip_if_no_keras()

  family <- "gaussian"
  expect_error(link(family))
})

# Test case 4: Check for missing 'family' argument
test_that("Function should throw an error for missing 'family' argument", {
  skip_if_no_keras()

  muhat <- c(0.1, 0.5, 0.9)
  expect_error(link(muhat = muhat))
})

# Test case 5: Check for unsupported family
test_that("Function should throw an error for unsupported 'family'", {
  family <- "poisson"
  muhat <- c(0.1, 0.5, 0.9)
  expect_error(link(family, muhat))
})

# Test case 6: Check that large positive values of muhat are capped at 10 for binomial family
test_that("Function should cap large positive values of muhat at 10 for binomial family", {
  skip_if_no_keras()

  family <- "binomial"
  muhat <- c(11, 20, 30)
  expected_cap_muhat <- exp(10) / (1 + exp(10))  # muhat capped at 10
  expected_output <- rep(expected_cap_muhat, length(muhat))
  actual_output <- link(family, muhat)
  testthat::expect_equal(expected_output, actual_output)
})

# Test case 7: Check that large negative values of muhat are capped at -10 for binomial family
test_that("Function should cap large negative values of muhat at -10 for binomial family", {
  skip_if_no_keras()

  family <- "binomial"
  muhat <- c(-11, -20, -30)
  expected_cap_muhat <- exp(-10) / (1 + exp(-10)) # muhat capped at -10
  expected_output <- rep(rep(expected_cap_muhat, length(muhat)))
  actual_output <- link(family, muhat)
  expect_equal(actual_output, expected_output)
})