Merge pull request #64 from nathan-russell/master

Added support for conversion to arma::Cube types

inst/include/RcppArmadilloAs.h

@@ -117,6 +117,94 @@ namespace traits {
     private:
         S4 mat ;
     } ;
+
+    // 30 November 2015
+    // default Exporter-Cube specialization:
+    // handles cube, icube, and cx_cube
+    // fails on fcube, ucube, and cx_fcube
+    template <typename T>
+    class Exporter< arma::Cube<T> > {
+    public:
+        typedef arma::Cube<T> cube_t;
+        enum { RTYPE = Rcpp::traits::r_sexptype_traits<T>::rtype };
+        typedef typename Rcpp::traits::storage_type<RTYPE>::type value_t;
+        Exporter(SEXP x) : vec(x) {}
+
+        cube_t get() {
+            Rcpp::Vector<INTSXP> dims = vec.attr("dim");
+            if (dims.size() != 3) {
+                std::string msg = 
+                  "Error converting object to arma::Cube<T>:\n"
+                  "Input array must have exactly 3 dimensions.\n";
+                Rcpp::stop(msg);
+            }
+
+            cube_t result(
+                reinterpret_cast<T*>(vec.begin()),
+                dims[0], dims[1], dims[2], false);
+            return result;
+        }
+
+    private:
+        Rcpp::Vector<RTYPE> vec;
+    };
+
+    // specializations for 3 cube typedefs that fail above
+    // first use viable conversion SEXP -> Cube<other_t>
+    // then use conv_to<cube_t>::from(other_t other)
+    template <>
+    class Exporter<arma::fcube> {
+    public:
+        typedef arma::fcube cube_t;
+
+        Exporter(SEXP x)
+            : tmp(Exporter<arma::cube>(x).get()) {}
+
+        cube_t get() {
+            cube_t result = arma::conv_to<cube_t>::from(tmp);
+            return result;
+        }
+
+    private:
+        typedef arma::cube other_t;
+        other_t tmp;
+    };
+
+    template <>
+    class Exporter<arma::ucube> {
+    public:
+        typedef arma::ucube cube_t;
+
+        Exporter(SEXP x)
+            : tmp(Exporter<arma::icube>(x).get()) {}
+
+        cube_t get() {
+            cube_t result = arma::conv_to<cube_t>::from(tmp);
+            return result;
+        }
+
+    private:
+        typedef arma::icube other_t;
+        other_t tmp;
+    };
+
+    template <>
+    class Exporter<arma::cx_fcube> {
+    public:
+        typedef arma::cx_fcube cube_t;
+
+        Exporter(SEXP x)
+            : tmp(Exporter<arma::cx_cube>(x).get()) {}
+
+        cube_t get() {
+            cube_t result = arma::conv_to<cube_t>::from(tmp);
+            return result;
+        }
+
+    private:
+        typedef arma::cx_cube other_t;
+        other_t tmp;
+    };
 
 } // end traits
 

inst/unitTests/cpp/cube.cpp

@@ -0,0 +1,91 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// cube.cpp: RcppArmadillo unit test code for cube types 
+//
+// Copyright (C) 2015 Dirk Eddelbuettel and Nathan Russell
+//
+// This file is part of RcppArmadillo.
+//
+// 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 <http://www.gnu.org/licenses/>.
+
+// 30 November 2015
+
+// [[Rcpp::depends(RcppArmadillo)]]
+#include <RcppArmadillo.h>
+
+// [[Rcpp::export]]
+arma::cube cube_test(const arma::cube& x) {
+  return arma::pow(x, 2);
+}
+
+// [[Rcpp::export]]
+arma::fcube fcube_test(const arma::fcube& x) {
+  return arma::pow(x, 2);
+}
+
+// [[Rcpp::export]]
+arma::icube icube_test(const arma::icube& x) {
+  return arma::pow(x, 2);
+}
+
+// [[Rcpp::export]]
+arma::ucube ucube_test(const arma::ucube& x) {
+  return arma::pow(x, 2);
+}
+
+// [[Rcpp::export]]
+arma::cx_cube cx_cube_test(const arma::cx_cube& x) {
+  return arma::pow(x, 2);
+}
+
+// [[Rcpp::export]]
+arma::cx_fcube cx_fcube_test(const arma::cx_fcube& x) {
+  return arma::pow(x, 2);
+}
+
+// [[Rcpp::export]]
+arma::cube as_cube(Rcpp::NumericVector x) {
+  arma::cube y = Rcpp::as<arma::cube>(x);
+  return arma::pow(y, 2);
+}
+
+// [[Rcpp::export]]
+arma::fcube as_fcube(Rcpp::NumericVector x) {
+  arma::fcube y = Rcpp::as<arma::fcube>(x);
+  return arma::pow(y, 2);
+}
+
+// [[Rcpp::export]]
+arma::icube as_icube(Rcpp::IntegerVector x) {
+  arma::icube y = Rcpp::as<arma::icube>(x);
+  return arma::pow(y, 2);
+}
+
+// [[Rcpp::export]]
+arma::ucube as_ucube(Rcpp::IntegerVector x) {
+  arma::ucube y = Rcpp::as<arma::ucube>(x);
+  return arma::pow(y, 2);
+}
+
+// [[Rcpp::export]]
+arma::cx_cube as_cx_cube(Rcpp::ComplexVector x) {
+  arma::cx_cube y = Rcpp::as<arma::cx_cube>(x);
+  return arma::pow(y, 2);
+}
+
+// [[Rcpp::export]]
+arma::cx_fcube as_cx_fcube(Rcpp::ComplexVector x) {
+  arma::cx_fcube y = Rcpp::as<arma::cx_fcube>(x);
+  return arma::pow(y, 2);
+}

inst/unitTests/runit.cube.R

@@ -0,0 +1,92 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2015 Dirk Eddelbuettel and Nathan Russell
+#
+# This file is part of RcppArmadillo.
+#
+# 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 <http://www.gnu.org/licenses/>.
+
+# 30 November 2015
+
+.setUp <- RcppArmadillo:::unit_test_setup("cube.cpp")
+
+test.cube <- function() {
+
+  ## test arrays
+  dbl_cube <- array(1.5:27.5, rep(3, 3))
+  int_cube <- array(1L:27L, rep(3, 3))
+  cplx_cube <- array(1.5:27.5 + 2i, rep(3, 3))
+
+  ## check cube (Cube<double>) and fcube (Cube<float>)
+  checkEquals(cube_test(dbl_cube), (dbl_cube ** 2), "cube_test")
+  checkEquals(fcube_test(dbl_cube), (dbl_cube ** 2), "fcube_test")
+
+  ## check icube (Cube<sword>) and ucube (Cube<uword>)
+  checkEquals(icube_test(int_cube), (int_cube ** 2), "icube_test")
+  checkEquals(ucube_test(int_cube), (int_cube ** 2), "ucube_test")
+
+  ## check cx_cube (Cube<cx_double>) and cx_fcube (Cube<cx_float>)
+  checkEquals(cx_cube_test(cplx_cube), (cplx_cube ** 2), "cx_cube_test")
+  checkEquals(cx_fcube_test(cplx_cube), (cplx_cube ** 2), "cx_fcube_test",
+              tolerance = 1.5e-7)
+
+
+  ## test that exception is thrown with dims(x) != 3
+  dbl_cube <- array(1.5:16.5, rep(2, 4))
+  int_cube <- array(1L:16L, rep(2, 4))
+  cplx_cube <- array(1.5:16.5 + 2i, rep(2, 4))
+
+  ## cube_test and fcube_test should throw here
+  checkTrue(
+    inherits(try(cube_test(dbl_cube), silent = TRUE), "try-error"),
+    "cube_test bad dimensions")
+  checkTrue(
+    inherits(try(fcube_test(dbl_cube), silent = TRUE), "try-error"),
+    "fcube_test bad dimensions")
+
+  ## icube_test and ucube_test should throw here
+  checkTrue(
+    inherits(try(icube_test(int_cube), silent = TRUE), "try-error"),
+    "icube_test bad dimensions")
+  checkTrue(
+    inherits(try(ucube_test(int_cube), silent = TRUE), "try-error"),
+    "ucube_test bad dimensions")
+
+  ## cx_cube_test and cx_fcube_test should throw here
+  checkTrue(
+    inherits(try(cx_cube_test(cplx_cube), silent = TRUE), "try-error"),
+    "cx_cube_test bad dimensions")
+  checkTrue(
+    inherits(try(cx_fcube_test(cplx_cube), silent = TRUE), "try-error"),
+    "cx_fcube_test bad dimensions")
+
+
+  ## sanity check for explicit calls to Rcpp::as< arma::Cube<T> > 
+  dbl_cube <- array(1.5:27.5, rep(3, 3))
+  int_cube <- array(1L:27L, rep(3, 3))
+  cplx_cube <- array(1.5:27.5 + 2i, rep(3, 3))
+
+  ## check cube (Cube<double>) and fcube (Cube<float>)
+  checkEquals(as_cube(dbl_cube), (dbl_cube ** 2), "as_cube")
+  checkEquals(as_fcube(dbl_cube), (dbl_cube ** 2), "as_fcube")
+
+  ## check icube (Cube<sword>) and ucube (Cube<uword>)
+  checkEquals(as_icube(int_cube), (int_cube ** 2), "as_icube")
+  checkEquals(as_ucube(int_cube), (int_cube ** 2), "as_ucube")
+
+  ## check cx_cube (Cube<cx_double>) and cx_fcube (Cube<cx_float>)
+  checkEquals(as_cx_cube(cplx_cube), (cplx_cube ** 2), "as_cx_cube")
+  checkEquals(as_cx_fcube(cplx_cube), (cplx_cube ** 2), "as_cx_fcube",
+              tolerance = 1.5e-7)
+}