Ordering big.matrix Columns

.travis.yml

@@ -6,6 +6,9 @@ os:
   - linux
   - osx
 
+r_build_args: --no-build-vignettes --no-manual --no-resave-data
+r_check_args: --no-build-vignettes --no-manual
+
 r_binary_packages:
   - Rcpp
   - bigmemory.sri

NAMESPACE

@@ -17,7 +17,9 @@ export(is.separated)
 export(is.shared)
 export(is.sub.big.matrix)
 export(morder)
+export(morderCols)
 export(mpermute)
+export(mpermuteCols)
 export(mwhich)
 export(read.big.matrix)
 export(shared.name)

R/RcppExports.R

@@ -13,6 +13,18 @@ ReorderBigMatrix <- function(address, orderVec) {
     invisible(.Call('bigmemory_ReorderBigMatrix', PACKAGE = 'bigmemory', address, orderVec))
 }
 
+ReorderRIntMatrixCols <- function(matrixVector, nrow, ncol, orderVec) {
+    invisible(.Call('bigmemory_ReorderRIntMatrixCols', PACKAGE = 'bigmemory', matrixVector, nrow, ncol, orderVec))
+}
+
+ReorderRNumericMatrixCols <- function(matrixVector, nrow, ncol, orderVec) {
+    invisible(.Call('bigmemory_ReorderRNumericMatrixCols', PACKAGE = 'bigmemory', matrixVector, nrow, ncol, orderVec))
+}
+
+ReorderBigMatrixCols <- function(address, orderVec) {
+    invisible(.Call('bigmemory_ReorderBigMatrixCols', PACKAGE = 'bigmemory', address, orderVec))
+}
+
 OrderRIntMatrix <- function(matrixVector, nrow, columns, naLast, decreasing) {
     .Call('bigmemory_OrderRIntMatrix', PACKAGE = 'bigmemory', matrixVector, nrow, columns, naLast, decreasing)
 }
@@ -25,6 +37,18 @@ OrderBigMatrix <- function(address, columns, naLast, decreasing) {
     .Call('bigmemory_OrderBigMatrix', PACKAGE = 'bigmemory', address, columns, naLast, decreasing)
 }
 
+OrderRIntMatrixCols <- function(matrixVector, nrow, ncol, rows, naLast, decreasing) {
+    .Call('bigmemory_OrderRIntMatrixCols', PACKAGE = 'bigmemory', matrixVector, nrow, ncol, rows, naLast, decreasing)
+}
+
+OrderRNumericMatrixCols <- function(matrixVector, nrow, ncol, rows, naLast, decreasing) {
+    .Call('bigmemory_OrderRNumericMatrixCols', PACKAGE = 'bigmemory', matrixVector, nrow, ncol, rows, naLast, decreasing)
+}
+
+OrderBigMatrixCols <- function(address, rows, naLast, decreasing) {
+    .Call('bigmemory_OrderBigMatrixCols', PACKAGE = 'bigmemory', address, rows, naLast, decreasing)
+}
+
 CCleanIndices <- function(indices, rc) {
     .Call('bigmemory_CCleanIndices', PACKAGE = 'bigmemory', indices, rc)
 }

R/bigmemory.R

@@ -1796,29 +1796,41 @@ morder <- function(x, cols, na.last=TRUE, decreasing = FALSE)
   {
     stop("Bad column indices.")
   }
+
+  switch(class(x),
+         "big.matrix" = OrderBigMatrix(x@address, as.double(cols), 
+                                       as.integer(na.last), as.logical(decreasing) ),
+         "matrix" = switch(typeof(x),
+                           'integer' = OrderRIntMatrix(x, nrow(x), as.double(cols), 
+                                                       as.integer(na.last), as.logical(decreasing) ),
+                           'double' = OrderRNumericMatrix(x, nrow(x), as.double(cols), 
+                                                          as.integer(na.last), as.logical(decreasing) ),
+                           stop("Unsupported matrix value type.")),
+         stop("unsupported matrix type")
+  )
+}
 
-  if (class(x) == 'big.matrix')
-  {
-    return(OrderBigMatrix(x@address, as.double(cols), 
-      as.integer(na.last), as.logical(decreasing) ))
-  }
-  else if (class(x) == 'matrix')
+#' @rdname morder
+#' @export
+morderCols <- function(x, rows, na.last=TRUE, decreasing = FALSE)
+{
+  if (is.character(rows)) rows <- mmap( rows, rownames(x) )
+  if (sum(rows > nrow(x)) > 0 | sum(rows < 1) > 0 | sum(is.na(rows) > 0))
   {
-    if (typeof(x) == 'integer')
-    {
-      return(OrderRIntMatrix(x, nrow(x), as.double(cols), 
-        as.integer(na.last), as.logical(decreasing) ))
-    }
-    else if (typeof(x) == 'double')
-    {
-      return(OrderRNumericMatrix(x, nrow(x), as.double(cols), 
-        as.integer(na.last), as.logical(decreasing) ))
-    }
-    else
-      stop("Unsupported matrix value type.")
+    stop("Bad row indices.")
   }
-  else
-    stop("Unsupported matrix type.")
+
+  switch(class(x),
+         "big.matrix" = OrderBigMatrixCols(x@address, as.double(rows), 
+                                           as.integer(na.last), as.logical(decreasing) ),
+         "matrix" = switch(typeof(x),
+                           'integer' = OrderRIntMatrixCols(x, nrow(x), ncol(x), as.double(rows), 
+                                                           as.integer(na.last), as.logical(decreasing) ),
+                           'double' = OrderRNumericMatrixCols(x, nrow(x), ncol(x), as.double(rows), 
+                                                              as.integer(na.last), as.logical(decreasing) ),
+                           stop("Unsupported matrix value type.")),
+         stop("unsupported matrix type")
+  )
 }
 
 #' @rdname morder
@@ -1848,28 +1860,59 @@ mpermute <- function(x, order=NULL, cols=NULL, allow.duplicates=FALSE, ...)
   else 
     order = morder(x, cols, ...)
 
-  if (class(x) == 'big.matrix')
-  {
-    ReorderBigMatrix(x@address, order)
-  }
-  else if (class(x) == 'matrix')
+  switch(class(x),
+         "big.matrix" = ReorderBigMatrix(x@address, order),
+         "matrix" = switch(typeof(x),
+                           'integer' = ReorderRIntMatrix(x, nrow(x), ncol(x), order),
+                           'double' = ReorderRNumericMatrix(x, nrow(x), ncol(x), order),
+                           stop("Unsupported matrix value type.")),
+         stop("invalid class")
+  )
+
+  return(invisible(TRUE))
+
+}
+
+#' @rdname morder
+#' @export
+mpermuteCols <- function(x, order=NULL, rows=NULL, allow.duplicates=FALSE, ...)
+{
+  if (is.null(order) && is.null(rows))
+    stop("You must specify either order or cols.")
+
+  if (!is.null(order) && !is.null(rows))
+    stop("You must specify either order or cols.")
+
+  if (!is.null(order))
   {
-    if (typeof(x) == 'integer')
-    {
-      OrderRIntMatrix(x, nrow(x), ncol(x), order)
-    }
-    else if (typeof(x) == 'double')
-    {
-      ReorderRNumericMatrix(x, nrow(x), ncol(x), order)
-    }
-    else
-      stop("Unsupported matrix value type.")
+    if (length(order) != ncol(x))
+      stop("order parameter must have the same length as ncol(x)")
+
+    if (!allow.duplicates && sum(duplicated(order)) > 0)
+      stop("order parameter contains duplicated entries.")
+
+    r = range(order)
+    if (is.na(r[1]))
+      stop("order parameter contains NAs")
+    if (r[1] < 1 || r[2] > nrow(x))
+      stop("order parameter contains values that are out-of-range.")
   }
+  else 
+    order = morderCols(x, rows, ...)
+
+  switch(class(x),
+         "big.matrix" = ReorderBigMatrixCols(x@address, order),
+         "matrix" = switch(typeof(x),
+                           'integer' = ReorderRIntMatrixCols(x, nrow(x), ncol(x), order),
+                           'double' = ReorderRNumericMatrixCols(x, nrow(x), ncol(x), order),
+                           stop("Unsupported matrix value type.")),
+         stop("unimplemented class")
+         )
+
   return(invisible(TRUE))
 
 }
 
-
 #' @rdname big.matrix
 #' @export
 setGeneric('is.readonly', function(x) standardGeneric('is.readonly'))

inst/include/bigmemory/MatrixAccessor.hpp

@@ -20,14 +20,27 @@ class MatrixAccessor
       _colOffset = 0;
       _nrow = nrow;
     }
+
+    MatrixAccessor(T* pData, const index_type &nrow, const index_type &ncol)
+    {
+      _pMat = pData;
+      _totalRows = nrow;
+      _totalCols = ncol;
+      _rowOffset = 0;
+      _colOffset = 0;
+      _nrow = nrow;
+      _ncol = ncol;
+    }
 
     MatrixAccessor( BigMatrix &bm )
     {
       _pMat = reinterpret_cast<T*>(bm.matrix());
       _totalRows = bm.total_rows();
+      _totalCols = bm.total_columns();
       _rowOffset = bm.row_offset();
       _colOffset = bm.col_offset();
       _nrow = bm.nrow();
+      _ncol = bm.ncol();
     }
 
     inline T* operator[](const index_type &col) 
@@ -39,13 +52,20 @@ class MatrixAccessor
     {
       return _nrow;
     }
+
+    index_type ncol() const
+    {
+      return _ncol;
+    }
 
   protected:
     T *_pMat;
     index_type _totalRows;
+    index_type _totalCols;
     index_type _rowOffset;
     index_type _colOffset;
     index_type _nrow;
+    index_type _ncol;
 };
 
 template<typename T>
@@ -61,6 +81,7 @@ class SepMatrixAccessor
       _rowOffset = bm.row_offset();
       _colOffset = bm.col_offset();
       _totalRows = bm.nrow();
+      _totalCols = bm.ncol();
     }
 
     inline T* operator[](const index_type col) 
@@ -70,15 +91,20 @@ class SepMatrixAccessor
 
     index_type nrow() const
     {
-      return _nrow;
+      return _totalRows;
+    }
+
+    index_type ncol() const
+    {
+      return _totalCols;
     }
 
   protected:
     T **_ppMat;
     index_type _rowOffset;
     index_type _colOffset;
     index_type _totalRows;
-    index_type _nrow;
+    index_type _totalCols;
 };
 
 #endif //BIG_MATRIX_ACCESSOR

man-roxygen/morder_template.R

@@ -1,5 +1,5 @@
 #' @rdname morder
-#' @title Ordering and row-permuting functions for ``big.matrix'' and 
+#' @title Ordering and Permuting functions for ``big.matrix'' and 
 #' ``matrix'' objects
 #' @description The \code{morder} function returns a permutation of row 
 #' indices which can be used to rearrangea an object according to the values 
@@ -9,6 +9,7 @@
 #' an order vector or a desired ordering on a set of columns.
 #' @param x A \code{big.matrix} or \code{matrix} object with numeric values.
 #' @param cols The columns of \code{x} to get the ordering for or reorder on
+#' @param rows The rows of \code{x} to get the ordering for or reorder on
 #' @param na.last for controlling the treatment of \code{NA}s. If 
 #' \code{TRUE}, missing values in the data are put last; if \code{FALSE}, 
 #' they are put first; if \code{NA}, they are removed.

man/morder.Rd

@@ -2,13 +2,19 @@
 % Please edit documentation in R/bigmemory.R
 \name{morder}
 \alias{morder}
+\alias{morderCols}
 \alias{mpermute}
-\title{Ordering and row-permuting functions for ``big.matrix'' and
+\alias{mpermuteCols}
+\title{Ordering and Permuting functions for ``big.matrix'' and
 ``matrix'' objects}
 \usage{
 morder(x, cols, na.last = TRUE, decreasing = FALSE)
 
+morderCols(x, rows, na.last = TRUE, decreasing = FALSE)
+
 mpermute(x, order = NULL, cols = NULL, allow.duplicates = FALSE, ...)
+
+mpermuteCols(x, order = NULL, rows = NULL, allow.duplicates = FALSE, ...)
 }
 \arguments{
 \item{x}{A \code{big.matrix} or \code{matrix} object with numeric values.}
@@ -22,6 +28,8 @@ they are put first; if \code{NA}, they are removed.}
 \item{decreasing}{logical. Should the sort order be increasing or
 decreasing?}
 
+\item{rows}{The rows of \code{x} to get the ordering for or reorder on}
+
 \item{order}{A vector specifying the reordering of rows, i.e. the
 result of a call to \code{order} or \code{morder}.}