#!/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)) ## }