## Test Utilties

## load packages
library("testthat")
library("gratia")
library("mgcv")
library("gamm4")
# library("MASS")

test_that("smooth_terms() methods work", {
    st <- smooth_terms(m_gam)
    expect_type(st, "list")
    expect_length(st, 4L)
    expect_identical(st, as.list(paste0("x", 0:3)))

    st <- smooth_terms(m_gamm)
    expect_type(st, "list")
    expect_length(st, 4L)
    expect_identical(st, as.list(paste0("x", 0:3)))

    st <- smooth_terms(m_gam[["smooth"]][[1]])
    expect_type(st, "character")
    expect_length(st, 1L)
    expect_identical(st, "x0")
})

test_that("smooth_dim() methods work", {
    d <- smooth_dim(m_gam)
    expect_type(d, "integer")
    expect_length(d, 4L)
    expect_identical(d, rep(1L, 4L))

    d <- smooth_dim(m_gamm)
    expect_type(d, "integer")
    expect_length(d, 4L)
    expect_identical(d, rep(1L, 4L))

    d <- smooth_dim(m_gam[["smooth"]][[1]])
    expect_type(d, "integer")
    expect_length(d, 1L)
    expect_identical(d, rep(1L, 1L))
})

test_that("select_terms() works", {
    st <- select_terms(m_gam)
    expect_type(st, "character")
    expect_length(st, 4L)
    expect_identical(st, paste0("x", 0:3))

    st <- select_terms(m_gam, "x1")
    expect_type(st, "character")
    expect_length(st, 1L)
    expect_identical(st, "x1")

    st <- select_terms(m_gam, c("x1", "x2"))
    expect_type(st, "character")
    expect_length(st, 2L)
    expect_identical(st, c("x1", "x2"))

    expect_message(select_terms(m_gam, "x4"), "x4 not found in `object`")
    expect_message(select_terms(m_gam, 
                                c("x1", "x4")), "x4 not found in `object`")

})

test_that("select_smooth() works", {
    expect_error(select_smooth(m_gam), "'smooth' must be supplied")
    expect_message(select_smooth(m_gam, smooth = c("s(x1)", "s(x2)")),
                   "Multiple smooths supplied. Using only first")

    sm <- select_smooth(m_gam, smooth = "s(x1)")
    expect_identical(sm, "s(x1)")

})

data(columb)       ## data frame
data(columb.polys) ## district shapes list
xt <- list(polys = columb.polys) ## neighbourhood structure info for MRF
## First a full rank MRF...
mrf_mod <- gam(crime ~ s(district, bs="mrf", xt=xt), data = columb,
               method = "REML")

test_that("is_mrf_smooth returns true for an MRF smooth", {
    expect_true(is_mrf_smooth(get_smooth(mrf_mod, "s(district)")))
})

test_that("is_mrf_smooth returns false for an none MRF smooth", {
    expect_false(is_mrf_smooth(get_smooth(m_gam, "s(x0)")))
})

test_that("is_mgcv_smooth returns false for objects that aren't smooths", {
    expect_false(is_mgcv_smooth(1:10))
})

test_that("check_is_mgcv_smooth throws error for objects that aren't smooths", {
    expect_error(check_is_mgcv_smooth(1:10),
                 "'smooth' is not an 'mgcv.smooth'",
                 fixed = TRUE)
})

test_that("is.gam returns TRUE for a GAM", {
    expect_true(is.gam(mrf_mod))
    expect_true(is.gam(m_gam))
})

test_that("is.gam returns FALSE for a none GAM", {
    expect_false(is.gam(1:10))
    expect_false(is.gam(data.frame(x = 1:10)))
    expect_false(is.gam(m_gamm))
})

test_that("is.gamm returns TRUE for a GAMM", {
    expect_true(is.gamm(m_gamm))
})

test_that("is.gam returns FALSE for a none GAMM", {
    expect_false(is.gamm(1:10))
    expect_false(is.gamm(data.frame(x = 1:10)))
    expect_false(is.gamm(m_gam))
    expect_false(is.gamm(mrf_mod))
})

test_that("get_vcov with frequentist TRUE works", {
    V <- get_vcov(m_gam, frequentist = TRUE)
    expect_type(V, "double")
    expect_equal(V, m_gam[["Ve"]])
})

test_that("get_vcov with unconditional = TRUE throws warning if not available", {
    expect_warning(V <- get_vcov(m_gamgcv, unconditional = TRUE),
                   "Covariance corrected for smoothness uncertainty not available.")
    expect_type(V, "double")
    expect_equal(V, m_gamgcv[["Vp"]])
})

test_that("get_vcov with unconditional = TRUE returns Vp", {
    V <- get_vcov(m_gam, unconditional = TRUE)
    expect_type(V, "double")
    expect_equal(V, m_gam[["Vc"]])
})

test_that("get_vcov with term specified works", {
    V <- get_vcov(m_gam, term = "s(x1)")
    expect_type(V, "double")
    smooth <- m_gam[["smooth"]][[2L]]
    ind <- smooth$first.para:smooth$last.para
    expect_equal(V, m_gam[["Vp"]][ind, ind, drop = FALSE])

    V <- get_vcov(m_gam, frequentist = TRUE, term = "s(x1)")
    expect_equal(V, m_gam[["Ve"]][ind, ind, drop = FALSE])

    V <- get_vcov(m_gam, unconditional = TRUE, term = "s(x1)")
    expect_equal(V, m_gam[["Vc"]][ind, ind, drop = FALSE])

    expect_message(get_vcov(m_gam, term = c("s(x1)", "s(x2)")),
                   "Supplied more than 1 'term'; using only the first")
})

test_that("get_smooth works for a GAM", {
    sm <- get_smooth(m_gam, "s(x1)")
    expect_s3_class(sm, "mgcv.smooth")
    expect_true(is_mgcv_smooth(sm))
})

test_that("get_smooth works for a GAMM", {
    sm <- get_smooth(m_gamm, "s(x1)")
    expect_s3_class(sm, "mgcv.smooth")
    expect_true(is_mgcv_smooth(sm))
})

test_that("get_smooths_by_id works for a GAM", {
    sm <- get_smooths_by_id(m_gam, 2L)
    expect_type(sm, "list")
    expect_true(is_mgcv_smooth(sm[[1L]]))
    expect_equal(sm[[1L]], get_smooth(m_gam, "s(x1)"))
})

test_that("get_smooths_by_id works for a GAMM", {
    sm <- get_smooths_by_id(m_gamm, 2L)
    expect_type(sm, "list")
    expect_true(is_mgcv_smooth(sm[[1L]]))
    expect_equal(sm[[1L]], get_smooth(m_gamm, "s(x1)"))
})

test_that("seq_min_max works as intended", {
    x <- rnorm(10)
    n <- 50L
    s1 <- seq_min_max(x, n = n)
    s2 <- seq(min(x), max(x), length.out = n)
    expect_equal(s1, s2)
    expect_identical(length(s1), length(s2))
    expect_identical(length(s1), n)
})

#set.seed(42)
#dat <- gamSim(4, n = 400, verbose = FALSE)

test_that("factor_var_names works", {
    expect_silent( result <- factor_var_names(su_eg4))
    expect_identical("fac", result)

    expect_null( factor_var_names(su_eg1[,1:2]) )
})

test_that("data_class works for a data frame", {
    expect_silent( result <- data_class(su_eg4) )

    expect_named( result, names(su_eg4) )

    actual <- c(rep("numeric", 4L), "factor", rep("numeric", 4L))
    names(actual) <- names(su_eg4)
    expect_identical(actual, result)
})

test_that("n_smooths works for gam models", {
    expect_silent( result <- n_smooths(m_gam) )
    expect_identical(result, 4L)
})

test_that("n_smooths works for gamm models", {
    expect_silent( result <- n_smooths(m_gamm) )
    expect_identical(result, 4L)
})

test_that("n_smooths works for bam models", {
    expect_silent( result <- n_smooths(m_bam) )
    expect_identical(result, 4L)
})

test_that("n_smooths, works for objects with a smooth component", {
    expect_silent( result <- n_smooths(list(smooth = 1:10)) )
    expect_identical( result, 10L)
})

test_that("n_smooths, fails for objects with no smooth component", {
    expect_error( result <- n_smooths(su_eg1),
                 "Don't know how to identify smooths for <tbl_df>",
                 fixed = TRUE)
})

test_that("which_smooths throws error if no smooths match the supplied term", {
    err_msg <- "None of the terms matched a smooth."
    expect_error(which_smooths(m_gam, "foo"), err_msg, fixed = TRUE)
    expect_error(which_smooths(m_gamm, "foo"), err_msg, fixed = TRUE)
    expect_error(which_smooths(m_bam, "foo"), err_msg, fixed = TRUE)

    expect_identical(2L, which_smooths(m_gam, "s(x1)"))
    expect_identical(2L, which_smooths(m_gamm, "s(x1)"))
    expect_identical(2L, which_smooths(m_bam, "s(x1)"))

    expect_identical(2L, which_smooth(m_gamm, "s(x1)"))
})

test_that("which_smooths throws error for objects It can't handle", {
    expect_error(which_smooths(su_eg1, terms = "foo"),
                 "Don't know how to identify smooths for <tbl_df>",
                 fixed = TRUE)
    expect_error(which_smooths(su_eg1),
                 "Don't know how to identify smooths for <tbl_df>",
                 fixed = TRUE)
})

test_that("fix_offset can replace and offset only if there is one", {
    ## df <- gamSim(1, n = 100, dist = "normal", verbose = FALSE)
    m <- gam(y ~ s(x0) + s(x1) + offset(x2), data = su_eg1, method = "REML")
    off_val <- 1L

    expect_silent(fixed <- fix_offset(m, model.frame(m),
                                      offset_val = off_val))
    expect_identical(c("y","x2","x0","x1"), names(fixed))
    expect_true(all(fixed[["x2"]] == off_val))

    # originally had this model
    # m <- gam(y ~ s(x0) + s(x1), data = df, method = "REML")
    expect_identical(model.frame(m_gam),
                     fix_offset(m_gam, model.frame(m_gam),
                                offset_val = off_val))
})

## test coverage_ functions
test_that("coverage_normal works for given level", {
    expect_silent(coverage_normal(0.95))
})

test_that("coverage_t works for given level", {
    expect_silent(coverage_t(0.95, df = 5))
})

test_that("parametric_terms works for a gaulss GAM", {
    data(mcycle, package = 'MASS')
    m1 <- gam(list(accel ~ s(times), ~ s(times)), data = mcycle, method = "REML",
              family = gaulss())
    expect_equal(parametric_terms(m1), character(0))
})

test_that("parametric_terms works for a gaussian GAM", {
    data(mcycle, package = 'MASS')
    m1 <- gam(accel ~ s(times), data = mcycle, method = "REML",
              family = gaussian())
    expect_equal(parametric_terms(m1), character(0))
})

test_that("parametric_terms works for a gaussian GAM", {
    expect_error(parametric_terms(character(0)),
                 "Don't know how to identify parametric terms from <character>",
                 fixed = TRUE)
})

test_that("load_mgcv returns invisibly", {
    out <- expect_invisible(load_mgcv())
    expect_true(out)
})

test_that("is_gamm4 returns true for a gamm4 model", {
    expect_true(is_gamm4(m_gamm4))
})

test_that("is_gamm4 returns false for something that isn't a gamm4 model object", {
    expect_false(is_gamm4(m_gam))
    expect_false(is_gamm4(m_gamgcv))
    expect_false(is_gamm4(m_bam))
    expect_false(is_gamm4(m_gamm))
    expect_false(is_gamm4(list(gam = 1:3, mer = 1:4)))
})

test_that("term_names works with a gam", {
    expect_silent(tn <- term_names(m_gam))
})

test_that("term_names works with a mgcv smooth", {
    expect_silent(tn <- term_names(get_smooth(m_gam, term = "s(x0)")))
    expect_identical(tn, "x0")

    expect_silent(tn <- term_names(get_smooth(su_m_factor_by,
                                              term = "s(x2):fac2")))
    expect_identical(tn, c("x2", "fac"))
})

test_that("term_names fails if not a gam", {
    skip_on_cran()
    expect_error(tn <- gratia:::term_names.gam(m_glm),
      "`object` does not contain `pred.formula`; is this is fitted GAM?",
      fixed = TRUE)
})

test_that("term_names works with a gamm", {
    expect_silent(tn <- term_names(m_gamm))
})

test_that("is_factor_term works", {
    expect_false(ft <- is_factor_term(m_para_sm, term = "x0"))
    expect_true(ft <- is_factor_term(m_para_sm, term = "ff"))
    expect_null(ft <- is_factor_term(m_gam, term = "s(x0)"))
})

test_that("is_factor_term works for a bam", {
    expect_null(ft <- is_factor_term(m_bam, term = "s(x0)"))
})

test_that("is_factor_term works for a gamm", {
    expect_null(ft <- is_factor_term(m_gamm, term = "s(x0)"))
})

test_that("is_factor_term works for a gamm4", {
    expect_null(ft <- is_factor_term(m_gamm4, term = "s(x0)"))
})

test_that("term_variables works for a gam", {
    expect_identical(term_variables(m_para_sm, term = "fac:ff"),
                     c("fac", "ff"))
})

test_that("term_variables works for a terms", {
    expect_identical(term_variables(terms(m_para_sm), term = "fac:ff"),
                     c("fac", "ff"))
})

test_that("transform_fun works for parametric_effects", {
    expect_message(pe <- parametric_effects(m_para_sm),
                   "Interaction terms are not currently supported.")
    expect_silent(pe <- transform_fun(pe, fun = abs))
    expect_true(all(!pe$partial < 0L))
})

test_that("transform_fun works for evaluated_smooth", {
    expect_warning(sm <- evaluate_smooth(m_gam, smooth = "s(x1)"))
    expect_silent(sm <- transform_fun(sm, fun = exp))
})

test_that("transform_fun works for smooth_estimates", {
    expect_silent(sm <- smooth_estimates(m_gam, smooth = "s(x1)"))
    expect_silent(sm <- transform_fun(sm, fun = exp))
})

test_that("transform_fun works for tbl", {
    expect_silent(tbl <- transform_fun(su_eg1, fun = abs, column = "y"))
})

test_that("involves_ranef_smooth works", {
    sm <- smooths(su_m_trivar_t2)
    expect_false(involves_ranef_smooth(get_smooth(su_m_trivar_t2, sm[1])))
})