# Tests for the non-regularized estimators (EstimateIsing*):
# (a) the 'beta' argument must actually be used. Convention: the Ising
#     measure depends on the parameters only through beta * graph and
#     beta * thresholds, so all estimators return the beta = 1 estimates
#     divided by beta (for 'pl' this is achieved by optimizing the
#     pseudo-likelihood at the supplied beta, which yields the same scaling);
# (b) supplying 'responses' explicitly must give the same result as the
#     default (missing) call on matching data;
# (c) EstimateIsingPL() must warn when a supplied 'responses' coding does
#     not match the values present in the data.
# Plain stopifnot tests, no package dependencies beyond IsingSampler itself.

library("IsingSampler")

## Small seeded 3-node test model ---------------------------------------------
set.seed(123)
N <- 3
graph <- matrix(0, N, N)
graph[upper.tri(graph)] <- c(0.4, -0.2, 0.6)
graph <- graph + t(graph)
thresholds <- c(-0.1, 0.1, 0)
data <- as.matrix(IsingSampler(500, graph, thresholds, responses = c(0L, 1L)))

## (a) beta rescaling ----------------------------------------------------------

# Pseudo-likelihood: fitting at beta = 2 optimizes the same objective as a
# function of 2 * par, so the estimates must (up to nlm convergence noise)
# equal the beta = 1 estimates divided by 2. Generous tolerance for nlm:
pl1 <- EstimateIsingPL(data, beta = 1)
pl2 <- EstimateIsingPL(data, beta = 2)
stopifnot(max(abs(pl2$graph - pl1$graph / 2)) < 1e-3)
stopifnot(max(abs(pl2$thresholds - pl1$thresholds / 2)) < 1e-3)

# Univariate logistic regressions: rescaling is exact (deterministic glm):
uni1 <- EstimateIsingUni(data, beta = 1)
uni2 <- EstimateIsingUni(data, beta = 2)
stopifnot(isTRUE(all.equal(uni2$graph, uni1$graph / 2)))
stopifnot(isTRUE(all.equal(uni2$thresholds, uni1$thresholds / 2)))

# Loglinear model: rescaling is exact (deterministic loglin/IPF):
ll1 <- EstimateIsingLL(data, beta = 1)
ll2 <- EstimateIsingLL(data, beta = 2)
stopifnot(isTRUE(all.equal(ll2$graph, ll1$graph / 2)))
stopifnot(isTRUE(all.equal(ll2$thresholds, ll1$thresholds / 2)))

# Bivariate (multinomial) regressions can be numerically unstable, so only
# the beta rescaling arithmetic is exercised here: identical RNG seeds make
# the two multinom fits start identically, so the estimates must satisfy the
# same divide-by-beta relation (generous tolerance for the optimizer):
set.seed(1)
bi1 <- EstimateIsingBi(data, beta = 1, trace = FALSE)
set.seed(1)
bi2 <- EstimateIsingBi(data, beta = 2, trace = FALSE)
stopifnot(all(is.finite(bi2$graph)), all(is.finite(bi2$thresholds)))
stopifnot(max(abs(bi2$graph - bi1$graph / 2)) < 1e-3)
stopifnot(max(abs(bi2$thresholds - bi1$thresholds / 2)) < 1e-3)

# Cross-method sanity check of the convention: beta * estimates should be on
# the same (measure) scale regardless of beta, e.g. 2 * pl2 approx 1 * pl1:
stopifnot(max(abs(2 * pl2$graph - pl1$graph)) < 2e-3)

## (b) explicit responses equal the default on matching 0/1 data ---------------
plDef <- EstimateIsingPL(data)
plExp <- EstimateIsingPL(data, responses = c(0, 1))
stopifnot(identical(plDef$graph, plExp$graph))
stopifnot(identical(plDef$thresholds, plExp$thresholds))

uniDef <- EstimateIsingUni(data)
uniExp <- EstimateIsingUni(data, responses = c(0, 1))
stopifnot(identical(uniDef$graph, uniExp$graph))
stopifnot(identical(uniDef$thresholds, uniExp$thresholds))

## (c) warning when 'responses' does not match the data ------------------------
w <- tryCatch(EstimateIsingPL(data, responses = c(0, 2)),
              warning = function(w) w)
stopifnot(inherits(w, "warning"))
stopifnot(grepl("response options", conditionMessage(w)))

cat("All estimator tests passed.\n")
