#!/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 . # 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) and fcube (Cube) checkEquals(cube_test(dbl_cube), (dbl_cube ** 2), "cube_test") checkEquals(fcube_test(dbl_cube), (dbl_cube ** 2), "fcube_test") ## check icube (Cube) and ucube (Cube) checkEquals(icube_test(int_cube), (int_cube ** 2), "icube_test") checkEquals(ucube_test(int_cube), (int_cube ** 2), "ucube_test") ## check cx_cube (Cube) and cx_fcube (Cube) 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 > 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) and fcube (Cube) checkEquals(as_cube(dbl_cube), (dbl_cube ** 2), "as_cube") checkEquals(as_fcube(dbl_cube), (dbl_cube ** 2), "as_fcube") ## check icube (Cube) and ucube (Cube) checkEquals(as_icube(int_cube), (int_cube ** 2), "as_icube") checkEquals(as_ucube(int_cube), (int_cube ** 2), "as_ucube") ## check cx_cube (Cube) and cx_fcube (Cube) 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) }