Merge branch 'dev' into dev_3

Claudius-Appel · Aug 28, 2024 · deb514b · deb514b
2 parents 9e57db5 + 90395ef
commit deb514b
Show file tree

Hide file tree

Showing 52 changed files with 129 additions and 52 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: duflor.gui
 Title: Frontend for duflor-package
-Version: 1.0.4
+Version: 1.0.5
 Author: Claudius Appel
 Authors@R: c(
     person("Claudius", "Appel", email =   "[email protected]" , role = c("aut", "cre"))

diff --git a/NAMESPACE b/NAMESPACE
@@ -6,7 +6,6 @@ importFrom(DT,renderDataTable)
 importFrom(doParallel,registerDoParallel)
 importFrom(doParallel,stopImplicitCluster)
 importFrom(dplyr,bind_rows)
-importFrom(duflor,HSVtoRGB)
 importFrom(duflor,apply_HSV_color_by_mask)
 importFrom(duflor,extract_pixels_HSV)
 importFrom(duflor,load_image)
@@ -23,10 +22,13 @@ importFrom(ggplot2,guides)
 importFrom(ggplot2,labs)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_minimal)
+importFrom(imager,HSVtoRGB)
+importFrom(imager,RGBtosRGB)
 importFrom(imager,display)
 importFrom(imager,draw_rect)
 importFrom(imager,grabRect)
 importFrom(imager,height)
+importFrom(imager,save.image)
 importFrom(imager,width)
 importFrom(magrittr,"%>%")
 importFrom(openxlsx,write.xlsx)
@@ -103,6 +105,7 @@ importFrom(stringr,str_split)
 importFrom(stringr,str_to_lower)
 importFrom(stringr,str_to_upper)
 importFrom(stringr,str_trim)
+importFrom(tools,file_path_sans_ext)
 importFrom(utils,hasName)
 importFrom(utils,packageDescription)
 importFrom(utils,write.csv2)
diff --git a/R/app.R b/R/app.R
@@ -70,10 +70,10 @@
 #' @importFrom imager draw_rect
 #' @importFrom imager grabRect
 #' @importFrom imager display
+#' @importFrom imager HSVtoRGB
 #' @importFrom duflor load_image
 #' @importFrom duflor extract_pixels_HSV
 #' @importFrom duflor apply_HSV_color_by_mask
-#' @importFrom duflor HSVtoRGB
 #' @importFrom utils packageDescription
 #' @return .
 #' @export
@@ -1190,11 +1190,11 @@ duflor_gui <- function() {
                     )
                     return()
                 } else {
-                    results_path <- str_c(
+                    results_path <- normalizePath(str_c(
                         dirname(DATA$results$results$full_path[[1]]),
                         "/results/results_",
                         input$date_of_image_shooting
-                    )
+                    ))
                     out <- store_results_to_file(
                         results = DATA$results,
                         results_path = results_path,

diff --git a/R/execute_multiple.R b/R/execute_multiple.R
@@ -13,6 +13,11 @@
 #' @importFrom dplyr bind_rows
 #' @importFrom imager width
 #' @importFrom imager height
+#' @importFrom imager save.image
+#' @importFrom imager RGBtosRGB
+#' @importFrom stringr str_c
+#' @importFrom imager HSVtoRGB
+#' @importFrom tools file_path_sans_ext
 #'
 execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
     #### INPUT VALIDATION ####
@@ -42,12 +47,24 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
         identifiersearch_y0 = input$identifiersearch_y0
         identifiersearch_y1 = input$identifiersearch_y1
         identifier_area <- input$identifier_area
+        do_save_masks <- input$do_save_masks
+        if (do_save_masks) {
+            results_path <- normalizePath(str_c(
+                dirname(files$images_filtered[1]),
+                "/results"
+            ))
+            if (isFALSE(dir.exists(results_path))) {
+                dir.create(results_path)
+            }
+        }
+        do_save_high_contrast_masks <- input$do_save_high_contrast_masks
         foreach_result <- foreach(index = 1:length(files$index),.packages = c("duflor","duflor.gui"), .verbose = T,.inorder = F) %dopar% {
         # stop(simpleError("parallelisation is not implemented yet. figure out how to do so!!"))
             current_results <- data.frame(matrix(NA, nrow = 1, ncol = length(names(results_object))))
             colnames(current_results) <- names(results_object)
             ## NAME
             file <- files$images_filtered[index]
+            bnf <- file_path_sans_ext(basename(file))
             current_results$full_path <- file
             current_results$image_name <- basename(file)
             ## DATE_OF_ANALYSIS
@@ -133,6 +150,17 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                 current_results[[str_c(name,"_area")]] <- areas[[name]]
                 current_results[[str_c(name,"_count")]] <- hsv_results[[name]]$pixel.count
                 current_results[[str_c(name,"_fraction")]] <- hsv_results[[name]]$pixel.count/(prod(image_dimensions))
+                if (do_save_masks) {
+                    mask_path <- normalizePath(str_c(results_path, "/", bnf, "_", name, ".png"))
+                    save.image(RGBtosRGB(HSVtoRGB(
+                        apply_HSV_color_by_mask(
+                            pixel.array = im,
+                            pixel.idx = hsv_results[[name]]$pixel.idx,
+                            target.color = "red",
+                            mask_extreme = do_save_high_contrast_masks
+                        )
+                    )),file = mask_path)
+                }
             }
             ## UPDATE RESULTS_OBJECT
             # results_object <- update_resultsObject(results_object,current_results)
@@ -141,12 +169,22 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
         }
         results_object <- bind_rows(foreach_result,.id = NULL)
     } else {
+        if (input$do_save_masks) {
+            results_path <- normalizePath(str_c(
+                dirname(files$images_filtered[1]),
+                "/results"
+            ))
+            if (isFALSE(dir.exists(results_path))) {
+                dir.create(results_path)
+            }
+        }
         for (index in files$index) {
             # create a results-row to be merged into the `results_object`
             current_results <- data.frame(matrix(NA, nrow = 1, ncol = length(names(results_object))))
             colnames(current_results) <- names(results_object)
             ## NAME
             file <- files$images_filtered[index]
+            bnf <- file_path_sans_ext(basename(file))
             current_results$full_path <- file
             current_results$image_name <- basename(file)
             ## DATE_OF_ANALYSIS
@@ -232,6 +270,17 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                 current_results[[str_c(name,"_area")]] <- areas[[name]]
                 current_results[[str_c(name,"_count")]] <- hsv_results[[name]]$pixel.count
                 current_results[[str_c(name,"_fraction")]] <- hsv_results[[name]]$pixel.count/(prod(image_dimensions))
+                if (input$do_save_masks) {
+                    mask_path <- normalizePath(str_c(results_path, "/", bnf, "_", name, ".png"))
+                    save.image(RGBtosRGB(HSVtoRGB(
+                        apply_HSV_color_by_mask(
+                            pixel.array = im,
+                            pixel.idx = hsv_results[[name]]$pixel.idx,
+                            target.color = "red",
+                            mask_extreme = input$do_save_high_contrast_masks
+                        )
+                    )),file = mask_path)
+                }
             }
             ## UPDATE RESULTS_OBJECT
             current_results$area_per_pixel <- areas$area_per_pixel

diff --git a/R/execute_single.R b/R/execute_single.R
@@ -19,11 +19,21 @@ execute_single <- function(file, input, DATA, DEBUGKEYS, FLAGS) {
     colnames(current_results) <- names(results_object)
     #TODO: decide if these paths must be sanitized still?
     current_results$full_path <- file
+    bnf <- file_path_sans_ext(basename(file))
     current_results$image_name <- basename(file)
     ## DATE_OF_ANALYSIS
     current_results$date_of_analysis <- input$date_of_image_shooting
     ## IMAGE DIMENSIONS
     image_dimensions <- as.integer(get_image_dimensions(file))
+    if (input$do_save_masks) {
+        results_path <- normalizePath(str_c(
+            dirname(file),
+            "/results"
+        ))
+        if (isFALSE(dir.exists(results_path))) {
+            dir.create(results_path)
+        }
+    }
     ## LOAD IMAGE
     if (input$do_crop_image) {
         im <- load_image(
@@ -103,6 +113,17 @@ execute_single <- function(file, input, DATA, DEBUGKEYS, FLAGS) {
         current_results[[str_c(name,"_area")]] <- areas[[name]]
         current_results[[str_c(name,"_count")]] <- hsv_results[[name]]$pixel.count
         current_results[[str_c(name,"_fraction")]] <- hsv_results[[name]]$pixel.count/(prod(image_dimensions))
+        if (input$do_save_masks) {
+            mask_path <- normalizePath(str_c(results_path, "/", bnf, "_", name, ".png"))
+            save.image(RGBtosRGB(HSVtoRGB(
+                apply_HSV_color_by_mask(
+                    pixel.array = im,
+                    pixel.idx = hsv_results[[name]]$pixel.idx,
+                    target.color = "red",
+                    mask_extreme = input$do_save_high_contrast_masks
+                )
+            )),file = mask_path)
+        }
     }
     current_results$area_per_pixel <- areas$area_per_pixel
     ## UPDATE RESULTS_OBJECT

diff --git a/R/select_spectra_gui_comp.R b/R/select_spectra_gui_comp.R
@@ -26,6 +26,8 @@ select_spectra_gui_comp <- function(input) {
         # tags$h5('As a result, all images will be processed at full resolution. This is safer, but slower.'),
         footer=tagList(
             checkboxGroupInput("selected_spectra","Select spectra to analyse",choices = all_choices,selected = choices),
+            checkboxInput("do_save_masks","Save the spectrum-masks?"),
+            checkboxInput("do_save_high_contrast_masks","Save the high-contrast-masks instead?"),
             actionButton('submit_selected_spectra', 'Submit choices'),
             modalButton('cancel')
         )

diff --git a/R/store_KPI_plot_to_file.R b/R/store_KPI_plot_to_file.R
@@ -8,7 +8,7 @@
 #' @importFrom stringr str_c
 #'
 store_KPI_plot_to_file <- function(input, DATA) {
-    results_path <- str_c(dirname(DATA$results$results$full_path[[1]]),"/results/")
+    results_path <- normalizePath(str_c(dirname(DATA$results$results$full_path[[1]]),"/results/"))
     dir <- dirname(results_path)
     if (isFALSE(dir.exists(dir))) {
         dir.create(dir)

diff --git a/R/store_results_to_file.R b/R/store_results_to_file.R
@@ -31,6 +31,7 @@ store_results_to_file <- function(results, results_path, save_to_xlsx=FALSE, set
     }
     if (isTRUE(save_to_xlsx)) {
         results_path <- str_c(results_path,".xlsx")
+        results_path <- normalizePath(results_path)
         dir <- dirname(results_path)
         if (isFALSE(dir.exists(dir))) {
             dir.create(dir)
@@ -51,6 +52,7 @@ store_results_to_file <- function(results, results_path, save_to_xlsx=FALSE, set
         ) ## sign the file with being created by this username on this machine.
     } else {
         results_path <- str_c(results_path,".csv")
+        results_path <- normalizePath(results_path)
         dir <- dirname(results_path)
         if (isFALSE(dir.exists(dir))) {
             dir.create(dir)

diff --git a/docs/404.html b/docs/404.html
diff --git a/docs/LICENSE-text.html b/docs/LICENSE-text.html
diff --git a/docs/LICENSE.html b/docs/LICENSE.html
diff --git a/docs/articles/general-user-manual.html b/docs/articles/general-user-manual.html
diff --git a/docs/articles/identifier-cropping.html b/docs/articles/identifier-cropping.html
diff --git a/docs/articles/image-cropping.html b/docs/articles/image-cropping.html
diff --git a/docs/articles/index.html b/docs/articles/index.html
diff --git a/docs/articles/modifying-hsv-bounds.html b/docs/articles/modifying-hsv-bounds.html
diff --git a/docs/articles/optimising-speed.html b/docs/articles/optimising-speed.html
diff --git a/docs/articles/parallelisation.html b/docs/articles/parallelisation.html
diff --git a/docs/articles/raising-issues.html b/docs/articles/raising-issues.html
diff --git a/docs/articles/saving-and-restoring-application-states.html b/docs/articles/saving-and-restoring-application-states.html
diff --git a/docs/authors.html b/docs/authors.html
diff --git a/docs/index.html b/docs/index.html
diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml
@@ -10,7 +10,7 @@ articles:
   parallelisation: parallelisation.html
   raising-issues: raising-issues.html
   saving-and-restoring-application-states: saving-and-restoring-application-states.html
-last_built: 2024-08-28T13:46Z
+last_built: 2024-08-28T21:26Z
 urls:
   reference: https://Claudius-Appel.github.io/duflor.gui/reference
   article: https://Claudius-Appel.github.io/duflor.gui/articles
diff --git a/docs/reference/convert_pixels_to_area_gui.html b/docs/reference/convert_pixels_to_area_gui.html