tests/testthat/test-family-utils.R

In gavinsimpson/gratia: Graceful 'ggplot'-Based Graphics and Other Functions for GAMs Fitted Using 'mgcv'

## Test family and link utilities

val <- 1
l <- list(mer = 1:3, gam = 1:3)

test_that("link() works with a glm() model", {
  f <- link(m_glm)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkfun)
})

test_that("link() works with a gam() model", {
  f <- link(m_gam)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkfun)
})

test_that("link() works with a gamm() model", {
  f <- link(m_gamm)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkfun)
})

test_that("link() works with a gamm4() model", {
  f <- link(m_gamm4)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkfun)
})

test_that("link.list() fails with a list that isn't a gamm4", {
  expect_error(link(l),
    regexp = "`object` does not appear to a `gamm4` model object",
    fixed = TRUE
  )
})

test_that("link() works with a bam() model", {
  f <- link(m_bam)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkfun)
})

test_that("link() works with a gam() gaulss model", {
  f <- link(m_gaulss)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkfun)
})

test_that("inv_link() works with a gam() model", {
  f <- inv_link(m_gam)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkinv)
})

test_that("inv_link() works with a glm() model", {
  f <- inv_link(m_glm)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkinv)
})

test_that("inv_link() works with a gamm() model", {
  f <- inv_link(m_gamm)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkinv)
})

test_that("inv_link() works with a gamm4() model", {
  f <- inv_link(m_gamm4)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkinv)
})

test_that("inv_link() works with a bam() model", {
  f <- inv_link(m_bam)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkinv)
})

test_that("inv_link.list() fails with a list that isn't a gamm4", {
  expect_error(inv_link(l),
    regexp = "`object` does not appear to a `gamm4` model object",
    fixed = TRUE
  )
})

test_that("inv_link() works with a gam() gaulss model", {
  f <- inv_link(m_gaulss)
  expect_type(f, "closure")
  expect_identical(f, gaussian()$linkinv)
})

## link
test_that("link() works for gaussian() family objects", {
  f <- link(gaussian())
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, gaussian()$linkfun)
})

test_that("link() works for poisson() family objects", {
  f <- link(poisson())
  expect_type(f, "closure")
  expect_identical(f(val), log(val))
  expect_identical(f, poisson()$linkfun)
})

test_that("link() works for binomial() family objects", {
  f <- link(binomial())
  expect_type(f, "closure")
  expect_identical(f(val), binomial()$linkfun(val))
  expect_identical(f, binomial()$linkfun)
})

test_that("link() works for Gamma() family objects", {
  f <- link(Gamma())
  expect_type(f, "closure")
  expect_identical(f(val), Gamma()$linkfun(val))
  expect_identical(f, Gamma()$linkfun)
})

test_that("link() works for inverse.gaussian() family objects", {
  f <- link(inverse.gaussian())
  expect_type(f, "closure")
  expect_identical(f(val), inverse.gaussian()$linkfun(val))
  expect_identical(f, inverse.gaussian()$linkfun)
})

test_that("link() works for quasi() family objects", {
  f <- link(quasi())
  expect_type(f, "closure")
  expect_identical(f(val), quasi()$linkfun(val))
  expect_identical(f, quasi()$linkfun)
})

test_that("link() works for quasibinomial() family objects", {
  f <- link(quasibinomial())
  expect_type(f, "closure")
  expect_identical(f(val), quasibinomial()$linkfun(val))
  expect_identical(f, quasibinomial()$linkfun)
})

test_that("link() works for quasipoisson() family objects", {
  f <- link(quasipoisson())
  expect_type(f, "closure")
  expect_identical(f(val), quasipoisson()$linkfun(val))
  expect_identical(f, quasipoisson()$linkfun)
})

test_that("link() works for negbin() family objects", {
  theta <- 1.1
  f <- link(negbin(theta = theta))
  expect_type(f, "closure")
  expect_identical(f(val), negbin(theta = theta)$linkfun(val))
  expect_identical(f, negbin(theta = theta)$linkfun)
})

test_that("link() works for nb() family objects", {
  f <- link(nb())
  expect_type(f, "closure")
  expect_identical(f(val), nb()$linkfun(val))
  expect_identical(f, nb()$linkfun)
})

test_that("link() works for Tweedie() family objects", {
  p <- 1.1
  f <- link(Tweedie(p = p))
  expect_type(f, "closure")
  expect_identical(f(val), Tweedie(p = p)$linkfun(val))
  expect_identical(f, Tweedie(p = p)$linkfun)
})

test_that("link() works for tw() family objects", {
  f <- link(tw())
  expect_type(f, "closure")
  expect_identical(f(val), tw()$linkfun(val))
  expect_identical(f, tw()$linkfun)
})

test_that("link() works for scat() family objects", {
  f <- link(scat())
  expect_type(f, "closure")
  expect_identical(f(val), scat()$linkfun(val))
  expect_identical(f, scat()$linkfun)
})

test_that("link() works for scat() family objects", {
  f <- link(m_scat)
  expect_type(f, "closure")
  expect_identical(f(val), scat()$linkfun(val))
  expect_identical(f, scat()$linkfun)
})

test_that("link() works for betar() family objects", {
  f <- link(betar())
  expect_type(f, "closure")
  expect_identical(f(val), betar()$linkfun(val))
  expect_identical(f, betar()$linkfun)
})

test_that("link() works for ocat() family objects", {
  theta <- 1.1
  f <- link(ocat(theta = theta))
  expect_type(f, "closure")
  expect_identical(f(val), ocat(theta = theta)$linkfun(val))
  expect_identical(f, ocat(theta = theta)$linkfun)
})

test_that("link() works for ziP() family objects", {
  f <- link(ziP())
  expect_type(f, "closure")
  expect_identical(f(val), ziP()$linkfun(val))
  expect_identical(f, ziP()$linkfun)
})

test_that("link() works for cox.ph() family objects", {
  f <- link(cox.ph())
  expect_type(f, "closure")
  expect_identical(f(val), cox.ph()$linkfun(val))
  expect_identical(f, cox.ph()$linkfun)
})

test_that("link() works for cnorm() family objects", {
  f <- link(cnorm())
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, cnorm()$linkfun)
})

## inv_link
test_that("inv_link() works for gaussian() family objects", {
  f <- inv_link(gaussian())
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, gaussian()$linkinv)
})

test_that("inv_link() works for poisson() family objects", {
  f <- inv_link(poisson())
  expect_type(f, "closure")
  expect_identical(f(val), exp(val))
  expect_identical(f, poisson()$linkinv)
})

test_that("inv_link() works for binomial() family objects", {
  f <- inv_link(binomial())
  expect_type(f, "closure")
  expect_identical(f(val), binomial()$linkinv(val))
  expect_identical(f, binomial()$linkinv)
})

test_that("inv_link() works for Gamma() family objects", {
  f <- inv_link(Gamma())
  expect_type(f, "closure")
  expect_identical(f(val), Gamma()$linkinv(val))
  expect_identical(f, Gamma()$linkinv)
})

test_that("inv_link() works for inverse.gaussian() family objects", {
  f <- inv_link(inverse.gaussian())
  expect_type(f, "closure")
  expect_identical(f(val), inverse.gaussian()$linkinv(val))
  expect_identical(f, inverse.gaussian()$linkinv)
})

test_that("inv_link() works for quasi() family objects", {
  f <- inv_link(quasi())
  expect_type(f, "closure")
  expect_identical(f(val), quasi()$linkinv(val))
  expect_identical(f, quasi()$linkinv)
})

test_that("inv_link() works for quasibinomial() family objects", {
  f <- inv_link(quasibinomial())
  expect_type(f, "closure")
  expect_identical(f(val), quasibinomial()$linkinv(val))
  expect_identical(f, quasibinomial()$linkinv)
})

test_that("inv_link() works for quasipoisson() family objects", {
  f <- inv_link(quasipoisson())
  expect_type(f, "closure")
  expect_identical(f(val), quasipoisson()$linkinv(val))
  expect_identical(f, quasipoisson()$linkinv)
})

test_that("inv_link() works for negbin() family objects", {
  theta <- 1.1
  f <- inv_link(negbin(theta = theta))
  expect_type(f, "closure")
  expect_identical(f(val), negbin(theta = theta)$linkinv(val))
  expect_identical(f, negbin(theta = theta)$linkinv)
})

test_that("inv_link() works for nb() family objects", {
  f <- inv_link(nb())
  expect_type(f, "closure")
  expect_identical(f(val), nb()$linkinv(val))
  expect_identical(f, nb()$linkinv)
})

test_that("inv_link() works for Tweedie() family objects", {
  p <- 1.1
  f <- inv_link(Tweedie(p = p))
  expect_type(f, "closure")
  expect_identical(f(val), Tweedie(p = p)$linkinv(val))
  expect_identical(f, Tweedie(p = p)$linkinv)
})

test_that("inv_link() works for tw() family objects", {
  f <- inv_link(tw())
  expect_type(f, "closure")
  expect_identical(f(val), tw()$linkinv(val))
  expect_identical(f, tw()$linkinv)
})

test_that("inv_link() works for scat() family objects", {
  f <- inv_link(scat())
  expect_type(f, "closure")
  expect_identical(f(val), scat()$linkinv(val))
  expect_identical(f, scat()$linkinv)
})

test_that("inv_link() works for betar() family objects", {
  f <- inv_link(betar())
  expect_type(f, "closure")
  expect_identical(f(val), betar()$linkinv(val))
  expect_identical(f, betar()$linkinv)
})

test_that("inv_link() works for ocat() family objects", {
  theta <- 1.1
  f <- inv_link(ocat(theta = theta))
  expect_type(f, "closure")
  expect_identical(f(val), ocat(theta = theta)$linkinv(val))
  expect_identical(f, ocat(theta = theta)$linkinv)
})

test_that("inv_link() works for ziP() family objects", {
  f <- inv_link(ziP())
  expect_type(f, "closure")
  expect_identical(f(val), ziP()$linkinv(val))
  expect_identical(f, ziP()$linkinv)
})

test_that("inv_link() works for cox.ph() family objects", {
  f <- inv_link(cox.ph())
  expect_type(f, "closure")
  expect_identical(f(val), cox.ph()$linkinv(val))
  expect_identical(f, cox.ph()$linkinv)
})

test_that("inv_link() works for cnorm() family objects", {
  f <- inv_link(cnorm())
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, cnorm()$linkinv)
})

test_that("extract_link() works on gaussian() family objects", {
  ## link
  f <- extract_link(gaussian())
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, gaussian()$linkfun)
  ## inverse
  f <- extract_link(gaussian(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, gaussian()$linkinv)
})

test_that("extract_link() works on poisson() family objects", {
  ## link
  f <- extract_link(poisson())
  expect_type(f, "closure")
  expect_identical(f(val), log(val))
  expect_identical(f, poisson()$linkfun)
  ## inverse
  f <- extract_link(poisson(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), exp(val))
  expect_identical(f, poisson()$linkinv)
})

test_that("extract_link() works on binomial() family objects", {
  ## link
  f <- extract_link(binomial())
  expect_type(f, "closure")
  expect_identical(f(val), binomial()$linkfun(val))
  expect_identical(f, binomial()$linkfun)
  ## inverse
  f <- extract_link(binomial(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), binomial()$linkinv(val))
  expect_identical(f, binomial()$linkinv)
})

test_that("extract_link() works on Gamma() family objects", {
  ## link
  f <- extract_link(Gamma())
  expect_type(f, "closure")
  expect_identical(f(val), Gamma()$linkfun(val))
  expect_identical(f, Gamma()$linkfun)
  ## inverse
  f <- extract_link(Gamma(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), Gamma()$linkinv(val))
  expect_identical(f, Gamma()$linkinv)
})

test_that("extract_link() works on inverse.gaussian() family objects", {
  ## link
  f <- extract_link(inverse.gaussian())
  expect_type(f, "closure")
  expect_identical(f(val), inverse.gaussian()$linkfun(val))
  expect_identical(f, inverse.gaussian()$linkfun)
  ## inverse
  f <- extract_link(inverse.gaussian(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), inverse.gaussian()$linkinv(val))
  expect_identical(f, inverse.gaussian()$linkinv)
})

test_that("extract_link() works on quasi() family objects", {
  ## link
  f <- extract_link(quasi())
  expect_type(f, "closure")
  expect_identical(f(val), quasi()$linkfun(val))
  expect_identical(f, quasi()$linkfun)
  ## inverse
  f <- extract_link(quasi(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), quasi()$linkinv(val))
  expect_identical(f, quasi()$linkinv)
})

test_that("extract_link() works on quasibinomial() family objects", {
  ## link
  f <- extract_link(quasibinomial())
  expect_type(f, "closure")
  expect_identical(f(val), quasibinomial()$linkfun(val))
  expect_identical(f, quasibinomial()$linkfun)
  ## inverse
  f <- extract_link(quasibinomial(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), quasibinomial()$linkinv(val))
  expect_identical(f, quasibinomial()$linkinv)
})

test_that("extract_link() works on quasipoisson() family objects", {
  ## link
  f <- extract_link(quasipoisson())
  expect_type(f, "closure")
  expect_identical(f(val), quasipoisson()$linkfun(val))
  expect_identical(f, quasipoisson()$linkfun)
  ## inverse
  f <- extract_link(quasipoisson(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), quasipoisson()$linkinv(val))
  expect_identical(f, quasipoisson()$linkinv)
})

test_that("extract_link() works on negbin() family objects", {
  ## link
  theta <- 1.1
  f <- extract_link(negbin(theta = theta))
  expect_type(f, "closure")
  expect_identical(f(val), negbin(theta = theta)$linkfun(val))
  expect_identical(f, negbin(theta = theta)$linkfun)
  ## inverse
  f <- extract_link(negbin(theta = theta), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), negbin(theta = theta)$linkinv(val))
  expect_identical(f, negbin(theta = theta)$linkinv)
})

test_that("extract_link() works on nb() family objects", {
  ## link
  f <- extract_link(nb())
  expect_type(f, "closure")
  expect_identical(f(val), nb()$linkfun(val))
  expect_identical(f, nb()$linkfun)
  ## inverse
  f <- extract_link(nb(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), nb()$linkinv(val))
  expect_identical(f, nb()$linkinv)
})

test_that("extract_link() works on Tweedie() family objects", {
  ## link
  p <- 1.1
  f <- extract_link(Tweedie(p = p))
  expect_type(f, "closure")
  expect_identical(f(val), Tweedie(p = p)$linkfun(val))
  expect_identical(f, Tweedie(p = p)$linkfun)
  ## inverse
  f <- extract_link(Tweedie(p = p), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), Tweedie(p = p)$linkinv(val))
  expect_identical(f, Tweedie(p = p)$linkinv)
})

test_that("extract_link() works on tw() family objects", {
  ## link
  f <- extract_link(tw())
  expect_type(f, "closure")
  expect_identical(f(val), tw()$linkfun(val))
  expect_identical(f, tw()$linkfun)
  ## inverse
  f <- extract_link(tw(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), tw()$linkinv(val))
  expect_identical(f, tw()$linkinv)
})

test_that("extract_link() works on scat() family objects", {
  ## link
  f <- extract_link(scat())
  expect_type(f, "closure")
  expect_identical(f(val), scat()$linkfun(val))
  expect_identical(f, scat()$linkfun)
  ## inverse
  f <- extract_link(scat(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), scat()$linkinv(val))
  expect_identical(f, scat()$linkinv)
})

test_that("extract_link() works on betar() family objects", {
  ## link
  f <- extract_link(betar())
  expect_type(f, "closure")
  expect_identical(f(val), betar()$linkfun(val))
  expect_identical(f, betar()$linkfun)
  ## inverse
  f <- extract_link(betar(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), betar()$linkinv(val))
  expect_identical(f, betar()$linkinv)
})

test_that("extract_link() works on ziP() family objects", {
  ## link
  f <- extract_link(ziP())
  expect_type(f, "closure")
  expect_identical(f(val), ziP()$linkfun(val))
  expect_identical(f, ziP()$linkfun)
  ## inverse
  f <- extract_link(ziP(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), ziP()$linkinv(val))
  expect_identical(f, ziP()$linkinv)
})

test_that("extract_link() works on ocat() family objects", {
  theta <- 1.1
  ## link
  f <- extract_link(ocat(theta = theta))
  expect_type(f, "closure")
  expect_identical(f(val), ocat(theta = theta)$linkfun(val))
  expect_identical(f, ocat(theta = theta)$linkfun)
  ## inverse
  f <- extract_link(ocat(theta = theta), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), ocat(theta = theta)$linkinv(val))
  expect_identical(f, ocat(theta = theta)$linkinv)
})

test_that("extract_link() works on cox.ph() family objects", {
  ## link
  f <- extract_link(cox.ph())
  expect_type(f, "closure")
  expect_identical(f(val), cox.ph()$linkfun(val))
  expect_identical(f, cox.ph()$linkfun)
  ## inverse
  f <- extract_link(cox.ph(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), cox.ph()$linkinv(val))
  expect_identical(f, cox.ph()$linkinv)
})

test_that("extract_link() works on gaulss() family objects", {
  fam <- gaulss()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  f <- extract_link(fam, parameter = "sigma")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam, parameter = "sigma", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
})

test_that("extract_link() works on gammals() family objects", {
  fam <- gammals()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  f <- extract_link(fam, parameter = "phi")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam, parameter = "phi", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
})

test_that("extract_link() works on gumbls() family objects", {
  fam <- gumbls()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
})

test_that("extract_link() works on twlss() family objects", {
  fam <- twlss()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  f <- extract_link(fam, parameter = "sigma")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam, parameter = "sigma", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)

  ## power parameter
  ## link
  f <- extract_link(fam, parameter = "power")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[3L]]$linkfun(val))
  expect_identical(f, fam$linfo[[3L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "power", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[3L]]$linkinv(val))
  expect_identical(f, fam$linfo[[3L]]$linkinv)
})

test_that("extract_link() works on gevlss() family objects", {
  fam <- gevlss()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  f <- extract_link(fam, parameter = "sigma")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam, parameter = "sigma", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)

  ## shape parameter, also xi
  ## link
  xi_val <- 0.5 # must be in range 0-1
  f <- extract_link(fam, parameter = "shape")
  expect_type(f, "closure")
  expect_identical(f(xi_val), fam$linfo[[3L]]$linkfun(xi_val))
  expect_identical(f, fam$linfo[[3L]]$linkfun)
  f <- extract_link(fam, parameter = "xi")
  expect_type(f, "closure")
  expect_identical(f(xi_val), fam$linfo[[3L]]$linkfun(xi_val))
  expect_identical(f, fam$linfo[[3L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "shape", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(xi_val), fam$linfo[[3L]]$linkinv(xi_val))
  expect_identical(f, fam$linfo[[3L]]$linkinv)
  f <- extract_link(fam, parameter = "xi", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(xi_val), fam$linfo[[3L]]$linkinv(xi_val))
  expect_identical(f, fam$linfo[[3L]]$linkinv)
})

test_that("extract_link() works on ziplss() family objects", {
  fam <- ziplss()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter - really the zero-inflation bit
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  f <- extract_link(fam, parameter = "pi")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam, parameter = "pi", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
})

test_that("extract_link() works on mvn() family objects", {
  fam <- mvn(d = 2)
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location", which_eta = 1L)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu", which_eta = 1L)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)

  ## error if no `which_eta`
  expect_error(extract_link(fam, parameter = "mu"),
    "Which linear predictor not specified; see 'which_eta'",
    fixed = TRUE
  )

  ## inverse
  f <- extract_link(fam,
    parameter = "location", inverse = TRUE,
    which_eta = 2L
  )
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam,
    parameter = "mu", inverse = TRUE,
    which_eta = 2L
  )
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
})

test_that("extract_link() works on multinom() family objects", {
  fam <- multinom(K = 2)
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location", which_eta = 1L)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu", which_eta = 1L)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)

  ## error if no `which_eta`
  expect_error(extract_link(fam, parameter = "mu"),
    "Which linear predictor not specified; see 'which_eta'",
    fixed = TRUE
  )

  ## inverse
  f <- extract_link(fam,
    parameter = "location", inverse = TRUE,
    which_eta = 2L
  )
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam,
    parameter = "mu", inverse = TRUE,
    which_eta = 2L
  )
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
})

test_that("extract_link() works on shash() family objects", {
  fam <- shash()
  ## location parameter
  ## link
  f <- extract_link(fam, parameter = "location")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  f <- extract_link(fam, parameter = "mu")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "location", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)
  f <- extract_link(fam, parameter = "mu", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkinv(val))
  expect_identical(f, fam$linfo[[1L]]$linkinv)

  ## scale parameter
  ## link
  f <- extract_link(fam, parameter = "scale")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  f <- extract_link(fam, parameter = "sigma")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkfun(val))
  expect_identical(f, fam$linfo[[2L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "scale", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)
  f <- extract_link(fam, parameter = "sigma", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[2L]]$linkinv(val))
  expect_identical(f, fam$linfo[[2L]]$linkinv)

  ## skewness parameter
  ## link
  f <- extract_link(fam, parameter = "skewness")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[3L]]$linkfun(val))
  expect_identical(f, fam$linfo[[3L]]$linkfun)
  f <- extract_link(fam, parameter = "epsilon")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[3L]]$linkfun(val))
  expect_identical(f, fam$linfo[[3L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "skewness", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[3L]]$linkinv(val))
  expect_identical(f, fam$linfo[[3L]]$linkinv)
  f <- extract_link(fam, parameter = "epsilon", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[3L]]$linkinv(val))
  expect_identical(f, fam$linfo[[3L]]$linkinv)

  ## skewness parameter
  ## link
  f <- extract_link(fam, parameter = "kurtosis")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[4L]]$linkfun(val))
  expect_identical(f, fam$linfo[[4L]]$linkfun)
  f <- extract_link(fam, parameter = "delta")
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[4L]]$linkfun(val))
  expect_identical(f, fam$linfo[[4L]]$linkfun)
  ## inverse
  f <- extract_link(fam, parameter = "kurtosis", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[4L]]$linkinv(val))
  expect_identical(f, fam$linfo[[4L]]$linkinv)
  f <- extract_link(fam, parameter = "delta", inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[4L]]$linkinv(val))
  expect_identical(f, fam$linfo[[4L]]$linkinv)
})

test_that("extract_link() works on cnorm() family objects", {
  ## link
  f <- extract_link(cnorm())
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, cnorm()$linkfun)
  ## inverse
  f <- extract_link(cnorm(), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, cnorm()$linkinv)
})

## tests some specific extract functions
test_that("twlss_link() can extract a link function", {
  fam <- twlss()
  expect_silent(f <- twlss_link(fam, parameter = "mu"))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("gevlss_link() can extract a link function", {
  fam <- gevlss()
  expect_silent(f <- gevlss_link(fam, parameter = "mu"))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("gumbls_link() can extract a link function", {
  fam <- gumbls()
  expect_silent(f <- gumbls_link(fam, parameter = "mu"))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("gammals_link() can extract a link function", {
  fam <- gammals()
  expect_silent(f <- gammals_link(fam, parameter = "mu"))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("ziplss_link() can extract a link function", {
  fam <- ziplss()
  expect_silent(f <- ziplss_link(fam, parameter = "mu"))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("mvn_link() can extract a link function", {
  fam <- mvn()
  expect_silent(f <- mvn_link(fam,
    parameter = "location",
    which_eta = 1
  ))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("multinom_link() can extract a link function", {
  fam <- multinom()
  expect_silent(f <- multinom_link(fam,
    parameter = "location",
    which_eta = 1
  ))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## tests some specific extract functions
test_that("shash_link() can extract a link function", {
  fam <- shash()
  expect_silent(f <- shash_link(fam, parameter = "mu"))
  expect_type(f, "closure")
  expect_identical(f(val), fam$linfo[[1L]]$linkfun(val))
  expect_identical(f, fam$linfo[[1L]]$linkfun)
})

## test internal link functions fail gracefully
test_that("gaussian_link() fails gracefully", {
  expect_error(gaussian_link(1), "'family' is not a family object")
  expect_error(gaussian_link(nb()), "'family' is not of type '\"gaussian\"'")
})

## test internal link functions fail gracefully
test_that("poisson_link() fails gracefully", {
  expect_error(poisson_link(1), "'family' is not a family object")
  expect_error(poisson_link(nb()), "'family' is not of type '\"poisson\"'")
})

## test internal link functions fail gracefully
test_that("binomial_link() fails gracefully", {
  expect_error(binomial_link(1), "'family' is not a family object")
  expect_error(binomial_link(nb()), "'family' is not of type '\"binomial\"'")
})

## test internal link functions fail gracefully
test_that("gamma_link() fails gracefully", {
  expect_error(gamma_link(1), "'family' is not a family object")
  expect_error(gamma_link(nb()), "'family' is not of type '\"Gamma\"'")
})

## test internal link functions fail gracefully
test_that("inverse_gaussian_link() fails gracefully", {
  expect_error(inverse_gaussian_link(1), "'family' is not a family object")
  expect_error(inverse_gaussian_link(nb()), "'family' is not of type '\"inverse.gaussian\"'")
})

## test internal link functions fail gracefully
test_that("quasi_link() fails gracefully", {
  expect_error(quasi_link(1), "'family' is not a family object")
  expect_error(quasi_link(nb()), "'family' is not of type '\"quasi\"'")
})

## test internal link functions fail gracefully
test_that("quasi_poisson_link() fails gracefully", {
  expect_error(quasi_poisson_link(1), "'family' is not a family object")
  expect_error(quasi_poisson_link(nb()), "'family' is not of type '\"quasipoisson\"'")
})

## test internal link functions fail gracefully
test_that("quasi_binomial_link() fails gracefully", {
  expect_error(quasi_binomial_link(1), "'family' is not a family object")
  expect_error(quasi_binomial_link(nb()), "'family' is not of type '\"quasibinomial\"'")
})

## test internal link functions fail gracefully
test_that("nb_link() fails gracefully", {
  expect_error(nb_link(1), "'family' is not a family object")
  expect_error(nb_link(tw()), "'family' is not of type '\"Negative Binomial\"'")
})

## test internal link functions fail gracefully
test_that("tw_link() fails gracefully", {
  expect_error(tw_link(1), "'family' is not a family object")
  expect_error(tw_link(nb()), "'family' is not of type '\"Tweedie\"'")
})

## test internal link functions fail gracefully
test_that("beta_link() fails gracefully", {
  expect_error(beta_link(1), "'family' is not a family object")
  expect_error(beta_link(nb()), "'family' is not of type '\"Beta regression\"'")
})

## test internal link functions fail gracefully
test_that("scaled_t_link() fails gracefully", {
  expect_error(scaled_t_link(1), "'family' is not a family object")
  expect_error(scaled_t_link(nb()), "'family' is not of type '\"scaled t\"'")
})

## test internal link functions fail gracefully
test_that("ocat_link() fails gracefully", {
  expect_error(ocat_link(1), "'family' is not a family object")
  expect_error(ocat_link(nb()), "'family' is not of type '\"Ordered Categorical\"'")
})

## test internal link functions fail gracefully
test_that("zip_link() fails gracefully", {
  expect_error(zip_link(1), "'family' is not a family object")
  expect_error(zip_link(nb()), "'family' is not of type '\"zero inflated Poisson\"'")
})

## test internal link functions fail gracefully
test_that("cox_ph_link() fails gracefully", {
  expect_error(cox_ph_link(1), "'family' is not a family object")
  expect_error(cox_ph_link(nb()), "'family' is not of type '\"Cox PH\"'")
})

## test internal link functions fail gracefully
test_that("gaulss_link() fails gracefully", {
  expect_error(gaulss_link(1), "'family' is not a family object")
  expect_error(gaulss_link(nb()), "'family' is not of type '\"gaulss\"'")
})

## test internal link functions fail gracefully
test_that("twlss_link() fails gracefully", {
  expect_error(twlss_link(1), "'family' is not a family object")
  expect_error(twlss_link(nb()), "'family' is not of type '\"twlss\"'")
})

## test internal link functions fail gracefully
test_that("gevlss_link() fails gracefully", {
  expect_error(gevlss_link(1), "'family' is not a family object")
  expect_error(gevlss_link(nb()), "'family' is not of type '\"gevlss\"'")
})

## test internal link functions fail gracefully
test_that("gammals_link() fails gracefully", {
  expect_error(gammals_link(1), "'family' is not a family object")
  expect_error(gammals_link(nb()), "'family' is not of type '\"gammals\"'")
})

## test internal link functions fail gracefully
test_that("ziplss_link() fails gracefully", {
  expect_error(ziplss_link(1), "'family' is not a family object")
  expect_error(ziplss_link(nb()), "'family' is not of type '\"ziplss\"'")
})

## test internal link functions fail gracefully
test_that("mvn_link() fails gracefully", {
  expect_error(mvn_link(1), "'family' is not a family object")
  expect_error(mvn_link(nb()), "'family' is not of type '\"Multivariate normal\"'")
})

## test internal link functions fail gracefully
test_that("multinom_link() fails gracefully", {
  expect_error(multinom_link(1), "'family' is not a family object")
  expect_error(multinom_link(nb()), "'family' is not of type '\"multinom\"'")
})

## test other gamm4 family utils
test_that("family.gamm4 works for a gamm4 object", {
  fam <- family(m_gamm4)
  expect_s3_class(fam, class = "family")
  expect_equal(fam, gaussian(), ignore_function_env = TRUE)
})

test_that("family.gamm4 throws an error when passed a non-gamm4 object", {
  expect_error(family(l),
    regexp = "`object` does not appear to a `gamm4` model object",
    fixed = TRUE
  )
})

## test gamm family
test_that("family.gamm works for a gamm object", {
  fam <- family(m_gamm)
  expect_s3_class(fam, class = "family")
  expect_equal(fam, gaussian(), ignore_function_env = TRUE)
})

## test family name
test_that("family_name() works with a gam() model", {
  f <- family_name(m_gam)
  expect_type(f, "character")
  expect_identical(f, "gaussian")
})

test_that("family_name() works with a glm() model", {
  f <- family_name(m_glm)
  expect_type(f, "character")
  expect_identical(f, "gaussian")
})

test_that("family_name() works with a gamm() model", {
  f <- family_name(m_gamm)
  expect_type(f, "character")
  expect_identical(f, "gaussian")
})

test_that("family_name() works with a gamm4() model", {
  f <- family_name(m_gamm4)
  expect_type(f, "character")
  expect_identical(f, "gaussian")
})

test_that("family_name() works with a bam() model", {
  f <- family_name(m_bam)
  expect_type(f, "character")
  expect_identical(f, "gaussian")
})

test_that("family_name.list() fails with a list that isn't a gamm4", {
  expect_error(family_name(l),
    regexp = "`object` does not appear to a `gamm4` model object",
    fixed = TRUE
  )
})

test_that("family_name() works with a gam() gaulss model", {
  f <- family_name(m_gaulss)
  expect_type(f, "character")
  expect_identical(f, "gaulss")
})

test_that("family_name() works with a family() object", {
  f <- family_name(gaussian())
  expect_type(f, "character")
  expect_identical(f, "gaussian")
})

# special cnorm tests
test_that("family utils work on cnorm() family objects from a model", {
  ## link
  f <- extract_link(family(m_censor))
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, cnorm()$linkfun)
  ## inverse
  f <- extract_link(family(m_censor), inverse = TRUE)
  expect_type(f, "closure")
  expect_identical(f(val), val)
  expect_identical(f, cnorm()$linkinv)

  f <- family_name(m_censor)
  expect_type(f, "character")
  expect_match(f, "^cnorm\\(\\d+\\.?\\d+\\)$")
})