test-confint.R
In beezdemand: Behavioral Economic Easy Demand

# Test confint() methods for all model classes

test_that("confint.beezdemand_fixed returns tibble with correct structure", {
  data(apt, package = "beezdemand")
  apt_small <- apt[apt$id %in% unique(apt$id)[1:5], ]

  # Suppress deprecation warning from FitCurves
  fit <- suppressMessages(
    fit_demand_fixed(apt_small, equation = "hs", k = 2)
  )

  ci <- confint(fit)

  expect_s3_class(ci, "tbl_df")
  expect_true(all(c("id", "term", "estimate", "conf.low", "conf.high", "level") %in%
                    names(ci)))
  expect_equal(unique(ci$level), 0.95)
  expect_true(nrow(ci) > 0)
})

test_that("confint.beezdemand_fixed respects level parameter", {
  data(apt, package = "beezdemand")
  apt_small <- apt[apt$id %in% unique(apt$id)[1:3], ]

  fit <- suppressMessages(
    fit_demand_fixed(apt_small, equation = "hs", k = 2)
  )

  ci_90 <- confint(fit, level = 0.90)
  ci_95 <- confint(fit, level = 0.95)

  expect_equal(unique(ci_90$level), 0.90)
  expect_equal(unique(ci_95$level), 0.95)

  # 90% CI should be narrower than 95% CI
  ci_90_q0 <- ci_90[ci_90$term == "Q0", ]
  ci_95_q0 <- ci_95[ci_95$term == "Q0", ]

  if (nrow(ci_90_q0) > 0 && nrow(ci_95_q0) > 0) {
    width_90 <- ci_90_q0$conf.high[1] - ci_90_q0$conf.low[1]
    width_95 <- ci_95_q0$conf.high[1] - ci_95_q0$conf.low[1]
    if (!is.na(width_90) && !is.na(width_95)) {
      expect_lt(width_90, width_95)
    }
  }
})

test_that("confint.beezdemand_fixed filters parameters with parm argument", {
  data(apt, package = "beezdemand")
  apt_small <- apt[apt$id %in% unique(apt$id)[1:3], ]

  fit <- suppressMessages(
    fit_demand_fixed(apt_small, equation = "hs", k = 2)
  )

  ci_all <- confint(fit)
  ci_q0 <- confint(fit, parm = "Q0")

  expect_true(nrow(ci_q0) < nrow(ci_all))
  expect_true(all(ci_q0$term == "Q0"))
})

test_that("confint.beezdemand_fixed handles empty results gracefully", {
  fit <- structure(
    list(results = data.frame()),
    class = c("beezdemand_fixed", "list")
  )

  ci <- confint(fit)

  expect_s3_class(ci, "tbl_df")
  expect_equal(nrow(ci), 0)
})


test_that("confint.beezdemand_hurdle returns tibble with correct structure", {
  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")

  ci <- confint(fit)

  expect_s3_class(ci, "tbl_df")
  expect_true(all(c("term", "estimate", "conf.low", "conf.high", "level",
                    "component", "estimate_scale") %in% names(ci)))
  expect_equal(unique(ci$level), 0.95)
  expect_true(nrow(ci) > 0)
})

test_that("confint.beezdemand_hurdle supports report_space argument", {
  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")

  ci_internal <- confint(fit, report_space = "internal")
  ci_natural <- confint(fit, report_space = "natural")

  # Internal scale should have log terms, natural should not
  expect_true(any(grepl("log", ci_internal$term)))

  # Natural scale Q0 should be exponentiated (larger than log scale)
  q0_internal <- ci_internal[grepl("Q0|log_q0", ci_internal$term), "estimate"]
  q0_natural <- ci_natural[grepl("Q0", ci_natural$term), "estimate"]

  if (nrow(q0_internal) > 0 && nrow(q0_natural) > 0) {
    expect_true(q0_natural$estimate[1] > q0_internal$estimate[1])
  }
})


test_that("confint.beezdemand_nlme returns tibble with correct structure", {
  skip_on_cran()

  # Create simple test data with non-negative log10 values
  set.seed(42)
  n_subj <- 8
  n_obs <- 8
  prices <- c(0.1, 0.5, 1, 2, 5, 10, 20, 50)
  base_consumption <- c(100, 95, 85, 65, 30, 12, 4, 1)
  test_data <- do.call(rbind, lapply(1:n_subj, function(i) {
    y_vals <- base_consumption * (0.8 + 0.4 * runif(1)) + rnorm(n_obs, 0, 3)
    y_vals <- pmax(y_vals, 0.1)
    data.frame(
      id = i,
      x = prices,
      y = log10(y_vals)
    )
  }))

  fit <- tryCatch(
    suppressWarnings(suppressMessages(
      fit_demand_mixed(
        test_data,
        y_var = "y",
        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")

  ci <- confint(fit)

  expect_s3_class(ci, "tbl_df")
  expect_true(all(c("term", "estimate", "conf.low", "conf.high", "level",
                    "component") %in% names(ci)))
  if (nrow(ci) > 0) {
    expect_equal(unique(ci$level), 0.95)
  }
})

test_that("confint.beezdemand_nlme supports method argument", {
  skip_on_cran()

  # Create simple test data with non-negative log10 values
  set.seed(42)
  n_subj <- 8
  n_obs <- 8
  prices <- c(0.1, 0.5, 1, 2, 5, 10, 20, 50)
  base_consumption <- c(100, 95, 85, 65, 30, 12, 4, 1)
  test_data <- do.call(rbind, lapply(1:n_subj, function(i) {
    y_vals <- base_consumption * (0.8 + 0.4 * runif(1)) + rnorm(n_obs, 0, 3)
    y_vals <- pmax(y_vals, 0.1)
    data.frame(
      id = i,
      x = prices,
      y = log10(y_vals)
    )
  }))

  fit <- tryCatch(
    suppressWarnings(suppressMessages(
      fit_demand_mixed(
        test_data,
        y_var = "y",
        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")

  ci_wald <- confint(fit, method = "wald")

  expect_s3_class(ci_wald, "tbl_df")
  if (nrow(ci_wald) > 0) {
    expect_equal(unique(ci_wald$level), 0.95)
  }
})


test_that("confint.cp_model_nls returns tibble with correct structure", {
  skip_on_cran()

  # Create simple cross-price test data
  set.seed(123)
  n_obs <- 20
  test_data <- data.frame(
    x = seq(0.1, 10, length.out = n_obs),
    y = 100 * 10^(-0.5 * exp(-0.3 * seq(0.1, 10, length.out = n_obs))) +
        rnorm(n_obs, 0, 5)
  )
  test_data$y <- pmax(test_data$y, 0.1)

  fit <- tryCatch(
    fit_cp_nls(test_data, equation = "exponentiated", return_all = TRUE),
    error = function(e) NULL
  )
  skip_if(is.null(fit) || is.null(fit$model), "Model fitting failed")

  ci <- confint(fit)

  expect_s3_class(ci, "tbl_df")
  expect_true(all(c("term", "estimate", "conf.low", "conf.high", "level",
                    "method") %in% names(ci)))
  expect_equal(unique(ci$level), 0.95)
})

test_that("confint.cp_model_nls respects method argument", {
  skip_on_cran()

  set.seed(123)
  n_obs <- 20
  test_data <- data.frame(
    x = seq(0.1, 10, length.out = n_obs),
    y = 100 * 10^(-0.5 * exp(-0.3 * seq(0.1, 10, length.out = n_obs))) +
        rnorm(n_obs, 0, 5)
  )
  test_data$y <- pmax(test_data$y, 0.1)

  fit <- tryCatch(
    fit_cp_nls(test_data, equation = "exponentiated", return_all = TRUE),
    error = function(e) NULL
  )
  skip_if(is.null(fit) || is.null(fit$model), "Model fitting failed")

  ci_asymp <- confint(fit, method = "asymptotic")

  expect_s3_class(ci_asymp, "tbl_df")
  expect_equal(unique(ci_asymp$method), "asymptotic")
})


test_that("confint methods reject invalid level arguments", {
  data(apt, package = "beezdemand")
  apt_small <- apt[apt$id %in% unique(apt$id)[1:3], ]

  fit <- suppressMessages(
    fit_demand_fixed(apt_small, equation = "hs", k = 2)
  )

  expect_error(confint(fit, level = 0), "between 0 and 1")
  expect_error(confint(fit, level = 1), "between 0 and 1")
  expect_error(confint(fit, level = -0.5), "between 0 and 1")
  expect_error(confint(fit, level = "0.95"), "between 0 and 1")
})