# tests/testthat/test-mat-by-svec.R In MatrixExtra: Extra Methods for Sparse Matrices

```library("testthat")
library("Matrix")
library("MatrixExtra")
context("Elementwise Matrix*svec")

v[sample(length(v), floor(.1 * length(v)), replace=FALSE)] <- NA_real_
return(v)
}

v[sample(length(v), floor(.1 * length(v)), replace=FALSE)] <- Inf
v[sample(length(v), floor(.1 * length(v)), replace=FALSE)] <- (-Inf)
return(v)
}

as.imatrix <- function(X) {
X <- as.matrix(X)
suppressWarnings(mode(X) <- "integer")
return(X)
}

test_that("Exact shape", {
set.seed(1)
X <- rsparsematrix(100, 35, .2, repr="R")
v <- as.sparse.vector(rsparsematrix(100, 1, .2))

expect_equal(unname(as.matrix(X * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_s4_class(X * v, "dgRMatrix")

expect_equal(unname(as.matrix(as.matrix(X) * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_equal(unname(as.matrix(as.imatrix(X) * v)),
unname(as.imatrix(X) * as.numeric(v)))
})

test_that("Recycled", {
set.seed(1)
X <- rsparsematrix(100, 35, .2, repr="R")
v <- as.sparse.vector(rsparsematrix(25, 1, .2))

expect_equal(unname(as.matrix(X * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_s4_class(X * v, "dgRMatrix")

expect_equal(unname(as.matrix(as.matrix(X) * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_equal(unname(as.matrix(as.imatrix(X) * v)),
unname(as.imatrix(X) * as.numeric(v)))
})

test_that("Exact shape with NA and Inf", {
set.seed(1)
X <- rsparsematrix(10, 5, .2, repr="R")
v <- as.sparse.vector(rsparsematrix(10, 1, .2))

restore_old_matrix_behavior()

expect_equal(unname(as.matrix(X * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_s4_class(X * v, "dgRMatrix")

expect_equal(unname(as.matrix(as.matrix(X) * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_equal(unname(as.matrix(as.imatrix(X) * v)),
unname(as.imatrix(X) * as.numeric(v)))
})

test_that("Recycled with NA and Inf", {
set.seed(1)
X <- rsparsematrix(10, 5, .2, repr="R")
v <- as.sparse.vector(rsparsematrix(10, 1, .2))

restore_old_matrix_behavior()

expect_equal(unname(as.matrix(X * v)),
unname(as.matrix(X) * as.numeric(v)))
expect_s4_class(X * v, "dgRMatrix")

expect_equal(unname(as.matrix(as.imatrix(X) * v)),
unname(as.imatrix(X) * as.numeric(v)))
})

test_that("Atypical recycles", {
set.seed(1)
X <- rsparsematrix(100, 35, .2, repr="R")
v_factor_larger <- as.sparse.vector(rsparsematrix(200, 1, .2))
v_uneven_smaller <- as.sparse.vector(rsparsematrix(30, 1, .2))
v_uneven_larger <- as.sparse.vector(rsparsematrix(111, 1, .2))
v_uneven_larger2 <- as.sparse.vector(rsparsematrix(222, 1, .2))
v_full <- as.sparse.vector(rsparsematrix(nrow(X)*ncol(X), 1, .2))

suppressWarnings({
expect_equal(unname(as.matrix(as.matrix(X) * v_factor_larger)),
unname(as.matrix(X) * as.numeric(v_factor_larger)))
expect_equal(unname(as.matrix(as.matrix(X) * v_uneven_smaller)),
unname(as.matrix(X) * as.numeric(v_uneven_smaller)))
expect_equal(unname(as.matrix(as.matrix(X) * v_uneven_larger)),
unname(as.matrix(X) * as.numeric(v_uneven_larger)))
expect_equal(unname(as.matrix(as.matrix(X) * v_uneven_larger2)),
unname(as.matrix(X) * as.numeric(v_uneven_larger2)))
expect_equal(unname(as.matrix(as.matrix(X) * v_full)),
unname(as.matrix(X) * as.numeric(v_full)))
})

restore_old_matrix_behavior()
suppressWarnings({
expect_equal(unname(as.matrix(as.matrix(X) * v_factor_larger)),
unname(as.matrix(X) * as.numeric(v_factor_larger)))
expect_equal(unname(as.matrix(as.matrix(X) * v_uneven_smaller)),
unname(as.matrix(X) * as.numeric(v_uneven_smaller)))
expect_equal(unname(as.matrix(as.matrix(X) * v_uneven_larger)),
unname(as.matrix(X) * as.numeric(v_uneven_larger)))
expect_equal(unname(as.matrix(as.matrix(X) * v_uneven_larger2)),
unname(as.matrix(X) * as.numeric(v_uneven_larger2)))
expect_equal(unname(as.matrix(as.matrix(X) * v_full)),
unname(as.matrix(X) * as.numeric(v_full)))
})
})
```

## Try the MatrixExtra package in your browser

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

MatrixExtra documentation built on Dec. 19, 2021, 9:07 a.m.