[Rcpp-commits] r4387 - in pkg/Rcpp/inst/unitTests: . cpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 2 19:26:25 CEST 2013
Author: romain
Date: 2013-07-02 19:26:25 +0200 (Tue, 02 Jul 2013)
New Revision: 4387
Removed:
pkg/Rcpp/inst/unitTests/runit.sugarOps.R
Modified:
pkg/Rcpp/inst/unitTests/cpp/sugar.cpp
pkg/Rcpp/inst/unitTests/runit.sugar.R
Log:
move sugar Ops to sugar, use more sourceCpp
Modified: pkg/Rcpp/inst/unitTests/cpp/sugar.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/sugar.cpp 2013-07-02 17:16:26 UTC (rev 4386)
+++ pkg/Rcpp/inst/unitTests/cpp/sugar.cpp 2013-07-02 17:26:25 UTC (rev 4387)
@@ -2,7 +2,7 @@
//
// sugar.cpp: Rcpp R/C++ interface class library -- sugar unit tests
//
-// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2012 - 2013 Dirk Eddelbuettel and Romain Francois
//
// This file is part of Rcpp.
//
@@ -594,3 +594,40 @@
return clamp( a, x, b ) ;
}
+// [[Rcpp::export]]
+List vector_scalar_ops( NumericVector xx ){
+ NumericVector y1 = xx + 2.0; // NB does not work with ints as eg "+ 2L"
+ NumericVector y2 = 2 - xx;
+ NumericVector y3 = xx * 2.0;
+ NumericVector y4 = 2.0 / xx;
+ return List::create(y1, y2, y3, y4);
+}
+
+// [[Rcpp::export]]
+List vector_scalar_logical( NumericVector xx ){
+ LogicalVector y1 = xx < 2;
+ LogicalVector y2 = 2 > xx;
+ LogicalVector y3 = xx <= 2;
+ LogicalVector y4 = 2 != xx;
+ return List::create(y1, y2, y3, y4);
+}
+
+// [[Rcpp::export]]
+List vector_vector_ops( NumericVector xx, NumericVector yy){
+ NumericVector y1 = xx + yy;
+ NumericVector y2 = yy - xx;
+ NumericVector y3 = xx * yy;
+ NumericVector y4 = yy / xx;
+ return List::create(y1, y2, y3, y4);
+}
+
+// [[Rcpp::export]]
+List vector_vector_logical( NumericVector xx, NumericVector yy){
+ LogicalVector y1 = xx < yy;
+ LogicalVector y2 = xx > yy;
+ LogicalVector y3 = xx <= yy;
+ LogicalVector y4 = xx >= yy;
+ LogicalVector y5 = xx == yy;
+ LogicalVector y6 = xx != yy;
+ return List::create(y1, y2, y3, y4, y5, y6);
+}
Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R 2013-07-02 17:16:26 UTC (rev 4386)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R 2013-07-02 17:26:25 UTC (rev 4387)
@@ -22,10 +22,7 @@
if (.runThisTest) {
-.setUp <- function() {
- #sourceCpp( system.file( "unitTests/cpp/sugar.cpp", package = "Rcpp") )
- sourceCpp(file.path(pathRcppTests, "cpp/sugar.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "sugar.cpp" )
test.sugar.abs <- function( ){
x <- rnorm(10)
@@ -729,4 +726,26 @@
)
}
+test.vector.scalar.ops <- function( ){
+ x <- rnorm(10)
+ checkEquals(vector_scalar_ops(x), list(x + 2, 2 - x, x * 2, 2 / x), "sugar vector scalar operations")
}
+
+test.vector.scalar.logical <- function( ){
+ x <- rnorm(10) + 2
+ checkEquals(vector_scalar_logical(x), list(x < 2, 2 > x, x <= 2, 2 != x), "sugar vector scalar logical operations")
+}
+
+test.vector.vector.ops <- function( ){
+ x <- rnorm(10)
+ y <- runif(10)
+ checkEquals(vector_vector_ops(x,y), list(x + y, y - x, x * y, y / x), "sugar vector vector operations")
+}
+
+test.vector.vector.logical <- function( ){
+ x <- rnorm(10)
+ y <- runif(10)
+ checkEquals(vector_vector_logical(x,y), list(x < y, x > y, x <= y, x >= y, x == y, x != y), "sugar vector vector operations")
+}
+
+}
Deleted: pkg/Rcpp/inst/unitTests/runit.sugarOps.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugarOps.R 2013-07-02 17:16:26 UTC (rev 4386)
+++ pkg/Rcpp/inst/unitTests/runit.sugarOps.R 2013-07-02 17:26:25 UTC (rev 4387)
@@ -1,130 +0,0 @@
-#!/usr/bin/r -t
-# -*- mode: R; ess-indent-level: 4; indent-tabs-mode: nil; -*-
-#
-# Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of Rcpp.
-#
-# Rcpp 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.
-#
-# Rcpp 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 Rcpp. If not, see <http://www.gnu.org/licenses/>.
-
-.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
-
-if (.runThisTest) {
-
-definitions <- function() {
- list(
- "vector_scalar_ops" = list(signature(x = "numeric"),
- '
- NumericVector xx(x);
- NumericVector y1 = xx + 2.0; // NB does not work with ints as eg "+ 2L"
- NumericVector y2 = 2 - xx;
- NumericVector y3 = xx * 2.0;
- NumericVector y4 = 2.0 / xx;
- return List::create(y1, y2, y3, y4);
- '
- )
-
- ,
- "vector_scalar_logical" = list(signature(x = "numeric"),
- '
- NumericVector xx(x);
- LogicalVector y1 = xx < 2;
- LogicalVector y2 = 2 > xx;
- LogicalVector y3 = xx <= 2;
- LogicalVector y4 = 2 != xx;
- return List::create(y1, y2, y3, y4);
- '
- )
-
- ,
- "vector_vector_ops" = list(signature(x = "numeric", y="numeric"),
- '
- NumericVector xx(x);
- NumericVector yy(y);
- NumericVector y1 = xx + yy;
- NumericVector y2 = yy - xx;
- NumericVector y3 = xx * yy;
- NumericVector y4 = yy / xx;
- return List::create(y1, y2, y3, y4);
- '
- )
-
- ,
- "vector_vector_logical" = list(signature(x = "numeric", y="numeric"),
- '
- NumericVector xx(x);
- NumericVector yy(y);
- LogicalVector y1 = xx < yy;
- LogicalVector y2 = xx > yy;
- LogicalVector y3 = xx <= yy;
- LogicalVector y4 = xx >= yy;
- LogicalVector y5 = xx == yy;
- LogicalVector y6 = xx != yy;
- return List::create(y1, y2, y3, y4, y5, y6);
- '
- )
-
- ## ,
- ## "matrix_plus" = list(signature(x = "numeric"),
- ## '
- ## NumericMatrix xx(x);
- ## // -- fails to compile
- ## NumericMatrix yy = xx + 2;
- ## return yy;
- ## '
- ## )
- )
-}
-
-.setUp <- function(){
- if ( ! exists( ".rcpp.sugarOps", globalenv() ) ) {
- fun <- Rcpp:::compile_unit_tests(definitions())
- assign( ".rcpp.sugarOps", fun, globalenv() )
- }
-}
-
-test.vector.scalar.ops <- function( ){
- fx <- .rcpp.sugarOps$vector_scalar_ops
- x <- rnorm(10)
- checkEquals(fx(x), list(x + 2, 2 - x, x * 2, 2 / x), "sugar vector scalar operations")
-}
-
-test.vector.scalar.logical <- function( ){
- fx <- .rcpp.sugarOps$vector_scalar_logical
- x <- rnorm(10) + 2
- checkEquals(fx(x), list(x < 2, 2 > x, x <= 2, 2 != x), "sugar vector scalar logical operations")
-}
-
-test.vector.vector.ops <- function( ){
- fx <- .rcpp.sugarOps$vector_vector_ops
- x <- rnorm(10)
- y <- runif(10)
- checkEquals(fx(x,y), list(x + y, y - x, x * y, y / x), "sugar vector vector operations")
-}
-
-test.vector.vector.logical <- function( ){
- fx <- .rcpp.sugarOps$vector_vector_logical
- x <- rnorm(10)
- y <- runif(10)
- checkEquals(fx(x,y), list(x < y, x > y, x <= y, x >= y, x == y, x != y), "sugar vector vector operations")
-}
-
-## test.matrix.plus <- function( ){
-## fx <- .rcpp.sugarOps$matrix_plus
-## x <- matrix(rnorm(10), 5, 2)
-## checkEquals(fx(x) , x + 2)
-## #checkEquals(fx(x) , x ) # DUMMY
-## }
-
-}
More information about the Rcpp-commits
mailing list