Put back in \dontrun commands in rasterPCA.R and rasterCVA.R, fixed a…

… bug that caused rasterPCA to fail internally

R/rasterCVA.R

@@ -21,14 +21,12 @@
 #' Returns a SpatRaster with two layers: change vector angle and change vector magnitude
 #' @export 
 #' @examples
-#' \dontrun{
 #' library(terra)
 #' pca <- rasterPCA(lsat)$map
 #'
 #' ## Do change vector analysis
 #' cva <- rasterCVA(pca[[1:2]], pca[[3:4]])
 #' cva
-#' }
 rasterCVA <- function(x, y, tmf = NULL, nct = NULL,  ...) {
 	x <- .toTerra(x)
 	y <- .toTerra(y)

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
-#' \dontrun{
 #' 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)
 
@@ -69,21 +67,21 @@ rasterPCA <- function(img, nSamples = NULL, nComp = nlyr(img), spca = FALSE,  ma
             if(sum(terra::values(totalMask)) == 0) stop("img contains either a layer with NAs only or no single pixel with valid values across all layers")
             img <- terra::mask(img, totalMask , maskvalue = 0) ## NA areas must be masked from all layers, otherwise the covariance matrix is not non-negative definite
         }
-        covMat <- terra::layerCor(img, "cov", na.rm = TRUE)
-        model  <- stats::princomp(covmat = covMat$covariance, cor = spca)
-        model$center <- covMat$mean
+        covMat <- cov.wt(as.data.frame(img))
+        model <- stats::princomp(cor = spca, covmat = covMat)
+        model$center <- covMat$center
         model$n.obs  <- ncell(any(!is.na(img)))
 
-        if(spca) {    
+        if(spca) {
             ## Calculate scale as population sd like in in princomp
-            S <- diag(covMat$covariance)
+            S <- diag(covMat$cov)
             model$scale <- sqrt(S * (model$n.obs-1)/model$n.obs)
         }
     }
     ## Predict
     out   <- .paraRasterFun(img, terra::predict, args = list(model = model, na.rm = TRUE, index = 1:nComp), wrArgs = ellip)
 
     names(out) <- paste0("PC", 1:nComp)
-    structure(list(call = match.call(), model = model, map = out), class = c("rasterPCA", "RStoolbox"))  
+    structure(list(call = match.call(), model = model, map = out), class = c("rasterPCA", "RStoolbox"))
 
 }

tests/testthat/test-panSharpen.R

@@ -3,9 +3,6 @@ context("panSharpen")
 library(terra)
 
 test_that("panSharpen methods", {
-	skip_on_ci()
-	skip_on_cran()
-	skip_on_covr()
 	suppressWarnings({
 		agg     <- aggregate(lsat, 10)
 		pan     <- sum(lsat[[1:3]])

tests/testthat/test-rasterPCA.R

@@ -7,9 +7,6 @@ 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_ci()
-		skip_on_cran()
-		skip_on_covr()
 		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)))
@@ -25,9 +22,6 @@ for(i in seq_len(nrow(G))){
 	spc  <- G[i,"spc"]
 	smpl <- if(G[i,"smpl"]) ncell(lsat_t) else NULL
 	test_that(paste("rasterPCA NA handling; spca =",spc, "; nSamples =", deparse(smpl)), {
-		skip_on_ci()
-		skip_on_cran()
-		skip_on_covr()
 		suppressWarnings({
 			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)])))