Merge branch 'feat/explore-restructured-rectangularRange_cpp' into dev

# Conflicts:
#	docs/pkgdown.yml

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: duflor
 Title: Plant Image Analysis For Determination of Leaf- and Root-Area 
-Version: 0.0.1.9023
+Version: 0.0.1.9024
 Author: Claudius Appel
 Authors@R: c(
     person("Claudius", "Appel", email =   "claudius.appel@freenet.de" , role = c("aut", "cre"))

NAMESPACE

@@ -14,6 +14,7 @@ export(plot_array_as_image_sRGB)
 export(plot_indicator_image)
 export(rectangularRange_HSV)
 export(rectangularRange_HSV_cpp)
+export(rectangularRange_HSV_iteronce_cpp)
 export(retrieve_adjacency_coords)
 export(sRGBtoRGB)
 export(validate_mask_edges)

R/RcppExports.R

@@ -7,6 +7,8 @@
 #' The use of  [rectangularRange_HSV()] is strongly discouraged in favour of this function,
 #' due to its drastically slower execution.
 #'
+#' @seealso [rectangularRange_HSV_iteronce_cpp()]
+#'
 #' @inheritParams .main_args
 #' @param H respective component of a `pixel.array`
 #' @param S respective component of a `pixel.array`
@@ -17,8 +19,60 @@
 #' - `pixel.idx` - pixel-locations of pixels detected between lower and upper bound.
 #'
 #' Upon failure to find any matching pixels, an empty matrix of dimensions `[0, 1:2]` is returned.
+#'
+#'
 #' @export
 rectangularRange_HSV_cpp <- function(H, S, V, upper_bound, lower_bound, image_width, check_V) {
     .Call(`_duflor_rectangularRange_HSV_cpp`, H, S, V, upper_bound, lower_bound, image_width, check_V)
 }
 
+#' @title optimised 'C++'-implementation of [rectangularRange_HSV()]
+#'
+#' @note
+#' The use of  [rectangularRange_HSV()] & [rectangularRange_HSV_cpp()] is strongly discouraged in favour of this function,
+#' due to its drastically slower execution.
+#'
+#' @param H respective component of a `pixel.array`
+#' @param S respective component of a `pixel.array`
+#' @param V respective component of a `pixel.array`
+#' @param image_width Width of `pixel.array`, as returned via `dim(pixel.array)[1]`
+#' @param check_V boolean toggle to also check the `VALUE`-component of an HSV-pixel
+#' @param upper_bound EITHER:
+#' - **matrix** of upper HSV-bounds, e.g. `do.call(rbind,list(green = c(H_green_lower,S_green_lower,V_green_lower),drought = c(H_drought_lower,S_drought_lower,V_drought_lower)))`
+#' - single vector of length 3 declaring a set of HSV-values
+#' @param lower_bound see `upper_bound`
+#' @return A list-object with the following elements (when supplying one one pair of bounds)
+#' - `pixel.idx` - pixel-locations of pixels detected between lower and upper bound.
+#'
+#' Upon failure to find any matching pixels, an empty matrix of dimensions `[0, 1:2]` is returned.
+#' @examples
+#' \dontrun{
+#' library(duflor)
+#' ## load example data
+#' file_path <- load_extdata("duflor-icon.png")
+#' pixel.array <- load_image(file_path,F,T)
+#' spectrums <- getOption("duflor.default_hsv_spectrums")
+#'
+#' ## convert spectrums to matrix
+#' nlb <- do.call(rbind,spectrums$lower_bound)
+#' nub <- do.call(rbind,spectrums$upper_bound)
+#'
+#' ## strip dimnames-attributes
+#' dimnames(nlb) <- c()
+#' dimnames(nub) <- c()
+#' ## extract matches
+#' result <- rectangularRange_HSV_iteronce_cpp(H = pixel.array[,,,1],
+#'                                             S = pixel.array[,,,2],
+#'                                             V = pixel.array[,,,3],
+#'                                             upper_bound = nub,
+#'                                             lower_bound = nlb,
+#'                                             image_width = dim(pixel.array)[1],
+#'                                             check_V = T)
+#' ## add names to results-matrix.
+#' names(result) <- names(spectrums$lower_bound)
+#' }
+#' @export
+rectangularRange_HSV_iteronce_cpp <- function(H, S, V, upper_bound, lower_bound, image_width, check_V) {
+    .Call(`_duflor_rectangularRange_HSV_iteronce_cpp`, H, S, V, upper_bound, lower_bound, image_width, check_V)
+}
+

R/extract_pixels_HSV.R

@@ -4,7 +4,7 @@
 #' @param bundle_pixelarray logical, indicating if the input parameter `pixel.array` is to be bundled into the return-value
 #' This is useful to retain `pixel.array` into the output if this function is called in a loop.
 #' @param check_value boolean toggle to also check the `VALUE`-component of an HSV-pixel
-#'
+#' @param use_single_iteration_cpp Use [rectangularRange_HSV_iteronce_cpp()] for computing hits per range. This is slightly more efficient than using [rectangularRange_HSV_cpp()].
 #' @return EITHER:
 #' list-object with the following elements (when supplying one one pair of bounds)
 #' - `pixel.idx` - pixel-locations of pixels detected between lower and upper bound.
@@ -23,8 +23,41 @@
 #' @importFrom grDevices rgb2hsv
 #' @importFrom stringr str_c
 #'
-extract_pixels_HSV <- function(pixel.array, lower_bound, upper_bound, fast_eval = TRUE, bundle_pixelarray = FALSE, check_value = FALSE) {
-    if (is.list(lower_bound) && is.list(upper_bound)) {
+extract_pixels_HSV <- function(pixel.array, lower_bound, upper_bound, fast_eval = TRUE, bundle_pixelarray = FALSE, check_value = FALSE, use_single_iteration_cpp = FALSE) {
+    # structure of the return object:
+    #
+    # return_Object[[spectrum_name]]
+    #   - pixel.idx
+    #   - pixel.count
+    #   - img.fraction
+    #   - (bundle_pixelarray==TRUE?pixel.array)
+    #
+    # IN CASE OF SINGLE SPECTRUM,
+    #
+    # return_Object[[1]]
+    #   - pixel.idx
+    #   - pixel.count
+    #   - img.fraction
+    #   - (bundle_pixelarray==TRUE?pixel.array)
+    #
+    #
+    # Overview: For details, see function definitions for respective extraction-
+    # function.
+    #
+    # rectangularRange_HSV
+    # - slowest, must iterate over all desired spectra
+    # - `pixel.count` and `img.fraction` must be calculated separately
+    # rectangularRange_HSV_cpp
+    # - middle path, must iterate over all desired spectra
+    # - `pixel.count` and `img.fraction` must be calculated separately
+    # rectangularRange_HSV_iteronce_cpp
+    # - fastest, does the iterating itself and returns the bundled results for all spectra
+    # - `pixel.count` and `img.fraction` are already calculated
+    # - spectrum names must be assigned to the first-level entries of its return-values separately
+    # - input must be a matrix, **not** a list
+    #
+    return_Object <- list()
+    if (is.list(lower_bound) && is.list(upper_bound)) { # multiple spectra
         if (length(lower_bound) != length(upper_bound)) {
             stop(
                 simpleError(
@@ -45,64 +78,104 @@ extract_pixels_HSV <- function(pixel.array, lower_bound, upper_bound, fast_eval
                 )
             )
         }
-        return_Object <- list()
-        if (as.logical(bundle_pixelarray)) {
-            return_Object$pixel.array <- pixel.array
-        }
+
         if (as.logical(fast_eval)) {
-            for (type in names(lower_bound)) {
-                ret <- list()
-                ret$pixel.idx <- rectangularRange_HSV_cpp(
+            if (as.logical(use_single_iteration_cpp)) {
+                nlb <- do.call(rbind,lower_bound)
+                dimnames(nlb) <- c()
+                nub <- do.call(rbind,upper_bound)
+                dimnames(nub) <- c()
+                return_Object <- rectangularRange_HSV_iteronce_cpp(
                     H = pixel.array[,,,1],
                     S = pixel.array[,,,2],
                     V = pixel.array[,,,3],
-                    lower_bound = lower_bound[[type]],
-                    upper_bound = upper_bound[[type]],
+                    lower_bound = nlb,
+                    upper_bound = nub,
                     image_width = dim(pixel.array)[1],
                     check_V = as.logical(check_value)
-                ) + 1
-
-                ## the '+1' is required to handle Cpp being 0-indexed, while R is 1-indexed.
-                ret$pixel.idx <- as.matrix(ret$pixel.idx)
-                mode(ret$pixel.idx) <- "integer"
-                ret$pixel.count <- nrow(ret$pixel.idx)
-                ret$img.fraction <- nrow(ret$pixel.idx)/ (nrow(pixel.array) * ncol(pixel.array))
-                return_Object[[type]] <- ret
+                )
+                names(return_Object) <- names(lower_bound) ## assign names
+            } else {
+                for (spectrum_name in names(lower_bound)) {
+                    ret <- list()
+                    ret$pixel.idx <- rectangularRange_HSV_cpp(
+                        H = pixel.array[,,,1],
+                        S = pixel.array[,,,2],
+                        V = pixel.array[,,,3],
+                        lower_bound = lower_bound[[spectrum_name]],
+                        upper_bound = upper_bound[[spectrum_name]],
+                        image_width = dim(pixel.array)[1],
+                        check_V = as.logical(check_value)
+                    )
+                    ret$pixel.idx <- as.matrix(ret$pixel.idx)
+                    mode(ret$pixel.idx) <- "integer"
+                    ret$pixel.count <- nrow(ret$pixel.idx)
+                    ret$img.fraction <- nrow(ret$pixel.idx)/ (nrow(pixel.array) * ncol(pixel.array))
+                    return_Object[[spectrum_name]] <- ret
+                }
             }
         } else {
-            for (type in names(lower_bound)) {
+            for (spectrum_name in names(lower_bound)) {
                 ret <- list()
                 ret$pixel.idx <- rectangularRange_HSV(
                     pixel.array = pixel.array,
-                    lower_bound = lower_bound[[type]], # TODO: implement list-ranges to detect all relvant ranges??
-                    upper_bound = upper_bound[[type]] # TODO: implement list-ranges to detect all relvant ranges??
+                    lower_bound = lower_bound[[spectrum_name]],
+                    upper_bound = upper_bound[[spectrum_name]],
+                    check_V = as.logical(check_value)
                 )
                 ret$pixel.count <- nrow(ret$pixel.idx)
                 ret$img.fraction <- nrow(ret$pixel.idx)/ (nrow(pixel.array) * ncol(pixel.array))
-                return_Object[[type]] <- ret
+                return_Object[[spectrum_name]] <- ret
             }
         }
-        return(return_Object)
-    } else {
+        if (as.logical(bundle_pixelarray)) {
+            return_Object$pixel.array <- pixel.array
+        }
+    } else { # a single spectrum
+        return_Object[[1]] <- list()
         if (as.logical(fast_eval)) {
-            ret <- rectangularRange_HSV_cpp(
-                H = pixel.array[,,,1],
-                S = pixel.array[,,,2],
-                V = pixel.array[,,,3],
-                lower_bound = lower_bound[[type]],
-                upper_bound = upper_bound[[type]],
-                image_width = dim(pixel.array)[1]
-            ) + 1
-            ## the '+1' is required to handle Cpp being 0-indexed, while R is 1-indexed.
-            ret <- as.matrix(ret)
-            mode(ret) <- "integer"
-            return(ret)
+            if (as.logical(use_single_iteration_cpp)) {
+                nlb <- matrix(lower_bound,ncol = 3)
+                nub <- matrix(upper_bound, ncol = 3)
+                return_Object <- rectangularRange_HSV_iteronce_cpp(
+                    H = pixel.array[,,,1],
+                    S = pixel.array[,,,2],
+                    V = pixel.array[,,,3],
+                    lower_bound = nlb,
+                    upper_bound = nub,
+                    image_width = dim(pixel.array)[1],
+                    check_V = as.logical(check_value)
+                )
+                names(return_Object) <- names(lower_bound) ## assign names
+            } else {
+                ret <- list()
+                ret$pixel.idx <- rectangularRange_HSV_cpp(
+                    H = pixel.array[,,,1],
+                    S = pixel.array[,,,2],
+                    V = pixel.array[,,,3],
+                    lower_bound = lower_bound,
+                    upper_bound = upper_bound,
+                    image_width = dim(pixel.array)[1],
+                    check_V = as.logical(check_value)
+                )
+                ret$pixel.idx <- as.matrix(ret$pixel.idx)
+                mode(ret$pixel.idx) <- "integer"
+                ret$pixel.count <- nrow(ret$pixel.idx)
+                ret$img.fraction <- nrow(ret$pixel.idx)/ (nrow(pixel.array) * ncol(pixel.array))
+                return_Object[[1]] <- ret
+            }
         } else {
-            return(rectangularRange_HSV(
+            return_Object[[1]]$pixel.idx <- rectangularRange_HSV(
                 pixel.array = pixel.array,
                 lower_bound = lower_bound,
                 upper_bound = upper_bound
-            ))
+            )
+            return_Object[[1]]$pixel.count <- nrow(return_Object[[1]]$pixel.idx)
+            return_Object[[1]]$img.fraction <- nrow(return_Object[[1]]$pixel.idx) / (nrow(pixel.array) * ncol(pixel.array))
+        }
+        if (as.logical(bundle_pixelarray)) {
+            return_Object$pixel.array <- pixel.array
         }
     }
+    return(return_Object)
 }

R/rectangularRange_HSV.R

@@ -4,6 +4,7 @@
 #' When determining which pixels lie within the bounds, only the `hue`- and `saturation`-
 #' values are respected. The `value`-component is not considered.
 #' @inheritParams .main_args
+#' @param check_V boolean toggle to also check the `VALUE`-component of an HSV-pixel
 #'
 #' @return upon success, returns a list-object with the following elements:
 #' - `pixel.idx` - pixel-locations of pixels detected between lower and upper bound.
@@ -28,21 +29,22 @@
 #'     upper_bound = an_upper_bound
 #' )
 #' }
-rectangularRange_HSV <- function(pixel.array, upper_bound, lower_bound) {
+rectangularRange_HSV <- function(pixel.array, upper_bound, lower_bound, check_V = FALSE) {
     # pixel.array[X,Y,1,[H]]
     # pixel.array[X,Y,1,[S]]
     # pixel.array[X,Y,1,[V]]
-    # j <- (lower_bound[1] <= pixel.array[, , 1, 1] & pixel.array[, , 1, 1] <= upper_bound[1])
-    # k <- (lower_bound[2] <= pixel.array[, , 1, 2] & pixel.array[, , 1, 2] <= upper_bound[2])
-    idx <- which((lower_bound[1] <= pixel.array[, , 1, 1] & pixel.array[, , 1, 1] <= upper_bound[1])
-                 & (lower_bound[2] <= pixel.array[, , 1, 2] & pixel.array[, , 1, 2] <= upper_bound[2])
-                 # & (lower_bound[3] <= pixel.array[, , 1, 3] & pixel.array[, , 1, 3] <= upper_bound[3])
-                 ,arr.ind = TRUE
-    )
-    dimnames(idx)[[2]] <- c("x","y")
-    if (length(idx) == 0) { # no pixels match the requirements.
-        return(idx)
+    if (as.logical(check_V)) {
+        idx <- which((lower_bound[1] <= pixel.array[, , 1, 1] & pixel.array[, , 1, 1] <= upper_bound[1])
+                     & (lower_bound[2] <= pixel.array[, , 1, 2] & pixel.array[, , 1, 2] <= upper_bound[2])
+                     & (lower_bound[3] <= pixel.array[, , 1, 3] & pixel.array[, , 1, 3] <= upper_bound[3])
+                     ,arr.ind = TRUE
+                     )
     } else {
-        return(idx)
+        idx <- which((lower_bound[1] <= pixel.array[, , 1, 1] & pixel.array[, , 1, 1] <= upper_bound[1])
+                     & (lower_bound[2] <= pixel.array[, , 1, 2] & pixel.array[, , 1, 2] <= upper_bound[2])
+                     ,arr.ind = TRUE
+                     )
     }
+    dimnames(idx)[[2]] <- c("x","y")
+    return(idx)
 }

_pkgdown.yml

@@ -10,6 +10,7 @@ reference:
       - '`extract_pixels_HSV`'
       - '`rectangularRange_HSV`'
       - '`rectangularRange_HSV_cpp`'
+      - '`rectangularRange_HSV_iteronce_cpp`'
   - title: Conversion & Modification
     desc: modification or conversion of objects
     contents: