# Tests for the minimum sum-score correction of EstimateIsingUni():
# 'min_sum' refers to sum scores on the ORIGINAL response coding, but the
# row filter used to run after the data were recoded to 0/1, so for data
# coded e.g. c(1,2) it filtered the wrong rows (usually none). The filter
# now runs on the raw data: for node i a row is biased iff the rest score
# is compatible with the truncation when node i takes the high response
# but not when it takes the low response. Checks:
# (a) on 0/1 data the new raw-scale filter retains exactly the rows the
#     old binarized-scale filter (rest != min_sum - 1) retained, per node;
# (b) on c(1,2)-coded data (same data recoded, min_sum shifted accordingly)
#     the estimator drops the corresponding rows and the estimates agree
#     with the 0/1 fit after LinTransform;
# (c) the default min_sum = -Inf drops no rows.
# Plain stopifnot tests, no package dependencies beyond IsingSampler itself.

library("IsingSampler")

## Small seeded 4-node test model ---------------------------------------------
set.seed(42)
N <- 4
graph <- matrix(0, N, N)
graph[upper.tri(graph)] <- c(0.4, -0.2, 0.6, 0.2, -0.3, 0.5)
graph <- graph + t(graph)
thresholds <- c(-0.2, 0.1, 0, -0.1)
full <- as.matrix(IsingSampler(1000, graph, thresholds, responses = c(0L, 1L)))

# Mimic sum-score truncated data: keep only rows with sum score >= min_sum:
min_sum <- 2
data01 <- full[rowSums(full) >= min_sum, , drop = FALSE]

# Number of retained rows per fitted node model:
nRows <- function(fit) sapply(fit$results, function(m) length(residuals(m)))

## (a) new raw-scale filter == old filter on 0/1 data --------------------------
# On 0/1 data the binarized data equal the raw data, so the old filter
# (rest != min_sum - 1 on the binarized data) must be reproduced exactly by
# the new condition (rest + 1 >= min_sum & rest + 0 < min_sum on raw data):
uni01 <- EstimateIsingUni(data01, min_sum = min_sum)
for (i in seq_len(N)){
  rest <- rowSums(data01[, -i, drop = FALSE])
  keepOld <- which(rest != min_sum - 1)
  keepNew <- which(!(rest + 1 >= min_sum & rest + 0 < min_sum))
  stopifnot(identical(keepOld, keepNew))
  # The estimator must have fitted node i on exactly these rows:
  stopifnot(nRows(uni01)[i] == length(keepNew))
  # Make the test non-trivial: some rows must actually be dropped:
  stopifnot(length(keepNew) < nrow(data01))
}

## (b) c(1,2)-coded data: same rows dropped, estimates agree -------------------
# Recode the same data to responses c(1,2); each row's sum score shifts by
# the number of nodes, so the equivalent truncation threshold shifts too:
data12 <- data01 + 1
min_sum12 <- min_sum + N
uni12 <- EstimateIsingUni(data12, min_sum = min_sum12)

# Corresponding rows are dropped per node (the old binarized-scale filter
# would have dropped none here, since rest scores of 0/1-binarized data
# never equal min_sum12 - 1 = 5 with only 3 remaining nodes):
stopifnot(identical(nRows(uni12), nRows(uni01)))

# The glm fits run on identical binarized data and identical retained rows,
# so mapping the 0/1 estimates to the (1,2) coding via LinTransform must
# reproduce the (1,2) fit essentially exactly:
trans <- LinTransform(uni01$graph, uni01$thresholds, from = c(0, 1), to = c(1, 2))
stopifnot(isTRUE(all.equal(trans$graph, uni12$graph, tolerance = 1e-6)))
stopifnot(isTRUE(all.equal(trans$thresholds, uni12$thresholds, tolerance = 1e-6)))

## (c) default min_sum = -Inf drops no rows ------------------------------------
uniDef <- EstimateIsingUni(full)
uniInf <- EstimateIsingUni(full, min_sum = -Inf)
stopifnot(all(nRows(uniInf) == nrow(full)))
stopifnot(identical(uniDef$graph, uniInf$graph))
stopifnot(identical(uniDef$thresholds, uniInf$thresholds))

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