Commit f7385ec9 authored by Carsten Neumann's avatar Carsten Neumann
Browse files

merge origin conflicts not solved

parents e50cf8c9 d2a87c9a
File added
.Rproj.user
.Rhistory
.RData
.Ruserdata
stages:
- test
- deploy
- cleanup
test_hasa_install:
stage: test
script:
- Rscript docker/context/install_runner.R
only:
- master
pages: # this job must be called 'pages' to advise GitLab to upload content to GitLab Pages
stage: deploy
dependencies:
- test_hasa_install
script:
# Create the public directory
- rm -rf public
- mkdir public
- mkdir -p public/doc
- mkdir -p public/images/
# Copy over the docs
- cp -r docs/*.html public/index.html
- cp -r docs/images/* public/images/
# Check if everything is working great
- ls -al public
- ls -al public/doc
artifacts:
paths:
- public
expire_in: 30 days
only:
- master
- documentation
Version: 1.0
RestoreWorkspace: Default
SaveWorkspace: Default
AlwaysSaveHistory: Default
EnableCodeIndexing: Yes
UseSpacesForTab: Yes
NumSpacesForTab: 2
Encoding: UTF-8
RnwWeave: Sweave
LaTeX: pdfLaTeX
......@@ -32,6 +32,6 @@ LazyData: true
Roxygen: list(markdown = TRUE)
RoxygenNote: 7.1.1
Suggests:
knitr,
rmarkdown
rmarkdown,
knitr
VignetteBuilder: knitr
......@@ -2,7 +2,15 @@
export(clip)
export(iplot)
export(load_reference_as_shape)
export(load_reference_as_table)
export(load_timeseries_stack)
export(multi_Class_Sampling)
export(plot_configuration)
export(plot_results)
export(sample_nb)
export(save_class_tiff)
export(save_kml)
export(save_run)
export(write_Out_Samples)
exportClasses(Habitat)
......@@ -2,8 +2,8 @@
#'
#' Clips a raster object
#'
#' @param raster
#' @param shape
#' @param raster raster object
#' @param shape shape object
#'
#' @return a raster object
#' @export
......
......@@ -17,11 +17,14 @@
#' @param save_runs if the user wants to save the runs, if TRUE the complete Habitat Class object is returned
#' @param parallel_mode run loops in parallel
#' @param max_num_cores maximum number of cores for parallelism
#' @param progress_bar if true use a normal progress bar, otherwise a shiny's progress bar
#'
#' @return a list with 3 elements:
#' 1) An index
#' 2) Accuracy vector
#' 3) A vector with a Habitat objects, each consisting of 7 slots: \cr
#' @return a list with 5 elements:
#' 1) returns 0 succeeded, 1 increase init.samples, or 2 increase init.samples and nb_models
#' 2) An index
#' 3) num_models number of models selected
#' 4) Accuracy vector
#' 5) A vector with a Habitat objects, each consisting of 7 slots: \cr
#' run1@models - list of selected classifiers (only if save_runs is TRUE) \cr
#' run1@ref_samples - list of SpatialPointsDataFrames with same length as run1@models holding reference labels [1,2] for each selected model (only if save_runs is TRUE) \cr
#' run1@switch - vector of length run1@models indicating if target class equals 2, if not NA the labels need to be switched (only if save_runs is TRUE) \cr
......@@ -31,6 +34,7 @@
#' run1@seeds - vector of seeds for random sampling (only if save_runs is TRUE) \cr
#' all files are saved with step number, the *.tif file is additionally saved with class names
#' @keywords internal
#' @export
###################################################################################
......@@ -50,7 +54,10 @@ sample_nb <- function(raster,
in.memory,
save_runs,
parallel_mode,
max_num_cores) {
max_num_cores,
progress_bar = TRUE) {
print(paste(paste("init.samples = ", nb_samples[1]),
paste("models = ", nb_mean)))
###
n_channel <- length(names(raster))
###raster in MEMORY or NOT
......@@ -69,7 +76,7 @@ sample_nb <- function(raster,
n <- nb_it
sample_size <- r
max_samples_per_class <- sample_size * 5
if (init.seed == "sample") {
if (class(init.seed) == "character" && init.seed == "sample") {
seed2 <- sample(c(1:1000000), size = nb_mean, replace = F)
} else {
seed2 <- init.seed
......@@ -80,9 +87,11 @@ sample_nb <- function(raster,
dif <- matrix(NA, nrow = nb_mean, ncol = nrow(reference))
channel <- matrix(NA, nrow = nb_mean, ncol = nrow(reference))
switch <- matrix(NA, nrow = nb_mean, ncol = nrow(reference))
pb <- utils::txtProgressBar(min = 1,
max = nb_mean,
style = 3)
if (progress_bar == TRUE) {
pb <- utils::txtProgressBar(min = 1,
max = nb_mean,
style = 3)
}
if (parallel_mode == TRUE) {
cores = parallel::detectCores( logical = TRUE)
......@@ -142,7 +151,14 @@ sample_nb <- function(raster,
points_list[[k]] <- res$points
models_list[[k]] <- res$models
oobe[, k] <- res$oobe[, 1]
setTxtProgressBar(pb, k)
if (progress_bar) {
setTxtProgressBar(pb, k)
} else {
shinybusy::update_modal_progress(
value = k / (nb_mean + nrow(reference)),
text = paste("Doing sampling for model", k)
)
}
}
}
......@@ -152,8 +168,14 @@ sample_nb <- function(raster,
length(which_models_null[which_models_null == FALSE]) == length(models_list)) {
remove(points_list)
remove(models_list)
remove(ooe)
stop("No Models - would you be so kind to increase init.samples, please")
out <- list(
returns = 1,
index = NULL,
num_models = 0,
acc = NULL,
obj = NULL
)
return(out)
}
if (length(which_models_null[which_models_null == FALSE]) > 0) {
models <- models_list[which_models_null]
......@@ -204,21 +226,35 @@ sample_nb <- function(raster,
}
}
m[l] <- max(dif[2,], na.rm = T)
if (!progress_bar) {
shinybusy::update_modal_progress(
value = (nb_mean+jj) / (nb_mean + nrow(reference)),
text = paste("Doing prediction for class", jj)
)
}
}
index <- which.max(dif[2,])
ch <- as.numeric(na.omit(channel[, index]))
if (length(ch) == 0) {
stop(
"No optimal classifier - would you be so kind to adjust init.samples & nb_models, please"
out <- list(
returns = 2,
index = NULL,
num_models = 0,
acc = NULL,
obj = NULL
)
return(out)
}
acc <- (round(m[l] ^ 2, 2) / 0.25)
cat("\n")
print(paste("class=", index, " difference=", (round(m[l] ^ 2, 2) / 0.25),
sep = ""))
l <- l + 1
}
close(pb)
if (progress_bar == TRUE) {
close(pb)
}
if (save_runs == TRUE) {
mod_all <- models
......@@ -226,7 +262,9 @@ sample_nb <- function(raster,
mod_all = list()
}
models <- models[ch]
print(paste("n_models =", length(models)))
num_models <- length(models)
print(paste("n_models =", num_models))
flush(stdout())
switch <- switch[ch, index]
points <- points_list[ch]
remove(points_list)
......@@ -254,7 +292,7 @@ sample_nb <- function(raster,
raster::reclassify(result1[[j]], rbind(c(0.5, 1.5, 2), c(1.6, 2.5, 1)))
}
}
print(j)
#print(j)
j <- j + 1
}
###
......@@ -294,6 +332,12 @@ sample_nb <- function(raster,
remove(seed2)
gc(full = TRUE)
out <- list(index = index, acc = acc, obj = obj)
out <- list(
returns = 0,
index = index,
num_models = num_models,
acc = acc,
obj = obj
)
return(out)
}
......@@ -164,7 +164,73 @@ model_opt_r <- function(k,
if (class(test1)[1] == "numeric") {
test1 <- t(matrix(test1))
}
<<<<<<< HEAD
if (length(levels(as.factor(nam))) < 2) {
=======
if (nrow(test1) == 0) {
break
}
##############################
##############################
which_classes_correct_2 <- which(classes[correct] == 2)
if (length(which_classes_correct_2) == 0) {
if (j == 1) {
break
}
} else {
d2 <- correct[which_classes_correct_2]
###generate new samples from only correctly classified samples [label 2]
p2 <- pbt@coords[d2, ]
pbtn2 <-
as.data.frame(cbind(classes[d2], matrix(p2, ncol = 2)))
sp::coordinates(pbtn2) <- c("V2", "V3")
#sp::proj4string(pbtn2) <- sp::proj4string(pbt)
raster::crs(pbtn2) <- raster::crs(pbt)
poly <- rgeos::gBuffer(spgeom = pbtn2,
width = buffer,
byid = TRUE)
test <- ras_vx$extract(sp = poly)
for (i in 1:length(test)) {
s1 <- dim(test[[i]])[1]
#if (s1 <= 5) {
# test[[i]] <-
# test[[i]]
#} else {
if (s1 > 5) {
set.seed(seed)
test[[i]] <-
test[[i]][sample(c(1:s1), 5, replace = F), ]
}
}
for (i in 1:length(test)) {
if (i == 1) {
co <- raster::xyFromCell(raster, test[[i]][, 1])
} else {
co <- rbind(co, raster::xyFromCell(raster, test[[i]][, 1]))
}
}
pbtn2 <- as.data.frame(cbind(rep(2, nrow(co)), co))
sp::coordinates(pbtn2) <- c("x", "y")
test2 <- as.matrix(do.call(rbind, test)[, -1])
if (ncol(test2) == 1) {
test2 <- t(test2)
}
colnames(test2) <- names(raster)
if (length(which(is.na(test2))) > 0) {
pbtn2 <- pbtn2[complete.cases(test2), ]
test2 <- test2[complete.cases(test2), ]
}
}
if (class(test2)[1] == "numeric") {
test2 <- t(matrix(test2))
}
if (nrow(test2) == 0) {
>>>>>>> d2a87c9a0c6aafd4ebc9d41451efcbb89a41ea1f
break
}
######################################
......
......@@ -8,18 +8,19 @@
#' @param nb_models number of models (independent classifiers) to collect
#' @param nb_it number of iterations for model accuracy
#' @param buffer distance (in m) for new sample collection around initial samples (depends on pixel size)
#' @param reference reference spectra either SpatialPointsDataFrame (shape file) or data.frame with lines = classes, column = predictors]
#' @param model which machine learning classifier to use c("rf", "svm") for random forest or suppurt vector machine implementation
#' @param reference reference spectra as a data.frame with (lines = classes, column = predictors)
#' @param model which machine learning classifier to use c("rf", "svm") for random forest or support vector machine implementation
#' @param mtry number of predictor used at random forest splitting nodes (mtry << n predictors)
#' @param last only true for one class classifier c("FALSE", TRUE")
#' @param seed set seed for reproducable results
#' @param seed set seed for reproducible results
#' @param init.seed "sample" for new or use run1@seeds to reproduce previous steps
#' @param outPath output path for saving results
#' @param step at which step should the procedure start, e.g. use step = 2 if the first habitat is already extracted
#' @param classNames character vector with class names in the order of reference spectra
#' @param classNames character vector with class names in the order of reference spectra
#' @param n_classes total number of classes (habitat types) to be separated
#' @param multiTest number of test runs to compare different probability outputs
#' @param RGB rgb channel numbers for image plot
#' @param color color pallet
#' @param overwrite overwrite the KML and raster files from previous runs (default TRUE)
#' @param save_runs an Habitat object is saved into disk for each run (default TRUE)
#' @param parallel_mode run loops using all available cores (default FALSE)
......@@ -85,19 +86,47 @@ multi_Class_Sampling <- function(in.raster,
n_classes,
multiTest = 1,
RGB = c(19, 20, 21),
<<<<<<< HEAD
in.memory = TRUE,
=======
color = c("lightgrey", "orange", "yellow", "limegreen", "forestgreen"),
>>>>>>> d2a87c9a0c6aafd4ebc9d41451efcbb89a41ea1f
overwrite = TRUE,
save_runs = TRUE,
parallel_mode = FALSE,
max_num_cores = 5,
plot_on_browser = TRUE) {
# Checks if its a new or a resumed run and asks the user to remove all .tif
# files from the results folder in case of a new run.
if(step == 1){
if (length(list.files(
outPath,
pattern = ".tif$",
all.files = FALSE,
include.dirs = TRUE,
no.. = TRUE
)) != 0) {
message("Remove all .tif files from the Results directory! Don't forget to save them and the other files.
All other files will be overwriten when a new sampling is started.")
return(NULL)
}
}
###first steps: data preparation
if (class(reference) == "SpatialPointsDataFrame") {
reference <- as.data.frame(raster::extract(in.raster, reference))
}
input_raster <- in.raster
<<<<<<< HEAD
=======
area <- as(raster::extent(in.raster), 'SpatialPolygons')
area <- sp::SpatialPolygonsDataFrame(area, data.frame(ID = 1:length(area)))
#sp::proj4string(area) <- sp::proj4string(in.raster)
raster::crs(area) <- raster::crs(in.raster)
>>>>>>> d2a87c9a0c6aafd4ebc9d41451efcbb89a41ea1f
col <- colorRampPalette(c("lightgrey",
"orange",
"yellow",
......@@ -121,11 +150,8 @@ multi_Class_Sampling <- function(in.raster,
}
}
print(paste(paste("Habitat", 0), "Starting"))
for (i in step:r) {
print(paste(
paste("init.samples = ", init.samples),
paste("models = ", nb_models)
))
if (i == r) {
last = T
}
......@@ -137,10 +163,10 @@ multi_Class_Sampling <- function(in.raster,
new.acc <- list()
decision = "0"
##########################################################################
while (decision == "0") {
for (rs in 1:multiTest) {
########################
<<<<<<< HEAD
maFo_rf <- sample_nb(
raster = in.raster,
nb_samples = seq(init.samples, init.samples, init.samples),
......@@ -164,27 +190,127 @@ multi_Class_Sampling <- function(in.raster,
index <- maFo_rf$index
acc <- maFo_rf$acc
maFo_rf <- maFo_rf$obj
=======
returns <- 1
while (returns != 0) {
decision3 <- ""
maFo_rf <- sample_nb(
raster = in.raster,
nb_samples = seq(init.samples, init.samples, init.samples),
sample_type = sample_type,
nb_mean = nb_models,
nb_it = nb_it,
buffer = buffer,
reference = reference,
model = model,
area = area,
mtry = mtry,
last = last,
seed = seed,
init.seed = init.seed,
save_runs = save_runs,
parallel_mode = parallel_mode,
max_num_cores = max_num_cores
)
returns <- maFo_rf$returns
index <- maFo_rf$index
num_models <- maFo_rf$num_models
acc <- maFo_rf$acc
maFo_rf <- maFo_rf$obj
if (returns == 1) {
decision3 <-
readline(
paste(
"No Models - Adjust init.samples (actual: ",
init.samples,
"), abort (0) or auto (1) [.. or 0 or 1]: ",
sep = ""
)
)
if (decision3 == "0") {
print("User decided to abort the classification.")
return(NULL)
} else if (decision3 == "1") {
init.samples <- init.samples + 50
} else {
init.samples <- as.numeric(decision3)
}
} else if (returns == 2) {
decision3 <-
readline(
paste(
"No optimal classifier - Adjust init.samples/nb.models (actual ",
init.samples,
"/",
nb_models,
"), abort (0) or auto (1) [../.. or 0 or 1]: ",
sep = ""
)
)
if (decision3 == "0") {
print("User decided to abort the classification.")
return(NULL)
} else if (decision3 == "1") {
init.samples <- init.samples + 50
nb_models <- nb_models + 15
} else {
init.samples <- as.numeric(strsplit(decision3, split = "/")[[1]][1])
nb_models <-
as.numeric(strsplit(decision3, split = "/")[[1]][2])
}
}
}
>>>>>>> d2a87c9a0c6aafd4ebc9d41451efcbb89a41ea1f
########################
maFo[[rs]] <- maFo_rf
test[[rs]] <- maFo_rf@layer[[1]]
new.names[[rs]] <- index
new.acc[[rs]] <- acc
if (rs == multiTest) {
if (plot_on_browser == TRUE) {
if (.Platform$OS.type == "unix") {
grDevices::x11()
} else {
grDevices::windows()
}
attach(mtcars)
if (multiTest < 4) {
par(mfrow = c(multiTest, 1))
} else {
par(mfrow = c(round(multiTest/4), multiTest %% 4))
}
}
par(mar = c(2, 2, 2, 3), mfrow = n2mfrow(multiTest))
for (rr in 1:length(test)) {
if (plot_on_browser == FALSE) {
png(file = paste(outPath, 'multi_', rr, '.png', sep = ""), width = 600, height = 500, res = 72)
}
plot(
test[[rr]],
col = col(200),
main = "",
legend.shrink = 1)
mtext(side = 3,
paste(rr, classNames[new.names[[rr]]], sep = " "),
paste('Test ', rr, '- class ', classNames[new.names[[rr]]], sep = " "),
font = 2)
if (plot_on_browser == FALSE) {
dev.off()
IRdisplay::display_png(file = paste(outPath, 'multi_', rr, '.png', sep = ""))
}
}
}
}
decision <-
readline("Which distribution is acceptable/ or sample again [../0]: ")
readline("Which distribution is acceptable or sample again (0) [.. or 0]: ")
if (plot_on_browser == FALSE) {
for (rr in 1:length(test)) {
fn <- paste(outPath, 'multi_', rr, '.png', sep = "")
if (file.exists(fn)) {
#Delete file if it exists
file.remove(fn)
}
}
}
}
maFo_rf <- maFo[[as.numeric(decision)]]
index <- new.names[[as.numeric(decision)]]
......@@ -195,6 +321,7 @@ multi_Class_Sampling <- function(in.raster,
##########################################################################
} else{
########################
<<<<<<< HEAD
maFo_rf <- sample_nb(
raster = in.raster,
nb_samples = seq(init.samples, init.samples, init.samples),
......@@ -219,6 +346,77 @@ multi_Class_Sampling <- function(in.raster,
acc <- maFo_rf$acc
maFo_rf <- maFo_rf$obj
########################
=======
returns <- 1
while (returns != 0) {
decision3 <- ""
maFo_rf <- sample_nb(
raster = in.raster,
nb_samples = seq(init.samples, init.samples, init.samples),
sample_type = sample_type,
nb_mean = nb_models,
nb_it = nb_it,
buffer = buffer,
reference = reference,
model = model,
area = area,
mtry = mtry,
last = last,
seed = seed,
init.seed = init.seed,
save_runs = save_runs,
parallel_mode = parallel_mode,
max_num_cores = max_num_cores