tests/testthat/test-14b-strategies-mle-hierarchical.R

In fb4package: 'Fish Bioenergetics 4.0' Model Implementation with High-Performance 'TMB' Backend

# =============================================================================
# test-14b-strategies-mle-hierarchical.R
# Tests de integración para run_fb4() con estrategias MLE y jerárquica.
# Se usan 30 días y pocos datos para que los tests sean rápidos.
# =============================================================================

# Peso objetivo razonable para bio_chinook_30 (800 g inicial, 30 días)
target_weight_30 <- 900   # g

# Vector numérico de pesos finales — usado por MLE y bootstrap
obs_weights_30   <- c(880, 890, 895, 900, 905, 910, 920,
                      885, 897, 903, 908, 915, 878, 912, 901)

# Data.frame individual — requerido por la estrategia hierarchical
obs_individual_30 <- data.frame(
  individual_id  = paste0("fish_", seq_along(obs_weights_30)),
  initial_weight = 800,          # igual al initial_weight de bio_chinook_30
  final_weight   = obs_weights_30,
  stringsAsFactors = FALSE
)

# =============================================================================
# 1. MLE — estructura del resultado
# =============================================================================

test_that("run_fb4 mle retorna objeto fb4_result", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_s3_class(result, "fb4_result")
})

test_that("run_fb4 mle: method es 'mle'", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_equal(result$summary$method, "mle")
})

test_that("run_fb4 mle: summary$p_value es numerico y finito", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  p <- result$summary$p_value
  expect_true(is.numeric(p))
  expect_true(is.finite(p))
  expect_gt(p, 0)
  expect_lte(p, 1.5)
})

test_that("run_fb4 mle: p_value y p_estimate son el mismo valor", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_equal(result$summary$p_value, result$summary$p_estimate)
})

test_that("run_fb4 mle: summary$total_consumption es alias de total_consumption_g", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_equal(result$summary$total_consumption,
               result$summary$total_consumption_g)
})

test_that("run_fb4 mle: summary$p_se es numerico (puede ser NA si no converge)", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  # p_se should be numeric (NA is acceptable when not converged)
  expect_true(is.numeric(result$summary$p_se) || is.na(result$summary$p_se))
})

test_that("run_fb4 mle: summary$converged es logico", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_true(is.logical(result$summary$converged))
})

test_that("run_fb4 mle: daily_output tiene 30 filas", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_equal(nrow(result$daily_output), 30L)
})

test_that("run_fb4 mle: print no lanza error", {
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "mle",
    fit_to           = "Weight",
    observed_weights = obs_weights_30,
    upper            = 1.5
  )
  expect_no_error(print(result))
})

test_that("run_fb4 mle: mle con mas observaciones da SE menor o igual", {
  set.seed(42)
  obs_small <- rnorm(5,  mean = target_weight_30, sd = 15)
  obs_large <- rnorm(50, mean = target_weight_30, sd = 15)

  r_small <- run_fb4(bio_chinook_30, strategy = "mle",
                     fit_to = "Weight", observed_weights = obs_small,
                     upper = 1.5)
  r_large <- run_fb4(bio_chinook_30, strategy = "mle",
                     fit_to = "Weight", observed_weights = obs_large,
                     upper = 1.5)

  se_small <- r_small$summary$p_se
  se_large <- r_large$summary$p_se

  # Only test if both SEs are available and finite
  if (all(!is.na(c(se_small, se_large))) && all(is.finite(c(se_small, se_large)))) {
    expect_lte(se_large, se_small * 1.5)   # larger n → SE should not grow much
  } else {
    skip("SE not available (optimization did not converge)")
  }
})

# =============================================================================
# 2. Jerárquica — estructura del resultado
# =============================================================================

test_that("run_fb4 hierarchical retorna objeto fb4_result", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available — skipping hierarchical tests")
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "hierarchical",
    backend          = "tmb",
    fit_to           = "Weight",
    observed_weights = obs_individual_30
  )
  expect_s3_class(result, "fb4_result")
})

test_that("run_fb4 hierarchical: method es 'hierarchical'", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available")
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "hierarchical",
    backend          = "tmb",
    fit_to           = "Weight",
    observed_weights = obs_individual_30
  )
  expect_equal(result$summary$method, "hierarchical")
})

test_that("run_fb4 hierarchical: mu_p_estimate es numerico y positivo", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available")
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "hierarchical",
    backend          = "tmb",
    fit_to           = "Weight",
    observed_weights = obs_individual_30
  )
  mu_p <- result$summary$mu_p_estimate
  expect_true(is.numeric(mu_p))
  expect_gt(mu_p, 0)
})

test_that("run_fb4 hierarchical: sigma_p_estimate es numerico y no negativo", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available")
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "hierarchical",
    backend          = "tmb",
    fit_to           = "Weight",
    observed_weights = obs_individual_30
  )
  sigma_p <- result$summary$sigma_p_estimate
  expect_true(is.numeric(sigma_p))
  expect_gte(sigma_p, 0)
})

test_that("run_fb4 hierarchical: n_individuals coincide con nrow(observed_weights)", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available")
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "hierarchical",
    backend          = "tmb",
    fit_to           = "Weight",
    observed_weights = obs_individual_30
  )
  expect_equal(result$summary$n_individuals, nrow(obs_individual_30))
})

test_that("run_fb4 hierarchical: summary$converged es logico", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available")
  set.seed(1)
  result <- run_fb4(
    x                = bio_chinook_30,
    strategy         = "hierarchical",
    backend          = "tmb",
    fit_to           = "Weight",
    observed_weights = obs_individual_30
  )
  expect_true(is.logical(result$summary$converged))
})

test_that("run_fb4 hierarchical: mu_p coherente con binary_search en datos sin ruido", {
  skip_if_not(requireNamespace("TMB", quietly = TRUE),
              "TMB not available")

  # Run binary search first to get the "true" p
  r_bs <- run_fb4(bio_chinook_30, strategy = "binary_search",
                  fit_to = "Weight", fit_value = target_weight_30)
  p_true <- r_bs$summary$p_value

  # Generate low-noise observations around that target weight (data.frame format)
  set.seed(99)
  tight_weights <- rnorm(20, mean = target_weight_30, sd = 5)
  obs_tight <- data.frame(
    individual_id  = paste0("fish_", seq_along(tight_weights)),
    initial_weight = 800,
    final_weight   = tight_weights,
    stringsAsFactors = FALSE
  )

  r_hier <- run_fb4(bio_chinook_30, strategy = "hierarchical",
                    backend = "tmb", fit_to = "Weight",
                    observed_weights = obs_tight)

  mu_p <- r_hier$summary$mu_p_estimate
  if (!is.na(mu_p) && is.finite(mu_p)) {
    # mu_p should be within 10% of the binary_search p for tight data
    expect_lt(abs(mu_p - p_true) / p_true, 0.10)
  } else {
    skip("Hierarchical model did not converge — skipping coherence check")
  }
})