Thrown out seed for topCor.R

bleutner · Jan 15, 2024 · 1763d2d · 1763d2d
1 parent 04d0c0a
commit 1763d2d
Show file tree

Hide file tree

Showing 5 changed files with 11 additions and 14 deletions.
diff --git a/R/sam.R b/R/sam.R
@@ -31,7 +31,7 @@
 #' lsat_sam <- sam(lsat, endmembers, angles = FALSE)
 #'
 #' ggR(lsat_sam, forceCat = TRUE, geom_raster=TRUE) +
-#'         scale_fill_manual(values = c("blue", "green"), labels = c("water", "vegetation"))
+#'              scale_fill_manual(values = c("blue", "green"), labels = c("water", "vegetation"))
 sam <- function(img, em, angles = FALSE, ...){
 	img <- .toTerra(img)
 

diff --git a/R/topCor.R b/R/topCor.R
@@ -33,7 +33,7 @@
 #' ## C correction, solar angles provided manually
 #' lsat_C <- topCor(lsat, dem = srtm, solarAngles = c(1.081533, 0.7023922), method = "C")
 #' 
-topCor <- function(img, dem, metaData, seed, solarAngles = c(), method = "C", stratImg = NULL, nStrat = 5, illu, ...){
+topCor <- function(img, dem, metaData, solarAngles = c(), method = "C", stratImg = NULL, nStrat = 5, illu, ...){
     img_t <- .toTerra(img)
     if(!missing("dem")) dem_t <- .toTerra(dem)
 	if(!missing("illu")) illu_t <- .toTerra(illu)
@@ -101,7 +101,7 @@ topCor <- function(img, dem, metaData, seed, solarAngles = c(), method = "C", st
         ## Lambertian assumption if k == 1
         ## Non-lambertian if 0 <= k < 1   
         stratMethod <- if(is.null(stratImg)) {stratImg <- "slope"; "noStrat"} else "stratEqualBins"
-        ks_t <- .kestimate_t(img_t, illu_t, slope_t, seed = seed, method = stratMethod, stratImg = stratImg, n = nStrat, sz=sz)
+        ks_t <- .kestimate_t(img_t, illu_t, slope_t, method = stratMethod, stratImg = stratImg, n = nStrat, sz=sz)
 
         ks_t$k <- lapply(ks_t$k, function(x){
             x[x[,2] < 0, 2] <- 0
@@ -129,7 +129,7 @@ topCor <- function(img, dem, metaData, seed, solarAngles = c(), method = "C", st
     }    
     if(method ==  "stat") {
         ## Eq 8 in Riano2003
-        ks_t <- .kestimate_t(img_t, illu_t, slope_t, seed = seed, method = "stat")
+        ks_t <- .kestimate_t(img_t, illu_t, slope_t, method = "stat")
         sub_t <- rast(lapply(ks_t$k, function(x){
             x[,2] * illu_t
         }))
@@ -138,7 +138,7 @@ topCor <- function(img, dem, metaData, seed, solarAngles = c(), method = "C", st
 
     }
     if(method == "C") {
-        ks_t <- .kestimate_t(img_t, illu_t, slope_t, seed = seed, method = "stat")
+        ks_t <- .kestimate_t(img_t, illu_t, slope_t, method = "stat")
         mult_t <- rast(lapply(ks_t$k, function(x){
             ck <- x[,1]/x[,2]
             (cos(sz) + ck) /  (illu_t + ck)
@@ -186,11 +186,10 @@ topCor <- function(img, dem, metaData, seed, solarAngles = c(), method = "C", st
 #' Parameter estimation
 #' @noRd 
 #' @keywords internal
-.kestimate_t <- function(img, illu, slope, seed, stratImg = "slope", method = "noStrat", n = 5, minN = 50, sz) {
+.kestimate_t <- function(img, illu, slope, stratImg = "slope", method = "noStrat", n = 5, minN = 50, sz) {
     suppressWarnings({
         stopifnot(method %in% c("stat", "noStrat", "stratEqualBins", "stratQuantiles"))
         ## Following Lu 2008 sample pre selection
-        set.seed(seed)
         strat <- if(inherits(stratImg, "character")) NULL else {names(stratImg) <- "strat"; stratImg}
         sr       <- as.data.frame(spatSample(c(img, illu, slope, strat), size = min(ncell(img), 10000), na.rm=TRUE))
 

diff --git a/man/sam.Rd b/man/sam.Rd
diff --git a/man/topCor.Rd b/man/topCor.Rd
diff --git a/tests/testthat/test-topCor.R b/tests/testthat/test-topCor.R
@@ -3,23 +3,22 @@ suppressPackageStartupMessages(library(terra))
 metaData <- system.file("external/landsat/LT52240631988227CUB02_MTL.txt", package="RStoolbox")
 metaData <- readMeta(metaData)
 lsat_t   <- stackMeta(metaData)
-seed <- 10
 
 ## Minnaert correction, solar angles from metaData
 test_that("basic functioning", { 
     suppressWarnings({
       mths <-  if (identical(Sys.getenv("NOT_CRAN"), "true")) c("cos", "avgcos", "C", "stat", "illu")  else "cos"
       for(method in mths){
-          expect_is(tc <- topCor(lsat_t, seed = seed, dem = srtm, metaData = metaData, method = method), "SpatRaster")
+          expect_is(tc <- topCor(lsat_t, dem = srtm, metaData = metaData, method = method), "SpatRaster")
           expect_equal(names(tc),  if(method!="illu") names(lsat_t) else "illu")
       }
       skip_on_cran()
       for(method in  mths){
-          expect_is(tc <- topCor(lsat_t, seed = seed, dem = srtm, metaData = metaData, method = method, filename = .terraTmpFile()), "SpatRaster")
+          expect_is(tc <- topCor(lsat_t, dem = srtm, metaData = metaData, method = method, filename = .terraTmpFile()), "SpatRaster")
           expect_equal(names(tc),  if(method!="illu") names(lsat_t) else "illu")
       }
-      expect_is(tc2 <- topCor(lsat_t, seed = seed, dem = srtm, metaData = metaData, method = "minnaert", stratImg='slope', nStrat = 5), "list")
-      expect_is(tc3 <- topCor(lsat_t, seed = seed, dem = srtm, solarAngles = c(1.081533, 0.7023922), method = "C"), "SpatRaster")
+      expect_is(tc2 <- topCor(lsat_t, dem = srtm, metaData = metaData, method = "minnaert", stratImg='slope', nStrat = 5), "list")
+      expect_is(tc3 <- topCor(lsat_t, dem = srtm, solarAngles = c(1.081533, 0.7023922), method = "C"), "SpatRaster")
     })
 
 })