Nothing
#' `ijtiff_img` class.
#'
#' A class for images which are read or to be written by the `ijtiff` package.
#'
#' @param img An array representing the image. \itemize{\item For a
#' single-plane, grayscale image, use a matrix `img[y, x]`. \item For a
#' multi-plane, grayscale image, use a 3-dimensional array `img[y, x, plane]`.
#' \item For a multi-channel, single-plane image, use a 4-dimensional array
#' with a redundant 4th slot `img[y, x, channel, ]` (see [ijtiff_img]
#' 'Examples' for an example). \item For a multi-channel, multi-plane image,
#' use a 4-dimensional array `img[y, x, channel, plane]`.}
#' @param ... Named arguments which are set as attributes.
#'
#' @return A 4 dimensional array representing an image, indexed by `img[y, x,
#' channel, frame]`, with selected attributes.
#'
#' @export
#'
#' @examples
#' img <- matrix(1:4, nrow = 2) # to be a single-channel, grayscale image
#' ijtiff_img(img, description = "single-channel, grayscale")
#' img <- array(seq_len(2^3), dim = rep(2, 3)) # 1 channel, 2 frame
#' ijtiff_img(img, description = "blah blah blah")
#' img <- array(seq_len(2^3), dim = c(2, 2, 2, 1)) # 2 channel, 1 frame
#' ijtiff_img(img, description = "blah blah")
#' img <- array(seq_len(2^4), dim = rep(2, 4)) # 2 channel, 2 frame
#' ijtiff_img(img, software = "R")
ijtiff_img <- function(img, ...) {
checkmate::assert_array(img, min.d = 2, max.d = 4)
if (is.logical(img)) {
atts <- attributes(img)
img <- as.numeric(img)
attributes(img) <- atts
}
checkmate::assert_numeric(img)
if (length(dim(img)) == 2) dim(img) <- c(dim(img), 1, 1)
if (length(dim(img)) == 3) {
dim(img) <- c(dim(img)[1:2], 1, dim(img)[3])
}
dots <- list(...)
if (length(dots)) {
namez <- names(dots)
if (is.null(namez) || any(namez == "")) {
rlang::abort(
c(
"All arguments in ... must be named.",
stringr::str_glue("Your argument {dots[[1]]} is not named.")
)
)
}
do_call_args <- c(list(img), dots)
img <- do.call(structure, do_call_args)
}
cls <- class(img)
if (is_EBImage(img)) img <- aperm(img, c(2, 1, 3, 4))
suppressWarnings(
class(img) <- unique(c("ijtiff_img", dplyr::setdiff(cls, "Image")))
)
img
}
#' @rdname ijtiff_img
#' @export
as_ijtiff_img <- ijtiff_img
#' Convert an [ijtiff_img] to an [EBImage::Image].
#'
#' This is for interoperability with the the `EBImage` package.
#'
#' The guess for the `colormode` is made as follows: * If `img` has an attribute
#' `color_space` with value `"RGB"`, then `colormode` is set to `"Color"`. *
#' Else if `img` has 3 or 4 channels, then `colormode` is set to `"Color"`. *
#' Else `colormode` is set to "Grayscale".
#'
#' @param img An [ijtiff_img] object (or something coercible to one).
#' @param colormode A numeric or a character string containing the color mode
#' which can be either `"Grayscale"` or `"Color"`. If not specified, a guess
#' is made. See 'Details'.
#' @param scale Scale values in an integer image to the range `[0, 1]`? Has no
#' effect on floating-point images.
#' @param force This function is designed to take [ijtiff_img]s as input. To
#' force any old array through this function, use `force = TRUE`, but take
#' care to check that the result is what you'd like it to be.
#'
#' @return An [EBImage::Image].
#'
#' @examples
#' if (rlang::is_installed("EBImage")) {
#' img <- read_tif(system.file("img", "Rlogo.tif", package = "ijtiff"))
#' str(img)
#' str(as_EBImage(img))
#' }
#' @export
as_EBImage <- function(img, colormode = NULL, scale = TRUE, force = TRUE) {
ebimg_check()
checkmate::assert_flag(scale)
checkmate::assert_flag(force)
if (!methods::is(img, "ijtiff_img")) {
if (methods::is(img, "Image")) {
return(img)
} else {
if (force) {
img <- ijtiff_img(img)
} else {
rlang::abort(
c(
paste(
" This function expects the input `img` to be of class",
"'ijtiff_img', however the `img` you have supplied is not."
),
i = paste(
"To force your array through this function, use",
"`force = TRUE`, but take care to",
"check that the result is what you'd like it to be."
)
)
)
}
}
}
if (is.null(colormode)) {
if (isTRUE(attr(img, "color_space") == "RGB")) {
colormode <- "color"
} else {
colormode <- dplyr::if_else(dim(img)[3] %in% 3:4, "color", "gray")
}
}
checkmate::assert_string(colormode)
colormode <- dplyr::if_else(
startsWith("colo", tolower(colormode)),
"Color", colormode
)
colormode <- dplyr::if_else(
startsWith("gr", tolower(colormode)),
"Gray", colormode
)
colormode <- strex::match_arg(colormode,
c("Color", "Colour", "Grayscale", "Greyscale"),
ignore_case = TRUE
)
colormode <- dplyr::if_else(colormode == "Colour", "Color", colormode)
colormode <- dplyr::if_else(colormode == "Greyscale", "Grayscale", colormode)
if (scale && can_be_intish(img)) {
lub <- max(lowest_upper_bound(img, c(2^c(8, 16, 32) - 1)), max(img),
na.rm = TRUE
)
if (!is.na(lub)) img <- img / lub
}
img <- aperm(img, c(2, 1, 3, 4))
if (length(dim(img)) == 4 && dim(img)[3] == 1) dim(img) <- dim(img)[-3]
EBImage::Image(img, colormode = colormode)
}
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.