Commit 4c92bb0e authored by Romulo Pereira Goncalves's avatar Romulo Pereira Goncalves
Browse files

Merge branch 'issue#42' into 'master'

To be able to handle NAs we need to add the parameter: na.action = na.omit,...

See merge request !28
parents ec8c492e cea37de3
Pipeline #28134 passed with stages
in 7 minutes and 46 seconds
Package: HaSa
Title: Autonomous Image Sampling and Probability Mapping
Version: 1.3.0
Version: 1.3.1
Authors@R:
person(given = "Carsten",
family = "Neumann",
......
......@@ -65,7 +65,13 @@ sample_nb <- function(raster,
###
n_channel <- length(names(raster))
###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
pbtn1 <- matrix(1, nrow = 1, ncol = 1)
......@@ -107,7 +113,8 @@ sample_nb <- function(raster,
res <- parallel::mclapply(
1:nb_mean,
model_opt_r,
raster = raster,
raster = rast,
col_names = names(raster),
sample_type = sample_type,
buffer = buffer,
model = model,
......@@ -119,7 +126,6 @@ sample_nb <- function(raster,
mtry = mtry,
mod.error = mod.error,
pbtn1 = pbtn1,
rast = rast,
max_samples_per_class = max_samples_per_class,
mc.cores = cores,
mc.preschedule = TRUE,
......@@ -133,7 +139,8 @@ sample_nb <- function(raster,
} else {
for (k in 1:nb_mean) {
res <- model_opt_r(
raster = raster,
raster = rast,
col_names = names(raster),
sample_type = sample_type,
buffer = buffer,
model = model,
......@@ -146,7 +153,6 @@ sample_nb <- function(raster,
mtry = mtry,
mod.error = mod.error,
pbtn1 = pbtn1,
rast = rast,
max_samples_per_class = max_samples_per_class
)
points_list[[k]] <- res$points
......
......@@ -4,6 +4,7 @@
#'
#' @param k Iteration value for the models.
#' @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 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
......@@ -15,7 +16,6 @@
#' @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 pbtn1 matrix for points
#' @param rast raster
#' @param max_samples_per_class maximum number of samples per class
#'
#' @return a list with 4 elements:
......@@ -26,6 +26,7 @@
#' @keywords internal
model_opt_r <- function(k,
raster,
col_names,
sample_type,
buffer,
model,
......@@ -37,7 +38,6 @@ model_opt_r <- function(k,
mtry,
mod.error,
pbtn1,
rast,
max_samples_per_class) {
points <- NULL
models <- NULL
......@@ -49,24 +49,21 @@ model_opt_r <- function(k,
if (sample_type == "random") {
set.seed(seed2[k])
pbt <-
raster::sampleRandom(raster, size = sample_size, sp = T)
raster::sampleRandom(rast, size = sample_size, sp = T)
}
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]))
if (length(f) != 0) {
pbt <- pbt[-f,]
}
set.seed(seed2[k])
classes <-
as.factor(sample(c(1:2), size = nrow(pbt), replace = T))
if (length(levels(classes)) < 2) {
break
}
data <- as.data.frame(cbind(classes, pbt@data))
}
########################################################################
......@@ -148,17 +145,20 @@ model_opt_r <- function(k,
width = buffer,
byid = TRUE)
test1<-na.omit(raster::as.matrix(fasterize::fasterize(sf::st_as_sf(poly), rast[[1]])*rast))
nam<-as.vector(fasterize::fasterize(sf::st_as_sf(poly), rast[[1]], field="V1"))[-attr(test1,"na.action")]
co<-raster::xyFromCell(rast, c(1:raster::ncell(rast))[-attr(test1,"na.action")])
test1 <-
na.omit(raster::as.matrix(fasterize::fasterize(sf::st_as_sf(poly), rast[[1]]) *
rast))
nam <-
as.vector(fasterize::fasterize(sf::st_as_sf(poly), rast[[1]], field = "V1"))[-attr(test1, "na.action")]
co <- raster::xyFromCell(rast, c(1:raster::ncell(rast))[-attr(test1,"na.action")])
pbtn1 <- as.data.frame(cbind(nam, co))
sp::coordinates(pbtn1) <- c("x", "y")
if (ncol(test1) == 1) {
test1 <- t(test1)
}
colnames(test1) <- names(raster)
colnames(test1) <- col_names
}
if (class(test1)[1] == "numeric") {
test1 <- t(matrix(test1))
......@@ -168,33 +168,37 @@ model_opt_r <- function(k,
}
######################################
###balancing sample size
di <- c(sum(pbtn1@data$nam==1), sum(pbtn1@data$nam==2))
di <- c(sum(pbtn1@data$nam == 1), sum(pbtn1@data$nam == 2))
if (abs(di[1] - di[2]) > min(di) * 0.3) {
if (which.min(di) == 2) {
set.seed(seed)
d3 <- sample(which(pbtn1@data$nam==1), di[1]-di[2], replace = F)
d3 <- sample(which(pbtn1@data$nam == 1), di[1] - di[2], replace = F)
pbtn1 <- pbtn1[-d3, ]
test1 <- test1[-d3, ]
} else {
set.seed(seed)
d4 <- sample(which(pbtn1@data$nam==2), di[2]-di[1], replace = F)
d4 <- sample(which(pbtn1@data$nam == 2), di[2] - di[1], replace = F)
pbtn1 <- pbtn1[-d4, ]
test1 <- test1[-d4, ]
}
}
#####################################
###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)
dr <-
sample(which(pbtn1@data$nam==1), sum(pbtn1@data$nam==1) - max_samples_per_class, replace = F)
sample(which(pbtn1@data$nam == 1),
sum(pbtn1@data$nam == 1) - max_samples_per_class,
replace = F)
pbtn1 <- pbtn1[-dr, ]
test1 <- test1[-dr, ]
}
if (sum(pbtn1@data$nam==2) > max_samples_per_class) {
if (sum(pbtn1@data$nam == 2) > max_samples_per_class) {
set.seed(seed)
dr <-
sample(which(pbtn1@data$nam==2), sum(pbtn1@data$nam==2) - max_samples_per_class, replace = F)
sample(which(pbtn1@data$nam == 2),
sum(pbtn1@data$nam == 2) - max_samples_per_class,
replace = F)
pbtn1 <- pbtn1[-dr, ]
test1 <- test1[-dr, ]
}
......
......@@ -7,6 +7,7 @@
model_opt_r(
k,
raster,
col_names,
sample_type,
buffer,
model,
......@@ -18,7 +19,6 @@ model_opt_r(
mtry,
mod.error,
pbtn1,
rast,
max_samples_per_class
)
}
......@@ -27,6 +27,8 @@ model_opt_r(
\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{buffer}{distance (in m) for new sample collection around initial samples (depends on pixel size)}
......@@ -49,8 +51,6 @@ model_opt_r(
\item{pbtn1}{matrix for points}
\item{rast}{raster}
\item{max_samples_per_class}{maximum number of samples per class}
}
\value{
......
Markdown is supported
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