#' Threshold every image frame in an image stack based on their mean.
#'
#' An [ijtiff_img][ijtiff::ijtiff_img] is a 4-dimensional array indexed by
#' `img[y, x, channel, frame]`. For each channel (which consists of a stack of
#' frames), this function finds a threshold based on the sum all of the frames,
#' uses this to create a mask and then applies this mask to every frame in the
#' stack (so for a given pillar in the image stack, either all the pixels
#' therein are thresholded away or all are untouched, where pillar `x,y` of
#' channel `ch` is `img[y, x, ch, ]`).
#'
#' It's called `mean_stack_thresh()` and not `sum_stack_thresh()` because its
#' easier for people to visualize the mean of an image series than to visualize
#' the sum, but for the sake of this procedure, both are equivalent, except for
#' the fact that the thresholding routine invoked inside this function prefers
#' integers, which we get by using a sum but not by using a mean.
#'
#' \itemize{\item Values greater than or equal to the found threshold
#' \emph{pass} the thresholding and values less than the threshold \emph{fail}
#' the thresholding.
#'
#' \item{For `ignore_white = TRUE`, if the maximum value in the array is one of
#' `2^8-1`, `2^16-1` or `2^32-1`, then those max values are ignored.
#' That's because they're the white values in 8, 16 and 32-bit images
#' respectively (and these are the common image bit sizes to work with). This
#' guesswork has to be done because `R` does not know how many bits the image
#' was on disk. This guess is very unlikely to be wrong, and if it is, the
#' consequences are negligible anyway. If you're very concerned, then just
#' specify the white value as an integer in this `ignore_white` argument.}
#'
#' \item{If you have set `ignore_black = TRUE` and/or `ignore_white = TRUE` but
#' you are still getting error/warning messages telling you to try them, then
#' your chosen method is not working for the given array, so you should try a
#' different method.}
#'
#' \item For a given array, if all values are less than `2^8`, saturated value
#' is `2^8 - 1`, otherwise, saturated value is `2^16 - 1`. }
#'
#' @param img A 4-dimensional array in the style of an
#' [ijtiff_img][ijtiff::ijtiff_img] (indexed by `img[y, x, channel, frame]`)
#' or a 3-dimensional array which is a single channel of an
#' [ijtiff_img][ijtiff::ijtiff_img] (indexed by `img[y, x, frame]`).
#' @param method The name of the thresholding method you wish to use. The
#' available methods are `"IJDefault"`, `"Huang"`, `"Huang2"`, `"Intermodes"`,
#' `"IsoData"`, `"Li"`, `"MaxEntropy"`, `"Mean"`, `"MinErrorI"`, `"Minimum"`,
#' `"Moments"`, `"Otsu"`, `"Percentile"`, `"RenyiEntropy"`, `"Shanbhag"`,
#' `"Triangle"` and `"Yen"`. Partial matching is performed i.e. `method = "h"`
#' is enough to get you `"Huang"` and `method = "in"` is enough to get you
#' `"Intermodes"`. To perform \emph{manual} thresholding (where you set the
#' threshold yourself), supply the threshold here as a number e.g. `method =
#' 3.8` (so note that this would \emph{not} select the third method in the
#' above list of methods). This manual threshold will then be used to
#' threshold the sum stack to create a 2D mask and then this mask will be
#' applied to all frames in the stack. If you want a different method for each
#' channel, specify this parameter as a vector or list, one element per
#' channel.
#' @param ignore_black Ignore black pixels/elements (zeros) when performing the
#' thresholding?
#' @param ignore_white Ignore white pixels when performing the thresholding? If
#' set to `TRUE`, the function makes a good guess as to what the white
#' (saturated) value would be (see 'Details'). If this is set to a number, all
#' pixels with value greater than or equal to that number are ignored.
#' @param fail When using `auto_thresh_apply_mask()`, to what value do you wish
#' to set the pixels which fail to exceed the threshold? `fail = 'saturate'`
#' sets them to saturated value (see 'Details'). `fail = 'zero'` sets them to
#' zero. You can also specify directly here a natural number (must be between
#' `0` and `2^16 - 1`) to use.
#' @param ignore_na This should be `TRUE` if `NA`s in `int_arr` should be
#' ignored or `FALSE` if you want the presence of `NA`s in `int_arr` to throw
#' an error.
#'
#' @return An object of class [stack_threshed_img] which is the thresholded
#' image (an array in the style of an [ijtiff_img][ijtiff::ijtiff_img]).
#' Pillars not exceeding the threshold are set to the `fail` value (default
#' `NA`).
#'
#' @examples
#' \donttest{
#' img <- ijtiff::read_tif(system.file("extdata", "50.tif",
#' package = "autothresholdr"
#' ))
#' ijtiff::display(img[, , 1, 1])
#' img_thresh_mask <- mean_stack_thresh(img, "Otsu")
#' ijtiff::display(img_thresh_mask[, , 1, 1])
#' ijtiff::display(img[, , 1, 1])
#' img_thresh_mask <- mean_stack_thresh(img, "Huang")
#' ijtiff::display(img_thresh_mask[, , 1, 1])
#' }
#' @export
mean_stack_thresh <- function(img, method, fail = NA,
ignore_black = FALSE, ignore_white = FALSE,
ignore_na = FALSE) {
checkmate::assert_array(img, min.d = 3, max.d = 4)
checkmate::assert_numeric(img, lower = 0)
if (all(is.na(img))) {
custom_stop(
"`img` cannot be all `NA`s.",
"Every element of your `img` is `NA`."
)
}
if (max(img, na.rm = TRUE) > .Machine$integer.max) {
custom_stop(
"All elements of `img` must be in the integer range.",
"
Your maximum element is
{format(max(img, na.rm = TRUE), scientific = FALSE)},
which is greater than the maximum allowed value for an `int`,
{format(.Machine$integer.max, scientific = FALSE)}.
"
)
}
if (!isTRUE(all.equal(floor(img), img, check.attributes = FALSE))) {
img[is.na(img)] <- 0
bad_index <- match(
FALSE,
as.vector(img) %>% {
. != floor(.)
}
)
custom_stop(
"`img` must be an array of integers.",
"
Element {format(bad_index, scientific = FALSE)} of `img` is
{format(img[bad_index], scientific = FALSE)}, which is not an integer.
"
)
}
if (length(dim(img)) == 3) {
dim(img) %<>% {
c(.[1:2], 1, .[3])
}
}
d <- dim(img)
n_ch <- dim(img)[3]
out <- array(as.vector(img), dim = d)
if (length(method) == 1) method %<>% rep(n_ch)
thresh <- as.list(seq_len(n_ch))
for (i in seq_len(n_ch)) {
if (length(unique(as.vector(img[, , i, ]))) == 1) {
custom_stop(
"Constant arrays cannot bbe thresholded.",
"The array given for thresholding is constant. ",
"All values are equal to {format(img[[1]], scientific = FALSE)}."
)
}
fail <- translate_fail(img, fail)
if (is.numeric(method[[i]])) {
thresh[[i]] <- method[[i]]
} else {
sum_stack <- sum_pillars(structure(img[, , i, ], dim = dim(img)[-3]))
scaling_factor <- 1 # we do this in case the sum stack has big elements
max32int <- 2^31 - 1
mx <- max(sum_stack)
if (mx > max32int) {
scaling_factor <- max32int / mx
sum_stack <- round(sum_stack * scaling_factor)
}
thresh[[i]] <- auto_thresh(sum_stack, method[[i]],
ignore_black = ignore_black,
ignore_white = ignore_white,
ignore_na = ignore_na
) %T>% {
thresh_atts <- attributes(.)
. <- . / (scaling_factor * d[4])
attributes(.) <- thresh_atts
}
}
if (inherits(thresh[[i]], "integer") &&
!isTRUE(checkmate::check_integerish(as.vector(thresh[[i]])))) {
class(thresh[[i]]) %<>% setdiff("integer")
}
mean_stack <- mean_pillars(structure(img[, , i, ], dim = dim(img)[-3]))
mean_stack_mask <- mean_stack >= thresh[[i]]
set_indices <- rep(!as.vector(mean_stack_mask), d[4])
out[, , i, ][set_indices] <- fail
}
if (length(thresh) == 1) thresh <- thresh[[1]]
stack_threshed_img(
img = out, thresh = thresh, fail_value = fail,
stack_thresh_method = "mean"
)
}
#' Threshold every image frame in a stack based on their median.
#'
#' An [ijtiff_img][ijtiff::ijtiff_img] is a 4-dimensional array indexed by
#' `img[y, x, channel, frame]`. For each channel (which consists of a stack of
#' frames), this function finds a threshold based on all of the frames, then
#' takes the median of all the frames in the stack image, uses this to create a
#' mask with the found threshold and then applies this mask to every frame in
#' the stack (so for a given pillar in the image stack, either all the pixels
#' therein are thresholded away or all are untouched, where pillar `x,y` of
#' channel `ch` is `img[y, x, ch, ]`).
#'
#' \itemize{\item Values greater than or equal to the found threshold
#' \emph{pass} the thresholding and values less than the threshold \emph{fail}
#' the thresholding.
#'
#' \item{For `ignore_white = TRUE`, if the maximum value in the array is one of
#' `2^8-1`, `2^16-1` or `2^32-1`, then those max values are ignored.
#' That's because they're the white values in 8, 16 and 32-bit images
#' respectively (and these are the common image bit sizes to work with). This
#' guesswork has to be done because `R` does not know how many bits the image
#' was on disk. This guess is very unlikely to be wrong, and if it is, the
#' consequences are negligible anyway. If you're very concerned, then just
#' specify the white value as an integer in this `ignore_white` argument.}
#'
#' \item{If you have set `ignore_black = TRUE` and/or `ignore_white = TRUE` but
#' you are still getting error/warning messages telling you to try them, then
#' your chosen method is not working for the given array, so you should try a
#' different method.}
#'
#' \item For a given array, if all values are less than `2^8`, saturated value
#' is `2^8 - 1`, otherwise, saturated value is `2^16 - 1`. }
#'
#' @param img A 3-dimensional array (the image stack, possibly a time-series of
#' images) where the \eqn{n}th slice is the \eqn{n}th image in the stack.
#' @param method The name of the thresholding method you wish to use. The
#' available methods are `"IJDefault"`, `"Huang"`, `"Huang2"`, `"Intermodes"`,
#' `"IsoData"`, `"Li"`, `"MaxEntropy"`, `"Mean"`, `"MinErrorI"`, `"Minimum"`,
#' `"Moments"`, `"Otsu"`, `"Percentile"`, `"RenyiEntropy"`, `"Shanbhag"`,
#' `"Triangle"` and `"Yen"`. Partial matching is performed i.e. `method = "h"`
#' is enough to get you `"Huang"` and `method = "in"` is enough to get you
#' `"Intermodes"`. To perform \emph{manual} thresholding (where you set the
#' threshold yourself), supply the threshold here as a number e.g. `method =
#' 3` (so note that this would \emph{not} select the third method in the above
#' list of methods). This manual threshold will then be used to threshold the
#' median stack to create a 2D mask and then this mask will be applied to all
#' frames in the stack. If you want a different method for each channel,
#' specify this parameter as a vector or list, one element per channel.
#' @param ignore_black Ignore black pixels/elements (zeros) when performing the
#' thresholding?
#' @param ignore_white Ignore white pixels when performing the thresholding? If
#' set to `TRUE`, the function makes a good guess as to what the white
#' (saturated) value would be (see 'Details').
#' @param fail When using `auto_thresh_apply_mask()`, to what value do you wish
#' to set the pixels which fail to exceed the threshold? `fail = 'saturate'`
#' sets them to saturated value (see 'Details'). `fail = 'zero'` sets them to
#' zero. You can also specify directly here a natural number (must be between
#' `0` and `2^32 - 1`) to use.
#' @param ignore_na This should be `TRUE` if `NA`s in `int_arr` should be
#' ignored or `FALSE` if you want the presence of `NA`s in `int_arr` to throw
#' an error.
#'
#' @return An object of class [stack_threshed_img] which is the thresholded
#' image (an array in the style of an [ijtiff_img][ijtiff::ijtiff_img]).
#' Pillars not exceeding the threshold are set to the `fail` value (default
#' `NA`).
#'
#' @examples
#' \donttest{
#' img <- ijtiff::read_tif(system.file("extdata", "50.tif",
#' package = "autothresholdr"
#' ))
#' ijtiff::display(img[, , 1, 1])
#' img_thresh_mask <- med_stack_thresh(img, "Otsu")
#' ijtiff::display(img_thresh_mask[, , 1, 1])
#' ijtiff::display(img[, , 1, 1])
#' img_thresh_mask <- med_stack_thresh(img, "Triangle")
#' ijtiff::display(img_thresh_mask[, , 1, 1])
#' }
#' @export
med_stack_thresh <- function(img, method, fail = NA,
ignore_black = FALSE, ignore_white = FALSE,
ignore_na = FALSE) {
checkmate::assert_array(img, min.d = 3, max.d = 4)
checkmate::assert_numeric(img, lower = 0)
if (all(is.na(img))) {
custom_stop(
"`img` cannot be all `NA`s.",
"Every element of your `img` is `NA`."
)
}
if (max(img, na.rm = TRUE) > .Machine$integer.max) {
custom_stop(
"All elements of `img` must be in the integer range.",
"
Your maximum element is
{format(max(img, na.rm = TRUE), scientific = FALSE)},
which is greater than the maximum allowed value for an `int`,
{format(.Machine$integer.max, scientific = FALSE)}.
"
)
}
if (!isTRUE(all.equal(floor(img), img, check.attributes = FALSE))) {
img[is.na(img)] <- 0
bad_index <- match(
FALSE,
as.vector(img) %>% {
. != floor(.)
}
)
custom_stop(
"`img` must be an array of integers.",
"
Element {format(bad_index, scientific = FALSE)} of `img` is
{format(img[bad_index], scientific = FALSE)}, which is not an integer.
"
)
}
if (length(dim(img)) == 3) {
dim(img) %<>% {
c(.[1:2], 1, .[3])
}
}
d <- dim(img)
n_ch <- dim(img)[3]
out <- array(as.vector(img), dim = d)
if (length(method) == 1) method %<>% rep(n_ch)
thresh <- as.list(seq_len(n_ch))
for (i in seq_len(n_ch)) {
if (length(unique(as.vector(img[, , i, ]))) == 1) {
custom_stop(
"Constant arrays cannot bbe thresholded.",
"The array given for thresholding is constant. ",
"All values are equal to {format(img[[1]], scientific = FALSE)}."
)
}
fail <- translate_fail(img, fail)
thresh[[i]] <- auto_thresh(img[, , i, ], method[[i]],
ignore_black = ignore_black,
ignore_white = ignore_white,
ignore_na = ignore_na
)
med_stack <- median_pillars(structure(img[, , i, ], dim = dim(img)[-3]))
med_stack_mask <- med_stack >= thresh[[i]]
set_indices <- rep(!as.vector(med_stack_mask), d[4])
out[, , i, ][set_indices] <- fail
}
stack_threshed_img(
img = out, thresh = thresh, fail_value = fail,
stack_thresh_method = "median"
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.