tests/testthat/test-sqi.R

In SQIpro: Comprehensive Soil Quality Index Computation and Visualization

library(testthat)
library(SQIpro)

# ── Fixtures ────────────────────────────────────────────────────────────────
make_test_data <- function() {
  set.seed(1)
  data.frame(
    LandUse = rep(c("Forest","Crop","Degraded"), each = 10),
    Depth   = rep(c("Surface","Sub"), 15),
    pH      = c(runif(10,5.8,6.8), runif(10,6.5,7.5), runif(10,7.0,8.5)),
    EC      = c(runif(10,0.1,0.3), runif(10,0.2,0.5), runif(10,0.5,1.2)),
    BD      = c(runif(10,0.9,1.1), runif(10,1.2,1.5), runif(10,1.5,1.8)),
    OC      = c(runif(10,2.5,4.5), runif(10,0.8,1.8), runif(10,0.2,0.8)),
    MBC     = c(runif(10,300,500), runif(10,100,250), runif(10,20,80))
  )
}

cfg <- make_config(
  variable = c("pH",   "EC",   "BD",   "OC",   "MBC"),
  type     = c("opt",  "less", "less", "more", "more"),
  opt_low  = c(6.0,    NA,     NA,     NA,     NA),
  opt_high = c(7.0,    NA,     NA,     NA,     NA)
)

# ── Scoring functions ────────────────────────────────────────────────────────
test_that("score_more returns [0,1]", {
  x <- c(1, 2, 3, 4, 5)
  s <- score_more(x)
  expect_true(all(s >= 0 & s <= 1))
  expect_equal(s[1], 0)
  expect_equal(s[5], 1)
})

test_that("score_less returns [0,1] inverted", {
  x <- c(1, 2, 3, 4, 5)
  s <- score_less(x)
  expect_true(all(s >= 0 & s <= 1))
  expect_equal(s[1], 1)
  expect_equal(s[5], 0)
})

test_that("score_optimum peaks at optimum", {
  x <- c(4, 5, 6.5, 7, 8, 9)
  s <- score_optimum(x, opt_low = 6.0, opt_high = 7.0)
  expect_equal(s[3], 1)   # 6.5 is within optimum
  expect_equal(s[4], 1)   # 7.0 is upper bound of optimum
  expect_true(s[1] < s[3])
  expect_true(s[6] < s[4])
})

test_that("score_trapezoid is 0 outside boundaries", {
  x <- c(3, 5, 6, 6.5, 7, 8, 9, 10)
  s <- score_trapezoid(x, min_val=4, opt_low=6, opt_high=7, max_val=9)
  expect_equal(s[1], 0)   # below min_val
  expect_equal(s[8], 0)   # above max_val
  expect_equal(s[4], 1)   # within plateau
})

test_that("score_custom errors if output not [0,1]", {
  x <- 1:5
  expect_warning(
    score_custom(x, function(v) v * 10),  # returns >1
    "outside \\[0, 1\\]"
  )
})

# ── make_config ──────────────────────────────────────────────────────────────
test_that("make_config returns sqi_config", {
  expect_s3_class(cfg, "sqi_config")
  expect_equal(nrow(cfg), 5)
})

test_that("make_config errors on length mismatch", {
  expect_error(
    make_config(variable = c("a","b"), type = "more"),
    "same length"
  )
})

# ── validate_data ────────────────────────────────────────────────────────────
test_that("validate_data passes on clean data", {
  dat <- make_test_data()
  res <- validate_data(dat, group_cols = c("LandUse","Depth"),
                       verbose = FALSE)
  expect_true(res$valid)
})

test_that("validate_data detects missing values", {
  dat     <- make_test_data()
  dat$OC[1:3] <- NA
  res <- validate_data(dat, group_cols = c("LandUse","Depth"),
                       verbose = FALSE)
  expect_true(any(grepl("Missing", res$messages)))
})

# ── score_all ────────────────────────────────────────────────────────────────
test_that("score_all returns same dimensions", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  expect_equal(dim(scored), dim(dat))
  expect_true(all(scored$OC >= 0 & scored$OC <= 1))
  expect_true(all(scored$BD >= 0 & scored$BD <= 1))
})

# ── select_mds ───────────────────────────────────────────────────────────────
test_that("select_mds returns sqi_mds with mds_vars", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  mds    <- select_mds(scored, group_cols = c("LandUse","Depth"),
                       verbose = FALSE)
  expect_s3_class(mds, "sqi_mds")
  expect_true(length(mds$mds_vars) >= 1)
  expect_true(all(mds$mds_vars %in% cfg$variable))
})

# ── Indexing functions ───────────────────────────────────────────────────────
test_that("sqi_linear returns values in [0,1]", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  res    <- sqi_linear(scored, cfg, group_cols = c("LandUse","Depth"))
  expect_true(all(res$SQI_linear >= 0 & res$SQI_linear <= 1))
})

test_that("sqi_pca returns values in [0,1]", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  res    <- sqi_pca(scored, cfg, group_cols = c("LandUse","Depth"))
  expect_true(all(res$SQI_pca >= 0 & res$SQI_pca <= 1))
})

test_that("sqi_entropy returns weights summing to ~1", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  res    <- sqi_entropy(scored, cfg, group_cols = c("LandUse","Depth"))
  w      <- attr(res, "entropy_weights")
  expect_equal(sum(w), 1, tolerance = 1e-3)
})

test_that("sqi_topsis returns values in [0,1]", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  res    <- sqi_topsis(scored, cfg, group_cols = c("LandUse","Depth"))
  expect_true(all(res$SQI_topsis >= 0 & res$SQI_topsis <= 1))
})

test_that("sqi_compare includes all method columns", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = c("LandUse","Depth"))
  res    <- sqi_compare(scored, cfg, group_cols = c("LandUse","Depth"))
  expected_cols <- c("SQI_linear","SQI_pca","SQI_fuzzy",
                     "SQI_entropy","SQI_topsis","Mean_SQI","Rank")
  for (col in expected_cols) {
    expect_true(col %in% names(res),
                info = paste("Missing column:", col))
  }
})

# ── Forest > Degraded ────────────────────────────────────────────────────────
test_that("Forest has higher SQI than Degraded_Land (linear)", {
  dat    <- make_test_data()
  scored <- score_all(dat, cfg, group_cols = "LandUse")
  res    <- sqi_linear(scored, cfg, group_cols = "LandUse")
  forest  <- res$SQI_linear[res$LandUse == "Forest"]
  degraded <- res$SQI_linear[res$LandUse == "Degraded"]
  expect_true(mean(forest) > mean(degraded))
})