#!/usr/bin/r -t
#
# Copyright (C) 2017 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
.runThisTest <- suppressMessages(require(Matrix))
if (.runThisTest) {
.setUp <- RcppArmadillo:::unit_test_setup("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, "dgRMatrix")
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")
checkEquals(mm, asSpMat(mm), msg="dgC2dgC_1")
## [Matrix] p36 (dgCMatrix)
m <- Matrix(c(0,0,2:0), 3,5)
checkEquals(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 <- crossprod(IM1,IM2)
checkEquals(c12, asSpMat(c12), msg="dgC2dgC_3")
## [Matrix] p87 (dgCMatrix)
m <- Matrix(c(0,0,2:0), 3,5, dimnames=list(LETTERS[1:3],NULL))
dimnames(m) <- NULL
checkEquals(m, asSpMat(m), msg="dgC2dgC_4")
## [Matrix] p118 (dgCMatrix)
f1 <- gl(5, 3, labels = LETTERS[1:5])
X <- as(f1, "sparseMatrix")
dimnames(X) <- NULL
checkEquals(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)
checkEquals(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)
checkEquals(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)
checkEquals(SM, asSpMat(SM), msg="dgC2dgC_8")
## [slam] p12 (dgCMatrix)
x <- matrix(c(1, 0, 0, 2), nrow = 2)
SM <- Matrix(x, sparse = TRUE)
dgc <- as(SM, "dgCMatrix")
checkEquals(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)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")
# checkEquals(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")
# checkEquals(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")
# checkEquals(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)
# checkEquals(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))
# }
}