# ==============================================================================
# test-v020.R — Tests for the 0.5.0 features (file name kept from development)
# ==============================================================================
# Null models A / B stratified / entities, global test, seed handling,
# matching of species by name, transitions (midpoint, partition, entities),
# asc_entities and the Gower square-root correction.
# ==============================================================================

tr <- data.frame(
  Mass = c(15, 20, 30, 45, 60, 90, 150, 250, 400, 600),
  Beak = c(10, 12, 15, 22, 28, 35,  45,  60,  85, 120),
  Diet = factor(c(0, 0, 1, 1, 1, 0,  1,  1,  1,  0))
)
rownames(tr) <- paste0("Sp", 1:10)

ab2 <- rbind(
  Ref = c(0, 0, 10, 15, 25, 20, 10, 8, 4, 2),
  Imp = c(40, 35, 15, 5, 0, 0, 0, 0, 0, 0)
)
colnames(ab2) <- rownames(tr)

# Two states with three replicates each
ab_rep <- rbind(
  R1 = c(2, 3, 10, 15, 20, 18, 10, 8, 4, 2),
  R2 = c(1, 4, 12, 14, 22, 15, 12, 6, 5, 1),
  R3 = c(3, 2,  9, 16, 25, 20,  9, 7, 3, 2),
  I1 = c(30, 25, 15, 6, 3, 2, 1, 0, 0, 0),
  I2 = c(28, 30, 12, 8, 2, 1, 0, 1, 0, 0),
  I3 = c(35, 22, 16, 5, 4, 0, 1, 0, 0, 0)
)
colnames(ab_rep) <- rownames(tr)

pair_rep <- function(ab = ab_rep, ...) {
  asc_paired(tr, ab, sites = rep("S", 6), time = rep(c("R", "I"), each = 3),
             ref_time = "R", ...)
}


# ==============================================================================
# asc_null: dispatch, p-values, seed
# ==============================================================================
test_that("replicates give A by samples; single samples give A by individuals", {
  r_rep <- asc_null(pair_rep(), n_perm = 19, seed = 1)
  expect_setequal(unique(r_rep$null_models$Test), c("A_samples", "B_stratified"))

  r_one <- asc_null(asc_paired(tr, ab2, sites = c("S", "S"), time = c("R", "I"), ref_time = "R"),
                    n_perm = 19, seed = 1)
  expect_setequal(unique(r_one$null_models$Test), c("A_individuals", "B_stratified"))
  expect_equal(r_one$null_settings$stratum_size, 5)
})

test_that("p-values are (b + 1) / (n + 1) and lie in (0, 1]", {
  r <- asc_null(pair_rep(), n_perm = 99, seed = 2)
  p <- unlist(r$null_models[, c("P_upper", "P_lower", "P_two")])
  p <- p[!is.na(p)]
  expect_true(all(p > 0 & p <= 1))
  expect_true(all(abs(p * 100 - round(p * 100)) < 1e-9))
})

test_that("identical communities give no shift and P_upper = 1 for A position", {
  ab <- rbind(A = ab2[1, ], B = ab2[1, ])
  r <- asc_null(asc_paired(tr, ab, sites = c("S", "S"), time = c("R", "C"), ref_time = "R"),
                n_perm = 19, seed = 3)
  d_pos <- r$null_models[r$null_models$Test == "A_individuals" & r$null_models$Layer == "Position", ]
  expect_equal(d_pos$Observed, 0, tolerance = 1e-12)
  expect_equal(d_pos$P_upper, 1)
})

test_that("asc_null with a seed leaves the user's random stream unchanged", {
  x <- pair_rep()
  set.seed(10); a <- stats::runif(3)
  set.seed(10); invisible(asc_null(x, n_perm = 19, seed = 99)); b <- stats::runif(3)
  expect_identical(a, b)
})

test_that("non-integer abundances: warning, A skipped, only B evaluated", {
  ab <- ab2 / rowSums(ab2)
  x <- suppressWarnings(asc_paired(tr, ab, sites = c("S", "S"), time = c("R", "I"), ref_time = "R"))
  expect_warning(r <- asc_null(x, n_perm = 19, seed = 1), "no counts")
  expect_setequal(unique(r$null_models$Test), "B_stratified")
})

test_that("entities add the A test on entity totals", {
  ent <- stats::setNames(paste0("E", c(1, 1, 2, 2, 2, 3, 3, 4, 4, 4)), rownames(tr))
  r <- asc_null(pair_rep(), n_perm = 19, seed = 1, entities = ent)
  expect_true("A_entities_samples" %in% r$null_models$Test)
  r1 <- asc_null(asc_paired(tr, ab2, sites = c("S", "S"), time = c("R", "I"), ref_time = "R"),
                 n_perm = 19, seed = 1, entities = ent)
  expect_true("A_entities" %in% r1$null_models$Test)
})

test_that("pairwise objects get one global test and site contributions", {
  ab <- rbind(A = ab_rep[1, ], B = ab_rep[2, ], C = ab_rep[4, ], D = ab_rep[5, ])
  r <- asc_null(asc_pairwise(tr, ab), n_perm = 19, seed = 4)
  expect_true(all(r$null_models$Contrast == "Global"))
  expect_setequal(unique(r$null_models$Test), c("A_global", "B_global_stratified"))
  expect_equal(nrow(r$site_contribution), 4)
  expect_equal(sum(r$site_contribution$Fraction), 1, tolerance = 1e-12)
})

test_that("invalid arguments are rejected", {
  x <- pair_rep()
  expect_error(asc_null(x, n_perm = 5))
  expect_error(asc_null(x, n_perm = 19, stratum_size = 1))
  expect_error(asc_null(list(), n_perm = 19))
})


# ==============================================================================
# Species matched by name
# ==============================================================================
test_that("column order of the abundance matrix does not matter", {
  x1 <- pair_rep()
  x2 <- pair_rep(ab_rep[, rev(colnames(ab_rep))])
  expect_equal(x1$rDelta_C, x2$rDelta_C, tolerance = 1e-12)
  expect_equal(x1$site_results$S$Delta_FDis, x2$site_results$S$Delta_FDis, tolerance = 1e-12)
})

test_that("a species without traits gives an error", {
  ab <- cbind(ab2, Sp99 = c(1, 1))
  expect_error(asc_paired(tr, ab, sites = c("S", "S"), time = c("R", "I"), ref_time = "R"))
})


# ==============================================================================
# asc_transitions
# ==============================================================================
test_that("leverage adds up to the shift for every reference point", {
  x <- pair_rep()
  for (rf in c("midpoint", "reference", "comparison")) {
    t <- asc_transitions(x, ref = rf)$S
    expect_equal(sum(t$species_leverage$Leverage), t$shift, tolerance = 1e-10)
    expect_equal(sum(t$partition$Fraction), 1, tolerance = 1e-10)
  }
})

test_that("midpoint partition is symmetric when the states are swapped", {
  ab <- rbind(A = c(0, 0, 10, 15, 25, 20, 10, 8, 4, 2),
              B = c(40, 35, 15, 5, 0, 3, 0, 0, 0, 0))
  colnames(ab) <- rownames(tr)
  pAB <- asc_transitions(asc_paired(tr, ab, sites = c("S", "S"), time = c("A", "B"), ref_time = "A"))$S$partition
  pBA <- asc_transitions(asc_paired(tr, ab, sites = c("S", "S"), time = c("A", "B"), ref_time = "B"))$S$partition
  f <- function(p, g) p$Fraction[p$Group == g]
  expect_equal(f(pAB, "shared"), f(pBA, "shared"), tolerance = 1e-10)
  expect_equal(f(pAB, "gained"), f(pBA, "lost"), tolerance = 1e-10)
})

test_that("between + within entities equals the shift", {
  ent <- stats::setNames(paste0("E", c(1, 1, 2, 2, 2, 3, 3, 4, 4, 4)), rownames(tr))
  t <- asc_transitions(pair_rep(), entities = ent)$S
  expect_equal(unname(t$entities["Between"] + t$entities["Within"]), t$shift, tolerance = 1e-10)
  expect_equal(unname(t$entities["Shift"]), t$shift, tolerance = 1e-12)
})


# ==============================================================================
# asc_entities and the square-root correction
# ==============================================================================
test_that("asc_entities returns membership usable by asc_null and asc_transitions", {
  ent <- suppressWarnings(suppressMessages(asc_entities(tr, k_max = 5, B = 10, seed = 1)))
  expect_s3_class(ent, "ascfcd_entities")
  expect_named(ent$membership, rownames(tr))
  expect_equal(ent$k, length(unique(ent$membership)))
  expect_named(ent$suggestions, c("silhouette", "mojena", "gap"))
  expect_equal(ent$k, ent$suggestions[["silhouette"]])
  t <- asc_transitions(pair_rep(), entities = ent)$S
  expect_false(is.null(t$entities))
})

test_that("a fixed k is respected and the gap statistic is reproducible", {
  e1 <- suppressWarnings(suppressMessages(asc_entities(tr, k = 3, k_max = 5, B = 10, seed = 7)))
  e2 <- suppressWarnings(suppressMessages(asc_entities(tr, k = 3, k_max = 5, B = 10, seed = 7)))
  expect_equal(e1$k, 3)
  expect_identical(e1$indices, e2$indices)
})

test_that("correction = 'sqrt' gives a Euclidean space (quality 1)", {
  q <- assess_functional_space(tr, correction = "sqrt")
  expect_equal(q$quality, 1, tolerance = 1e-8)
  expect_equal(q$correction, "sqrt")
})