Skip to content
This repository has been archived by the owner on Jan 14, 2025. It is now read-only.

Commit

Permalink
Merge branch 'feat/fix-issue-24' into dev
Browse files Browse the repository at this point in the history
  • Loading branch information
Claudius-Appel committed Apr 24, 2024
2 parents 5bb8389 + 6541861 commit f91e33e
Show file tree
Hide file tree
Showing 16 changed files with 421 additions and 139 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: duflor.gui
Title: Frontend for duflor-package
Version: 0.0.1.9014
Version: 0.0.1.9015
Author: Claudius Appel
Authors@R: c(
person("Claudius", "Appel", email = "[email protected]" , role = c("aut", "cre"))
Expand Down
3 changes: 0 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,9 +1,6 @@
# Generated by roxygen2: do not edit by hand

export(convert_pixels_to_area_gui)
export(duflor_gui)
export(execute_analysis)
export(get_image_dimensions)
importFrom(DT,dataTableOutput)
importFrom(DT,renderDataTable)
importFrom(doParallel,registerDoParallel)
Expand Down
275 changes: 163 additions & 112 deletions R/app.R

Large diffs are not rendered by default.

2 changes: 1 addition & 1 deletion R/convert_pixels_to_area_gui.R
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,7 @@
#' All values are in \[cm^2\]
#' @note
#' This is a restructured version of [duflor::convert_pixels_to_area], to be more suitable to the needs of this specific app.
#' @export
#' @keywords internal
convert_pixels_to_area_gui <- function(pixel.counts)
{
default_identifier_area <- getOption("duflor.default_identifier_area")
Expand Down
5 changes: 2 additions & 3 deletions R/execute_analysis.R
Original file line number Diff line number Diff line change
Expand Up @@ -7,23 +7,22 @@
#'
#' @return list with components
#' - `results`: results-data passed-through from [execute_multiple()] or [execute_single()]
#' @export
#' @keywords internal
#'
execute_analysis <- function(input, DATA, DEBUGKEYS, FLAGS) {

#### CALL RESPECTIVE ANALYSIS-FUNCTION ####
if (FLAGS$analyse_single_image) {
isolate(DATA$r__tbl_dir_files)
file <- DATA$r__tbl_dir_files$images_filtered[[input$tbl_dir_files_rows_selected]]
file <- duflor.check(file)
results <- execute_single(file, input, DATA, DEBUGKEYS, FLAGS)
showNotification(
ui = "should single-eval runs even be saved to file? Should it even be considered relevant for the sake of displaying in the results-tab?",
duration = DATA$notification_duration * 4,
type = "warning"
)
} else {
files <- duflor.check(DATA$r__tbl_dir_files)
files <- DATA$r__tbl_dir_files
results <- execute_multiple(files, input, DATA, DEBUGKEYS, FLAGS)
}
return(list(results = results))
Expand Down
28 changes: 27 additions & 1 deletion R/execute_multiple.R
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,12 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
x1 <- input$x1
y1 <- input$y1
do_crop_image <- input$do_crop_image
do_crop_image <- input$do_crop_image
do_crop_identifier_range <- input$do_crop_identifier_range
spectrums <- DATA$spectrums
identifiersearch_x0 = input$identifiersearch_x0
identifiersearch_x1 = input$identifiersearch_x1
identifiersearch_y0 = input$identifiersearch_y0
identifiersearch_y1 = input$identifiersearch_y1
foreach_result <- foreach(index = 1:length(files$index),.packages = c("duflor","duflor.gui"), .verbose = T,.inorder = T) %dopar% {
# stop(simpleError("parallelisation is not implemented yet. figure out how to do so!!"))
# TODO: figure out how to parallelise this code?!
Expand Down Expand Up @@ -83,6 +87,17 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
check_value = T,
use_single_iteration_cpp = T
)
## LIMIT RANGE OF IDENTIFIER-HITS FROM CROPPED SEARCH REGION FOR ID-DOT
if (do_crop_identifier_range) {
hsv_results <- limit_identifier_coordinates(
spectrums_object = hsv_results,
image_dimensions = image_dimensions,
identifiersearch_x0 = identifiersearch_x0,
identifiersearch_x1 = identifiersearch_x1,
identifiersearch_y0 = identifiersearch_y0,
identifiersearch_y1 = identifiersearch_y1
)
}
## CALCULATE AREA FROM PIXEL_COUNTS
repackaged_pixel_counts <- list()
for (name in names(hsv_results)) {
Expand Down Expand Up @@ -144,6 +159,17 @@ execute_multiple <- function(files, input, DATA, DEBUGKEYS, FLAGS) {
check_value = T,
use_single_iteration_cpp = T
)
## LIMIT RANGE OF IDENTIFIER-HITS FROM CROPPED SEARCH REGION FOR ID-DOT
if (input$do_crop_identifier_range) {
hsv_results <- limit_identifier_coordinates(
spectrums_object = hsv_results,
image_dimensions = image_dimensions,
identifiersearch_x0 = input$identifiersearch_x0,
identifiersearch_x1 = input$identifiersearch_x1,
identifiersearch_y0 = input$identifiersearch_y0,
identifiersearch_y1 = input$identifiersearch_y1
)
}
## CALCULATE AREA FROM PIXEL_COUNTS
repackaged_pixel_counts <- list()
for (name in names(hsv_results)) {
Expand Down
11 changes: 11 additions & 0 deletions R/execute_single.R
Original file line number Diff line number Diff line change
Expand Up @@ -57,6 +57,17 @@ execute_single <- function(file, input, DATA, DEBUGKEYS, FLAGS) {
check_value = T,
use_single_iteration_cpp = T
)
## LIMIT RANGE OF IDENTIFIER-HITS FROM CROPPED SEARCH REGION FOR ID-DOT
if (input$do_crop_identifier_range) {
hsv_results <- limit_identifier_coordinates(
spectrums_object = hsv_results,
image_dimensions = image_dimensions,
identifiersearch_x0 = input$identifiersearch_x0,
identifiersearch_x1 = input$identifiersearch_x1,
identifiersearch_y0 = input$identifiersearch_y0,
identifiersearch_y1 = input$identifiersearch_y1
)
}
## CALCULATE AREA FROM PIXEL_COUNTS
repackaged_pixel_counts <- list()
for (name in names(hsv_results)) {
Expand Down
2 changes: 1 addition & 1 deletion R/get_image_dimensions.R
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@
#' @param path path to file to measure
#'
#' @return `list(width=dbl,height=dbl)`
#' @export
#' @keywords internal
#'
get_image_dimensions <- function(path) {
# get image dimensions.
Expand Down
54 changes: 54 additions & 0 deletions R/limit_identifier_coordinates.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,54 @@
#' restrict area in which `identifier`-pixels are considered "valid"
#'
#' This function is only applied to the `identifier`-range.
#' The intention is to exclude random pixels which **definitely** should not be
#' attributed to the identifier-data.
#'
#'
#' @param spectrums_object return object of [extract_pixels_HSV()]
#' @param image_dimensions dimensions of image
#' @param identifiersearch_x0 respective coordinate of the search bounding rectangle
#' @param identifiersearch_x1 respective coordinate of the search bounding rectangle
#' @param identifiersearch_y0 respective coordinate of the search bounding rectangle
#' @param identifiersearch_y1 respective coordinate of the search bounding rectangle
#'
#' @return modified `spectrums_object`
#' @keywords internal
#'
limit_identifier_coordinates <- function(spectrums_object, image_dimensions, identifiersearch_x0, identifiersearch_x1, identifiersearch_y0, identifiersearch_y1) {
if (length(spectrums_object)==1) { # single image
current_identifier_idx <- spectrums_object[[1]]$pixel.idx
condition <- ((current_identifier_idx[,1] >= identifiersearch_x0)
& (current_identifier_idx[,1]<=identifiersearch_x1)
& (current_identifier_idx[,2]>=identifiersearch_y0)
& (current_identifier_idx[,2]<=identifiersearch_y1)
)
# update pixel.count, img.fraction & pixel.idx,
# as they are inserted into the `current_results`
# and the `spectrums_objectobject`
spectrums_object[[1]]$pixel.count <- sum(condition)
spectrums_object[[1]]$img.fraction <- spectrums_object[[1]]$pixel.count/(prod(image_dimensions))
spectrums_object[[1]]$pixel.idx <- current_identifier_idx[condition,]
} else { # multiple images
for (name in names(spectrums_object)) {
if (any(grep("identifier",names(spectrums_object)))) { # get position of identifier-object
idx <- grep("identifier",names(spectrums_object))
if (names(spectrums_object)[[idx]]==name) {
current_identifier_idx <- spectrums_object[[idx]]$pixel.idx
condition <- ((current_identifier_idx[,1] >= identifiersearch_x0)
& (current_identifier_idx[,1]<=identifiersearch_x1)
& (current_identifier_idx[,2]>=identifiersearch_y0)
& (current_identifier_idx[,2]<=identifiersearch_y1)
)
# update pixel.count, img.fraction & pixel.idx,
# as they are inserted into the `current_results`
# and the `spectrums_objectobject`
spectrums_object[[name]]$pixel.count <- sum(condition)
spectrums_object[[name]]$img.fraction <- spectrums_object[[name]]$pixel.count/(prod(image_dimensions))
spectrums_object[[name]]$pixel.idx <- current_identifier_idx[condition,]
}
}
}
}
return(spectrums_object)
}
96 changes: 96 additions & 0 deletions R/render_selected_mask.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,96 @@
#' render mask based on input data
#'
#' @param input - `input` respective shiny-component
#' @param DATA - `DATA` respective shiny-component
#' @param FLAGS - `FLAGS` respective shiny-component
#'
#' @keywords internal
render_selected_mask <- function(input, DATA, FLAGS) {
if (is.null(input$tbl_results_filtered_rows_selected)) {
showNotification(
ui = "No row selected.",
duration = DATA$notification_duration * 4,
type = "warning"
)
return()
}
if (!(input$reinspected_spectrums %in% names(DATA$spectrums$lower_bound))) {
showNotification(
ui = "This spectrum was not analysed for this image.",
duration = DATA$notification_duration * 4,
type = "warning"
)
return()
}
if (FLAGS$analyse_single_image) {
file <- DATA$results$results$full_path
} else {
file <- DATA$r__tbl_dir_files$images_filtered[[input$tbl_results_filtered_rows_selected]]
}
image_dimensions <- as.integer(get_image_dimensions(file))
## LOAD IMAGE
if (is.na(DATA$last_masked_image) || (DATA$last_masked_image!=file)) {
if (input$do_crop_image) {
im <- load_image(
image.path = file,
subset_only = T,
return_hsv = T,
crop_left = input$x0,
crop_right = image_dimensions[[1]] - input$x1,
crop_top = input$y0,
crop_bottom = image_dimensions[[2]] - input$y1
)
DATA$last_masked_image <- file
DATA$last_im <- im
} else {
im <- load_image(
image.path = file,
subset_only = F,
return_hsv = T
)
DATA$last_masked_image <- file
DATA$last_im <- im
}
} else {
im <- DATA$last_im
}
mask <- input$reinspected_spectrums

# get the spectrum's HSV scope
lower_bound <- DATA$spectrums$lower_bound[[mask]]
upper_bound <- DATA$spectrums$upper_bound[[mask]]

# extract the spectrum & get its coordinates
hsv_results <- extract_pixels_HSV(
pixel.array = im,
lower_bound = lower_bound,
upper_bound = upper_bound,
fast_eval = T,
bundle_pixelarray = F,
check_value = T,
use_single_iteration_cpp = T
)
# LIMIT RANGE OF IDENTIFIER-HITS FROM CROPPED SEARCH REGION FOR ID-DOT
if (input$do_crop_identifier_range) {
hsv_results <- limit_identifier_coordinates(
spectrums_object = hsv_results,
image_dimensions = image_dimensions,
identifiersearch_x0 = input$identifiersearch_x0,
identifiersearch_x1 = input$identifiersearch_x1,
identifiersearch_y0 = input$identifiersearch_y0,
identifiersearch_y1 = input$identifiersearch_y1
)
# # update the repackaged pixel.counts, so that the area's are updated properly
# repackaged_pixel_counts[[idx]] <- sum(condition)
# repackaged_pixel_counts[[idx]] <- current_identifier_idx[condition,]
}
# make a mask
mask <- apply_HSV_color_by_mask(
pixel.array = im,
pixel.idx = hsv_results[[1]]$pixel.idx,
target.color = "red",
mask_extreme = input$mask_extreme
)
# display the mask
display(HSVtoRGB(mask))
}
17 changes: 0 additions & 17 deletions R/temporary_utils.R

This file was deleted.

1 change: 1 addition & 0 deletions man/convert_pixels_to_area_gui.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/execute_analysis.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/get_image_dimensions.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

37 changes: 37 additions & 0 deletions man/limit_identifier_coordinates.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

25 changes: 25 additions & 0 deletions man/render_selected_mask.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit f91e33e

Please sign in to comment.