test_that("Package 2-channel example I/O works", { set.seed(1) img0 <- read_tif(test_path("testthat-figs", "2ch_ij.tif"), msg = FALSE) expect_equal(dim(img0), c(15, 6, 2, 5)) img1 <- read_tif(system.file("img", "Rlogo-banana-red_green.tif", package = "ijtiff" ), msg = FALSE) expect_equal(dim(img1), c(155, 200, 2, 2)) img2 <- read_tif(test_path("testthat-figs", "Rlogo-banana-1-2.tif"), msg = FALSE ) expect_equal(dim(img2), c(155, 200, 3, 2)) img3 <- read_tif( test_path("testthat-figs", "Rlogo-banana-red_green_blue.tif"), msg = FALSE ) expect_equal(dim(img3), c(155, 200, 3, 2)) img4 <- read_tif(test_path("testthat-figs", "Rlogo-banana-red.tif"), msg = FALSE ) expect_equal(dim(img4), c(155, 200, 1, 2)) expect_equal(img3[, , 1, 1], img4[, , 1, 1]) v22 <- c(2, 2, 1, 1) a22 <- array(seq_len(prod(v22)), dim = v22) tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") write_tif(a22, tmptif, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v22) expect_equal(as.vector(in_tif), as.vector(a22), ignore_attr = FALSE) v2345 <- 2:5 a2345 <- array(seq_len(prod(v2345)), dim = v2345) suppressMessages( expect_message( write_tif(a2345, tmptif, overwrite = TRUE), "Writing.+.tif.+8-bit.+2x3 pixel image.+unsigned integer.+4 ch.+5 frames" ) ) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v2345) expect_equal(as.vector(in_tif), as.vector(a2345), ignore_attr = FALSE) expect_equal( as.vector(read_tif(tmptif, frames = c(3, 5), msg = FALSE)), as.vector(a2345[, , , c(3, 5)]) ) v22 <- c(2, 2, 1, 1) a22 <- array(sample.int(prod(v22)), dim = v22) tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") write_tif(a22, tmptif, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v22) expect_equal(as.vector(in_tif), as.vector(a22), ignore_attr = FALSE) v2345 <- 2:5 a2345 <- array(sample.int(prod(v2345)), dim = v2345) write_tif(a2345, tmptif, overwrite = TRUE, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v2345) expect_equal(as.vector(in_tif), as.vector(a2345), ignore_attr = FALSE) }) test_that("Package RGB I/O works", { img <- read_tif(system.file("img", "Rlogo.tif", package = "ijtiff"), msg = FALSE ) expect_equal(dim(img), c(76, 100, 4, 1)) }) test_that("8-bit unsigned integer TIFF I/O works", { set.seed(2) v2345 <- 2:5 a2345 <- array(sample.int(prod(v2345)), dim = v2345) tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") write_tif(a2345, tmptif, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v2345) expect_equal(as.vector(in_tif), as.vector(a2345), ignore_attr = FALSE) }) test_that("16-bit unsigned integer TIFF I/O works", { set.seed(3) v6789 <- 6:9 a6789 <- array(sample.int(prod(v6789)), dim = v6789) tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") tif_write(a6789, tmptif, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v6789) expect_equal(as.vector(in_tif), as.vector(a6789), ignore_attr = FALSE) }) test_that("32-bit unsigned integer TIFF I/O works", { set.seed(4) v1m <- c(20, 50, 10, 100) a1m <- array(sample.int(2^32 - 1, prod(v1m)), dim = v1m) tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") write_tif(a1m, tmptif, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v1m) expect_equal(as.vector(in_tif), as.vector(a1m), ignore_attr = FALSE) }) test_that("Float (real-numbered) TIFF I/O works", { set.seed(5) v2345 <- 2:5 a2345 <- array(sample.int(prod(v2345)), dim = v2345) + 0.5 tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") write_tif(a2345, paste0(tmptif, "f"), msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v2345) expect_equal(as.vector(in_tif), as.vector(a2345), ignore_attr = FALSE) a2345[9] <- NaN expect_error( write_tif(a2345, tmptif, msg = FALSE), "To enable overwriting, use `overwrite = TRUE`" ) write_tif(a2345, tmptif, overwrite = TRUE, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v2345) expect_equal(as.vector(in_tif), as.vector(a2345), ignore_attr = FALSE) }) test_that("Negative-numbered TIFF I/O works", { v2345 <- 2:5 a2345 <- array(sample.int(prod(v2345)), dim = v2345) a2345[1] <- -1 tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") write_tif(a2345, tmptif, msg = FALSE) in_tif <- read_tif(tmptif, msg = FALSE) expect_equal(dim(in_tif), v2345) expect_equal(as.vector(in_tif), as.vector(a2345), ignore_attr = FALSE) expect_equal(attr(in_tif, "sample_format"), "float") }) test_that("List returning works", { skip_if_not_installed("tiff") img1 <- matrix(0.5, nrow = 2, ncol = 2) img2 <- matrix(0.7, nrow = 3, ncol = 7) weird_list_img <- list(img1, img2) tmptif <- tempfile(fileext = ".tif") %>% stringr::str_replace_all(stringr::coll("\\"), "/") expect_equal(tiff::writeTIFF(weird_list_img, tmptif), 2) expect_error(read_tif(tmptif, msg = FALSE), "tried to return a list") expect_warning( read_tif(tmptif, list_safety = "warn", msg = FALSE), "returning a list" ) suppressMessages( expect_message( in_weird <- read_tif(tmptif, list_safety = "n"), "Reading a list of images with differing dimensions" ) ) purrr::map2( in_weird, purrr::map(weird_list_img, ~ floor(. * (2^8 - 1))), expect_equal, ignore_attr = TRUE ) }) test_that("TIFFErrorHandler_ works", { tmptxt <- tempfile(fileext = ".txt") %>% stringr::str_replace_all(stringr::coll("\\"), "/") writeLines(c("a", "b"), tmptxt) expect_error(suppressWarnings(tif_read(tmptxt)), "Cannot read TIFF header") }) test_that("write_tif() errors correctly", { aaaa <- array(0, dim = rep(4, 4)) expect_error( tif_write(aaaa, "path/", msg = FALSE), "path.+cannot end with.+/" ) expect_snapshot_error( write_tif(aaaa, "a", bits_per_sample = "abc", msg = FALSE) ) expect_snapshot_error(write_tif(aaaa, "a", bits_per_sample = 12)) aaaa[1] <- -2 * .Call("float_max_C", PACKAGE = "ijtiff") expect_snapshot_error(write_tif(aaaa, "a")) aaaa[1] <- -1 aaaa[2] <- 2 * .Call("float_max_C", PACKAGE = "ijtiff") expect_snapshot_error(write_tif(aaaa, "a")) aaaa[2] <- 1 aaaa[1] <- 0.5 expect_snapshot_error(write_tif(aaaa, "a", bits_per_sample = 16)) aaaa[1] <- 2^33 expect_snapshot_error(write_tif(aaaa, "a", bits_per_sample = 16)) aaaa[1] <- 2^20 expect_snapshot_error(write_tif(aaaa, "a", bits_per_sample = 16)) expect_snapshot_error( suppressWarnings(read_tif(test_path("testthat-figs", "bad_ij1.tif"))) ) expect_snapshot_error( suppressWarnings(read_tif(test_path("testthat-figs", "bad_ij2.tif"))) ) }) test_that("text-image-io works", { mm <- matrix(1:60, nrow = 4) dim(mm) <- c(dim(mm), 1, 1) tmpfl <- tempfile() %>% stringr::str_replace_all(stringr::coll("\\"), "/") txt_img_write(mm, tmpfl, msg = FALSE) tmpfl_txt <- strex::str_give_ext(tmpfl, "txt") expect_true(file.exists(tmpfl_txt)) expect_equal(as.vector(mm), as.vector(txt_img_read(tmpfl_txt, msg = FALSE)), ignore_attr = FALSE ) suppressMessages( expect_message( txt_img_read(tmpfl_txt, msg = TRUE), "Reading 4x15 pixel text image" ) ) file.remove(tmpfl_txt) skip_if_not_installed("abind") mmm <- abind::abind(mm, mm, along = 3) suppressMessages( expect_message( write_txt_img(mmm, tmpfl, rds = TRUE), "_ch1.txt and .+_ch2.txt" ) ) expect_equal(readRDS(strex::str_give_ext(tmpfl, "rds")), ijtiff_img(mmm)) tmpfl_txts <- paste0(tmpfl, "_ch", 1:2, ".txt") expect_equal( dir(strex::str_before_last(tmpfl, "/"), pattern = paste0( strex::str_after_last(tmpfl, "/"), ".+txt$" ) ), strex::str_after_last(tmpfl_txts, "/"), ignore_attr = FALSE ) expect_equal(unlist(lapply(tmpfl_txts, read_txt_img, msg = FALSE)), as.vector(mmm), ignore_attr = FALSE ) file.remove(tmpfl_txts) mmmm <- abind::abind(mmm, mmm, along = 4) write_txt_img(mmmm, tmpfl, msg = FALSE) tmpfl_txts <- paste0(tmpfl, c( "_ch1_frame1", "_ch1_frame2", "_ch2_frame1", "_ch2_frame2" ), ".txt") expect_equal( dir(strex::str_before_last(tmpfl, "/"), pattern = paste0( strex::str_after_last(tmpfl, "/"), ".+txt$" ) ), strex::str_after_last(tmpfl_txts, "/"), ignore_attr = FALSE ) expect_equal(unlist(lapply(tmpfl_txts, read_txt_img, msg = FALSE)), as.vector(mmmm), ignore_attr = FALSE ) bad_txt_img <- dplyr::tribble( ~col1, ~col2, 1, "5", 8, "y" ) tmpfl <- tempfile(fileext = ".txt") readr::write_tsv(bad_txt_img, tmpfl, col_names = FALSE) expect_error( read_txt_img(tmpfl), paste0( "`path` must be the path to a text file which is.+", "an array of.+numbers.", "* Column 2 of the text file at your `path`.+", "is not numeric." ) ) }) test_that("reading certain frames works", { `%T>%` <- magrittr::`%T>%` path <- test_path("testthat-figs", "2ch_ij.tif") img <- read_tif(path, "A", msg = FALSE) img12 <- read_tif(path, frames = 1:2, msg = FALSE) img34 <- read_tif(path, frames = 3:4, msg = FALSE) img25 <- read_tif(path, frames = c(2, 5), msg = FALSE) expect_equal( img[, , , c(1, 2)] %>% { list( dim(.), as.vector(.), attributes(img) %T>% { .[["dim"]] <- c(dim(img)[1:3], 2) } ) }, img12 %>% { list(dim(.), as.vector(.), attributes(.)) } ) expect_equal( img[, , , c(3, 4)] %>% { list( dim(.), as.vector(.), attributes(img) %T>% { .[["dim"]] <- c(dim(img)[1:3], 2) } ) }, img34 %>% { list(dim(.), as.vector(.), attributes(.)) } ) expect_equal( img[, , , c(2, 5)] %>% { list( dim(.), as.vector(.), attributes(img) %T>% { .[["dim"]] <- c(dim(img)[1:3], 2) } ) }, img25 %>% { list(dim(.), as.vector(.), attributes(.)) } ) expect_snapshot_error(read_tif(path, frames = 7)) }) test_that("Reading Mathieu's file works", { i2 <- read_tif(test_path("testthat-figs", "image2.tif"), msg = FALSE) expect_equal(dim(i2), c(200, 200, 6, 1)) expect_equal(dim(attr(i2, "color_map")), c(256, 3)) expect_equal(colnames(attr(i2, "color_map")), c("red", "green", "blue")) })