tests/testthat/test-io.R

In ijtiff: Comprehensive TIFF I/O with Full Support for 'ImageJ' TIFF Files

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"))
})