New data, changed output band name of classification algos

bleutner · Feb 19, 2024 · 4abdd69 · 4abdd69
1 parent 2644f17
commit 4abdd69
Show file tree

Hide file tree

Showing 14 changed files with 23 additions and 45 deletions.
diff --git a/R/RStoolbox.R → R/RStoolbox-package.R b/R/RStoolbox.R → R/RStoolbox-package.R
@@ -46,6 +46,9 @@
 #' \item \code{\link{ggRGB}}: efficient plotting of remote sensing imagery in RGB with ggplot2
 #' }
 #'
+#' @keywords earth-observation, remote-sensing, spatial-data-analysis
+#' "RStoolbox"
+#'
 #' @import sf terra
 #' @importFrom exactextractr exact_extract
 #' @importFrom lifecycle is_present deprecate_warn deprecated
@@ -62,7 +65,6 @@
 #' @importFrom grDevices hsv
 #' @useDynLib RStoolbox
 #' @importFrom Rcpp sourceCpp
-#' @docType package
 #' @name RStoolbox
 NULL
 

diff --git a/R/superClass.R b/R/superClass.R
@@ -318,7 +318,7 @@ superClass <- function(img, trainData, valData = NULL, responseCol = NULL,
         wrArgs$filename <- filename ## remove filename from args if is.null(filename) --> standard writeRaster handling applies
         spatPred <- .paraRasterFun(img, rasterFun=terra::predict, args = list(model=caretModel, type = predType, index = probInd, na.rm = T), wrArgs = wrArgs)
         if(predType != "prob")
-          names(spatPred) <- responseCol
+          names(spatPred) <- paste0(responseCol, "_supervised")
 
     } else {
         spatPred <- "No map was produced (predict = FALSE)."
@@ -528,7 +528,7 @@ predict.superClass <- function(object, img, predType = "raw", filename = NULL, d
     wrArgs          <- c(list(...), list(filename = filename, datatype = datatype))
     wrArgs$filename <- filename ## remove filename from args if is.null(filename) --> standard writeRaster handling applies
     .paraRasterFun(img, rasterFun=terra::predict, args = list(model=model, type = predType, index = probInd, na.rm = TRUE), wrArgs = wrArgs)
-    
+
 }
 
 #' @method print superClass

diff --git a/R/unsuperClass.R b/R/unsuperClass.R
@@ -103,11 +103,12 @@ unsuperClass <- function(img, nSamples = 10000, nClasses = 5, nStarts = 25, nIte
   } else {
     out   <- app(img, fun = function(x, kmeans= model){
       predKmeansCpp(x, centers=kmeans$centers, returnDistances)}, ...)
-    names(out) <- if(returnDistances) paste0("dist_c", 1:nClasses) else "class"
+    names(out) <- if(returnDistances) paste0("dist_c", 1:nClasses) else "class_unsupervised"
   }
 
   model$cluster <- NULL
   structure(list(call = match.call(), model = model, map = out), class = c("unsuperClass", "RStoolbox"))
+
 }
 
 

diff --git a/inst/external/sen2.rds b/inst/external/sen2.rds
diff --git a/inst/external/srtm_sen2.rds b/inst/external/srtm_sen2.rds
diff --git a/inst/external/trainingPoints_sen2.rds b/inst/external/trainingPoints_sen2.rds
diff --git a/inst/external/trainingPolygons_sen2.rds b/inst/external/trainingPolygons_sen2.rds
diff --git a/man/RStoolbox.Rd b/man/RStoolbox.Rd
diff --git a/man/lsat.Rd b/man/lsat.Rd
diff --git a/man/rlogo.Rd b/man/rlogo.Rd
diff --git a/man/sen2.Rd b/man/sen2.Rd
diff --git a/man/srtm.Rd b/man/srtm.Rd
diff --git a/man/srtm_sen2.Rd b/man/srtm_sen2.Rd
diff --git a/tests/testthat/test-superClass.R b/tests/testthat/test-superClass.R
@@ -144,13 +144,12 @@ test_that("terra inputs",{
         })
 #
 if (identical(Sys.getenv("NOT_CRAN"), "true") ) {
-    ## Tiny raster bug caused superClass to fail when predictions were written to .grd file 
-#	test_that("NA in raster remains NA",{
-#				expect_is(sc <- superClass(lsNA, trainData = pts, responseCol = "class", model = "rf",
-#                                filename = rasterTmpFile(), trainPartition = 0.7, predict = TRUE), "superClass")
-#				expect_equal(sum(is.na(sc$map[1:100,])), 100*ncol(lsNA))
-#				expect_false(anyNA(sc$map[101:nrow(lsNA),]))
-#			})
+    test_that("NA in raster remains NA",{
+        expect_is(sc <- superClass(lsNA, trainData = pts, responseCol = "class", model = "rf",
+                         filename = .terraTmpFile(), trainPartition = 0.7, predict = TRUE), "superClass")
+        expect_equal(sum(is.na(sc$map[1:100,])), 100*ncol(lsNA))
+        expect_false(anyNA(sc$map[101:nrow(lsNA),]))
+    })
 
     ## Checks after clipping 
     test_that("fails if no validation points remain after clipping",{
@@ -163,5 +162,4 @@ if (identical(Sys.getenv("NOT_CRAN"), "true") ) {
     test_that("projection mismatch errors", 
             expect_error(superClass(lsat_t, trainData = poly, responseCol = "class"), "must have the same projection")
     )
-#	
 }