Skip to content

Commit

Permalink
Rewrite conversion for ddiMatrix (#145)
Browse files Browse the repository at this point in the history
  • Loading branch information
@binxiangni @eddelbuettel
binxiangni authored and eddelbuettel committed Jul 11, 2017
1 parent cc04640 commit 7a50d12
Show file tree
Hide file tree
Showing 4 changed files with 113 additions and 202 deletions.
9 changes: 9 additions & 0 deletions ChangeLog
View file
@@ -1,3 +1,12 @@
2017-07-10 Binxiang Ni <binxiangni@gmail.com>

* inst/include/RcppArmadilloAs.h: Rewrite conversion for ddiMatrix
to support an extreme case
* inst/unitTests/runit.sparse.R: Move unit tests for the conversion
for sparse matrices to runit.sparseConversion.R
* inst/unitTests/runit.sparseConversion.R: Add more unit tests for
the conversion for ddiMatrix

2017-07-08 Binxiang Ni <binxiangni@gmail.com>

* inst/include/RcppArmadilloAs.h: Add conversion for indMatrix
Expand Down
36 changes: 21 additions & 15 deletions inst/include/RcppArmadilloAs.h
View file
Expand Up @@ -551,24 +551,30 @@ namespace traits {
std::copy(x.begin(), x.end(), arma::access::rwp(res.values));
}
else if (type == "ddiMatrix") {
IntegerVector i(ncol);
IntegerVector p(ncol+1);
std::vector<int> i;
std::vector<int> p;
std::vector<double> x;
std::string diag = Rcpp::as<std::string>(mat.slot("diag"));
Vector<RTYPE> x = no_init(ncol);

if (diag == "U") {
x.fill(1);
for(int idx = 0; idx < ncol; idx++){
i.push_back(idx);
p.push_back(idx);
x.push_back(1);
}
p.push_back(ncol);
} else {
x = Vector<RTYPE>(mat.slot("x"));
}

// Calculate i
for(int tmp = 0; tmp < i.size(); tmp++){
i[tmp] = tmp;
}

// Calculate p
for(int tmp = 0; tmp < p.size(); tmp++){
p[tmp] = tmp;
Vector<RTYPE> tmpx = mat.slot("x");
int tmpp = 0;
for(int idx = 0; idx < ncol; idx++){
p.push_back(tmpp);
if (tmpx[idx] != 0) {
i.push_back(idx);
x.push_back(tmpx[idx]);
tmpp++;
}
}
p.push_back(tmpp);
}

// Making space for the elements
Expand Down
165 changes: 0 additions & 165 deletions inst/unitTests/runit.sparse.R
View file
Expand Up @@ -35,7 +35,6 @@ if (.runThisTest) {
dimnames(M) <- NULL
SM <- Matrix(M, sparse=TRUE)


test.as.sparse <- function() {
checkEquals(SM, asSpMat(SM), msg="as<sp_mat>")
}
Expand Down Expand Up @@ -91,168 +90,4 @@ if (.runThisTest) {
l <- list(SM, SM)
checkEquals(l, sparseList(l), msg="sparseList")
}

test.dtc2dgc <- function() {
mtxt <- c("0 0 0 3",
"0 0 7 0",
"0 0 0 0",
"0 0 0 0")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dtc <- Matrix(M, sparse=TRUE)
dgc <- methods::as(dtc, "dgCMatrix")
checkEquals(dgc, asSpMat(dtc), msg="asSpMat")

dtc@diag <- "U"
dgc <- methods::as(dtc, "dgCMatrix")
checkEquals(dgc, asSpMat(dtc), msg="asSpMat")
}

test.dsc2dgc <- function() {
mtxt <- c("10 0 1 0 3",
"0 10 0 1 0",
"1 0 10 0 1",
"0 1 0 10 0",
"3 0 1 0 10")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dsc <- Matrix(M, sparse=TRUE)
dgc <- methods::as(dsc, "dgCMatrix")
checkEquals(dgc, asSpMat(dsc), msg="asSpMat")

dsc <- t(dsc)
dgc <- methods::as(dsc, "dgCMatrix")
checkEquals(dgc, asSpMat(dsc), msg="asSpMat")
}

test.dgt2dgc <- function() {
dgt <- methods::as(SM, "dgTMatrix")
checkEquals(SM, asSpMat(dgt), msg="asSpMat")
}

test.dtt2dgc <- function() {
mtxt <- c("0 0 0 3",
"0 0 7 0",
"0 0 0 0",
"0 0 0 0")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dtc <- Matrix(M, sparse=TRUE)
dgc <- methods::as(dtc, "dgCMatrix")
dtt <- methods::as(dtc, "dtTMatrix")
checkEquals(dgc, asSpMat(dtt), msg="asSpMat")

dtc@diag <- "U"
dgc <- methods::as(dtc, "dgCMatrix")
dtt <- methods::as(dtc, "dtTMatrix")
checkEquals(dgc, asSpMat(dtt), msg="asSpMat")
}

test.dst2dgc <- function() {
mtxt <- c("10 0 1 0 3",
"0 10 0 1 0",
"1 0 10 0 1",
"0 1 0 10 0",
"3 0 1 0 10")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dsc <- Matrix(M, sparse=TRUE)
dgc <- methods::as(dsc, "dgCMatrix")
dst <- methods::as(dsc, "dsTMatrix")
checkEquals(dgc, asSpMat(dst), msg="asSpMat")

dsc <- t(dsc)
dgc <- methods::as(dsc, "dgCMatrix")
dst <- methods::as(dsc, "dsTMatrix")
checkEquals(dgc, asSpMat(dst), msg="asSpMat")
}

test.dgr2dgc <- function() {
dgr <- methods::as(M, "dgRMatrix")
checkEquals(SM, asSpMat(dgr), msg="asSpMat")
}

test.dtr2dgc <- function() {
mtxt <- c("0 0 0 3",
"0 0 7 0",
"0 0 0 0",
"0 0 0 0")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dtc <- Matrix(M, sparse=TRUE)
dgc <- methods::as(dtc, "dgCMatrix")
dtr <- methods::as(dtc, "RsparseMatrix")
checkEquals(dgc, asSpMat(dtr), msg="asSpMat")

dtc@diag <- "U"
dgc <- methods::as(dtc, "dgCMatrix")
dtr <- methods::as(dtc, "RsparseMatrix")
checkEquals(dgc, asSpMat(dtr), msg="asSpMat")
}

test.dsr2dgc <- function() {
mtxt <- c("10 0 1 0 3",
"0 10 0 1 0",
"1 0 10 0 1",
"0 1 0 10 0",
"3 0 1 0 10")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dsc <- Matrix(M, sparse=TRUE)
dgc <- methods::as(dsc, "dgCMatrix")
dsr <- methods::as(dsc, "RsparseMatrix")
checkEquals(dgc, asSpMat(dsr), msg="asSpMat")

dsc <- t(dsc)
dgc <- methods::as(dsc, "dgCMatrix")
dsr <- methods::as(dsc, "RsparseMatrix")
checkEquals(dgc, asSpMat(dsr), msg="asSpMat")
}

test.ind2dgc <- function() {
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 <- methods::as(M, "dgCMatrix")
ind <- as(rep(c(2,3,1), e=3), "indMatrix")
checkEquals(dgc, asSpMat(ind), msg="asSpMat")
}

test.p2dgc <- function() {
mtxt <- c("0 1 0",
"0 0 1",
"1 0 0")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dgc <- methods::as(M, "dgCMatrix")
p <- as(as.integer(c(2,3,1)), "pMatrix")
checkEquals(dgc, asSpMat(p), msg="asSpMat")
}

test.ddi2dgc <- function() {
mtxt <- c("1 0 0",
"0 1 0",
"0 0 1")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dgc <- methods::as(M, "dgCMatrix")
ddi <- methods::as(M, "diagonalMatrix")
checkEquals(dgc, asSpMat(ddi), msg="asSpMat")

mtxt <- c("10 0",
"0 1")
M <- as.matrix(read.table(text=mtxt))
dimnames(M) <- NULL
dgc <- methods::as(M, "dgCMatrix")
ddi <- methods::as(M, "diagonalMatrix")
checkEquals(dgc, asSpMat(ddi), msg="asSpMat")
}
}

0 comments on commit 7a50d12

Please sign in to comment.