Fixed a bug in rasterPCA.R causing model.center and model.n.obs not t…

…o have the same dim
bleutner · Jan 16, 2024 · 523c6f2 · 523c6f2
1 parent 1e20c50
commit 523c6f2
Show file tree

Hide file tree

Showing 7 changed files with 9 additions and 23 deletions.
diff --git a/R/rasterCVA.R b/R/rasterCVA.R
@@ -21,15 +21,13 @@
 #' Returns a SpatRaster with two layers: change vector angle and change vector magnitude
 #' @export 
 #' @examples
-#' \donttest{
 #' library(terra)
 #' pca <- rasterPCA(lsat)$map
 #'
 #' ## Do change vector analysis
 #' cva <- rasterCVA(pca[[1:2]], pca[[3:4]])
 #' cva
 #' plot(cva)
-#' }
 rasterCVA <- function(x, y, tmf = NULL, nct = NULL,  ...) {
 	x <- .toTerra(x)
 	y <- .toTerra(y)

diff --git a/R/rasterPCA.R b/R/rasterPCA.R
@@ -24,7 +24,6 @@
 #' @return Returns a named list containing the PCA model object ($model) and a SpatRaster with the principal component layers ($object).
 #' @export 
 #' @examples
-#' \donttest{
 #' library(ggplot2)
 #' library(reshape2)
 #' ggRGB(rlogo, 1,2,3)
@@ -43,7 +42,6 @@
 #'   plots <- lapply(1:3, function(x) ggR(rpc$map, x, geom_raster = TRUE))
 #'   grid.arrange(plots[[1]],plots[[2]], plots[[3]], ncol=2)
 #' }
-#' }
 rasterPCA <- function(img, nSamples = NULL, nComp = nlyr(img), spca = FALSE,  maskCheck = TRUE, ...){
     img <- .toTerra(img)
 
@@ -60,7 +58,7 @@ rasterPCA <- function(img, nSamples = NULL, nComp = nlyr(img), spca = FALSE,  ma
 
     if(!is.null(nSamples)){
         trainData <- terra::spatSample(img, size = nSamples, na.rm = TRUE)
-        if(nrow(trainData) < terra::nlyr(img)) stop("nSamples too small or img contains a layer with NAs only")
+        if(nrow(trainData) < nlyr(img)) stop("nSamples too small or img contains a layer with NAs only")
         model <- stats::princomp(trainData, scores = FALSE, cor = spca)
     } else {
         if(maskCheck) {
@@ -72,7 +70,7 @@ rasterPCA <- function(img, nSamples = NULL, nComp = nlyr(img), spca = FALSE,  ma
         covMat <- terra::layerCor(img, "cov", na.rm = TRUE)
         model  <- stats::princomp(covmat = covMat$covariance, cor = spca)
         model$center <- covMat$mean
-        model$n.obs  <- terra::ncell(!any(is.na(img)))
+        model$n.obs  <- t(global(img, "sum", na.rm = TRUE))
 
         if(spca) {    
             ## Calculate scale as population sd like in in princomp

diff --git a/R/sam.R b/R/sam.R
@@ -13,20 +13,20 @@
 #' In a second step one can the go ahead an enforce thresholds of maximum angles or simply classify each pixel to the most similar endmember. 
 #' @return SpatRaster
 #' If \code{angles = FALSE} a single Layer will be returned in which each pixel is assigned to the closest endmember class (integer pixel values correspond to row order of \code{em}. 
-#' @examples 
+#' @examples
 #' library(terra)
 #' library(ggplot2)
-#' 
-#' ## Sample endmember spectra 
+#'
+#' ## Sample endmember spectra
 #' ## First location is water, second is open agricultural vegetation
 #' pts <- data.frame(x = c(624720, 627480), y = c(-414690, -411090))
 #' endmembers <- extract(lsat, pts)
 #' rownames(endmembers) <- c("water", "vegetation")
-#' 
+#'
 #' ## Calculate spectral angles
 #' lsat_sam <- sam(lsat, endmembers, angles = TRUE)
 #' plot(lsat_sam)
-#' 
+#'
 #' ## Classify based on minimum angle
 #' lsat_sam <- sam(lsat, endmembers, angles = FALSE)
 #'

diff --git a/man/rasterCVA.Rd b/man/rasterCVA.Rd
diff --git a/man/rasterPCA.Rd b/man/rasterPCA.Rd
diff --git a/man/sam.Rd b/man/sam.Rd
diff --git a/tests/testthat/test-rasterPCA.R b/tests/testthat/test-rasterPCA.R
@@ -7,13 +7,10 @@ ld   <- as.data.frame(lsat_t)
 
 for(spc in c(FALSE, TRUE)) {
 	test_that(paste("stats::princomp(covMat(raster)) == stats::princomp(sample) with spca=",spc), {
-		skip_on_covr()
-		skip_on_cran()
-		skip_on_ci()
 		expect_s3_class(r   <- rasterPCA(lsat_t, nSamples = NULL, spca = spc), c("RStoolbox", "rasterPCA"))
 		expect_s3_class(rs  <- rasterPCA(lsat_t, nSamples = ncell(lsat_t), spca = spc), c("RStoolbox", "rasterPCA"))
 		expect_equal(abs(unclass(rs$model$loadings)), abs(unclass(r$model$loadings)))
-		expect_equivalent(abs(r$map[]), abs(rs$map[]))
+		expect_equal(abs(r$map[]), abs(rs$map[]), tolerance = 1e-03)
 	})
 
 }
@@ -26,9 +23,6 @@ for(i in seq_len(nrow(G))){
 	smpl <- if(G[i,"smpl"]) ncell(lsat_t) else NULL
 	test_that(paste("rasterPCA NA handling; spca =",spc, "; nSamples =", deparse(smpl)), {
 		suppressWarnings({
-			skip_on_cran()
-			skip_on_covr()
-			skip_on_ci()
 			expect_s3_class(r   <- rasterPCA(lsat_t, nSamples = smpl, spca = spc), c("RStoolbox", "rasterPCA"))
 			expect_true(all(is.na(r$map[c(100:200,400:500)])))
 			expect_false(any(is.na(r$map[1:99])))