# Test tidy()/glance() contract compliance for all model classes test_that("tidy.beezdemand_hurdle meets contract", { skip_if_not_installed("TMB") skip_on_cran() data(apt, package = "beezdemand") apt_small <- apt[apt$id %in% unique(apt$id)[1:5], ] fit <- tryCatch( fit_demand_hurdle(apt_small, y_var = "y", x_var = "x", id_var = "id"), error = function(e) NULL ) skip_if(is.null(fit), "Model fitting failed") t <- tidy(fit) expect_s3_class(t, "tbl_df") expect_true(all(c("term", "estimate", "std.error", "statistic", "p.value") %in% names(t))) expect_true("component" %in% names(t)) expect_true(all(c("estimate_scale", "term_display") %in% names(t))) expect_true(all(t$estimate_scale %in% c("natural", "log", "log10", "logit"))) # Component vocabulary (canonical) expect_false(any(t$component %in% c("probability"))) expect_true(any(t$component == "zero_probability")) expect_true(any(t$component == "consumption")) }) test_that("glance.beezdemand_hurdle meets contract", { skip_if_not_installed("TMB") skip_on_cran() data(apt, package = "beezdemand") apt_small <- apt[apt$id %in% unique(apt$id)[1:5], ] fit <- tryCatch( fit_demand_hurdle(apt_small, y_var = "y", x_var = "x", id_var = "id"), error = function(e) NULL ) skip_if(is.null(fit), "Model fitting failed") g <- glance(fit) expect_s3_class(g, "tbl_df") expect_equal(nrow(g), 1) expect_true(all(c("model_class", "backend", "nobs", "n_subjects", "converged", "logLik", "AIC", "BIC") %in% names(g))) expect_equal(g$model_class, "beezdemand_hurdle") expect_equal(g$backend, "TMB") }) test_that("tidy.beezdemand_nlme meets contract", { skip_on_cran() skip_if_not_installed("nlme") data(apt, package = "beezdemand") apt_small <- apt[apt$id %in% unique(apt$id)[1:5], ] apt_small$y_ll4 <- ll4(apt_small$y) fit <- tryCatch( fit_demand_mixed(apt_small, y_var = "y_ll4", x_var = "x", id_var = "id"), error = function(e) NULL ) skip_if(is.null(fit) || is.null(fit$model), "Model fitting failed") t <- tidy(fit) expect_s3_class(t, "tbl_df") expect_true(all(c("term", "estimate", "std.error", "statistic", "p.value") %in% names(t))) expect_true("component" %in% names(t)) expect_true(all(c("estimate_scale", "term_display") %in% names(t))) expect_true(all(t$estimate_scale %in% c("natural", "log", "log10", "logit"))) }) test_that("glance.beezdemand_nlme meets contract", { skip_on_cran() skip_if_not_installed("nlme") data(apt, package = "beezdemand") apt_small <- apt[apt$id %in% unique(apt$id)[1:5], ] apt_small$y_ll4 <- ll4(apt_small$y) fit <- tryCatch( fit_demand_mixed(apt_small, y_var = "y_ll4", x_var = "x", id_var = "id"), error = function(e) NULL ) skip_if(is.null(fit) || is.null(fit$model), "Model fitting failed") g <- glance(fit) expect_s3_class(g, "tbl_df") expect_equal(nrow(g), 1) expect_true(all(c("model_class", "backend", "equation_form", "nobs", "n_subjects", "converged", "logLik", "AIC", "BIC") %in% names(g))) expect_equal(g$model_class, "beezdemand_nlme") expect_equal(g$backend, "nlme") }) test_that("tidy.beezdemand_fixed meets contract", { data(apt, package = "beezdemand") apt_small <- apt[apt$id %in% unique(apt$id)[1:3], ] fit <- fit_demand_fixed(apt_small) t <- tidy(fit) expect_s3_class(t, "tbl_df") expect_true(all(c("term", "estimate", "std.error", "statistic", "p.value") %in% names(t))) expect_true("component" %in% names(t)) expect_true("id" %in% names(t)) expect_true(all(c("estimate_scale", "term_display") %in% names(t))) expect_true(all(t$estimate_scale %in% c("natural", "log", "log10", "logit"))) }) test_that("glance.beezdemand_fixed meets contract", { data(apt, package = "beezdemand") apt_small <- apt[apt$id %in% unique(apt$id)[1:3], ] fit <- fit_demand_fixed(apt_small) g <- glance(fit) expect_s3_class(g, "tbl_df") expect_equal(nrow(g), 1) expect_true(all(c("model_class", "backend", "equation", "nobs", "n_subjects", "converged", "logLik", "AIC", "BIC") %in% names(g))) expect_equal(g$model_class, "beezdemand_fixed") expect_equal(g$backend, "legacy") }) test_that("tidy.beezdemand_systematicity meets contract", { data(apt, package = "beezdemand") check <- check_systematic_demand(apt) t <- tidy(check) expect_s3_class(t, "tbl_df") expect_true("type" %in% names(t)) expect_true(all(t$type == "demand")) expect_true("systematic" %in% names(t)) }) test_that("glance.beezdemand_systematicity meets contract", { data(apt, package = "beezdemand") check <- check_systematic_demand(apt) g <- glance(check) expect_s3_class(g, "tbl_df") expect_equal(nrow(g), 1) expect_true(all(c("model_class", "backend", "type", "nobs", "n_subjects", "n_systematic", "n_unsystematic", "pct_systematic", "converged", "logLik", "AIC", "BIC") %in% names(g))) expect_equal(g$type, "demand") }) test_that("demand and cp systematicity wrappers have identical column names", { data(apt, package = "beezdemand") demand_check <- check_systematic_demand(apt) # Create simple CP-like data cp_data <- data.frame( id = rep(1:3, each = 5), x = rep(c(0.1, 1, 2, 5, 10), 3), y = c(10, 8, 6, 3, 1, 10, 9, 7, 4, 2, 10, 5, 8, 2, 0) ) cp_check <- check_systematic_cp(cp_data) demand_cols <- names(tidy(demand_check)) cp_cols <- names(tidy(cp_check)) expect_identical(demand_cols, cp_cols) })