tests/testthat/test-operators.R

library("testthat")
library("Matrix")
library("MatrixExtra")
context("Methematical operators")

set.seed(1)
Mat1 <- rsparsematrix(100, 35, .4)
Mat2 <- rsparsematrix(100, 35, .6)
csr1 <- as.csr.matrix(Mat1)
csc1 <- as.csc.matrix(Mat1)
mat1 <- as.matrix(Mat1)
csr2 <- as.csr.matrix(Mat2)
csc2 <- as.csc.matrix(Mat2)
mat2 <- as.matrix(Mat2)
emat <- new("dgRMatrix")
emat@Dim <- csr1@Dim
emat@Dimnames <- csr1@Dimnames
emat@p <- integer(length(csr1@p))
eden <- as.matrix(emat)

expect_unmodified <- function(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden) {
    expect_equal(as.matrix(csr1), mat1)
    expect_equal(as.matrix(csr2), mat2)
    expect_equal(as.matrix(csc1), mat1)
    expect_equal(as.matrix(csc2), mat2)
    expect_equal(as.matrix(emat), eden)
}

set_new_matrix_behavior()

test_that("Operations CSR-CSR", {
    expect_equal(as.matrix(csr1 + csr2), as.matrix(mat1 + mat2))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 + csc2), as.matrix(mat1 + mat2))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 + csr1), as.matrix(mat1 + mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 + emat), as.matrix(mat1 + eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat + emat), as.matrix(eden + eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 + csr2, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 + csc2, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 + csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 + emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat + emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)

    expect_equal(as.matrix(csr2 + csr1), as.matrix(mat2 + mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csc2 + csr1), as.matrix(mat2 + mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 + csr1), as.matrix(mat1 + mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat + csr1), as.matrix(eden + mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat + emat), as.matrix(eden + eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr2 + csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csc2 + csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 + csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat + csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat + emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)

    expect_equal(as.matrix(csr1 - csr2), as.matrix(mat1 - mat2))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 - csc2), as.matrix(mat1 - mat2))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 - csr1), as.matrix(mat1 - mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 - emat), as.matrix(mat1 - eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat - emat), as.matrix(eden - eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 - csr2, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 - csc2, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 - csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 - emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat - emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)

    expect_equal(as.matrix(csr2 - csr1), as.matrix(mat2 - mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csc2 - csr1), as.matrix(mat2 - mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 - csr1), as.matrix(mat1 - mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat - csr1), as.matrix(eden - mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat - emat), as.matrix(eden - eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr2 - csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csc2 - csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 - csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat - csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat - emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)

    expect_equal(as.matrix(csr1 * csr2), as.matrix(mat1 * mat2))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 * csc2), as.matrix(mat1 * mat2))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 * csr1), as.matrix(mat1 * mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 * emat), as.matrix(mat1 * eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat * emat), as.matrix(eden * eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 * csr2, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 * csc2, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 * csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 * emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat * emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)

    expect_equal(as.matrix(csr2 * csr1), as.matrix(mat2 * mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csc2 * csr1), as.matrix(mat2 * mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 * csr1), as.matrix(mat1 * mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat * csr1), as.matrix(eden * mat1))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat * emat), as.matrix(eden * eden))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr2 * csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csc2 * csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 * csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat * csr1, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat * emat, "dgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    
    expect_equal(as.matrix(csr1 | csr2), unname(as.matrix(mat1 | mat2)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 | csc2), unname(as.matrix(mat1 | mat2)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 | csr1), unname(as.matrix(mat1 | mat1)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 | emat), unname(as.matrix(mat1 | eden)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(unname(as.matrix(emat | emat)), unname(as.matrix(eden | eden)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 | csr2, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 | csc2, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 | csr1, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 | emat, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat | emat, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    
    
    expect_equal(as.matrix(csr1 & csr2), unname(as.matrix(mat1 & mat2)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 & csc2), unname(as.matrix(mat1 & mat2)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 & csr1), unname(as.matrix(mat1 & mat1)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(csr1 & emat), unname(as.matrix(mat1 & eden)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_equal(as.matrix(emat & emat), unname(as.matrix(eden & eden)))
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 & csr2, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 & csc2, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 & csr1, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(csr1 & emat, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    expect_s4_class(emat & emat, "lgRMatrix")
    expect_unmodified(csr1, csr2, csc1, csc2, emat, mat1, mat2, eden)
    

    expect_equal(as.matrix(csr1^2), as.matrix(mat1^2))
    expect_equal(as.matrix(sqrt(csr1^2)), as.matrix(sqrt(mat1^2)))
    expect_equal(as.matrix(abs(csr1)), as.matrix(abs(mat1)))
    expect_s4_class(csr1^2, "dgRMatrix")
    expect_s4_class(sqrt(csr1^2), "dgRMatrix")
    expect_s4_class(abs(csr1), "dgRMatrix")

    expect_equal(as.matrix(emat^2), as.matrix(eden^2))
    expect_equal(as.matrix(sqrt(emat^2)), as.matrix(sqrt(eden^2)))
    expect_equal(as.matrix(abs(emat)), as.matrix(abs(eden)))
    expect_s4_class(emat^2, "dgRMatrix")
    expect_s4_class(sqrt(emat^2), "dgRMatrix")
    expect_s4_class(abs(emat), "dgRMatrix")
})

test_that("Operations CSR-COO", {
    coo1 <- as.coo.matrix(csr1)
    coo2 <- as.coo.matrix(csr2)
    expect_equal(unname(as.matrix(coo1 + csr2)), unname(as.matrix(mat1 + mat2)))
    expect_equal(unname(as.matrix(coo1 + emat)), unname(as.matrix(mat1 + eden)))
    expect_equal(unname(as.matrix(emat + emat)), unname(as.matrix(eden + eden)))
    expect_s4_class(coo1 + csr2, "dgRMatrix")
    expect_s4_class(coo1 + emat, "dgRMatrix")

    expect_equal(unname(as.matrix(csr2 + coo1)), unname(as.matrix(mat2 + mat1)))
    expect_equal(unname(as.matrix(emat + coo1)), unname(as.matrix(eden + mat1)))
    expect_s4_class(csr2 + coo1, "dgRMatrix")
    expect_s4_class(emat + coo1, "dgRMatrix")

    expect_equal(unname(as.matrix(coo1 - csr2)), unname(as.matrix(mat1 - mat2)))
    expect_equal(unname(as.matrix(coo1 - emat)), unname(as.matrix(mat1 - eden)))
    expect_s4_class(coo1 - csr2, "dgRMatrix")
    expect_s4_class(coo1 - emat, "dgRMatrix")

    expect_equal(unname(as.matrix(csr2 - coo1)), unname(as.matrix(mat2 - mat1)))
    expect_equal(unname(as.matrix(emat - coo1)), unname(as.matrix(eden - mat1)))
    expect_s4_class(csr2 - coo1, "dgRMatrix")
    expect_s4_class(emat - coo1, "dgRMatrix")

    expect_equal(unname(as.matrix(coo1 * csr2)), unname(as.matrix(mat1 * mat2)))
    expect_equal(unname(as.matrix(coo1 * emat)), unname(as.matrix(mat1 * eden)))
    expect_s4_class(coo1 * csr2, "dgTMatrix")
    expect_s4_class(coo1 * emat, "dgTMatrix")

    expect_equal(unname(as.matrix(csr2 * coo1)), unname(as.matrix(mat2 * mat1)))
    expect_equal(unname(as.matrix(emat * coo1)), unname(as.matrix(eden * mat1)))
    expect_s4_class(csr2 * coo1, "dgTMatrix")
    expect_s4_class(emat * coo1, "dgTMatrix")
    
    expect_equal(unname(as.matrix(coo1 | csr2)), unname(as.matrix(mat1 | mat2)))
    expect_equal(unname(as.matrix(coo1 | emat)), unname(as.matrix(mat1 | eden)))
    expect_s4_class(coo1 | csr2, "lgRMatrix")
    expect_s4_class(coo1 | emat, "lgRMatrix")
    
    expect_equal(unname(as.matrix(csr2 | coo1)), unname(as.matrix(mat2 | mat1)))
    expect_equal(unname(as.matrix(emat | coo1)), unname(as.matrix(eden | mat1)))
    expect_s4_class(csr2 | coo1, "lgRMatrix")
    expect_s4_class(emat | coo1, "lgRMatrix")
    
    expect_equal(unname(as.matrix(coo1 & csr2)), unname(as.matrix(mat1 & mat2)))
    expect_equal(unname(as.matrix(coo1 & emat)), unname(as.matrix(mat1 & eden)))
    expect_s4_class(coo1 & csr2, "lgTMatrix")
    expect_s4_class(coo1 & emat, "lgTMatrix")
    
    expect_equal(unname(as.matrix(csr2 & coo1)), unname(as.matrix(mat2 & mat1)))
    expect_equal(unname(as.matrix(emat & coo1)), unname(as.matrix(eden & mat1)))
    expect_s4_class(csr2 & coo1, "lgTMatrix")
    expect_s4_class(emat & coo1, "lgTMatrix")


    expect_equal(unname(as.matrix(coo1^2)), unname(as.matrix(mat1^2)))
    expect_equal(unname(as.matrix(sqrt(coo1^2))), unname(as.matrix(sqrt(mat1^2))))
    expect_equal(unname(as.matrix(abs(coo1))), unname(as.matrix(abs(mat1))))
    expect_s4_class(coo1^2, "dgTMatrix")
    expect_s4_class(sqrt(coo1^2), "dgTMatrix")
    expect_s4_class(abs(coo1), "dgTMatrix")
})

test_that("Operations CSR-CSC", {
    csc1 <- as.csc.matrix(csr1)
    csc2 <- as.csc.matrix(csr2)
    expect_equal(unname(as.matrix(csc1 + csr2)), unname(as.matrix(mat1 + mat2)))
    expect_equal(unname(as.matrix(csc1 + emat)), unname(as.matrix(mat1 + eden)))
    expect_equal(unname(as.matrix(emat + emat)), unname(as.matrix(eden + eden)))
    expect_equal(unname(as.matrix(csr2 + csc1)), unname(as.matrix(mat2 + mat1)))
    expect_equal(unname(as.matrix(emat + csc1)), unname(as.matrix(eden + mat1)))

    expect_equal(unname(as.matrix(csc1 - csr2)), unname(as.matrix(mat1 - mat2)))
    expect_equal(unname(as.matrix(csc1 - emat)), unname(as.matrix(mat1 - eden)))

    expect_equal(unname(as.matrix(csr2 - csc1)), unname(as.matrix(mat2 - mat1)))
    expect_equal(unname(as.matrix(emat - csc1)), unname(as.matrix(eden - mat1)))

    expect_equal(unname(as.matrix(csc1 * csr2)), unname(as.matrix(mat1 * mat2)))
    expect_equal(unname(as.matrix(csc1 * emat)), unname(as.matrix(mat1 * eden)))

    expect_equal(unname(as.matrix(csr2 * csc1)), unname(as.matrix(mat2 * mat1)))
    expect_equal(unname(as.matrix(emat * csc1)), unname(as.matrix(eden * mat1)))
    
    expect_equal(unname(as.matrix(csc1 | csr2)), unname(as.matrix(mat1 | mat2)))
    expect_equal(unname(as.matrix(csc1 | emat)), unname(as.matrix(mat1 | eden)))
    
    expect_equal(unname(as.matrix(csr2 | csc1)), unname(as.matrix(mat2 | mat1)))
    expect_equal(unname(as.matrix(emat | csc1)), unname(as.matrix(eden | mat1)))
    
    expect_equal(unname(as.matrix(csc1 & csr2)), unname(as.matrix(mat1 & mat2)))
    expect_equal(unname(as.matrix(csc1 & emat)), unname(as.matrix(mat1 & eden)))
    
    expect_equal(unname(as.matrix(csr2 & csc1)), unname(as.matrix(mat2 & mat1)))
    expect_equal(unname(as.matrix(emat & csc1)), unname(as.matrix(eden & mat1)))
})

test_that("Types of objects", {
    set.seed(1)
    Mat <- rsparsematrix(5, 3, .4)
    Mat <- as.csr.matrix(Mat)

    expect_s4_class(Mat + as.csr.matrix(Mat, binary=TRUE), "dgRMatrix")
    expect_equal(Mat + as.csr.matrix(Mat, binary=TRUE),
                 Mat + as.csr.matrix(as.csr.matrix(Mat, binary=TRUE)))
    expect_s4_class(Mat - as.csr.matrix(Mat, binary=TRUE), "dgRMatrix")
    expect_equal(Mat - as.csr.matrix(Mat, binary=TRUE),
                 Mat - as.csr.matrix(as.csr.matrix(Mat, binary=TRUE)))
    expect_s4_class(Mat * as.csr.matrix(Mat, binary=TRUE), "dgRMatrix")
    expect_equal(Mat * as.csr.matrix(Mat, binary=TRUE),
                 Mat * as.csr.matrix(as.csr.matrix(Mat, binary=TRUE)))
    expect_s4_class(Mat | as.csr.matrix(Mat, binary=TRUE), "lgRMatrix")
    expect_equal(Mat | as.csr.matrix(Mat, binary=TRUE),
                 Mat | as.csr.matrix(as.csr.matrix(Mat, binary=TRUE)))
    expect_s4_class(Mat & as.csr.matrix(Mat, binary=TRUE), "lgRMatrix")
    expect_equal(Mat & as.csr.matrix(Mat, binary=TRUE),
                 Mat & as.csr.matrix(as.csr.matrix(Mat, binary=TRUE)))

    expect_s4_class(Mat + as.csr.matrix(Mat, logical=TRUE), "dgRMatrix")
    expect_equal(Mat + as.csr.matrix(Mat, logical=TRUE),
                 Mat + as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(Mat - as.csr.matrix(Mat, logical=TRUE), "dgRMatrix")
    expect_equal(Mat - as.csr.matrix(Mat, logical=TRUE),
                 Mat - as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(Mat * as.csr.matrix(Mat, logical=TRUE), "dgRMatrix")
    expect_equal(Mat * as.csr.matrix(Mat, logical=TRUE),
                 Mat * as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(Mat | as.csr.matrix(Mat, logical=TRUE), "lgRMatrix")
    expect_equal(Mat | as.csr.matrix(Mat, logical=TRUE),
                 Mat | as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(Mat & as.csr.matrix(Mat, logical=TRUE), "lgRMatrix")
    expect_equal(Mat & as.csr.matrix(Mat, logical=TRUE),
                 Mat & as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))




    expect_s4_class(as.csr.matrix(Mat, binary=TRUE) + as.csr.matrix(Mat, logical=TRUE), "dgRMatrix")
    expect_equal(as.csr.matrix(Mat, binary=TRUE) + as.csr.matrix(Mat, logical=TRUE),
                 as.csr.matrix(Mat, binary=TRUE) + as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(as.csr.matrix(Mat, binary=TRUE) - as.csr.matrix(Mat, logical=TRUE), "dgRMatrix")
    expect_equal(as.csr.matrix(Mat, binary=TRUE) - as.csr.matrix(Mat, logical=TRUE),
                 as.csr.matrix(Mat, binary=TRUE) - as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(as.csr.matrix(Mat, binary=TRUE) * as.csr.matrix(Mat, logical=TRUE), "dgRMatrix")
    expect_equal(as.csr.matrix(Mat, binary=TRUE) * as.csr.matrix(Mat, logical=TRUE),
                 as.csr.matrix(Mat, binary=TRUE) * as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    
    expect_s4_class(as.csr.matrix(Mat, binary=TRUE) | as.csr.matrix(Mat, logical=TRUE), "lgRMatrix")
    expect_equal(as.csr.matrix(Mat, binary=TRUE) | as.csr.matrix(Mat, logical=TRUE),
                 as.csr.matrix(Mat, binary=TRUE) | as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))
    expect_s4_class(as.csr.matrix(Mat, binary=TRUE) & as.csr.matrix(Mat, logical=TRUE), "lgRMatrix")
    expect_equal(as.csr.matrix(Mat, binary=TRUE) & as.csr.matrix(Mat, logical=TRUE),
                 as.csr.matrix(Mat, binary=TRUE) & as.csr.matrix(as.csr.matrix(Mat, logical=TRUE)))

})

test_that("CSC and dense", {
    Dense <- matrix(1:10, nrow=5L)
    Sparse <- as.csc.matrix(matrix(c(0,0,1,2,3, 11,12,13,14,15),
                                   nrow=5L, ncol=2L, byrow=FALSE))
    expect_equal(as.matrix(Dense * Sparse), Dense * as.matrix(Sparse))
    expect_s4_class(Dense * Sparse, "dgCMatrix")
    expect_equal(as.matrix(Sparse * Dense), Dense * as.matrix(Sparse))
    expect_s4_class(Sparse * Dense, "dgCMatrix")
    
    DenseNew <- Dense
    DenseNew[1,1] <- NA_real_
    
    set_new_matrix_behavior()
    expect_equal(as.matrix(DenseNew * Sparse), Dense * as.matrix(Sparse))
    expect_s4_class(DenseNew * Sparse, "dgCMatrix")
    expect_equal(as.matrix(Sparse * DenseNew), Dense * as.matrix(Sparse))
    expect_s4_class(Sparse * DenseNew, "dgCMatrix")
    
    restore_old_matrix_behavior()
    expect_equal(as.matrix(DenseNew * Sparse), DenseNew * as.matrix(Sparse))
    expect_s4_class(DenseNew * Sparse, "dgCMatrix")
    expect_equal(as.matrix(Sparse * DenseNew), DenseNew * as.matrix(Sparse))
    expect_s4_class(Sparse * DenseNew, "dgCMatrix")
    
    
    set_new_matrix_behavior()
    expect_equal(as.matrix(DenseNew & Sparse), unname(DenseNew & as.matrix(Sparse)))
    expect_s4_class(DenseNew & Sparse, "lgCMatrix")
    expect_equal(as.matrix(Sparse & DenseNew), unname(as.matrix(Sparse) & DenseNew))
    expect_s4_class(Sparse & DenseNew, "lgCMatrix")
    
    restore_old_matrix_behavior()
    expect_equal(as.matrix(DenseNew & Sparse), unname(DenseNew & as.matrix(Sparse)))
    expect_s4_class(DenseNew & Sparse, "lgCMatrix")
    expect_equal(as.matrix(Sparse & DenseNew), unname(as.matrix(Sparse) & DenseNew))
    expect_s4_class(Sparse & DenseNew, "lgCMatrix")
})

test_that("NAs in multiplication and ampersand", {
    Dense <- matrix(1:10, nrow=5L)
    Sparse <- as.csc.matrix(matrix(c(0,0,1,2,3, 11,12,13,14,15),
                                   nrow=5L, ncol=2L, byrow=FALSE))
    DenseNew <- Dense
    DenseNew[1,1] <- NA_real_
    DenseNew[2,2] <- 0
    DenseNew[3,2] <- 0
    DenseNew[5,2] <- NA_real_
    Sparse <- as.matrix(Sparse)
    Sparse[2,2] <- NA_real_
    Sparse[4,2] <- NA_real_
    Sparse[5,2] <- NA_real_
    Sparse <- as.csc.matrix(Sparse)
    DenseFilled <- DenseNew
    DenseFilled[is.na(DenseNew)] <- 0
    SparseFilled <- as.matrix(Sparse)
    SparseFilled[is.na(DenseNew) & !is.na(SparseFilled)] <- 0
    
    run_tests <- function(Sparse, DenseNew, SparseFilled, DenseFilled) {
        suppressWarnings({
            set_new_matrix_behavior()
            expect_equal(unname(as.matrix(DenseNew * Sparse)),
                         unname(DenseFilled * SparseFilled))
            expect_equal(unname(as.matrix(Sparse * DenseNew)),
                         unname(DenseFilled * SparseFilled))
            
            restore_old_matrix_behavior()
            expect_equal(unname(as.matrix(DenseNew * Sparse)),
                         unname(DenseNew * as.matrix(Sparse)))
            expect_equal(unname(as.matrix(Sparse * DenseNew)),
                         unname(DenseNew * as.matrix(Sparse)))
            
            set_new_matrix_behavior()
            expect_equal(as.matrix(DenseNew & Sparse),
                         unname(DenseNew & as.matrix(Sparse)))
            expect_equal(as.matrix(Sparse & DenseNew),
                         unname(as.matrix(Sparse) & DenseNew))
            
            restore_old_matrix_behavior()
            expect_equal(as.matrix(DenseNew & Sparse),
                         unname(DenseNew & as.matrix(Sparse)))
            expect_equal(as.matrix(Sparse & DenseNew),
                         unname(as.matrix(Sparse) & DenseNew))
        })
    }
    
    run_tests(as.coo.matrix(Sparse), DenseNew, SparseFilled, DenseFilled)
    run_tests(as.csr.matrix(Sparse), DenseNew, SparseFilled, DenseFilled)
    run_tests(as.csc.matrix(Sparse), DenseNew, SparseFilled, DenseFilled)
})

test_that("Vector recycling", {
    set.seed(1)
    X <- as.csr.matrix(rsparsematrix(100, 30, .1))
    v_exact <- rnorm(100)
    v_factor <- rnorm(20)
    v_factor_larger <- rnorm(500)
    v_dense <- rnorm(3000)
    v_longer <- rnorm(6000)
    v_uneven <- rnorm(80)
    v_uneven_longer <- rnorm(111)
    v_uneven_longer2 <- rnorm(333)
    v_scalar <- rnorm(1)
    X_dense <- as.matrix(X)
    
    add_rare <- function(v, pct) {
        n <- ceiling(length(v) * pct/4)
        v[sample(length(v), n, replace=FALSE)] <-  .5
        v[sample(length(v), n, replace=FALSE)] <- (-.5)
        v[sample(length(v), n, replace=FALSE)] <- (1/3)
        v[sample(length(v), n, replace=FALSE)] <- (-1/3)
        return(v)
    }
    
    add_zeros <- function(v, pct) {
        n <- ceiling(length(v) * pct)
        v[sample(length(v), n, replace=FALSE)] <- 0
        return(v)
    }
    
    add_ones <- function(v, pct) {
        n <- ceiling(length(v) * pct/2)
        v[sample(length(v), n, replace=FALSE)] <- 1
        v[sample(length(v), n, replace=FALSE)] <- (-1)
        return(v)
    }
    
    add_inf <- function(v, pct) {
        n <- ceiling(length(v) * pct/2)
        v[sample(length(v), n, replace=FALSE)] <-  Inf
        v[sample(length(v), n, replace=FALSE)] <- -Inf
        return(v)
    }
    
    as.lmatrix <- function(X) {
        X <- as.matrix(X)
        mode(X) <- "logical"
        return(X)
    }
    
    run_tests_ <- function(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
                           v_longer, v_uneven, v_uneven_longer,
                           v_uneven_longer2, v_scalar) {
        suppressWarnings({
            expect_equal(unname(as.matrix(X * v_exact)),
                         unname(X_dense * as.numeric(v_exact)))
            expect_equal(unname(as.matrix(X * v_factor)),
                         unname(X_dense * as.numeric(v_factor)))
            expect_equal(unname(as.matrix(X * v_factor_larger)),
                         unname(X_dense * as.numeric(v_factor_larger)))
            expect_equal(unname(as.matrix(X * v_dense)),
                         unname(X_dense * as.numeric(v_dense)))
            expect_error(X * v_longer)
            expect_error(X_dense * v_longer)
            expect_equal(unname(as.matrix(X * v_uneven)),
                         unname(X_dense * as.numeric(v_uneven)))
            expect_equal(unname(as.matrix(X * v_uneven_longer)),
                         unname(X_dense * as.numeric(v_uneven_longer)))
            expect_equal(unname(as.matrix(X * v_uneven_longer2)),
                         unname(X_dense * as.numeric(v_uneven_longer2)))
            expect_equal(unname(as.matrix(X * v_scalar)),
                         unname(X_dense * as.numeric(v_scalar)))
            
            
            expect_equal(unname(as.lmatrix(X & v_exact)),
                         unname(X_dense & as.numeric(v_exact)))
            expect_equal(unname(as.lmatrix(X & v_factor)),
                         unname(X_dense & as.numeric(v_factor)))
            expect_equal(unname(as.lmatrix(X & v_factor_larger)),
                         unname(X_dense & as.numeric(v_factor_larger)))
            expect_equal(unname(as.lmatrix(X & v_dense)),
                         unname(X_dense & as.numeric(v_dense)))
            expect_error(X & v_longer)
            expect_error(X_dense & v_longer)
            expect_equal(unname(as.lmatrix(X & v_uneven)),
                         unname(X_dense & as.numeric(v_uneven)))
            expect_equal(unname(as.lmatrix(X & v_uneven_longer)),
                         unname(X_dense & as.numeric(v_uneven_longer)))
            expect_equal(unname(as.lmatrix(X & v_uneven_longer2)),
                         unname(X_dense & as.numeric(v_uneven_longer2)))
            expect_equal(unname(as.lmatrix(X & v_scalar)),
                         unname(X_dense & as.numeric(v_scalar)))


            expect_equal(unname(as.matrix(X / v_exact)),
                         unname(X_dense / as.numeric(v_exact)))
            expect_equal(unname(as.matrix(X / v_factor)),
                         unname(X_dense / as.numeric(v_factor)))
            expect_equal(unname(as.matrix(X / v_factor_larger)),
                         unname(X_dense / as.numeric(v_factor_larger)))
            expect_equal(unname(as.matrix(X / v_dense)),
                         unname(X_dense / as.numeric(v_dense)))
            expect_error(X / v_longer)
            expect_error(X_dense / v_longer)
            expect_equal(unname(as.matrix(X / v_uneven)),
                         unname(X_dense / as.numeric(v_uneven)))
            expect_equal(unname(as.matrix(X / v_uneven_longer)),
                         unname(X_dense / as.numeric(v_uneven_longer)))
            expect_equal(unname(as.matrix(X / v_uneven_longer2)),
                         unname(X_dense / as.numeric(v_uneven_longer2)))
            expect_equal(unname(as.matrix(X / v_scalar)),
                         unname(X_dense / as.numeric(v_scalar)))
            
            if (!getOption("MatrixExtra.ignore_na")) {
                expect_equal(unname(as.matrix(v_exact / X)),
                             unname(as.numeric(v_exact) / X_dense))
                expect_equal(unname(as.matrix(v_factor / X)),
                             unname(as.numeric(v_factor) / X_dense))
                expect_equal(unname(as.matrix(v_factor_larger / X)),
                             unname(as.numeric(v_factor_larger) / X_dense))
                expect_equal(unname(as.matrix(v_dense / X)),
                             unname(as.numeric(v_dense) / X_dense))
                expect_error(v_longer / X)
                expect_error(v_longer / X_dense)
                expect_equal(unname(as.matrix(v_uneven / X)),
                             unname(as.numeric(v_uneven) / X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer / X)),
                             unname(as.numeric(v_uneven_longer) / X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer2 / X)),
                             unname(as.numeric(v_uneven_longer2) / X_dense))
                expect_equal(unname(as.matrix(v_scalar / X)),
                             unname(as.numeric(v_scalar) / X_dense))
            }

            if (!getOption("MatrixExtra.ignore_na")) {
                expect_equal(unname(as.matrix(X ^ v_exact)),
                             unname(X_dense ^ as.numeric(v_exact)))
                expect_equal(unname(as.matrix(X ^ v_factor)),
                             unname(X_dense ^ as.numeric(v_factor)))
                expect_equal(unname(as.matrix(X ^ v_factor_larger)),
                             unname(X_dense ^ as.numeric(v_factor_larger)))
                expect_equal(unname(as.matrix(X ^ v_dense)),
                             unname(X_dense ^ as.numeric(v_dense)))
                expect_error(X ^ v_longer)
                expect_error(X_dense ^ v_longer)
                expect_equal(unname(as.matrix(X ^ v_uneven)),
                             unname(X_dense ^ as.numeric(v_uneven)))
                expect_equal(unname(as.matrix(X ^ v_uneven_longer)),
                             unname(X_dense ^ as.numeric(v_uneven_longer)))
                expect_equal(unname(as.matrix(X ^ v_uneven_longer2)),
                             unname(X_dense ^ as.numeric(v_uneven_longer2)))
                expect_equal(unname(as.matrix(X ^ v_scalar)),
                             unname(X_dense ^ as.numeric(v_scalar)))

                expect_equal(unname(as.matrix(v_exact ^ X)),
                             unname(as.numeric(v_exact) ^ X_dense))
                expect_equal(unname(as.matrix(v_factor ^ X)),
                             unname(as.numeric(v_factor) ^ X_dense))
                expect_equal(unname(as.matrix(v_factor_larger ^ X)),
                             unname(as.numeric(v_factor_larger) ^ X_dense))
                expect_equal(unname(as.matrix(v_dense ^ X)),
                             unname(as.numeric(v_dense) ^ X_dense))
                expect_error(v_longer ^ X)
                expect_error(v_longer ^ X_dense)
                expect_equal(unname(as.matrix(v_uneven ^ X)),
                             unname(as.numeric(v_uneven) ^ X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer ^ X)),
                             unname(as.numeric(v_uneven_longer) ^ X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer2 ^ X)),
                             unname(as.numeric(v_uneven_longer2) ^ X_dense))
                expect_equal(unname(as.matrix(v_scalar ^ X)),
                             unname(as.numeric(v_scalar) ^ X_dense))
            }

            expect_equal(unname(as.matrix(X %% v_exact)),
                         unname(X_dense %% as.numeric(v_exact)))
            expect_equal(unname(as.matrix(X %% v_factor)),
                         unname(X_dense %% as.numeric(v_factor)))
            expect_equal(unname(as.matrix(X %% v_factor_larger)),
                         unname(X_dense %% as.numeric(v_factor_larger)))
            expect_equal(unname(as.matrix(X %% v_dense)),
                         unname(X_dense %% as.numeric(v_dense)))
            expect_error(X %% v_longer)
            expect_error(X_dense %% v_longer)
            expect_equal(unname(as.matrix(X %% v_uneven)),
                         unname(X_dense %% as.numeric(v_uneven)))
            expect_equal(unname(as.matrix(X %% v_uneven_longer)),
                         unname(X_dense %% as.numeric(v_uneven_longer)))
            expect_equal(unname(as.matrix(X %% v_uneven_longer2)),
                         unname(X_dense %% as.numeric(v_uneven_longer2)))
            expect_equal(unname(as.matrix(X %% v_scalar)),
                         unname(X_dense %% as.numeric(v_scalar)))
            
            if (!getOption("MatrixExtra.ignore_na")) {
                expect_equal(unname(as.matrix(v_exact %% X)),
                             unname(as.numeric(v_exact) %% X_dense))
                expect_equal(unname(as.matrix(v_factor %% X)),
                             unname(as.numeric(v_factor) %% X_dense))
                expect_equal(unname(as.matrix(v_factor_larger %% X)),
                             unname(as.numeric(v_factor_larger) %% X_dense))
                expect_equal(unname(as.matrix(v_dense %% X)),
                             unname(as.numeric(v_dense) %% X_dense))
                expect_error(v_longer %% X)
                expect_error(v_longer %% X_dense)
                expect_equal(unname(as.matrix(v_uneven %% X)),
                             unname(as.numeric(v_uneven) %% X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer %% X)),
                             unname(as.numeric(v_uneven_longer) %% X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer2 %% X)),
                             unname(as.numeric(v_uneven_longer2) %% X_dense))
                expect_equal(unname(as.matrix(v_scalar %% X)),
                             unname(as.numeric(v_scalar) %% X_dense))
            }

            expect_equal(unname(as.matrix(X %/% v_exact)),
                         unname(X_dense %/% as.numeric(v_exact)))
            expect_equal(unname(as.matrix(X %/% v_factor)),
                         unname(X_dense %/% as.numeric(v_factor)))
            expect_equal(unname(as.matrix(X %/% v_factor_larger)),
                         unname(X_dense %/% as.numeric(v_factor_larger)))
            expect_equal(unname(as.matrix(X %/% v_dense)),
                         unname(X_dense %/% as.numeric(v_dense)))
            expect_error(X %/% v_longer)
            expect_error(X_dense %/% v_longer)
            expect_equal(unname(as.matrix(X %/% v_uneven)),
                         unname(X_dense %/% as.numeric(v_uneven)))
            expect_equal(unname(as.matrix(X %/% v_uneven_longer)),
                         unname(X_dense %/% as.numeric(v_uneven_longer)))
            expect_equal(unname(as.matrix(X %/% v_uneven_longer2)),
                         unname(X_dense %/% as.numeric(v_uneven_longer2)))
            expect_equal(unname(as.matrix(X %/% v_scalar)),
                         unname(X_dense %/% as.numeric(v_scalar)))
            
            if (!getOption("MatrixExtra.ignore_na")) {
                expect_equal(unname(as.matrix(v_exact %/% X)),
                             unname(as.numeric(v_exact) %/% X_dense))
                expect_equal(unname(as.matrix(v_factor %/% X)),
                             unname(as.numeric(v_factor) %/% X_dense))
                expect_equal(unname(as.matrix(v_factor_larger %/% X)),
                             unname(as.numeric(v_factor_larger) %/% X_dense))
                expect_equal(unname(as.matrix(v_dense %/% X)),
                             unname(as.numeric(v_dense) %/% X_dense))
                expect_error(v_longer %/% X)
                expect_error(v_longer %/% X_dense)
                expect_equal(unname(as.matrix(v_uneven %/% X)),
                             unname(as.numeric(v_uneven) %/% X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer %/% X)),
                             unname(as.numeric(v_uneven_longer) %/% X_dense))
                expect_equal(unname(as.matrix(v_uneven_longer2 %/% X)),
                             unname(as.numeric(v_uneven_longer2) %/% X_dense))
                expect_equal(unname(as.matrix(v_scalar %/% X)),
                             unname(as.numeric(v_scalar) %/% X_dense))
            }
        })
    }
    
    run_tests <- function(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
                          v_longer, v_uneven, v_uneven_longer,
                          v_uneven_longer2, v_scalar) {
        run_tests_(as.csr.matrix(X), X_dense, v_exact, v_factor, v_factor_larger, v_dense,
                   v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
        run_tests_(as.coo.matrix(X), X_dense, v_exact, v_factor, v_factor_larger, v_dense,
                   v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
        
        ### Make sure that it didn't introduce any circular reference in 'Matrix'
        ### Note: 'Matrix' itself does not match exactly with base R, so these tests
        ### are bound to fail. However, they should fail due to mixing up NAs and zeros,
        ### not due to failure to execute. Thus, check them once in a while but do not
        ### leave them turned on for CRAN checks.
        # run_tests_(as.csc.matrix(X), X_dense, v_exact, v_factor, v_factor_larger, v_dense,
        #            v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
        
        # v_exact <- as(v_exact, "sparseVector")
        # v_factor <- as(v_factor, "sparseVector")
        # v_factor_larger <- as(v_factor_larger, "sparseVector")
        # v_longer <- as(v_longer, "sparseVector")
        # v_uneven <- as(v_uneven, "sparseVector")
        # v_uneven_longer <- as(v_uneven_longer, "sparseVector")
        # v_uneven_longer2 <- as(v_uneven_longer2, "sparseVector")
        # v_scalar <- as(v_scalar, "sparseVector")
        # run_tests_(as.csr.matrix(X), X_dense, v_exact, v_factor, v_factor_larger, v_dense,
        #            v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
        # run_tests_(as.csc.matrix(X), X_dense, v_exact, v_factor, v_factor_larger, v_dense,
        #            v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
        # run_tests_(as.coo.matrix(X), X_dense, v_exact, v_factor, v_factor_larger, v_dense,
        #            v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    }
    
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact <- add_rare(v_exact, .3)
    v_factor <- add_rare(v_factor, .3)
    v_factor_larger <- add_rare(v_factor_larger, .3)
    v_dense <- add_rare(v_dense, .3)
    v_uneven <- add_rare(v_uneven, .3)
    v_uneven_longer <- add_rare(v_uneven_longer, .3)
    v_uneven_longer2 <- add_rare(v_uneven_longer2, .3)
    X@x <- add_rare(X@x, .15)
    X_dense <- as.matrix(X)
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact <- add_zeros(v_exact, .3)
    v_factor <- add_zeros(v_factor, .3)
    v_factor_larger <- add_zeros(v_factor_larger, .3)
    v_dense <- add_zeros(v_dense, .3)
    v_uneven <- add_zeros(v_uneven, .3)
    v_uneven_longer <- add_zeros(v_uneven_longer, .3)
    v_uneven_longer2 <- add_zeros(v_uneven_longer2, .3)
    X@x <- add_zeros(X@x, .15)
    X_dense <- as.matrix(X)
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact <- add_ones(v_exact, .15)
    v_factor <- add_ones(v_factor, .15)
    v_factor_larger <- add_ones(v_factor_larger, .15)
    v_dense <- add_ones(v_dense, .15)
    v_uneven <- add_ones(v_uneven, .15)
    v_uneven_longer <- add_ones(v_uneven_longer, .15)
    v_uneven_longer2 <- add_ones(v_uneven_longer2, .15)
    X@x <- add_ones(X@x, .1)
    X_dense <- as.matrix(X)
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact[c(1,5,7,10,length(v_exact))] <- NA_real_
    v_factor[c(1,5,7,10,length(v_factor))] <- NA_real_
    v_factor_larger[c(1,5,7,10,length(v_factor_larger))] <- NA_real_
    v_dense[c(1,5,7,10,length(v_dense))] <- NA_real_
    v_longer[c(1,5,7,10,length(v_longer))] <- NA_real_
    v_uneven[c(1,5,7,10,length(v_uneven))] <- NA_real_
    v_uneven_longer[c(1,5,7,10,length(v_uneven_longer))] <- NA_real_
    v_uneven_longer2[c(1,5,7,10,length(v_uneven_longer2))] <- NA_real_
    X@x[c(1,5,7,10,length(X@x))] <- NA_real_
    X_dense <- as.matrix(X)
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact <- add_inf(v_exact, .3)
    v_factor <- add_inf(v_factor, .3)
    v_factor_larger <- add_inf(v_factor_larger, .3)
    v_dense <- add_inf(v_dense, .3)
    v_uneven <- add_inf(v_uneven, .3)
    v_uneven_longer <- add_inf(v_uneven_longer, .3)
    v_uneven_longer2 <- add_inf(v_uneven_longer2, .3)
    v_scalar <- Inf
    X@x <- add_inf(X@x, .1)
    X_dense <- as.matrix(X)
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    
    v_exact[5:20] <- NA_real_
    v_factor[5:20] <- NA_real_
    v_factor_larger[5:20] <- NA_real_
    v_dense[5:20] <- NA_real_
    v_longer[5:20] <- NA_real_
    v_uneven[5:20] <- NA_real_
    v_uneven_longer[5:20] <- NA_real_
    v_uneven_longer2[5:20] <- NA_real_
    v_scalar <- 1
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact[] <- NA_real_
    v_factor[] <- NA_real_
    v_factor_larger[] <- NA_real_
    v_dense[] <- NA_real_
    v_longer[] <- NA_real_
    v_uneven[] <- NA_real_
    v_uneven_longer[] <- NA_real_
    v_uneven_longer2[] <- NA_real_
    v_scalar <- NA_real_
    X@x[] <- NA_real_
    X_dense <- as.matrix(X)
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    v_exact[] <- 0
    v_factor[] <- 0
    v_factor_larger[] <- 0
    v_dense[] <- 0
    v_longer[] <- 0
    v_uneven[] <- 0
    v_uneven_longer[] <- 0
    v_uneven_longer2[] <- 0
    v_scalar <- 0
    X@x[] <- 0
    X_dense <- as.matrix(X)
    restore_old_matrix_behavior()
    run_tests(X, X_dense, v_exact, v_factor, v_factor_larger, v_dense,
              v_longer, v_uneven, v_uneven_longer, v_uneven_longer2, v_scalar)
    
    test_scalar <- function(X, X_dense, v_scalar) {
        suppressWarnings({
            expect_equal(unname(as.matrix(X * v_scalar)),
                         unname(X_dense * as.numeric(v_scalar)))
            expect_equal(unname(as.lmatrix(X & v_scalar)),
                         unname(X_dense & as.numeric(v_scalar)))
            expect_equal(unname(as.matrix(X / v_scalar)),
                         unname(X_dense / as.numeric(v_scalar)))
            expect_equal(unname(as.matrix(v_scalar / X)),
                         unname(as.numeric(v_scalar) / X_dense))
            expect_equal(unname(as.matrix(X ^ v_scalar)),
                         unname(X_dense ^ as.numeric(v_scalar)))
            expect_equal(unname(as.matrix(v_scalar ^ X)),
                         unname(as.numeric(v_scalar) ^ X_dense))
            expect_equal(unname(as.matrix(X %% v_scalar)),
                         unname(X_dense %% as.numeric(v_scalar)))
            expect_equal(unname(as.matrix(v_scalar %% X)),
                         unname(as.numeric(v_scalar) %% X_dense))
            expect_equal(unname(as.matrix(X %/% v_scalar)),
                         unname(X_dense %/% as.numeric(v_scalar)))
            expect_equal(unname(as.matrix(v_scalar %/% X)),
                         unname(as.numeric(v_scalar) %/% X_dense))
        })
    }
    
    for (v_scalar in c(-Inf, -3, -2, -1.5, -1, -.5, -1/3, 0,
                       1/3, .5, 1, 1.5, 2, 3, Inf, NA, numeric())) {
        test_scalar(as.csr.matrix(X), X_dense, v_scalar)
        test_scalar(as.coo.matrix(X), X_dense, v_scalar)
    }
})

Try the MatrixExtra package in your browser

Any scripts or data that you put into this service are public.

MatrixExtra documentation built on Aug. 21, 2023, 1:08 a.m.