From 7dc37b18be1265f851bc4aa902a19867cd5791c6 Mon Sep 17 00:00:00 2001
From: 16EAGLE <jxsw@web.de>
Date: Mon, 15 Apr 2024 17:28:49 +0200
Subject: [PATCH] adapted test to reflect changes made to mesma

---
 tests/testthat/test-mesma.R | 63 ++++++++++++++++++++++++++++---------
 1 file changed, 49 insertions(+), 14 deletions(-)

diff --git a/tests/testthat/test-mesma.R b/tests/testthat/test-mesma.R
index cf14190..5e66734 100644
--- a/tests/testthat/test-mesma.R
+++ b/tests/testthat/test-mesma.R
@@ -1,38 +1,73 @@
 context("multiple endmember spectral mixture analysis")
 
-pts <- data.frame(class=c("water", "land"), cell = c(47916,5294))
-em <- as.matrix(lsat[pts$cell])
+# sets of endmembers
+em_sma <- as.matrix(data.frame(lsat[c(5294, 47916)]))
+rownames(em_sma) <- c("forest", "water")
+
+em_mesma_2 <- rbind(
+   data.frame(lsat[c(4155, 17018, 53134, 69487, 83704)], class = "forest"),
+   data.frame(lsat[c(22742, 25946, 38617, 59632, 67313)], class = "water")
+)
+em_mesma_3 <- rbind(
+  data.frame(lsat[c(4155, 17018, 53134, 69487, 83704)], class = "forest"),
+  data.frame(lsat[c(22742, 25946, 38617, 59632, 67313)], class = "water"),
+  data.frame(lsat[c(4330, 1762, 1278, 1357, 17414)], class = "shortgrown")
+)
+
 props <- matrix(c(seq(0,1,.1), seq(1,0,-.1)),ncol=2)
-mat <- props %*% em
+mat <- props %*% em_sma
 
 test_that("nnls_solver returns correct solutions",{
-  expect_equal(props, round(nnls_solver(x = mat, A = em)[,c(1,2)], digits = 2))
+  expect_equal(props, round(nnls_solver(x = mat, A = em_sma)[,c(1,2)], digits = 2))
 }
 )
 
 test_that("solver output class", {
-  expect_is(solved <- nnls_solver(x = mat, A = em)[,c(1,2)], "matrix")
+  expect_is(solved <- nnls_solver(x = mat, A = em_sma)[,c(1,2)], "matrix")
 })
 
-test_that("mesma call using NNLS", {
-  expect_is(solved <- mesma(lsat, em, method = "NNLS"), "SpatRaster")
-  expect_is(solved <- mesma(lsat, data.frame(em), method = "NNLS"), "SpatRaster")
+test_that("sma call using NNLS", {
+  expect_is(solved <- mesma(lsat, em_sma, method = "NNLS"), "SpatRaster")
+  expect_is(solved <- mesma(lsat, data.frame(em_sma), method = "NNLS"), "SpatRaster")
 })
 
-test_that("mesma method error", {
-  expect_error(mesma(lsat, em, method = "no-valid-method"))
+test_that("method error", {
+  expect_error(mesma(lsat, em_sma, method = "no-valid-method"))
 })
 
 lsat_t <- lsat
 values(lsat_t)[c(1, 10, 100, 400, 200), c(3, 4, 5, 2, 7)] <- NA
 
-test_that("mesma img NA handling", {
-  expect_is(solved <- mesma(lsat_t, em), "SpatRaster")
+test_that("img NA handling", {
+  expect_is(solved <- mesma(lsat_t, em_sma), "SpatRaster")
 })
 
-emNA <- em
+emNA <- em_sma
 emNA[1,6] <- NA
 
-test_that("mesma img NA handling", {
+test_that("img NA handling", {
   expect_error(mesma(lsat_t, emNA))
 })
+
+test_that("mesma two classes", {
+  probs <- expect_is(mesma(lsat, em_mesma_2), "SpatRaster")
+  expect_equal(nlyr(probs), 3)
+  expect_equal(names(probs), c("forest", "water", "RMSE"))
+  expect_equal(sapply(c(1000, 2000, 3000), function(x) sum(probs[[1:2]][x])), c(1,1,1))
+})
+
+test_that("mesma n_models", {
+  expect_warning(mesma(lsat, em_mesma_2, n_models = 10))
+})
+
+test_that("mesma sum_to_one", {
+  probs <- expect_is(mesma(lsat, em_mesma_2, sum_to_one = F), "SpatRaster")
+  expect_equal(round(sapply(c(1000, 2000, 3000), function(x) sum(probs[[1:2]][x])), 5), c(0.99841, 1.09785, 1.00944))
+})
+
+test_that("mesma three classes", {
+  probs <- expect_is(mesma(lsat, em_mesma_3), "SpatRaster")
+  expect_equal(nlyr(probs), 4)
+  expect_equal(names(probs), c("forest", "water", "shortgrown", "RMSE"))
+})
+