Documentation branch

.gitignore

+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata

.gitlab-ci.yml

+stages:
+  - test
+  - deploy
+  - cleanup
+
+test_hasa_install:
+  stage: test
+  script:
+    - Rscript docker/context/install.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
+

HabitatSampler.Rproj

+Version: 1.0
+
+RestoreWorkspace: Default
+SaveWorkspace: Default
+AlwaysSaveHistory: Default
+
+EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
+Encoding: UTF-8
+
+RnwWeave: Sweave
+LaTeX: pdfLaTeX

R-package/DESCRIPTION

@@ -11,9 +11,9 @@ Description: Calculates samples and related classifiers for mapping gradual prob
 License: GPL-3
 Imports:
     BH (<= 1.69.0-1),
-    sf (<= 0.8-1),
-    sp (<= 1.4-1),
-    rgdal (<= 1.4-8),
+    sf (<= 0.9-0),
+    sp (<= 1.4-4),
+    rgdal (<= 1.5-12),
     raster,
     geojsonio,
     maptools,
@@ -33,6 +33,6 @@ LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
 Suggests: 
-    knitr,
-    rmarkdown
+    rmarkdown,
+    knitr
 VignetteBuilder: knitr

R-package/NAMESPACE

@@ -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)

R-package/R/clip.r

@@ -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

R-package/R/inner_procedure.r

@@ -18,11 +18,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
@@ -32,6 +35,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,
                       init.seed,
                       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))
   ###velox
@@ -83,9 +90,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)
@@ -145,7 +154,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)
+            )
+        }
       }
     }
 
@@ -155,8 +171,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]
@@ -207,21 +229,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
@@ -229,7 +265,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)
@@ -257,7 +295,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
   }
   ###
@@ -297,6 +335,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)
 }

R-package/R/model_opt.r

@@ -145,7 +145,7 @@ model_opt_r <- function(k,
         as.data.frame(cbind(classes[d1], matrix(p1, ncol = 2)))
       sp::coordinates(pbtn1) <- c("V2", "V3")
       #sp::proj4string(pbtn1) <- sp::proj4string(pbt)
-      crs(pbtn1) <- crs(pbt)
+      raster::crs(pbtn1) <- raster::crs(pbt)
       
       poly <- rgeos::gBuffer(spgeom = pbtn1,
                              width = buffer,
@@ -207,7 +207,7 @@ model_opt_r <- function(k,
         as.data.frame(cbind(classes[d2], matrix(p2, ncol = 2)))
       sp::coordinates(pbtn2) <- c("V2", "V3")
       #sp::proj4string(pbtn2) <- sp::proj4string(pbt)
-      crs(pbtn2) <- crs(pbt)
+      raster::crs(pbtn2) <- raster::crs(pbt)
       
       poly <- rgeos::gBuffer(spgeom = pbtn2,
                              width = buffer,

R-package/R/outer_procedure.r

@@ -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)
@@ -84,11 +85,28 @@ multi_Class_Sampling <- function(in.raster,
                                  n_classes,
                                  multiTest = 1,
                                  RGB = c(19, 20, 21),
+                                 color = c("lightgrey", "orange", "yellow", "limegreen", "forestgreen"),
                                  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))
@@ -98,7 +116,7 @@ multi_Class_Sampling <- function(in.raster,
   area <- as(raster::extent(in.raster), 'SpatialPolygons')
   area <- sp::SpatialPolygonsDataFrame(area, data.frame(ID = 1:length(area)))
   #sp::proj4string(area) <- sp::proj4string(in.raster)
-  crs(area) <- crs(in.raster)
+  raster::crs(area) <- raster::crs(in.raster)
 
   col <- colorRampPalette(c("lightgrey",
                             "orange",
@@ -123,11 +141,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
     }
@@ -143,28 +158,75 @@ multi_Class_Sampling <- function(in.raster,
       while (decision == "0") {
         for (rs in 1:multiTest) {
           ########################
-          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
-          )
-
-          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])
+              }
+            }
+          }
           ########################
           maFo[[rs]] <- maFo_rf
           test[[rs]] <- maFo_rf@layer[[1]]
@@ -185,7 +247,7 @@ multi_Class_Sampling <- function(in.raster,
           }
         }
         decision <-
-          readline("Which distribution is acceptable/ or sample again [../0]:  ")
+          readline("Which distribution is acceptable or sample again (0) [.. or 0]:  ")
       }
       maFo_rf <- maFo[[as.numeric(decision)]]
       index <- new.names[[as.numeric(decision)]]
@@ -196,29 +258,75 @@ multi_Class_Sampling <- function(in.raster,
       ##########################################################################
     } else{
       ########################
-      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
-      )
-
-      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])
+          }
+        }
+      }
     }
 
     dummy <- maFo_rf@layer[[1]]
@@ -229,54 +337,104 @@ multi_Class_Sampling <- function(in.raster,
       r = RGB[1],
       g = RGB[2],
       b = RGB[3],
+      num_models = num_models,
       acc = acc,
+      color = color,
       outPath = outPath,
       plot_on_browser = plot_on_browser
     )
 
     decision <-
-      readline("Threshold for Habitat Extraction or Sample Again [../0]:  ")
+      readline("Threshold for Habitat Extraction or Sample Again (0) [.. or 0]:  ")
 
     sample2 <- init.samples
     models2 <- nb_models
     while (decision == "0") {
       remove(maFo_rf)
-      decision2 <-
-        readline("Adjust init.samples/nb.models or auto [../.. or 0]:  ")
-      if (decision2 != "0") {
-        sample2 <- as.numeric(strsplit(decision2, split = "/")[[1]][1])
-        models2 <- as.numeric(strsplit(decision2, split = "/")[[1]][2])
-      } else {
-        sample2 <- sample2 + 50
-        models2 <- models2 + 15
+      decision2 <- readline(paste("Adjust init.samples/nb.models (actual ",
+                                  sample2,
+                                  "/",
+                                  models2,
+                                  "), auto (0), or same (1) [../.. or 0 or 1]:  ",
+                                  sep = ""))
+      if (decision2 != "1") {
+        if (decision2 == "0") {
+          sample2 <- sample2 + 50