fix spatialShrunkenCentroids() for r=0

kuwisdelu · Aug 9, 2024 · 6a46205 · 6a46205
1 parent b6131f2
commit 6a46205
Show file tree

Hide file tree

Showing 3 changed files with 14 additions and 2 deletions.
diff --git a/NEWS b/NEWS
@@ -1,4 +1,12 @@
 
+CHANGES IN VERSION 3.6.5 [2024-8-9]
+-----------------------------------
+
+BUG FIXES
+
+    o Fix 'spatialShrunkenCentroids()' failing when 'r=0'
+        or when a pixel has no neighboring pixels
+
 CHANGES IN VERSION 3.6.4 [2024-7-13]
 -----------------------------------
 

diff --git a/R/stats-spatialFastmap.R b/R/stats-spatialFastmap.R
@@ -133,7 +133,7 @@ setMethod("image", c(x = "SpatialFastmap"),
 			verbose=isTRUE(verbose), nchunks=nchunks,
 			BPPARAM=BPPARAM)
 		if ( length(i) > 1L ) {
-			FUN <- function(nbi, wi) colSums(wi * d[nbi,]) / sum(wi)
+			FUN <- function(nbi, wi) colSums(wi * d[nbi,,drop=FALSE]) / sum(wi)
 			t(mapply(FUN, neighbors, wts))
 		} else {
 			FUN <- function(nbi, wi) sum(wi * d[nbi]) / sum(wi)
@@ -159,7 +159,7 @@ setMethod("image", c(x = "SpatialFastmap"),
 			verbose=isTRUE(verbose), nchunks=nchunks,
 			BPPARAM=BPPARAM)
 		if ( length(i) > 1L ) {
-			FUN <- function(nbi, wi) colSums(wi * d[nbi,]) / sum(wi)
+			FUN <- function(nbi, wi) colSums(wi * d[nbi,,drop=FALSE]) / sum(wi)
 			t(mapply(FUN, neighbors, wts))
 		} else {
 			FUN <- function(nbi, wi) sum(wi * d[nbi]) / sum(wi)

diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R
@@ -171,6 +171,10 @@ test_that("spatialShrunkenCentroids (classification)", {
 	expect_is(topf[[1L]], "DataFrame")
 	expect_false(is.unsorted(rev(topf[[1L]]$statistic)))
 
+	sscr0 <- spatialShrunkenCentroids(s, s$class, r=0, s=0)
+
+	expect_true(validObject(sscr0))
+
 	sscmi <- spatialShrunkenCentroids(s, s$class, s=0:3, bags=run(s))
 	predmi <- predict(sscmi, newdata=s)