tests/testthat/test-SparseArray-Compare-methods.R

.test_Compare_SVT1_v2 <- function(a1, svt1, y)
{
    ## svt1 == y
    if (y == 0) {
	expect_error(svt1 == y, "not supported")
	expect_error(y == svt1, "not supported")
    } else {
        a <- a1 == y
        svt <- svt1 == y
        check_SVT_SparseArray_object(svt, a)
        svt <- y == svt1
        check_SVT_SparseArray_object(svt, a)
    }

    ## svt1 != y
    if (y != 0) {
	expect_error(svt1 != y, "not supported")
	expect_error(y != svt1, "not supported")
    } else {
        a <- a1 != y
        svt <- svt1 != y
        check_SVT_SparseArray_object(svt, a)
        svt <- y != svt1
        check_SVT_SparseArray_object(svt, a)
    }

    ## svt1 <= y
    if (type(svt1) == "complex" || type(y) == "complex") {
	expect_error(svt1 <= y, "invalid comparison with complex values")
	expect_error(y >= svt1, "invalid comparison with complex values")
    } else if (y >= 0) {
	expect_error(svt1 <= y, "not supported")
	expect_error(y >= svt1, "not supported")
    } else {
        a <- a1 <= y
        svt <- svt1 <= y
        check_SVT_SparseArray_object(svt, a)
        svt <- y >= svt1
        check_SVT_SparseArray_object(svt, a)
    }

    ## svt1 >= y
    if (type(svt1) == "complex" || type(y) == "complex") {
	expect_error(svt1 >= y, "invalid comparison with complex values")
	expect_error(y <= svt1, "invalid comparison with complex values")
    } else if (y <= 0) {
	expect_error(svt1 >= y, "not supported")
	expect_error(y <= svt1, "not supported")
    } else {
        a <- a1 >= y
        svt <- svt1 >= y
        check_SVT_SparseArray_object(svt, a)
        svt <- y <= svt1
        check_SVT_SparseArray_object(svt, a)
    }

    ## svt1 < y
    if (type(svt1) == "complex" || type(y) == "complex") {
        expect_error(svt1 < y, "invalid comparison with complex values")
        expect_error(y > svt1, "invalid comparison with complex values")
    } else if (type(y) %in% c("raw", "logical") || y > 0) {
	expect_error(svt1 < y, "not supported")
        expect_error(y > svt1, "not supported")
    } else {
        a <- a1 < y
        svt <- svt1 < y
        check_SVT_SparseArray_object(svt, a)
        svt <- y > svt1
        check_SVT_SparseArray_object(svt, a)
    }

    ## svt1 > y
    if (type(svt1) == "complex" || type(y) == "complex") {
        expect_error(svt1 > y, "invalid comparison with complex values")
        expect_error(y < svt1, "invalid comparison with complex values")
    } else if (y < 0) {
        expect_error(svt1 > y, "not supported")
        expect_error(y < svt1, "not supported")
    } else {
        a <- a1 > y
        svt <- svt1 > y
        check_SVT_SparseArray_object(svt, a)
        svt <- y < svt1
        check_SVT_SparseArray_object(svt, a)
    }
}

.test_Compare_SVT1_SVT2 <- function(a1, a2, svt1, svt2)
{
    ## svt1 != svt2
    a <- a1 != a2
    svt <- svt1 != svt2
    check_SVT_SparseArray_object(svt, a)

    ## svt1 < svt2
    if (type(svt1) == "complex" || type(svt2) == "complex") {
        expect_error(svt1 < svt2, "invalid comparison with complex values")
    } else {
        a <- a1 < a2
        svt <- svt1 < svt2
        check_SVT_SparseArray_object(svt, a)
    }

    ## svt1 > svt2
    if (type(svt1) == "complex" || type(svt2) == "complex") {
        expect_error(svt1 > svt2, "invalid comparison with complex values")
    } else {
        a <- a1 > a2
        svt <- svt1 > svt2
        check_SVT_SparseArray_object(svt, a)
    }
}

test_that("'Compare' ops between SVT_SparseArray object and single value", {
    ## "integer" array.
    a1 <- array(0L, 6:4)
    dimnames(a1) <- list(letters[1:6], NULL, LETTERS[1:4])
    a1[c(2:3, 6), 2, 1] <- 101:103
    a1[c(1, 6), 1 , 2] <- 201:202
    a1[1:5, 5, 3] <- -(301:305)
    a1[1, 3, 2] <- NA

    ## "double" array.
    a2 <- a1
    a2[3:6, 3, 2] <- c(NA, NaN, Inf, -Inf)

    ## "raw" array.
    a3 <- a1
    suppressWarnings(type(a3) <- "raw")

    ## "logical" array.
    a4 <- a1
    type(a4) <- "logical"

    ## "complex" array.
    a5 <- a2
    a5[4, , 1] <- (0.2 - 3i)^(1:5)
    a5[4:6, 4, 2] <- c(NaN, Inf, -Inf) + 3i
    a5[4:6, 4, 2] <- 0.2 + 1i * c(NaN, Inf, -Inf)

    ## Empty array.
    a0 <- a1[ , 0, ]

    for (a in list(a1, a2, a3, a4, a5, a0)) {
        svt <- as(a, "SVT_SparseArray")
        .test_Compare_SVT1_v2(a, svt, integer(1))
        .test_Compare_SVT1_v2(a, svt, 102L)
        .test_Compare_SVT1_v2(a, svt, -302L)
        .test_Compare_SVT1_v2(a, svt, raw(1))
        .test_Compare_SVT1_v2(a, svt, as.raw(102L))
        .test_Compare_SVT1_v2(a, svt, FALSE)
        .test_Compare_SVT1_v2(a, svt, TRUE)
        .test_Compare_SVT1_v2(a, svt, double(1))
        .test_Compare_SVT1_v2(a, svt, 102.5)
        .test_Compare_SVT1_v2(a, svt, -302.0)
        .test_Compare_SVT1_v2(a, svt, Inf)
        .test_Compare_SVT1_v2(a, svt, -Inf)
        .test_Compare_SVT1_v2(a, svt, complex(1))
        .test_Compare_SVT1_v2(a, svt, 0+9.5i)
        .test_Compare_SVT1_v2(a, svt, -302+0i)
        .test_Compare_SVT1_v2(a, svt, -302+9.5i)
        .test_Compare_SVT1_v2(a, svt, Inf+9.5i)
        .test_Compare_SVT1_v2(a, svt, -Inf+9.5i)
    }

    ## Not expected to work.
    svt1 <- as(a1, "SVT_SparseArray")
    for (y in list(NA, NaN, 11:15, numeric(0), list(-0.22))) {
        expect_error(svt1 == y, "not supported")
        expect_error(y == svt1, "not supported")
        expect_error(svt1 != y, "not supported")
        expect_error(y != svt1, "not supported")
        expect_error(svt1 <= y, "not supported")
        expect_error(y >= svt1, "not supported")
        expect_error(svt1 >= y, "not supported")
        expect_error(y <= svt1, "not supported")
        expect_error(svt1 < y, "not supported")
        expect_error(y > svt1, "not supported")
        expect_error(svt1 > y, "not supported")
        expect_error(y < svt1, "not supported")
    }
})

test_that("'Compare' ops between 2 SVT_SparseArray objects", {
    ## "integer" arrays.
    a1 <- array(0L, 6:4)
    dimnames(a1) <- list(letters[1:6], NULL, LETTERS[1:4])
    a1[c(2:3, 6), 2, 1] <- 101:103
    a1[c(1, 6), 1 , 2] <- 201:202
    a1[1:5, 5, 3] <- -(301:305)
    a1[ , 3, 2] <- NA

    a2 <- a1
    dimnames(a2) <- list(NULL, letters[22:26], LETTERS[23:26])
    a2[c(1, 2, 6), 2, 1] <- c(-3L, 100L, 104L)
    a2[2:6, 3, 1] <- -2:2
    a2[ , 3, 2] <- c(-1:3, NA)

    svt1 <- as(a1, "SVT_SparseArray")
    svt2 <- as(a2, "SVT_SparseArray")
    .test_Compare_SVT1_SVT2(a1, a2, svt1, svt2)
    .test_Compare_SVT1_SVT2(a2, a1, svt2, svt1)
    .test_Compare_SVT1_SVT2(a1, a1, svt1, svt1)
    .test_Compare_SVT1_SVT2(a2, a2, svt2, svt2)

    ## "double" arrays.
    a3 <- a1
    a3[ , 1, 3] <- NaN
    a3[ , 2, 3] <- Inf
    a3[ , 3, 3] <- -Inf
    a4 <- a2
    a4[ , 1:3, 3] <- c(-1, NA, 2, NaN, Inf, -Inf)

    svt3 <- as(a3, "SVT_SparseArray")
    svt4 <- as(a4, "SVT_SparseArray")
    .test_Compare_SVT1_SVT2(a3, a4, svt3, svt4)
    .test_Compare_SVT1_SVT2(a4, a3, svt4, svt3)
    .test_Compare_SVT1_SVT2(a3, a3, svt3, svt3)
    .test_Compare_SVT1_SVT2(a4, a4, svt4, svt4)

    ## "raw" arrays.
    a5 <- a1
    a6 <- a2
    suppressWarnings(type(a5) <- type(a6) <- "raw")

    svt5 <- as(a5, "SVT_SparseArray")
    svt6 <- as(a6, "SVT_SparseArray")
    .test_Compare_SVT1_SVT2(a5, a6, svt5, svt6)
    .test_Compare_SVT1_SVT2(a6, a5, svt6, svt5)
    .test_Compare_SVT1_SVT2(a5, a5, svt5, svt5)
    .test_Compare_SVT1_SVT2(a6, a6, svt6, svt6)

    ## "logical" arrays.
    a7 <- a1
    a8 <- a2
    type(a7) <- type(a8) <- "logical"

    svt7 <- as(a7, "SVT_SparseArray")
    svt8 <- as(a8, "SVT_SparseArray")
    .test_Compare_SVT1_SVT2(a7, a8, svt7, svt8)
    .test_Compare_SVT1_SVT2(a8, a7, svt8, svt7)
    .test_Compare_SVT1_SVT2(a7, a7, svt7, svt7)
    .test_Compare_SVT1_SVT2(a8, a8, svt8, svt8)

    ## "complex" arrays.
    a9 <- a3
    a10 <- a4
    a9[4, , 1] <- (0.2 - 3i)^(1:5)
    a9[4:6, 4, 2] <- 0.2 + 1i * c(NaN, Inf, -Inf)
    a10[4:6, 3, 2] <- c(NaN, Inf, -Inf) + 3i
    a10[ , 4, 2] <- NaN

    svt9 <- as(a9, "SVT_SparseArray")
    svt10 <- as(a10, "SVT_SparseArray")
    .test_Compare_SVT1_SVT2(a9, a10, svt9, svt10)
    .test_Compare_SVT1_SVT2(a10, a9, svt10, svt9)
    .test_Compare_SVT1_SVT2(a9, a9, svt9, svt9)
    .test_Compare_SVT1_SVT2(a10, a10, svt10, svt10)

    ## "integer" <op> "double".
    .test_Compare_SVT1_SVT2(a1, a4, svt1, svt4)
    .test_Compare_SVT1_SVT2(a4, a1, svt4, svt1)
    .test_Compare_SVT1_SVT2(a2, a3, svt2, svt3)
    .test_Compare_SVT1_SVT2(a3, a2, svt3, svt2)

    ## "integer" <op> "raw".
    .test_Compare_SVT1_SVT2(a1, a6, svt1, svt6)
    .test_Compare_SVT1_SVT2(a6, a1, svt6, svt1)
    .test_Compare_SVT1_SVT2(a2, a5, svt2, svt5)
    .test_Compare_SVT1_SVT2(a5, a2, svt5, svt2)

    ## "integer" <op> "logical".
    .test_Compare_SVT1_SVT2(a1, a8, svt1, svt8)
    .test_Compare_SVT1_SVT2(a8, a1, svt8, svt1)
    .test_Compare_SVT1_SVT2(a2, a7, svt2, svt7)
    .test_Compare_SVT1_SVT2(a7, a2, svt7, svt2)

    ## "integer" <op> "complex".
    .test_Compare_SVT1_SVT2(a1, a10, svt1, svt10)
    .test_Compare_SVT1_SVT2(a10, a1, svt10, svt1)
    .test_Compare_SVT1_SVT2(a2, a9, svt2, svt9)
    .test_Compare_SVT1_SVT2(a9, a2, svt9, svt2)

    ## "double" <op> "raw".
    .test_Compare_SVT1_SVT2(a3, a6, svt3, svt6)
    .test_Compare_SVT1_SVT2(a6, a3, svt6, svt3)
    .test_Compare_SVT1_SVT2(a4, a5, svt4, svt5)
    .test_Compare_SVT1_SVT2(a5, a4, svt5, svt4)

    ## "double" <op> "logical".
    .test_Compare_SVT1_SVT2(a3, a8, svt3, svt8)
    .test_Compare_SVT1_SVT2(a8, a3, svt8, svt3)
    .test_Compare_SVT1_SVT2(a4, a7, svt4, svt7)
    .test_Compare_SVT1_SVT2(a7, a4, svt7, svt4)

    ## "double" <op> "complex".
    .test_Compare_SVT1_SVT2(a3, a10, svt3, svt10)
    .test_Compare_SVT1_SVT2(a10, a3, svt10, svt3)
    .test_Compare_SVT1_SVT2(a4, a9, svt4, svt9)
    .test_Compare_SVT1_SVT2(a9, a4, svt9, svt4)

    ## "raw" <op> "logical".
    .test_Compare_SVT1_SVT2(a5, a8, svt5, svt8)
    .test_Compare_SVT1_SVT2(a8, a5, svt8, svt5)
    .test_Compare_SVT1_SVT2(a6, a7, svt6, svt7)
    .test_Compare_SVT1_SVT2(a7, a6, svt7, svt6)

    ## "raw" <op> "complex".
    .test_Compare_SVT1_SVT2(a5, a10, svt5, svt10)
    .test_Compare_SVT1_SVT2(a10, a5, svt10, svt5)
    .test_Compare_SVT1_SVT2(a6, a9, svt6, svt9)
    .test_Compare_SVT1_SVT2(a9, a6, svt9, svt6)

    ## "logical" <op> "complex".
    .test_Compare_SVT1_SVT2(a7, a10, svt7, svt10)
    .test_Compare_SVT1_SVT2(a10, a7, svt10, svt7)
    .test_Compare_SVT1_SVT2(a8, a9, svt8, svt9)
    .test_Compare_SVT1_SVT2(a9, a8, svt9, svt8)

    ## Not expected to work.
    expect_error(svt1 != svt2[ , , -1], "non-conformable")
    expect_error(svt1 < svt2[ , , -1], "non-conformable")
    expect_error(svt1 > svt2[ , , -1], "non-conformable")
    expect_error(svt1 == svt2, "not supported")
    expect_error(svt1 <= svt2, "not supported")
    expect_error(svt1 >= svt2, "not supported")
})
Bioconductor/SparseArray documentation built on Oct. 30, 2024, 12:14 p.m.