tests/testthat/test_imgData-methods.R

example(SpatialExperiment, echo = FALSE)

test_that("getImg/imgRaster/Source w/o imgData return NULL", {
    x <- spe
    imgData(x) <- NULL
    expect_null(getImg(x))
    expect_null(imgRaster(x))
    expect_null(imgSource(x))
})

# getImg -----------------------------------------------------------------------

test_that("getImg,sample_id=image_id='foo' throws error", {
    expect_error(getImg(spe, sample_id='foo', image_id='foo'))
})

test_that("getImg,sample_id=image_id=NULL returns a 'VirtualSpatialImage'", {
    x <- getImg(spe, sample_id=NULL, image_id=NULL)
    y <- imgData(spe)$data[[1]]
    expect_is(x, "VirtualSpatialImage")
    expect_identical(x, y)
})

test_that("getImg,sample_id=image_id=TRUE returns a list", {
    x <- getImg(spe, sample_id=TRUE, image_id=TRUE)
    y <- imgData(spe)$data
    expect_is(x, "list")
    expect_identical(x, y)
})

test_that("getImg handles non-character sample/image_id (#151)", {
    . <- (spe$sample_id <- factor(spe$sample_id))[1]
    expect_silent(getImg(spe, sample_id=.))
    . <- (spe$sample_id <- as.integer(spe$sample_id))[1]
    expect_silent(getImg(spe, sample_id=.))
    . <- imgData(spe)$image_id <- 1
    expect_silent(getImg(spe, image_id=.))
    expect_silent(getImg(spe, image_id=as.factor(.)))
})

# addImg -----------------------------------------------------------------------

test_that("addImg for existing sample_id,image_id throws error", {
    i <- sample(nrow(df <- imgData(spe)), 1)
    expect_error(addImg(spe, 
        imageSource=imgSource(spe), scaleFactor=NA_real_,
        sample_id=df$sample_id[i], image_id=df$image_id[i]))
})

# rmvImg -----------------------------------------------------------------------

test_that("rmvImg drops specified imgData entry", {
    i <- sample(nrow(df <- imgData(spe)), 1)
    x <- rmvImg(spe, sample_id=df$sample_id[i], image_id=df$image_id[i])
    expect_identical(imgData(x), imgData(spe)[-i, ])
})

# imgSource --------------------------------------------------------------------

test_that("imgSource,sample_id=image_id='foo' throws error", {
    expect_error(imgSource(spe, sample_id='foo', image_id='foo'))
})

test_that("imgSource,sample_id=image_id=NULL returns character", {
    x <- imgSource(spe, sample_id=NULL, image_id=NULL)
    y <- imgSource(imgData(spe)$data[[1]])
    expect_is(x, "character")
    expect_identical(x, y)
})

test_that("imgSource,sample_id=image_id=TRUE returns character vector", {
    x <- imgSource(spe, sample_id=TRUE, image_id=TRUE)
    y <- vapply(imgData(spe)$data, imgSource, character(1))
    expect_is(x, "character")
    expect_identical(x, y)
})

# imgRaster --------------------------------------------------------------------

test_that("imgRaster,sample_id=image_id='foo' throws error", {
    expect_error(imgRaster(spe, sample_id='foo', image_id='foo'))
})

test_that("imgRaster,sample_id=image_id=NULL returns character", {
    x <- imgRaster(spe, sample_id=NULL, image_id=NULL)
    y <- imgRaster(imgData(spe)$data[[1]])
    expect_is(x, "raster")
    expect_identical(x, y)
})

test_that("imgRaster,sample_id=image_id=TRUE returns raster list", {
    x <- imgRaster(spe, sample_id=TRUE, image_id=TRUE)
    y <- lapply(imgData(spe)$data, imgRaster)
    expect_is(x, "list")
    expect_true(all(vapply(x, class, character(1)) == "raster"))
    expect_identical(x, y)
})
drighelli/VisiumExperiment documentation built on June 30, 2024, 10:55 a.m.