# Test summary() contract compliance for all model classes test_that("summary.beezdemand_hurdle meets contract", { skip_if_not_installed("TMB") skip_on_cran() data(apt, package = "beezdemand") # Subset for faster testing 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") s <- summary(fit) # Class structure expect_s3_class(s, "summary.beezdemand_hurdle") expect_s3_class(s, "beezdemand_summary") # Required fields expect_true("call" %in% names(s)) expect_true("model_class" %in% names(s)) expect_equal(s$model_class, "beezdemand_hurdle") expect_true("backend" %in% names(s)) expect_equal(s$backend, "TMB") expect_true("nobs" %in% names(s)) expect_true("n_subjects" %in% names(s)) expect_true("converged" %in% names(s)) expect_true("logLik" %in% names(s)) expect_true("AIC" %in% names(s)) expect_true("BIC" %in% names(s)) expect_true("coefficients" %in% names(s)) expect_true("derived_metrics" %in% names(s)) expect_true("notes" %in% names(s)) # coefficients is tibble with required columns expect_s3_class(s$coefficients, "tbl_df") expect_true(all(c("term", "estimate", "std.error", "statistic", "p.value", "component") %in% names(s$coefficients))) expect_true(all(c("estimate_scale", "term_display") %in% names(s$coefficients))) expect_true(all(s$coefficients$estimate_scale %in% c("natural", "log", "log10", "logit"))) # derived_metrics is tibble with required columns expect_s3_class(s$derived_metrics, "tbl_df") expect_true(all(c("metric", "estimate") %in% names(s$derived_metrics))) expect_true(all(c("pmax_model", "omax_model") %in% s$derived_metrics$metric)) # Canonical components (probability part) prob_terms <- c("beta0", "beta1", "gamma0", "gamma1") present_prob_terms <- intersect(prob_terms, s$coefficients$term) expect_true(length(present_prob_terms) > 0) expect_true(all( s$coefficients$component[s$coefficients$term %in% present_prob_terms] == "zero_probability" )) }) test_that("summary.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", equation_form = "zben" ), error = function(e) NULL ) skip_if(is.null(fit) || is.null(fit$model), "Model fitting failed") s <- summary(fit) # Class structure expect_s3_class(s, "summary.beezdemand_nlme") expect_s3_class(s, "beezdemand_summary") # Required fields expect_equal(s$model_class, "beezdemand_nlme") expect_equal(s$backend, "nlme") expect_true("nobs" %in% names(s)) expect_true("n_subjects" %in% names(s)) expect_true("converged" %in% names(s)) expect_true("logLik" %in% names(s)) expect_true("coefficients" %in% names(s)) expect_true("derived_metrics" %in% names(s)) # coefficients is tibble expect_s3_class(s$coefficients, "tbl_df") expect_true(all(c("term", "estimate", "std.error", "statistic", "p.value", "component") %in% names(s$coefficients))) expect_true(all(c("estimate_scale", "term_display") %in% names(s$coefficients))) expect_true(all(s$coefficients$estimate_scale %in% c("natural", "log", "log10", "logit"))) # derived_metrics exists (may be empty) expect_s3_class(s$derived_metrics, "tbl_df") expect_true(all(c("metric", "estimate") %in% names(s$derived_metrics))) # For HS/Koff fixed fits, include derived Pmax/Omax per subject when available if (s$equation %in% c("hs", "koff")) { expect_true(any(s$derived_metrics$metric %in% c("pmax_model", "omax_model"))) } }) test_that("summary.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) s <- summary(fit) # Class structure expect_s3_class(s, "summary.beezdemand_fixed") expect_s3_class(s, "beezdemand_summary") # Required fields expect_equal(s$model_class, "beezdemand_fixed") expect_equal(s$backend, "legacy") expect_true("nobs" %in% names(s) || "n_subjects" %in% names(s)) expect_true("coefficients" %in% names(s)) expect_true("derived_metrics" %in% names(s)) # coefficients is tibble expect_s3_class(s$coefficients, "tbl_df") expect_true(all(c("term", "estimate", "std.error", "statistic", "p.value", "component") %in% names(s$coefficients))) expect_true(all(c("estimate_scale", "term_display") %in% names(s$coefficients))) expect_true(all(s$coefficients$estimate_scale %in% c("natural", "log", "log10", "logit"))) # derived_metrics exists (may be empty) expect_s3_class(s$derived_metrics, "tbl_df") expect_true(all(c("metric", "estimate") %in% names(s$derived_metrics))) }) test_that("summary.beezdemand_systematicity meets contract", { data(apt, package = "beezdemand") check <- check_systematic_demand(apt) s <- summary(check) # Class structure expect_s3_class(s, "summary.beezdemand_systematicity") expect_s3_class(s, "beezdemand_summary") # Required fields expect_equal(s$model_class, "beezdemand_systematicity") expect_true("n_subjects" %in% names(s)) expect_true("n_systematic" %in% names(s)) expect_true("n_unsystematic" %in% names(s)) })