tests/testthat/test-mesma.R

In bleutner/RStoolbox: Remote Sensing Data Analysis

context("multiple endmember spectral mixture analysis")

# 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_sma

test_that("nnls_solver returns correct solutions",{
  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_sma)[,c(1,2)], "matrix")
})

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("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("img NA handling", {
  expect_is(solved <- mesma(lsat_t, em_sma), "SpatRaster")
})

emNA <- em_sma
emNA[1,6] <- NA

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