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

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: duflor.gui
 Title: Frontend for duflor-package
-Version: 1.0.7
+Version: 1.0.8
 Author: Claudius Appel
 Authors@R: c(
     person("Claudius", "Appel", email =   "[email protected]" , role = c("aut", "cre"))

NAMESPACE

@@ -20,6 +20,7 @@ importFrom(ggplot2,ggplot)
 importFrom(ggplot2,ggsave)
 importFrom(ggplot2,guides)
 importFrom(ggplot2,labs)
+importFrom(ggplot2,position_dodge)
 importFrom(ggplot2,theme)
 importFrom(ggplot2,theme_minimal)
 importFrom(imager,HSVtoRGB)

R/app.R

@@ -155,6 +155,14 @@ duflor_gui <- function() {
                         id = "PARALLEL_PANEL",
                         numericInput(inputId = "parallel_cores",label = "Designate number of cores",value = 1, min = 1,max = (detectCores(logical = use_logical_cores) - 1)),
                     ),
+                    ## DISTORTION
+                    h4("Distortion Correction"),
+                    checkboxInput(inputId = "do_correct_distortion",label = "Correct Distortion?"),
+                    conditionalPanel(
+                        condition = "input.do_correct_distortion %% 2 == 1",
+                        id = "DISTORTION_PANEL",
+                        numericInput(inputId = "barrel_correction_factor",label = "Describe the lens' **maximum** barrel-distortion",value = -1.2, min = -100,max = 100,step = 0.00001),
+                    ),
                     ## MISCELLANEOUS STUFF
                     h5("Misc"),
                     textInput(inputId = "dev_pass",label = "Dev-console",placeholder = "enter '-h' for a list of valid commands"),
@@ -481,6 +489,7 @@ duflor_gui <- function() {
         hide("HSV_PANEL")
         hide("CROPPING_PANEL")
         hide("PARALLEL_PANEL")
+        hide("DISTORTION_PANEL")
         #### DEV TOGGLES ####
         observeEvent(input$dev_pass, {
             input_mirror <- input ## mirror input so that the error-trycatch can pass it to save_state
@@ -511,6 +520,41 @@ duflor_gui <- function() {
             open_parallelPanel_event(input, DATA, FLAGS, use_logical_cores, session, STARTUP)
             FLAGS$restoring_state <- FALSE
         })
+        #### SETUP DISTORTION ####
+        observeEvent(input$do_correct_distortion, {
+            if (input$do_correct_distortion) {
+                show("DISTORTION_PANEL")
+                showNotification(
+                    ui = str_c(
+                        "Provide maximum distortion-parameter of your lens."
+                    ),
+                    type = "message"
+                )
+                if (isFALSE(FLAGS$restoring_state)) {
+                    updateNumericInput(session,inputId = "barrel_correction_factor", value = 0)
+                }
+            } else {
+                hide("DISTORTION_PANEL")
+                if (isFALSE(FLAGS$restoring_state)) {
+                    updateNumericInput(session,inputId = "barrel_correction_factor", value = 0)
+                }
+                if (isTRUE(STARTUP$startup)) {
+                    STARTUP$startup <- FALSE
+                    # this line must be executed instead of the *last* message
+                    # which you want to suppress on startup. To be more precise,
+                    # if another `conditionalPanel` is added, the event-callback
+                    # for its notifications should be placed _above_ this
+                    # event-callback.
+                } else {
+                    showNotification(
+                        ui = str_c(
+                            "Disabled correction of barrel-distortion."
+                        ),
+                        type = "message"
+                    )
+                }
+            }
+        })
         #### EDIT CROPPING ####
         observeEvent(input$do_crop_image, {
             if (input$do_crop_image) {

R/correct_distortion.R

@@ -0,0 +1,56 @@
+#'
+#'
+#' @param pixel.idx natrixmatrix of
+#' @param distortions list of distortion-factors to apply. Values must be numeric, on a scale from -100 <> +100
+#' Currently, only `barrel`-distortion can be applied.
+#' @param image_dimensions actual dimensions of the image, without cropping.
+#' @param do_crop_image boolean to check if the image was cropped.
+#' @param x0 coordinates of the cropping top left corner. Necessary to correct coordinate-space for cropping.
+#' @param y0 coordinates of the
+#'
+#' @return sum of distortion-corrected pixels, rounded to the closest integer value.
+#' @keywords internal
+#'
+correct_distortion <- function(pixel.idx, distortions, image_dimensions, do_crop_image, x0, y0) {
+
+    # calculate the euclidean distance vectorized
+    euclidean_distance <- function(p1, p2) {
+        sqrt((p2[, 1] - p1[1])^2 + (p2[, 2] - p1[2])^2)
+    }
+
+    # Image dimensions and center
+    center_coords <- c(round(image_dimensions[1] / 2), round(image_dimensions[2] / 2))
+    euclidean_distance_edge <- sqrt((image_dimensions[1] - center_coords[1])^2 +
+                                        (image_dimensions[2] - center_coords[2])^2)
+
+    # correct coordinates if cropped
+    if (do_crop_image) {
+        pixel.idx_real_coords <- pixel.idx + c(x0, y0)
+    } else {
+        pixel.idx_real_coords <- pixel.idx
+    }
+
+    # calculate Euclidean distances for all pixels
+    euclidean_distances <- euclidean_distance(center_coords, pixel.idx_real_coords)
+
+    # normalize distances
+    normalized_distances <- euclidean_distances / euclidean_distance_edge
+
+    # apply barrel distortion
+    distortion_percentage <- distortions$barrel / 100  # Convert to decimal
+    if (distortion_type == "barrel") {
+        distortion_factors <- 1 + (distortion_percentage * normalized_distances)
+    } else {
+        # suggested factor calculation for pincushion:
+        # distortion_factors <- 1 - (distortion_percentage * normalized_distances)
+
+
+        stop("Invalid distortion type. Implemented types: 'barrel'.")
+    }
+
+    # calculate area change (distortion factor squared)
+    area_changes <- distortion_factors^2
+
+    # return the sum of corrected areas
+    return(round(sum(area_changes)))
+}

R/execute_multiple.R

@@ -48,6 +48,8 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
         identifiersearch_y1 = input$identifiersearch_y1
         identifier_area <- input$identifier_area
         do_save_masks <- input$do_save_masks
+        do_correct_distortion <- input$do_correct_distortion
+        barrel_correction_factor <- input$barrel_correction_factor
         if (do_save_masks) {
             results_path <- normalizePath(str_c(
                 dirname(files$images_filtered[1]),
@@ -141,9 +143,25 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
             ## CALCULATE AREA FROM PIXEL_COUNTS
             # Calculating the area based on pixel counts for each spectrum vs. the identifier-spectrum
             # but first, ensure calculations are possible:
+            for (name in names(hsv_results)) {
+                if (isTRUE(do_correct_distortion)) { # experimental distortion-correction.
+                    hsv_results[[name]]$pixel.count_undistorted <- correct_distortion(
+                        hsv_results[[name]]$pixel.idx,
+                        distortions = list("barrel" = barrel_correction_factor),
+                        image_dimensions = image_dimensions,
+                        do_crop_image = do_crop_image,
+                        x0 = x0,
+                        y0 = y0
+                    )
+                } else {
+                    hsv_results[[name]]$pixel.count_undistorted <- NA
+                }
+            }
             repackaged_pixel_counts <- list()
+            repackaged_pixel_counts_undistorted <- list()
             for (name in names(hsv_results)) {
                 repackaged_pixel_counts[[name]] <- hsv_results[[name]]$pixel.count
+                repackaged_pixel_counts_undistorted[[name]] <- hsv_results[[name]]$pixel.count_undistorted
             }
             # Calculating the area based on pixel counts for each spectrum vs. the identifier-spectrum
             # but first, ensure calculations are possible:
@@ -155,7 +173,6 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                 # parallelisation and without parallelisation will yield
                 # different output data - I think?
                 # TODO: verify the above
-                return(current_results)
             } else {
                 # in this case, the identifier has at least 1 pixel, so we can actually calculate areas now.
 
@@ -187,6 +204,32 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                 ## UPDATE RESULTS_OBJECT
                 # results_object <- update_resultsObject(results_object,current_results)
                 current_results$area_per_pixel <- areas$area_per_pixel
+            }
+            ## UNDISTORTED RESULTS
+            # if distortion-fixing is disabled, we skip this section; and inherit the entries in 'current_results' be 'NA'
+            if (isTRUE(do_correct_distortion)) {
+                if (repackaged_pixel_counts_undistorted[[grep("identifier",names(repackaged_pixel_counts_undistorted))]]==0) {
+                    return(current_results)
+                } else {
+                    # we use the duflor.gui-version of this function because we need a different structure.
+                    areas_undistorted <- convert_pixels_to_area_gui(repackaged_pixel_counts_undistorted, identifier_area)
+                    for (name in names(hsv_results)) {
+                        current_results[[str_c(name,"_area_undistorted")]] <- areas_undistorted[[name]]
+                        current_results[[str_c(name,"_count_undistorted")]] <- hsv_results[[name]]$pixel.count_undistorted
+                        current_results[[str_c(name,"_fraction_undistorted")]] <- hsv_results[[name]]$pixel.count_undistorted/(prod(image_dimensions))
+                        if (do_save_masks) {
+                            if (hsv_results[[name]]$pixel.count>0) {
+                                message(str_c("The undistorted mask for spectrum '",name,"' of image '",bnf,"' cannot be saved."))
+                            } else {
+                                message(str_c("No mask saved for spectrum '",name,"' of image '",bnf,"': 0 Hits."))
+                            }
+                        }
+                    }
+                    current_results$area_per_pixel_undistorted <- areas_undistorted$area_per_pixel
+                    ## UPDATE RESULTS_OBJECT
+                    return(current_results)
+                }
+            } else {
                 return(current_results)
             }
         }
@@ -283,9 +326,25 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
             current_results$identifiercrop_y0 <- identifiersearch_y0
             current_results$identifiercrop_y1 <- identifiersearch_y1
             ## CALCULATE AREA FROM PIXEL_COUNTS
+                for (name in names(hsv_results)) {
+                    if (isTRUE(input$do_correct_distortion)) { # experimental distortion-correction.
+                        hsv_results[[name]]$pixel.count_undistorted <- correct_distortion(
+                            hsv_results[[name]]$pixel.idx,
+                            distortions = list("barrel" = input$barrel_correction_factor),
+                            image_dimensions = image_dimensions,
+                            do_crop_image = input$do_crop_image,
+                            x0 = input$x0,
+                            y0 = input$y0
+                        )
+                    } else {
+                        hsv_results[[name]]$pixel.count_undistorted <- NA
+                    }
+            }
             repackaged_pixel_counts <- list()
+            repackaged_pixel_counts_undistorted <- list()
             for (name in names(hsv_results)) {
                 repackaged_pixel_counts[[name]] <- hsv_results[[name]]$pixel.count
+                repackaged_pixel_counts_undistorted[[name]] <- hsv_results[[name]]$pixel.count_undistorted
             }
             # Calculating the area based on pixel counts for each spectrum vs. the identifier-spectrum
             # but first, ensure calculations are possible:
@@ -325,12 +384,37 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
                 ## UPDATE RESULTS_OBJECT
                 current_results$area_per_pixel <- areas$area_per_pixel
             }
+            ## UNDISTORTED RESULTS
+            # if distortion-fixing is disabled, we skip this section; and inherit the entries in 'current_results' be 'NA'
+            if (isTRUE(input$do_correct_distortion)) {
+                if (repackaged_pixel_counts_undistorted[[grep("identifier",names(repackaged_pixel_counts_undistorted))]]==0) {
+
+                } else {
+                    # we use the duflor.gui-version of this function because we need a different structure.
+                    areas_undistorted <- convert_pixels_to_area_gui(repackaged_pixel_counts_undistorted, input$identifier_area)
+                    for (name in names(hsv_results)) {
+                        current_results[[str_c(name,"_area_undistorted")]] <- areas_undistorted[[name]]
+                        current_results[[str_c(name,"_count_undistorted")]] <- hsv_results[[name]]$pixel.count_undistorted
+                        current_results[[str_c(name,"_fraction_undistorted")]] <- hsv_results[[name]]$pixel.count_undistorted/(prod(image_dimensions))
+                        if (input$do_save_masks) {
+                            if (hsv_results[[name]]$pixel.count>0) {
+                                message(str_c("The undistorted mask for spectrum '",name,"' of image '",bnf,"' cannot be saved."))
+                            } else {
+                                message(str_c("No mask saved for spectrum '",name,"' of image '",bnf,"': 0 Hits."))
+                            }
+                        }
+                    }
+                    ## UPDATE RESULTS_OBJECT
+                    current_results$area_per_pixel_undistorted <- areas_undistorted$area_per_pixel
+                }
+            }
             results_object <- update_resultsObject(results_object,current_results)
         }
     }
+    message("Analysis itself finished; checking for images w/o identifiers")
     images_without_identifier_pixels_count <- 0
     for (each in 1:nrow(results_object)) {
-        if (is.na(results_object[each, grep("identifier.*count", names(results_object))])) {
+        if (any(is.na(results_object[each, grep("identifier.*count", names(results_object))]))) {
                 str_no_ID_pixels_warning <- str_c(
                     "Image '",
                     results_object[each, "image_name"],

R/execute_single.R

@@ -102,10 +102,26 @@ execute_single <- function(file, input, DATA, DEBUGKEYS, FLAGS) {
     current_results$identifiercrop_x1 <- identifiersearch_x1
     current_results$identifiercrop_y0 <- identifiersearch_y0
     current_results$identifiercrop_y1 <- identifiersearch_y1
+    for (name in names(hsv_results)) {
+        if (isTRUE(input$do_correct_distortion)) { # experimental distortion-correction.
+            hsv_results[[name]]$pixel.count_undistorted <- correct_distortion(
+                hsv_results[[name]]$pixel.idx,
+                distortions = list("barrel" = input$barrel_correction_factor),
+                image_dimensions = image_dimensions,
+                do_crop_image = input$do_crop_image,
+                x0 = input$x0,
+                y0 = input$y0
+            )
+        } else {
+            hsv_results[[name]]$pixel.count_undistorted <- NA
+        }
+    }
     ## CALCULATE AREA FROM PIXEL_COUNTS
     repackaged_pixel_counts <- list()
+    repackaged_pixel_counts_undistorted <- list()
     for (name in names(hsv_results)) {
         repackaged_pixel_counts[[name]] <- hsv_results[[name]]$pixel.count
+        repackaged_pixel_counts_undistorted[[name]] <- hsv_results[[name]]$pixel.count_undistorted
     }
     if (repackaged_pixel_counts[[grep("identifier",names(repackaged_pixel_counts))]]==0) {
 
@@ -137,10 +153,34 @@ execute_single <- function(file, input, DATA, DEBUGKEYS, FLAGS) {
         current_results$area_per_pixel <- areas$area_per_pixel
         ## UPDATE RESULTS_OBJECT
     }
+    ## UNDISTORTED RESULTS
+    # if distortion-fixing is disabled, we skip this section; and inherit the entries in 'current_results' be 'NA'
+    if (isTRUE(do_correct_distortion)) {
+        if (repackaged_pixel_counts_undistorted[[grep("identifier",names(repackaged_pixel_counts_undistorted))]]==0) {
+
+        } else {
+            # we use the duflor.gui-version of this function because we need a different structure.
+            areas_undistorted <- convert_pixels_to_area_gui(repackaged_pixel_counts_undistorted, input$identifier_area)
+            for (name in names(hsv_results)) {
+                current_results[[str_c(name,"_area_undistorted")]] <- areas_undistorted[[name]]
+                current_results[[str_c(name,"_count_undistorted")]] <- hsv_results[[name]]$pixel.count_undistorted
+                current_results[[str_c(name,"_fraction_undistorted")]] <- hsv_results[[name]]$pixel.count_undistorted/(prod(image_dimensions))
+                if (input$do_save_masks) {
+                    if (hsv_results[[name]]$pixel.count>0) {
+                        message(str_c("The undistorted mask for spectrum '",name,"' of image '",bnf,"' cannot be saved."))
+                    } else {
+                        message(str_c("No mask saved for spectrum '",name,"' of image '",bnf,"': 0 Hits."))
+                    }
+                }
+            }
+            current_results$area_per_pixel_undistorted <- areas_undistorted$area_per_pixel
+            ## UPDATE RESULTS_OBJECT
+        }
+    }
     results_object <- update_resultsObject(results_object,current_results)
     images_without_identifier_pixels_count <- 0
     for (each in 1:nrow(results_object)) {
-        if (is.na(results_object[each, grep("identifier.*count", names(results_object))])) {
+        if (any(is.na(results_object[each, grep("identifier.*count", names(results_object))]))) {
             str_no_ID_pixels_warning <- str_c(
                 "Image '",
                 results_object[each, "image_name"],