diff --git a/R/sam.R b/R/sam.R index 41a6eff..3493405 100644 --- 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 index d47c995..98a97d5 100644 --- 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 index 22bf713..63eca93 100644 --- a/man/sam.Rd +++ b/man/sam.Rd @@ -45,5 +45,5 @@ plot(lsat_sam) 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")) } diff --git a/man/topCor.Rd b/man/topCor.Rd index 0174892..d9a19b1 100644 --- a/man/topCor.Rd +++ b/man/topCor.Rd @@ -8,7 +8,6 @@ topCor( img, dem, metaData, - seed, solarAngles = c(), method = "C", stratImg = NULL, diff --git a/tests/testthat/test-topCor.R b/tests/testthat/test-topCor.R index 9c6528e..03385bc 100644 --- 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") }) })