Commit 42fa9b17 authored by Romulo Pereira Goncalves's avatar Romulo Pereira Goncalves
Browse files

Merge changes

parents 3c0527b6 4c92bb0e
Pipeline #28192 passed with stages
in 7 minutes and 42 seconds
Package: HaSa Package: HaSa
Title: Autonomous Image Sampling and Probability Mapping Title: Autonomous Image Sampling and Probability Mapping
Version: 1.3.0 Version: 1.3.1
Authors@R: Authors@R:
person(given = "Carsten", person(given = "Carsten",
family = "Neumann", family = "Neumann",
......
...@@ -65,7 +65,13 @@ sample_nb <- function(raster, ...@@ -65,7 +65,13 @@ sample_nb <- function(raster,
### ###
n_channel <- length(names(raster)) n_channel <- length(names(raster))
###raster in MEMORY or NOT ###raster in MEMORY or NOT
if (in.memory == TRUE && raster::fromDisk(raster) == TRUE) { rast <- raster::readAll(raster) }else { rast <-raster } if (in.memory == TRUE &&
raster::fromDisk(raster) == TRUE) {
rast <- raster::readAll(raster)
} else {
rast <- raster
}
rast <- raster::mask(rast, raster::calc(rast, fun = sum))
### ###
l <- 1 ###6. opt=260 l <- 1 ###6. opt=260
pbtn1 <- matrix(1, nrow = 1, ncol = 1) pbtn1 <- matrix(1, nrow = 1, ncol = 1)
...@@ -107,7 +113,8 @@ sample_nb <- function(raster, ...@@ -107,7 +113,8 @@ sample_nb <- function(raster,
res <- parallel::mclapply( res <- parallel::mclapply(
1:nb_mean, 1:nb_mean,
model_opt_r, model_opt_r,
raster = raster, raster = rast,
col_names = names(raster),
sample_type = sample_type, sample_type = sample_type,
buffer = buffer, buffer = buffer,
model = model, model = model,
...@@ -119,7 +126,6 @@ sample_nb <- function(raster, ...@@ -119,7 +126,6 @@ sample_nb <- function(raster,
mtry = mtry, mtry = mtry,
mod.error = mod.error, mod.error = mod.error,
pbtn1 = pbtn1, pbtn1 = pbtn1,
rast = rast,
max_samples_per_class = max_samples_per_class, max_samples_per_class = max_samples_per_class,
mc.cores = cores, mc.cores = cores,
mc.preschedule = TRUE, mc.preschedule = TRUE,
...@@ -133,7 +139,8 @@ sample_nb <- function(raster, ...@@ -133,7 +139,8 @@ sample_nb <- function(raster,
} else { } else {
for (k in 1:nb_mean) { for (k in 1:nb_mean) {
res <- model_opt_r( res <- model_opt_r(
raster = raster, raster = rast,
col_names = names(raster),
sample_type = sample_type, sample_type = sample_type,
buffer = buffer, buffer = buffer,
model = model, model = model,
...@@ -146,7 +153,6 @@ sample_nb <- function(raster, ...@@ -146,7 +153,6 @@ sample_nb <- function(raster,
mtry = mtry, mtry = mtry,
mod.error = mod.error, mod.error = mod.error,
pbtn1 = pbtn1, pbtn1 = pbtn1,
rast = rast,
max_samples_per_class = max_samples_per_class max_samples_per_class = max_samples_per_class
) )
points_list[[k]] <- res$points points_list[[k]] <- res$points
......
...@@ -4,6 +4,7 @@ ...@@ -4,6 +4,7 @@
#' #'
#' @param k Iteration value for the models. #' @param k Iteration value for the models.
#' @param raster satellite time series stack (rasterBrickObject) or just any type of image (*rasterObject) #' @param raster satellite time series stack (rasterBrickObject) or just any type of image (*rasterObject)
#' @param col_names layer names
#' @param sample_type distribution of spatial locations c("random","regular") #' @param sample_type distribution of spatial locations c("random","regular")
#' @param buffer distance (in m) for new sample collection around initial samples (depends on pixel size) #' @param buffer distance (in m) for new sample collection around initial samples (depends on pixel size)
#' @param model which machine learning classifier to use c("rf", "svm") for random forest or support vector machine implementation #' @param model which machine learning classifier to use c("rf", "svm") for random forest or support vector machine implementation
...@@ -15,7 +16,6 @@ ...@@ -15,7 +16,6 @@
#' @param mtry number of predictor used at random forest splitting nodes (mtry << n predictors) #' @param mtry number of predictor used at random forest splitting nodes (mtry << n predictors)
#' @param mod.error threshold for model error until which iteration is being executed #' @param mod.error threshold for model error until which iteration is being executed
#' @param pbtn1 matrix for points #' @param pbtn1 matrix for points
#' @param rast raster
#' @param max_samples_per_class maximum number of samples per class #' @param max_samples_per_class maximum number of samples per class
#' #'
#' @return a list with 4 elements: #' @return a list with 4 elements:
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
#' @keywords internal #' @keywords internal
model_opt_r <- function(k, model_opt_r <- function(k,
raster, raster,
col_names,
sample_type, sample_type,
buffer, buffer,
model, model,
...@@ -37,7 +38,6 @@ model_opt_r <- function(k, ...@@ -37,7 +38,6 @@ model_opt_r <- function(k,
mtry, mtry,
mod.error, mod.error,
pbtn1, pbtn1,
rast,
max_samples_per_class) { max_samples_per_class) {
points <- NULL points <- NULL
models <- NULL models <- NULL
...@@ -49,24 +49,21 @@ model_opt_r <- function(k, ...@@ -49,24 +49,21 @@ model_opt_r <- function(k,
if (sample_type == "random") { if (sample_type == "random") {
set.seed(seed2[k]) set.seed(seed2[k])
pbt <- pbt <-
raster::sampleRandom(raster, size = sample_size, sp = T) raster::sampleRandom(rast, size = sample_size, sp = T)
} }
if (sample_type == "regular") { if (sample_type == "regular") {
pbt <- raster::sampleRegular(raster, size = sample_size, sp = T) pbt <- raster::sampleRegular(rast, size = sample_size, sp = T)
} }
f <- which(is.na(pbt@data[1])) f <- which(is.na(pbt@data[1]))
if (length(f) != 0) { if (length(f) != 0) {
pbt <- pbt[-f,] pbt <- pbt[-f,]
} }
set.seed(seed2[k]) set.seed(seed2[k])
classes <- classes <-
as.factor(sample(c(1:2), size = nrow(pbt), replace = T)) as.factor(sample(c(1:2), size = nrow(pbt), replace = T))
if (length(levels(classes)) < 2) { if (length(levels(classes)) < 2) {
break break
} }
data <- as.data.frame(cbind(classes, pbt@data)) data <- as.data.frame(cbind(classes, pbt@data))
} }
######################################################################## ########################################################################
...@@ -154,15 +151,14 @@ model_opt_r <- function(k, ...@@ -154,15 +151,14 @@ model_opt_r <- function(k,
nam <- nam <-
as.vector(fasterize::fasterize(sf::st_as_sf(poly), rast[[1]], field = "V1"))[-attr(test1, "na.action")] as.vector(fasterize::fasterize(sf::st_as_sf(poly), rast[[1]], field = "V1"))[-attr(test1, "na.action")]
co <- co <- raster::xyFromCell(rast, c(1:raster::ncell(rast))[-attr(test1,"na.action")])
raster::xyFromCell(rast, c(1:raster::ncell(rast))[-attr(test1, "na.action")])
pbtn1 <- as.data.frame(cbind(nam, co)) pbtn1 <- as.data.frame(cbind(nam, co))
sp::coordinates(pbtn1) <- c("x", "y") sp::coordinates(pbtn1) <- c("x", "y")
if (ncol(test1) == 1) { if (ncol(test1) == 1) {
test1 <- t(test1) test1 <- t(test1)
} }
colnames(test1) <- names(raster) colnames(test1) <- col_names
} }
if (class(test1)[1] == "numeric") { if (class(test1)[1] == "numeric") {
test1 <- t(matrix(test1)) test1 <- t(matrix(test1))
...@@ -189,7 +185,6 @@ model_opt_r <- function(k, ...@@ -189,7 +185,6 @@ model_opt_r <- function(k,
##################################### #####################################
###maximum sample size ###maximum sample size
if (sum(pbtn1@data$nam == 1) > max_samples_per_class) { if (sum(pbtn1@data$nam == 1) > max_samples_per_class) {
set.seed(seed) set.seed(seed)
dr <- dr <-
sample(which(pbtn1@data$nam == 1), sample(which(pbtn1@data$nam == 1),
......
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
model_opt_r( model_opt_r(
k, k,
raster, raster,
col_names,
sample_type, sample_type,
buffer, buffer,
model, model,
...@@ -18,7 +19,6 @@ model_opt_r( ...@@ -18,7 +19,6 @@ model_opt_r(
mtry, mtry,
mod.error, mod.error,
pbtn1, pbtn1,
rast,
max_samples_per_class max_samples_per_class
) )
} }
...@@ -27,6 +27,8 @@ model_opt_r( ...@@ -27,6 +27,8 @@ model_opt_r(
\item{raster}{satellite time series stack (rasterBrickObject) or just any type of image (*rasterObject)} \item{raster}{satellite time series stack (rasterBrickObject) or just any type of image (*rasterObject)}
\item{col_names}{layer names}
\item{sample_type}{distribution of spatial locations c("random","regular")} \item{sample_type}{distribution of spatial locations c("random","regular")}
\item{buffer}{distance (in m) for new sample collection around initial samples (depends on pixel size)} \item{buffer}{distance (in m) for new sample collection around initial samples (depends on pixel size)}
...@@ -49,8 +51,6 @@ model_opt_r( ...@@ -49,8 +51,6 @@ model_opt_r(
\item{pbtn1}{matrix for points} \item{pbtn1}{matrix for points}
\item{rast}{raster}
\item{max_samples_per_class}{maximum number of samples per class} \item{max_samples_per_class}{maximum number of samples per class}
} }
\value{ \value{
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment