Nothing
#' Number and brightness image classes.
#'
#' The `number_img` and `brightness_img` classes are designed to hold objects
#' which are images calculated from the *number and brightness* technique.
#'
#' An object of class `number_img` or `brightness_img` is a 4-dimensional array
#' of real numbers in the mould of an [ijtiff_img][ijtiff::ijtiff_img] (indexed
#' as `img[y, x, channel, frame]`) with 4 attributes: \describe{\item{`def`}{Are
#' we using the `"N"` or `"n"` definition of number, or the `"B"` or `"epsilon"`
#' definition of brightness?} \item{`thresh`}{A positive integer, possibly an
#' object of class [autothresholdr::th] detailing which threshold and
#' thresholding method was used in preprocessing (in the multi-channel case, one
#' threshold per channel is given).} \item{`swaps`}{A non-negative integer
#' indicating the number of swaps Robin Hood detrending, with an attribute
#' `auto` which is a logical indicating whether or not the parameter was chosen
#' automatically (in the multi-channel case, one threshold per channel is
#' given).}\item{`filt`}{Was mean or median filtering used in postprocessing?}}
#'
#' @param img The calculated number or brightness image.
#' @param def The number or brightness definition used.
#' @param thresh A positive integer, possibly an object of class
#' [autothresholdr::th]. If the different channels of the image had different
#' thresholds, this argument may be specified as a vector or list (of positive
#' integers, possibly objects of class [autothresholdr::th]), one element for
#' each channel.
#' @param swaps A non-negative integer with an attribute `auto`. If the
#' different channels of the image had different `swaps`, this argument may be
#' specified as a list (of non-negative integers with attributes `auto`), one
#' element for each channel. For undetrended images, set `swaps = NA`.
#' @param filt A string, the filtering method used. Must be either `"mean"` or
#' `"median"`, or `NA` for no filtering. If the different channels of the
#' image had different filters, this may be specified as a character vector,
#' one element for each channel.
#'
#' @return An object of class `number_img` or `brightness_img`.
#'
#' @name nb-img-classes
NULL
#' @rdname nb-img-classes
#' @export
number_img <- function(img, def, thresh, swaps, filt) {
checkmate::assert_array(img, min.d = 2, max.d = 3)
checkmate::assert_numeric(img)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
n_ch <- dim(img) %>% {
dplyr::if_else(length(.) == 3, .[3], 1L)
}
img %<>% number_img_common(
n_ch = n_ch, def = def,
thresh = thresh, swaps = swaps, filt = filt
)
class(img) %<>% c("number_img", .)
img
}
number_img_common <- function(img, n_ch, def, thresh, swaps, filt) {
checkmate::assert_string(def)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
if (!isTRUE(def %in% c("n", "N"))) {
custom_stop(
"Argument `def` must be one of 'n' or 'N'.",
"You have used `def = '{def}'`."
)
}
if (length(thresh) == 1 && n_ch > 1) {
thresh %<>% {
rep(list(.), n_ch)
}
}
if (length(swaps) == 1 && n_ch > 1) {
swaps %<>% {
rep(list(.), n_ch)
}
}
if (all(is.na(filt))) {
filt <- rep(NA, n_ch)
} else {
filt %<>% fix_filt()
}
if (length(filt) == 1 && n_ch > 1) filt %<>% rep(n_ch)
thresh %<>% c_list_attr_na()
swaps %<>% c_list_attr_na()
checkmate::assert_numeric(thresh)
for (i in seq_along(swaps)) {
if (is.na(swaps[[i]]) && (!"auto" %in% names(attributes(swaps[[i]])))) {
attr(swaps[[i]], "auto") <- FALSE
}
}
checkmate::assert_numeric(swaps, lower = 0)
if (!"auto" %in% names(attributes(swaps))) {
custom_stop(
"If swaps is specified, it must have an attribute 'auto'.",
"Your `swaps` has no attribute 'auto'."
)
} else if (length(swaps) != length(attr(swaps, "auto"))) {
if (length(attr(swaps, "auto")) == 1) {
attr(swaps, "auto") %<>% rep(length(swaps))
} else {
custom_stop("
The 'auto' attribute of `swaps`
must be the same length as 'swaps' itself.
", "
Your `swaps` has length {length(swaps)} and its 'auto' attribute
has length {length(attr(swaps, 'auto'))}.
")
}
}
checkmate::assert_logical(attr(swaps, "auto"))
if ((!all(is.na(swaps))) && anyNA(attr(swaps, "auto"))) {
autos <- purrr::map(swaps, attr, "auto") %>%
unlist()
i <- match(T, is.na(autos))
custom_stop("
Each element of `swaps` must have an associated attribute 'auto'
which must be `TRUE` or `FALSE` and not NA.
", "
Element {i} of `swaps` has an 'auto' attribute which is NA.
")
}
if (!filesstrings::all_equal(c(
length(thresh), length(swaps),
length(filt), n_ch
))) {
custom_stop(
"
The lengths of `thresh`, `swaps` and `filt` must all be the same
as the number of channels in `img`.
",
"There are {n_ch} channels in `img`.",
"`thresh` has length {length(thresh)}.",
"`swaps` has length {length(swaps)}.",
"`filt` has length {length(filt)}."
)
}
img %<>% structure(def = def, thresh = thresh, swaps = swaps, filt = filt)
if (length(dim(img)) < 4) {
if (n_ch == 1 && length(dim(img)) == 3) {
dim(img) <- c(dim(img)[1:2], 1, dim(img)[3])
} else {
dim(img) %<>% c(rep(1, max(0, 4 - length(.))))
}
}
img
}
#' @rdname nb-img-classes
#' @export
brightness_img <- function(img, def, thresh, swaps, filt) {
checkmate::assert_string(def)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
def %<>% tolower()
if (def == "b") {
def <- "B"
} else if (startsWith("epsilon", def)) {
def <- "epsilon"
} else {
if (!def %in% c("epsilon", "B")) {
custom_stop(
"`def` must be one of 'B' or 'epsilon'.",
"You have used `def = '{def}'`."
)
}
}
out <- number_img(img, "n", thresh, swaps, filt)
attr(out, "def") <- def
class(out)[class(out) == "number_img"] <- "brightness_img"
out
}
#' Number and brightness time series image classes.
#'
#' The `number_ts_img` and `brightness_ts_img` classes are designed to hold
#' objects which are images calculated from the *number and brightness*
#' technique.
#'
#' An object of class `number_ts_img` or `brightness_ts_img` is a 3- or
#' 4-dimensional array of real numbers with 4 attributes:
#' \describe{\item{`def`}{Are we using the `"N"` or `"n"` definition of number,
#' or the `"B"` or `"epsilon"` definition of brightness?} \item{`thresh`}{A
#' positive integer, possibly an object of class [autothresholdr::th] detailing
#' which threshold and thresholding method was used in preprocessing (in the
#' multi-channel case, one threshold per channel is given).} \item{`swaps`}{A
#' non-negative integer indicating the number of swaps used for Robin Hood
#' detrending, with an attribute `auto` which is a logical indicating whether or
#' not the parameter was chosen automatically (in the multi-channel case, one
#' `swaps` per channel is given).} \item{`frames_per_set`}{A positive integer
#' detailing how many frames were used in the calculation of each point in the
#' number or brightness time series.} \item{`overlapped`}{A boolean. `TRUE`
#' indicates that the windows used to calculate consecutive brightnesses over
#' time were overlapped, `FALSE` indicates that they were not.}}
#'
#' @param img The calculated number or brightness time series image series.
#' @inheritParams number_img
#' @param frames_per_set The number of frames used in the calculation of each
#' point in the number or brightness time series.
#' @param overlapped A boolean. `TRUE` indicates that the windows used to
#' calculate consecutive brightnesses over time were overlapped, `FALSE`
#' indicates that they were not.
#'
#' @return An object of class `number_ts_img` or `brightness_ts_img`.
#'
#' @seealso [number_timeseries()], [brightness_timeseries()].
#'
#' @name nb-ts-img-classes
NULL
#' @rdname nb-ts-img-classes
#' @export
number_ts_img <- function(img, def, frames_per_set, overlapped,
thresh, swaps, filt) {
checkmate::assert_array(img, min.d = 3, max.d = 4)
checkmate::assert_numeric(img)
checkmate::assert_flag(overlapped)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
n_ch <- dim(img) %>% {
dplyr::if_else(length(.) == 4, .[3], 1L)
}
img %<>% number_img_common(
n_ch = n_ch, def = def,
thresh = thresh, swaps = swaps, filt = filt
)
class(img) %<>% c("number_ts_img", .)
structure(img, frames_per_set = frames_per_set, overlapped = overlapped)
}
#' @rdname nb-ts-img-classes
#' @export
brightness_ts_img <- function(img, def, frames_per_set, overlapped,
thresh, swaps, filt) {
checkmate::assert_string(def)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
def %<>% tolower()
if (def == "b") {
def <- "B"
} else if (startsWith("epsilon", def)) {
def <- "epsilon"
} else {
if (!def %in% c("epsilon", "B")) {
custom_stop(
"`def` must be one of 'B' or 'epsilon'.",
"You have used `def = '{def}'`."
)
}
}
out <- number_ts_img(img, "n",
frames_per_set = frames_per_set, overlapped = overlapped,
thresh = thresh, swaps = swaps, filt = filt
)
attr(out, "def") <- def
class(out)[class(out) == "number_ts_img"] <- "brightness_ts_img"
out
}
#' Cross-correlated number and brightness image classes.
#'
#' The `cc_number_img` and `cc_brightness_img` classes are designed to hold
#' objects which are images calculated from the *cross-correlated number and
#' brightness* technique.
#'
#' An object of class `cc_number_img` or `cc_brightness_img` is a 4-dimensional
#' array of real numbers in the mould of an [ijtiff_img][ijtiff::ijtiff_img]
#' (indexed as `img[y, x, channel, frame]`) with 3 attributes:
#' \describe{\item{`thresh`}{A positive integer, possibly an object of class
#' [autothresholdr::th] detailing which threshold and thresholding method was
#' used in preprocessing (in the multi-channel case, one threshold per channel
#' is given).} \item{`swaps`}{A non-negative integer indicating the number of
#' swaps used for Robin Hood detrending, with an attribute `auto` which is a
#' logical indicating whether or not the parameter was chosen automatically (in
#' the multi-channel case, one `swaps` per channel is given).}\item{`filt`}{Was
#' mean or median filtering used in postprocessing?}}
#'
#' @param img The calculated cross-correlated number or brightness image.
#' @inheritParams nb-img-classes
#'
#' @return An object of class `cc_number_img` or `cc_brightness_img`.
#'
#' @name cc-nb-img-classes
NULL
#' @rdname cc-nb-img-classes
#' @export
cc_number_img <- function(img, thresh, swaps, filt) {
checkmate::assert_array(img, d = 2)
checkmate::assert_numeric(img)
checkmate::assert_string(filt, na.ok = TRUE)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
img %<>% cc_number_img_common(thresh = thresh, swaps = swaps, filt = filt)
class(img) %<>% c("cc_number_img", .)
img
}
#' @rdname cc-nb-img-classes
#' @export
cc_brightness_img <- function(img, thresh, swaps, filt) {
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
img %<>% cc_number_img(thresh = thresh, swaps = swaps, filt = filt)
class(img)[class(img) == "cc_number_img"] %<>%
stringr::str_replace("number", "brightness")
img
}
#' Cross-correlated number and brightness time series image classes.
#'
#' The `cc_number_ts_img` and `cc_brightness_ts_img` classes are designed to
#' hold objects which are images calculated from the *cross-correlated number
#' and brightness* technique.
#'
#' An object of class `cc_number_ts_img` or `cc_brightness_ts_img` is a
#' 4-dimensional array of real numbers in the mould of an
#' [ijtiff_img][ijtiff::ijtiff_img] with 3 attributes:
#' \describe{\item{`thresh`}{A positive integer, possibly an object of class
#' [autothresholdr::th] detailing which threshold and thresholding method was
#' used in preprocessing (in the multi-channel case, one threshold per channel
#' is given).} \item{`swaps`}{A non-negative integer indicating the parameter
#' used for Robin Hood detrending with an attribute `auto` which is a logical
#' indicating whether or not the parameter was chosen automatically (in the
#' multi-channel case, one `swaps` per channel is given).}
#' \item{`frames_per_set`}{A positive integer detailing how many frames were
#' used in the calculation of each point in the number or brightness time
#' series.} \item{`overlapped`}{A boolean. `TRUE` indicates that the windows
#' used to calculate consecutive brightnesses over time were overlapped, `FALSE`
#' indicates that they were not.}}
#'
#' @param img The calculated cross-correlated number or brightness time series
#' image series.
#' @inheritParams cc_number_img
#' @param frames_per_set The number of frames used in the calculation of each
#' point in the cross-correlated number or brightness time series.
#' @param overlapped A boolean. `TRUE` indicates that the windows used to
#' calculate consecutive brightnesses over time were overlapped, `FALSE`
#' indicates that they were not.
#'
#' @return An object of class `cc_number_ts_img` or `cc_brightness_ts_img`.
#'
#' @seealso [cc_number_timeseries()], [cc_brightness_timeseries()].
#'
#' @name cc-nb-ts-img-classes
NULL
#' @rdname cc-nb-ts-img-classes
#' @export
cc_number_ts_img <- function(img, frames_per_set, overlapped,
thresh, swaps, filt) {
checkmate::assert_array(img, d = 3)
checkmate::assert_numeric(img)
checkmate::assert_flag(overlapped)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
img %<>% cc_number_img_common(thresh = thresh, swaps = swaps, filt = filt)
class(img) %<>% c("cc_number_ts_img", .)
structure(img, frames_per_set = frames_per_set, overlapped = overlapped)
}
#' @rdname cc-nb-ts-img-classes
#' @export
cc_brightness_ts_img <- function(img, frames_per_set, overlapped,
thresh, swaps, filt) {
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
checkmate::assert_flag(overlapped)
img %<>% cc_number_ts_img(
frames_per_set = frames_per_set, overlapped = overlapped, thresh = thresh,
swaps = swaps, filt = filt
)
class(img)[class(img) == "cc_number_ts_img"] %<>%
stringr::str_replace("number", "brightness")
img
}
cc_number_img_common <- function(img, thresh, swaps, filt) {
checkmate::assert_numeric(img)
checkmate::assert_array(img, min.d = 2, max.d = 3)
for (i in seq_along(swaps)) checkmate::assert_count(swaps[[i]], na.ok = TRUE)
filt %<>% prepare_filt()
thresh %<>% c_list_attr_na()
swaps %<>% c_list_attr_na()
checkmate::assert_numeric(thresh)
for (i in seq_along(swaps)) {
if (is.na(swaps[[i]]) && (!"auto" %in% names(attributes(swaps[[i]])))) {
attr(swaps[[i]], "auto") <- FALSE
}
}
checkmate::assert_numeric(swaps, lower = 0)
if (!"auto" %in% names(attributes(swaps))) {
custom_stop(
"If swaps is specified, it must have an attribute 'auto'.",
"Your `swaps` has no attribute 'auto'."
)
} else if (length(swaps) != length(attr(swaps, "auto"))) {
if (length(attr(swaps, "auto")) == 1) {
attr(swaps, "auto") %<>% rep(length(swaps))
} else {
custom_stop("
The 'auto' attribute of `swaps`
must be the same length as 'swaps' itself.
", "
Your `swaps` has length {length(swaps)} and its 'auto' attribute
has length {length(attr(swaps, 'auto'))}.
")
}
}
checkmate::assert_logical(attr(swaps, "auto"))
if ((!all(is.na(swaps))) && anyNA(attr(swaps, "auto"))) {
custom_stop(
"
Each element of `swaps` must have an associated attribute 'auto'
which must be `TRUE` or `FALSE` and not NA.
",
"Element {i} of `swaps` has an 'auto' attribute which is NA."
)
}
checkmate::assert_numeric(thresh, len = 2)
checkmate::assert_numeric(swaps, len = 2)
checkmate::assert_string(filt, na.ok = TRUE)
if (length(dim(img)) == 3) {
dim(img) %<>% {
c(.[1:2], 1, .[3])
}
}
if (length(dim(img)) == 2) dim(img) %<>% c(1, 1)
structure(img, thresh = thresh, swaps = swaps, filt = filt)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.