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)) })