Merge branch 'feat/fix-issue-#92' into dev

Claudius-Appel · Dec 9, 2024 · c153bad · c153bad
2 parents 7e1c5c1 + d3a272f
commit c153bad
Show file tree

Hide file tree

Showing 53 changed files with 187 additions and 103 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: duflor.gui
 Title: Frontend for duflor-package
-Version: 1.0.11
+Version: 1.0.12
 Author: Claudius Appel
 Authors@R: c(
     person("Claudius", "Appel", email =   "claudius.appel@freenet.de" , role = c("aut", "cre"))
@@ -16,6 +16,7 @@ Imports:
     doParallel,
     duflor,
     foreach,
+    fs,
     shiny,
     shinyjs,
     shinyFiles,

diff --git a/NAMESPACE b/NAMESPACE
@@ -13,6 +13,7 @@ importFrom(foreach,"%dopar%")
 importFrom(foreach,foreach)
 importFrom(foreach,getDoParRegistered)
 importFrom(foreach,getDoParWorkers)
+importFrom(fs,path_rel)
 importFrom(ggplot2,aes)
 importFrom(ggplot2,element_text)
 importFrom(ggplot2,geom_bar)

diff --git a/R/app.R b/R/app.R
@@ -66,6 +66,7 @@
 #' @importFrom parallel detectCores
 #' @importFrom foreach getDoParRegistered
 #' @importFrom foreach getDoParWorkers
+#' @importFrom fs path_rel
 #' @importFrom stats df
 #' @importFrom imager draw_rect
 #' @importFrom imager grabRect
@@ -234,7 +235,9 @@ duflor_gui <- function() {
             last_im = NA,
             folder_path = NA,
             search_root = NA,
-            selected_spectra = NA
+            selected_spectra = NA,
+            do_save_masks = NA,
+            do_save_high_contrast_masks = NA
         )
         DEBUGKEYS <- reactiveValues(
             # if you want to have functionality blocked by the dev-console, add
@@ -406,10 +409,6 @@ duflor_gui <- function() {
                 } else {
                     shinyDirChoose(input = input, 'folder', roots=volumes)
                 }
-                folder_path <- parseDirPath(roots = volumes,input$folder) # this is how you conver thte shinydirselection-objet to a valid path. cf: https://search.r-project.org/CRAN/refmans/shinyFiles/html/shinyFiles-parsers.html
-                req(dir.exists(folder_path))
-                DATA$folder_path <- folder_path
-                image_files_()
             }, error = function(e) {
                 DATA$stacktrace = traceback(1, 1)
                 error_state_path <- save_error_state(
@@ -423,12 +422,19 @@ duflor_gui <- function() {
                     erroneous_callback = "folder"
                 )
                 showNotification(
-                    ui = str_c("Error occured during callback 'input$folder'. The configuration which triggered this error was stored to '",error_state_path,"'."),
+                    ui = str_c("Error occured during callback 'input$folder' (1). The configuration which triggered this error was stored to '",error_state_path,"'."),
                     id = "error_state_generated.done",
                     duration = NULL,
                     type = "error"
                 )
             })
+            folder_path <- parseDirPath(roots = volumes,input$folder) # this is how you conver thte shinydirselection-objet to a valid path. cf: https://search.r-project.org/CRAN/refmans/shinyFiles/html/shinyFiles-parsers.html
+            if (length(folder_path)>0) {
+                if (dir.exists(folder_path)) {
+                    DATA$folder_path <- folder_path
+                    image_files_()
+                }
+            }
         })
         #### REACTIVE - RESULTS_TABLE, FILTERED BY SPECTRUM ####
         filtered_results <- reactive({
@@ -1389,6 +1395,8 @@ duflor_gui <- function() {
                 DATA$spectrums <- state_unpack$spectrums
                 DATA$folder_path <- state_unpack$loaded_path
                 DATA$selected_spectra <- state_unpack$selected_spectra
+                DATA$do_save_masks <- state_unpack$do_save_masks
+                DATA$do_save_high_contrast_masks <- state_unpack$do_save_high_contrast_masks
                 # once the loaded-path was updated, recompute the input-table
                 image_files_()
                 removeNotification(id = "restore_state.ongoing")
@@ -1430,48 +1438,43 @@ duflor_gui <- function() {
         observeEvent(input$save_state, {
             # Save directory selection
             input_mirror <- input ## mirror input so that the error-trycatch can pass it to save_state
-            shinyFileSave(
-                input,
-                "save_state",
-                roots = volumes,
-                session = getDefaultReactiveDomain(),
-                allowDirCreate = T
-            )
-            savedir_path <- parseDirPath(roots = volumes, selection = input$save_state)
-            req(isFALSE(is.numeric(input$save_state[[1]])))
-            req(dir.exists(savedir_path))
-            tryCatch({
-                showNotification(
-                    ui = "State is being saved.",
-                    id = "save_state.ongoing",
-                    duration = NA,
-                    type = "warning"
-                )
-                # but first we must remove some values which are not to be saved to ensure filesize is minimal:
-                # - DATA$last_im (which caches the last-loaded image of the 'render_selected_mask'-subroutine)
-                saved_state_path <- save_state(
-                    input = input,
-                    DATA = DATA,
-                    DEBUGKEYS = DEBUGKEYS,
-                    FLAGS = FLAGS,
-                    volumes = getVolumes()
-                )
-                removeNotification(id = "save_state.ongoing")
-                if (file.exists(saved_state_path)) {
-                    showNotification(
-                        ui = str_c("State successfully saved to '",saved_state_path,"'."),
-                        id = "save_state.done",
-                        duration = DATA$notification_duration * 4,
-                        type = "message"
-                    )
-                } else {
-                    showNotification(
-                        ui = str_c("State was not successfully saved to '",saved_state_path,"'."),
-                        id = "save_state.error",
-                        duration = DATA$notification_duration * 4,
-                        type = "error"
-                    )
+            if (isFALSE(is.na(DATA$folder_path))) {
+                r <- dirname(DATA$folder_path)
+                showNotification(str_c("searching from ",DATA$folder_path))
+                if (isFALSE(hasName(volumes,"reprex_location"))) {
+                    reprex_location = DATA$folder_path
+                    reprex_root <- volumes[which(str_count(r,volumes)==1)]
+                    reprex_path <- path_rel(path = reprex_location,start = reprex_root)
+                    if (isTRUE(as.logical(str_count(reprex_location,volumes[which(str_count(r,volumes)==1)])))) {
+                        shinyFileSave(
+                            input,
+                            "save_state",
+                            roots = volumes,
+                            defaultRoot = names(reprex_root),
+                            defaultPath = reprex_path,
+                            session = getDefaultReactiveDomain(),
+                            allowDirCreate = T
+                        )
+                    } else {
+                        shinyFileSave(
+                            input,
+                            "save_state",
+                            roots = volumes,
+                            session = getDefaultReactiveDomain(),
+                            allowDirCreate = T
+                        )
+                    }
                 }
+            } else {
+                shinyFileSave(
+                    input,
+                    "save_state",
+                    roots = volumes,
+                    session = getDefaultReactiveDomain(),
+                    allowDirCreate = T
+                )
+            }
+            tryCatch({
             }, error = function(e) {
                 DATA$stacktrace = traceback(1, 1)
                 error_state_path <- save_error_state(
@@ -1485,12 +1488,69 @@ duflor_gui <- function() {
                     erroneous_callback = "save_state"
                 )
                 showNotification(
-                    ui = str_c("Error occured while saving state (during callback 'input$save_state'). The configuration which triggered this error was stored to '",error_state_path,"'."),
+                    ui = str_c("Error occured during callback 'input$save_state'. The configuration which triggered this error was stored to '",error_state_path,"'."),
                     id = "error_state_generated.done",
                     duration = NULL,
                     type = "error"
                 )
             })
+            if (isFALSE(is.numeric(input$save_state[[1]]))) {
+                savedir_path <- parseDirPath(roots = volumes, selection = input$save_state)
+
+                if (isTRUE(dir.exists(savedir_path))) {
+                    tryCatch({
+                        showNotification(
+                            ui = "State is being saved.",
+                            id = "save_state.ongoing",
+                            duration = NA,
+                            type = "warning"
+                        )
+                        # but first we must remove some values which are not to be saved to ensure filesize is minimal:
+                        # - DATA$last_im (which caches the last-loaded image of the 'render_selected_mask'-subroutine)
+                        saved_state_path <- save_state(
+                            input = input,
+                            DATA = DATA,
+                            DEBUGKEYS = DEBUGKEYS,
+                            FLAGS = FLAGS,
+                            volumes = volumes
+                        )
+                        removeNotification(id = "save_state.ongoing")
+                        if (file.exists(saved_state_path)) {
+                            showNotification(
+                                ui = str_c("State successfully saved to '",saved_state_path,"'."),
+                                id = "save_state.done",
+                                duration = DATA$notification_duration * 4,
+                                type = "message"
+                            )
+                        } else {
+                            showNotification(
+                                ui = str_c("State was not successfully saved to '",saved_state_path,"'."),
+                                id = "save_state.error",
+                                duration = DATA$notification_duration * 4,
+                                type = "error"
+                            )
+                        }
+                    }, error = function(e) {
+                        DATA$stacktrace = traceback(1, 1)
+                        error_state_path <- save_error_state(
+                            input = input_mirror,
+                            DATA = DATA,
+                            DEBUGKEYS = DEBUGKEYS,
+                            FLAGS = FLAGS,
+                            volumes = getVolumes(),
+                            error = e,
+                            errordir_path = DATA$folder_path,
+                            erroneous_callback = "save_state"
+                        )
+                        showNotification(
+                            ui = str_c("Error occured while saving state (during callback 'input$save_state'). The configuration which triggered this error was stored to '",error_state_path,"'."),
+                            id = "error_state_generated.done",
+                            duration = NULL,
+                            type = "error"
+                        )
+                    })
+                }
+            }
         })
     }
     #### LAUNCH APP ####

diff --git a/R/execute_multiple.R b/R/execute_multiple.R
@@ -192,7 +192,7 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                                 apply_HSV_color_by_mask(
                                     pixel.array = im,
                                     pixel.idx = hsv_results[[name]]$pixel.idx,
-                                    target.color = ifelse(stringr::str_count(name,"identifier"),"white","red"),
+                                    target.color = ifelse(str_count(name,"identifier"),"white","red"),
                                     mask_extreme = do_save_high_contrast_masks
                                 )
                             )),file = mask_path)
@@ -372,7 +372,7 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                                 apply_HSV_color_by_mask(
                                     pixel.array = im,
                                     pixel.idx = hsv_results[[name]]$pixel.idx,
-                                    target.color = ifelse(stringr::str_count(name,"identifier"),"white","red"),
+                                    target.color = ifelse(str_count(name,"identifier"),"white","red"),
                                     mask_extreme = input$do_save_high_contrast_masks
                                 )
                             )),file = mask_path)

diff --git a/R/execute_single.R b/R/execute_single.R
@@ -141,7 +141,7 @@ execute_single <- function(file, input, DATA, DEBUGKEYS, FLAGS) {
                         apply_HSV_color_by_mask(
                             pixel.array = im,
                             pixel.idx = hsv_results[[name]]$pixel.idx,
-                            target.color = ifelse(stringr::str_count(name,"identifier"),"white","red"),
+                            target.color = ifelse(str_count(name,"identifier"),"white","red"),
                             mask_extreme = input$do_save_high_contrast_masks
                         )
                     )),file = mask_path)

diff --git a/R/render_selected_mask.R b/R/render_selected_mask.R
@@ -123,7 +123,7 @@ render_selected_mask <- function(input, DATA, FLAGS) {
         mask <- apply_HSV_color_by_mask(
             pixel.array = im,
             pixel.idx = hsv_results[[1]]$pixel.idx,
-            target.color = ifelse(stringr::str_count(mask,"identifier"),"white","red"),
+            target.color = ifelse(str_count(mask,"identifier"),"white","red"),
             mask_extreme = input$mask_extreme
         )
         # display the mask

diff --git a/R/restore_state.R b/R/restore_state.R
@@ -36,6 +36,8 @@ restore_state <- function(input, output, DATA, FLAGS, DEBUGKEYS, session, volume
     }
     DATA$spectrums <- DATA_spectr
     selected_spectra <- input_state$input$selected_spectra
+    do_save_high_contrast_masks <- input_state$input$do_save_high_contrast_masks
+    do_save_masks <- input_state$input$do_save_masks
     DATA$r__tbl_dir_files <- input_state$DATA$r__tbl_dir_files
     DEBUGKEYS <- input_state$DEBUGKEYS
     FLAGS <- input_state$FLAGS
@@ -185,5 +187,13 @@ restore_state <- function(input, output, DATA, FLAGS, DEBUGKEYS, session, volume
             value = input_state$input$identifier_area
         )
     }
-    return(list(loaded_path=loaded_path,spectrums=DATA$spectrums,selected_spectra = selected_spectra))
+    return(
+        list(
+            loaded_path = loaded_path,
+            spectrums = DATA$spectrums,
+            selected_spectra = selected_spectra,
+            do_save_masks = do_save_masks,
+            do_save_high_contrast_masks = do_save_high_contrast_masks
+        )
+    )
 }
diff --git a/R/select_spectra_gui_comp.R b/R/select_spectra_gui_comp.R
@@ -27,13 +27,25 @@ select_spectra_gui_comp <- function(input, DATA, FLAGS) {
         all_choices <- unique(all_choices,DATA$selected_spectra)
         # DATA$selected_spectra <- NA # and finally, purge the field again so that the state is uniform
     }
+    do_save_masks_ <- FALSE
+    do_save_high_contrast_masks_ <- FALSE
+    if (isFALSE(is.na(DATA$do_save_masks))) {
+        if (isTRUE(as.logical(DATA$do_save_masks))) {
+            do_save_masks_ <- ifelse(isTRUE(as.logical(DATA$do_save_masks)),T,F)
+            if (isFALSE(is.na(DATA$do_save_high_contrast_masks))) {
+                if (isTRUE(as.logical(DATA$do_save_high_contrast_masks))) {
+                    do_save_high_contrast_masks_ <- ifelse(isTRUE(as.logical(DATA$do_save_masks)),T,F)
+                }
+            }
+        }
+    }
     showModal(modalDialog(
         tags$h3('Choose which ranges to analyse'),
         # 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?"),
+            checkboxInput("do_save_masks","Save the spectrum-masks?",value = do_save_masks_),
+            checkboxInput("do_save_high_contrast_masks","Save the high-contrast-masks instead?",value = do_save_high_contrast_masks_),
             actionButton('submit_selected_spectra', 'Submit choices'),
             modalButton('cancel')
         )

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