context("unsuperClass") library(terra) ## Set-up test data lsatNA <- lsat lsatNA[20:40, ] <- NA lsatNA2 <- lsat lsatNA2 <- terra::writeRaster(lsatNA2, .terraTmpFile()) values(lsatNA2)[is.na(values(lsatNA2))] <- 20 ## Tiny raster bug caused superClass to fail when predictions were written to .grd file test_that("unsuperClass and NA",{ for(cm in c(TRUE, FALSE)) { expect_is(sc <- unsuperClass(lsat, nClasses = 2, clusterMap = cm), "unsuperClass") expect_is(scNA <- unsuperClass(lsatNA, nClasses = 2, clusterMap = cm), "unsuperClass") expect_true(all(is.na(scNA$map[20:40,]))) expect_is(scNA <- unsuperClass(lsatNA2, nClasses = 2, filename = .terraTmpFile(), clusterMap = cm), "unsuperClass") expect_equal(sort(unique(scNA$map[])), c(1,2)) } }) test_that("terra inputs",{ expect_is(sc <- unsuperClass(lsat, nClasses = 2), "unsuperClass") }) ## kmeans prediction function only mat <- matrix(1:20, by = TRUE, nrow = 5, ncol=4) cents <- mat[c(1,3),] dists <- apply(cents, 1, function(ce) { apply(mat, 1, function(x) { sqrt(sum((x - ce)^2)) } ) }) test_that("kmeans predictions",{ expect_equal(predKmeansCpp(mat, cents), matrix(c(1,1,2,2,2), ncol = 1)) expect_equal(predKmeansCpp(mat, cents,TRUE), dists) mat[1] <- NA dists[1,] <- NA expect_equal(predKmeansCpp(mat, cents), matrix(c(NA,1,2,2,2), ncol = 1)) expect_equal(predKmeansCpp(mat, cents, TRUE), dists) }) ## pretty print test_that("printing method", { skip_on_cran() expect_output(print(unsuperClass(lsat, nClasses = 2)), "unsuperClass results") }) ## algortithm warning test_that("kmeans fail detection", { skip_on_cran() set.seed(1) expect_warning(unsuperClass(lsat, nSamples = ncell(lsat), nStarts = 1, nClasses = 30), "doesn't converge properly") }) ## Helper for symlink-proof filename checking ## Added to fix CI on gh-actions slp_bn <- function(path, tmp = basename(tempdir())) { tail(strsplit(path, tmp)[[1]],1) } ## Predict S3 method test_that("predict.unSuperClass", { skip_on_cran() uc <- unsuperClass(lsat, nSamples = ncell(lsat), nClasses = 2) expect_s4_class(pred <- predict(uc, lsat), "SpatRaster") expect_equal(sum((uc$map - pred)[]), 0) tmpFile <- tempfile(fileext = ".grd") pred <- predict(uc, lsat, filename = tmpFile ) expect_false(inMemory(pred)) expect_equal(basename(sources(pred)), basename(tmpFile)) file.remove(tmpFile, gsub("grd", "gri", tmpFile)) })