Merge branch 'fix-as_refactor' into dev

Author: itsrainingdata

NAMESPACE

@@ -1,7 +1,10 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method(edgeList,SparseBlockMatrixR)
+S3method(sparse,SparseBlockMatrixR)
 export(ccdr.run)
 importFrom(Rcpp,sourceCpp)
+importFrom(sparsebnUtils,edgeList)
 importFrom(sparsebnUtils,get.adjacency.matrix)
 importFrom(sparsebnUtils,is.zero)
 importFrom(sparsebnUtils,num.edges)

R/s3-SparseBlockMatrixR.R

@@ -56,6 +56,10 @@ is.SparseBlockMatrixR <- function(x){
     inherits(x, "SparseBlockMatrixR")
 } # END IS.SPARSEBLOCKMATRIXR
 
+as.SparseBlockMatrixR <- function(x){
+    SparseBlockMatrixR(x) # NOTE: S3 delegation is implicitly handled by the constructor here
+}
+
 #------------------------------------------------------------------------------#
 # reIndexC.SparseBlockMatrixR
 #  Re-indexing TO C for SparseBlockMatrixR objects
@@ -201,30 +205,6 @@ SparseBlockMatrixR.matrix <- function(x, sigmas, ...){
     SparseBlockMatrixR(sparsebnUtils::as.sparse(x), sigmas, ...)
 } # END SPARSEBLOCKMATRIXR.MATRIX
 
-#------------------------------------------------------------------------------#
-# as.SparseBlockMatrixR.list
-#  Convert FROM list TO SparseBlockMatrixR
-#
-as.SparseBlockMatrixR.list <- function(x){
-    SparseBlockMatrixR(x)
-} # END AS.SPARSEBLOCKMATRIXR.LIST
-
-#------------------------------------------------------------------------------#
-# as.SparseBlockMatrixR.sparse
-#  Convert FROM sparse TO SparseBlockMatrixR
-#
-as.SparseBlockMatrixR.sparse <- function(x){
-    SparseBlockMatrixR(x)
-} # END AS.SPARSEBLOCKMATRIXR.SPARSE
-
-#------------------------------------------------------------------------------#
-# as.SparseBlockMatrixR.matrix
-#  Convert FROM matrix TO SparseBlockMatrixR
-#
-as.SparseBlockMatrixR.matrix <- function(x){
-    SparseBlockMatrixR(x)
-} # END AS.SPARSEBLOCKMATRIXR.MATRIX
-
 #------------------------------------------------------------------------------#
 # as.list.SparseBlockMatrixR
 #  Convert FROM SparseBlockMatrixR TO list
@@ -261,10 +241,11 @@ as.matrix.SparseBlockMatrixR <- function(x){
 } # END AS.MATRIX.SPARSEBLOCKMATRIXR
 
 #------------------------------------------------------------------------------#
-# as.edgeList.SparseBlockMatrixR
+# edgeList.SparseBlockMatrixR
 # Coerce SBM to edge list
 #
-as.edgeList.SparseBlockMatrixR <- function(x){
+#' @export
+edgeList.SparseBlockMatrixR <- function(x){
     #
     # We have to be careful in obtaining the edge list of a SparseBlockMatrixR object:
     #  It is NOT the same as the rows slot since some of these components may have
@@ -278,12 +259,13 @@ as.edgeList.SparseBlockMatrixR <- function(x){
     el <- mapply(function(x, y){ y[which(abs(x) > sparsebnUtils::zero_threshold())]}, x$vals, x$rows)
 
     sparsebnUtils::edgeList(el)
-} # AS.EDGELIST.SPARSEBLOCKMATRIXR
+} # EDGELIST.SPARSEBLOCKMATRIXR
 
 #------------------------------------------------------------------------------#
 # sparse.SparseBlockMatrixR
 # 2016-01-22: Migrated to this file from s3-sparse.R
 #
+#' @export
 sparse.SparseBlockMatrixR <- function(x, index = "R", ...){
 
     if(index != "R" && index != "C") stop("Invalid entry for index parameter: Must be either 'R' or 'C'!")
@@ -321,16 +303,16 @@ sparse.SparseBlockMatrixR <- function(x, index = "R", ...){
     }
 } # END SPARSE.SPARSEBLOCKMATRIXR
 
-#------------------------------------------------------------------------------#
-# as.sparse.SparseBlockMatrixR
-#  Convert FROM SparseBlockMatrixR TO sparse
-#  By default, return the object using R indexing. If desired, the method can return C-style indexing by setting
-#    index = "C".
-# 2016-01-22: Migrated to this file from s3-sparse.R
-#
-as.sparse.SparseBlockMatrixR <- function(x, index = "R", ...){
-    sparse.SparseBlockMatrixR(x, index)
-} # END AS.SPARSE.SPARSEBLOCKMATRIXR
+# #------------------------------------------------------------------------------#
+# # as.sparse.SparseBlockMatrixR
+# #  Convert FROM SparseBlockMatrixR TO sparse
+# #  By default, return the object using R indexing. If desired, the method can return C-style indexing by setting
+# #    index = "C".
+# # 2016-01-22: Migrated to this file from s3-sparse.R
+# #
+# as.sparse.SparseBlockMatrixR <- function(x, index = "R", ...){
+#     sparse.SparseBlockMatrixR(x, index)
+# } # END AS.SPARSE.SPARSEBLOCKMATRIXR
 
 # to_graphNEL.SparseBlockMatrixR
 #  Convert SBM object to graphNEL object
@@ -347,7 +329,7 @@ to_graphNEL.SparseBlockMatrixR <- function(x){
 } # END TO_GRAPHNEL.SPARSEBLOCKMATRIXR
 
 get.adjacency.matrix.SparseBlockMatrixR <- function(x){
-    sparsebnUtils::get.adjacency.matrix(as.edgeList.SparseBlockMatrixR(x))
+    sparsebnUtils::get.adjacency.matrix(as.edgeList(x))
 } # END GET.ADJACENCY.MATRIX.SPARSEBLOCKMATRIXR
 
 num.nodes.SparseBlockMatrixR <- function(x){
@@ -357,7 +339,7 @@ num.nodes.SparseBlockMatrixR <- function(x){
 
 num.edges.SparseBlockMatrixR <- function(x){
     ### The number of nodes should be exactly the same as the length of the rows list
-    sparsebnUtils::num.edges(as.edgeList.SparseBlockMatrixR(x))
+    sparsebnUtils::num.edges(as.edgeList(x))
 } # END NUM.EDGES.SPARSEBLOCKMATRIXR
 
 # This function is (so far) only used in unit tests

R/s3-generics.R

@@ -14,5 +14,4 @@
 
 # Generics for SparseBlockMatrixR ------------------------------------------------------------
 SparseBlockMatrixR <- function(x, ...) UseMethod("SparseBlockMatrixR", x)
-as.SparseBlockMatrixR <- function(x) UseMethod("as.SparseBlockMatrixR", x)
 to_B <- function(x) UseMethod("to_B", x)

R/zzz.R

@@ -14,6 +14,8 @@
 #' @importFrom sparsebnUtils num.nodes
 #' @importFrom sparsebnUtils num.edges
 #' @importFrom sparsebnUtils is.zero
+#' @importFrom sparsebnUtils edgeList
+#' @importFrom sparsebnUtils sparse
 
 .onAttach <- function(libname, pkgname){
     ### Only sparsebn needs a package startup message

tests/testthat/test-s3_as.R

@@ -77,12 +77,12 @@ test_that("as.sparse -> as.SparseBlockMatrixR -> as.sparse makes no changes", {
     m <- matrix(rep(0, 1), ncol = 1)
     sp <- sparsebnUtils::as.sparse(m)
     sbm <- suppressWarnings(sparsebnUtils::as.sparse(as.SparseBlockMatrixR(sp)))
-    expect_that(sbm, equals(sp))
+    expect_equivalent(sbm, sp)
 
     m <- matrix(rep(0, 4), ncol = 2)
     sp <- sparsebnUtils::as.sparse(m)
     sbm <- suppressWarnings(sparsebnUtils::as.sparse(as.SparseBlockMatrixR(sp)))
-    expect_that(sbm, equals(sp))
+    expect_equivalent(sbm, sp)
 
     ### NOTE: Cannot test on random sparse matrix since SBM class ASSUMES a block structure,
     ###        i.e. induced by a DAG
@@ -91,7 +91,7 @@ test_that("as.sparse -> as.SparseBlockMatrixR -> as.sparse makes no changes", {
     m <- random.dag.matrix(10, 10)
     sp <- sparsebnUtils::as.sparse(m)
     sbm <- suppressWarnings(sparsebnUtils::as.sparse(as.SparseBlockMatrixR(sp)))
-    expect_that(sbm, equals(sp))
+    expect_equivalent(sbm, sp)
 })
 
 ### SparseBlockMatrixR -> edgeList -> matrix