#!/usr/bin/r -t
##
## Copyright (C) 2017 - 2022 Binxiang Ni and Dirk Eddelbuettel
##
## This file is part of RcppArmadillo. It is based on the documentation
## of package Matrix, slam, SparseM, spam and SciPy, which are
## respectively created by developers of the packages: Douglas Bates,
## Martin Maechler; Kurt Hornik, David Meyer, Christian Buchta; Roger
## Koenker, Pin Ng; Reinhard Furrer, Florian Gerber, Daniel Gerber,
## Kaspar Moesinger, Youcef Saad, Esmond G. Ng, Barry W. Peyton, Joseph
## W.H. Liu, Alan D. George; the developers of SciPy. It is also
## modified by Binxiang Ni.
##
## RcppArmadillo is free software: you can redistribute it and/or modify it
## under the terms of the GNU General Public License as published by
## the Free Software Foundation, either version 2 of the License, or
## (at your option) any later version.
##
## RcppArmadillo is distributed in the hope that it will be useful, but
## WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with RcppArmadillo. If not, see .
## Reference:
## [Matrix]: https://cran.r-project.org/web/packages/Matrix/Matrix.pdf
## [slam]: https://cran.r-project.org/web/packages/slam/slam.pdf
## [SparseM]: https://cran.r-project.org/web/packages/SparseM/SparseM.pdf
## [spam]: https://cran.r-project.org/web/packages/spam/spam.pdf
## [SciPy]: https://docs.scipy.org/doc/scipy/reference/sparse.html
if (!requireNamespace("Matrix", quietly=TRUE)) exit_file("No Matrix package")
if (utils::packageVersion("Matrix") < "1.4-2") exit_file("Need Matrix 1.4-2 or later")
## It now (Nov 2020) appears to fail on Windows starting around line 115
.onWindows <- .Platform$OS.type == "windows"
library(RcppArmadillo)
Rcpp::sourceCpp("cpp/sparse.cpp")
## setting up an example matrix -- using the fact that the as
## converter prefers sparse matrix objects create by the Matrix package
suppressMessages({
library(Matrix)
library(stats)
## Per email with Martin Maechler, hard to suppress such messages on
## first (and only) use of particular dispatches. So simply running
## twice: once silent, and again to test and possibly fail visibly.
kronecker(Diagonal(3), Matrix(0+0:5, 3, 2))
##
n1 <- 10
p <- 5
a <- rnorm(n1*p)
a[abs(a)<0.5] <- 0
A <- matrix(a,n1,p)
RA <- as(A, "RsparseMatrix")
dgt <- RA %x% matrix(1:4,2,2)
})
#test.as.dgc2dgc <- function() {
## [Matrix] p10 (dgCMatrix)
set.seed(7)
m <- matrix(0, 5, 5)
m[sample(length(m), size = 14)] <- rep(1:9, length=14)
mm <- as(m, "CsparseMatrix")
expect_equal(mm, asSpMat(mm))#, msg="dgC2dgC_1")
## [Matrix] p36 (dgCMatrix)
m <- Matrix(c(0,0,2:0), 3,5)
expect_equal(m, asSpMat(m))#, msg="dgC2dgC_2")
## [Matrix] p74 (dgCMatrix)
set.seed(27)
IM1 <- as(sample(1:20, 100, replace=TRUE), "indMatrix")
set.seed(27)
IM2 <- as(sample(1:18, 100, replace=TRUE), "indMatrix")
c12 <- as(crossprod(IM1,IM2), "CsparseMatrix")
expect_equal(c12, asSpMat(c12))#, msg="dgC2dgC_3")
## [Matrix] p87 (dgCMatrix)
m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))
m <- unname(m)
expect_equal(m, asSpMat(m))#, msg="dgC2dgC_4")
## [Matrix] p118 (dgCMatrix)
f1 <- gl(5, 3, labels = LETTERS[1:5])
X <- as(f1, "sparseMatrix")
X <- unname(X)
expect_equal(X, asSpMat(X))#, msg="dgC2dgC_5")
## [Matrix] p142 (dgCMatrix)
i <- c(1,3:8); j <- c(2,9,6:10); x <- 7 * (1:7)
A <- sparseMatrix(i, j, x = x)
expect_equal(A, asSpMat(A))#, msg="dgC2dgC_6")
## [slam] p4 (dgCMatrix)
x <- matrix(c(1, 0, 0, 2, 1, 0), nrow = 3)
SM <- Matrix(x, sparse = TRUE)
expect_equal(SM, asSpMat(SM))#, msg="dgC2dgC_7")
## [slam] p9 (dgCMatrix)
x <- matrix(c(1, 0, 0, 2, 1, NA), nrow = 2)
SM <- Matrix(x, sparse = TRUE)
expect_equal(SM, asSpMat(SM))#, msg="dgC2dgC_8")
if (.onWindows) exit_file("Skipping remainder on Windows")
## [slam] p12 (dgCMatrix)
if (utils::packageVersion("Matrix") >= "1.3.0") {
x <- matrix(c(1, 0, 0, 2), nrow = 2)
SM <- Matrix(x, sparse = TRUE, doDiag=FALSE)
dgc <- as(SM, "generalMatrix")
expect_equal(dgc, asSpMat(SM))#, msg="dgC2dgC_9")
}
## [SparseM] p21 (dgCMatrix)
set.seed(21)
a <- rnorm(20*5)
A <- matrix(a,20,5)
A[row(A)>col(A)+4|row(A)col(A)+2|row(A)= "1.3.0") {
set.seed(129)
T2 <- rsparsematrix(40, 12, nnz = 99, repr="T")
dgc <- as(T2, "CsparseMatrix")
expect_equal(dgc, asSpMat(T2))#, msg="dgT2dgC_8")
}
## [Matrix] p152 (dgTMatrix)
A <- spMatrix(10,20, i = c(1,3:8),
j = c(2,9,6:10),
x = 7 * (1:7))
dgc <- as(A, "CsparseMatrix")
expect_equal(dgc, asSpMat(A))#, msg="dgT2dgC_9")
## [SparseM] p21 (dgTMatrix)
set.seed(21)
a <- rnorm(20*5)
A <- matrix(a,20,5)
A[row(A)>col(A)+4|row(A)col(A)+2|row(A) 1)
## checkException(asSpMat(lm))
## # [Matrix] p152 (lgTMatrix)
## L <- spMatrix(9, 30, i = rep(1:9, 3), 1:27,
## (1:27) %% 4 != 1)
## checkException(asSpMat(L))
## ## [Matrix] p111 (ngCMatrix)
## m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))
## dimnames(m) <- NULL
## nm <- as(m, "nsparseMatrix")
## checkException(asSpMat(nm))
## ## [Matrix] p74 (ngTMatrix)
## sm1 <- as(rep(c(2,3,1), e=3), "indMatrix")
## ngt <- as(sm1, "ngTMatrix")
## checkException(asSpMat(ngt))
## ## [Matrix] p85 (ntTMatrix)
## lM <- Diagonal(x = c(TRUE,FALSE,FALSE))
## nM <- as(lM, "nMatrix")
## checkException(asSpMat(nM))
## ## [Matrix] p85 (nsCMatrix)
## nsc <- crossprod(nM)
## checkException(asSpMat(nsc))
## ## [Matrix] p42 (ldiMatrix)
## ldi <- Diagonal(x = (1:4) >= 2)
## checkException(asSpMat(ldi))
## }
## test.as.lgc2dgc <- function() {
## ## [Matrix] p87 (lgCMatrix) (To be continued)
## lm <- (m > 1)
##
## ## [Matrix] p111 (lgCMatrix) (To be continued)
## m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))
## dimnames(m) <- NULL
## nm <- as(m, "nsparseMatrix")
## nnm <- !nm # no longer sparse
## nnm <- as(nnm, "sparseMatrix")
## }
##
## test.as.lgt2dgc <- function() {
## ## [Matrix] p152 (lgTMatrix) (To be continued)
## L <- spMatrix(9, 30, i = rep(1:9, 3), 1:27,
## (1:27) %% 4 != 1)
## }
##
## test.as.ngc2dgc <- function() {
## ## [Matrix] p111 (ngCMatrix) (To be continued)
## m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))
## dimnames(m) <- NULL
## nm <- as(m, "nsparseMatrix")
##
## ## [Matrix] p129 (ngCMatrix) (To be continued)
## n7 <- rsparsematrix(5, 12, nnz = 10, rand.x = NULL)
## }
##
## test.as.ngt2dgc <- function() {
## # [Matrix] p74 (ngTMatrix) (To be continued)
## sm1 <- as(rep(c(2,3,1), e=3), "indMatrix")
## ngt <- as(sm1, "ngTMatrix")
## mtxt <- c("0 1 0",
## "0 1 0",
## "0 1 0",
## "0 0 1",
## "0 0 1",
## "0 0 1",
## "1 0 0",
## "1 0 0",
## "1 0 0")
## M <- as.matrix(read.table(text=mtxt))
## dimnames(M) <- NULL
## dgc <- as(M, "dgCMatrix")
## expect_equal(dgc, asSpMat(ngt))#, msg="ngT2dgC")
##
## set.seed(27)
## s10 <- as(sample(10, 30, replace=TRUE),"indMatrix")
## ngt <- s10[1:7, 1:4]
## mtxt <- c("0 0 0 0",
## "1 0 0 0",
## "0 0 0 0",
## "0 0 0 1",
## "0 0 1 0",
## "0 0 0 0",
## "1 0 0 0")
## M <- as.matrix(read.table(text=mtxt))
## dimnames(M) <- NULL
## dgc <- as(M, "dgCMatrix")
## expect_equal(dgc, asSpMat(ngt))#, msg="ngT2dgC")
##
## ## [Matrix] p116 (ngTMatrix) (To be continued)
## pm1 <- as(as.integer(c(2,3,1)), "pMatrix")
## as(pm1, "ngTMatrix")
## set.seed(11)
## p10 <- as(sample(10),"pMatrix")
## p10[1:7, 1:4]
## }
##
## test.as.ntt2dgc <- function() {
## ## [Matrix] p85 (ntTMatrix) (To be continued)
## lM <- Diagonal(x = c(TRUE,FALSE,FALSE))
## nM <- as(lM, "nMatrix")
## expect_equal(dgc, asSpMat(nM))#, msg="ntT2dgC")
## }
##
## test.as.nsc2dgc <- function() {
## ## [Matrix] p85 (nsCMatrix) (To be continued)
## lM <- Diagonal(x = c(TRUE,FALSE,FALSE))
## nM <- as(lM, "nMatrix")
## nsc <- crossprod(nM)
## expect_equal(dgc, asSpMat(nsc))#, msg="nsC2dgC")
## }
##
## test.as.ldi2dgc <- function() {
## ## [Matrix] p42 (ldiMatrix) (To be continued)
## Diagonal(x = (1:4) >= 2)
##
## ## [Matrix] p85 (ldiMatrix) (To be continued)
## lM <- Diagonal(x = c(TRUE,FALSE,FALSE))
## }