[Rcpp-commits] r1790 - in pkg/Rcpp/inst: . include/Rcpp/sugar/functions unitTests

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-07-06 14:29:40 +0200 (Tue, 06 Jul 2010)
New Revision: 1790

Added:
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/rev.h
Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h
   pkg/Rcpp/inst/unitTests/runit.sugar.R
Log:
+ sugar rev

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-07-06 12:16:38 UTC (rev 1789)
+++ pkg/Rcpp/inst/ChangeLog	2010-07-06 12:29:40 UTC (rev 1790)
@@ -3,6 +3,8 @@
 	* inst/include/Rcpp/sugar/functions/ifelse.h: using compile time dispatch 
 	based on the NA-ness of the condition type. ifelse handles primitive
 	arguments on the lhs, rhs or both
+	
+	* inst/include/Rcpp/sugar/functions/rev.h: new sugar function: rev
 
 2010-07-05  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h	2010-07-06 12:16:38 UTC (rev 1789)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h	2010-07-06 12:29:40 UTC (rev 1790)
@@ -41,6 +41,7 @@
 #include <Rcpp/sugar/functions/rep.h>
 #include <Rcpp/sugar/functions/rep_len.h>
 #include <Rcpp/sugar/functions/rep_each.h>
+#include <Rcpp/sugar/functions/rev.h>
 
 #include <Rcpp/sugar/functions/Re.h>
 #include <Rcpp/sugar/functions/Im.h>

Added: pkg/Rcpp/inst/include/Rcpp/sugar/functions/rev.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/rev.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/rev.h	2010-07-06 12:29:40 UTC (rev 1790)
@@ -0,0 +1,56 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// rev.h: Rcpp R/C++ interface class library -- rev
+//
+// Copyright (C) 2010 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/>.
+
+#ifndef Rcpp__sugar__rev_h
+#define Rcpp__sugar__rev_h
+
+namespace Rcpp{
+namespace sugar{
+	
+template <int RTYPE, bool NA, typename T>
+class Rev : public Rcpp::VectorBase< RTYPE ,NA, Rev<RTYPE,NA,T> > {
+public:
+	typedef typename Rcpp::VectorBase<RTYPE,NA,T> VEC_TYPE ;
+	typedef typename Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
+	
+	Rev( const VEC_TYPE& object_ ) : 
+		object(object_), n(object_.size() - 1) {}
+	
+	inline STORAGE operator[]( int i ) const {
+		return object[n - i] ;
+	}
+	inline int size() const { return n + 1; }
+	         
+private:
+	const VEC_TYPE& object ;
+	int n ;
+} ;
+	
+} // sugar
+
+template <int RTYPE,bool NA, typename T>
+inline sugar::Rev<RTYPE,NA,T> rev( const VectorBase<RTYPE,NA,T>& t){
+	return sugar::Rev<RTYPE,NA,T>( t ) ;
+}
+
+} // Rcpp
+#endif
+

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-07-06 12:16:38 UTC (rev 1789)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-07-06 12:29:40 UTC (rev 1790)
@@ -239,8 +239,8 @@
 					return List::create( 
 						_["vec_vec" ]  = ifelse( xx < yy, xx*xx, -(yy*yy) ), 
 						_["vec_prim"]  = ifelse( xx < yy, 1.0  , -(yy*yy) ), 
-						_["prim_vec"]  = ifelse( xx < yy, xx*xx, 1.0      )
-						// , _["prim_prim"] = ifelse( xx < yy, 1.0, 2.0        )
+						_["prim_vec"]  = ifelse( xx < yy, xx*xx, 1.0      ), 
+						_["prim_prim"] = ifelse( xx < yy, 1.0, 2.0        )
 						) ;
 				'				
 			), 
@@ -491,8 +491,17 @@
 					) ;
 				return res ;
 				'
+				), 
+			"runit_rev" = list( 
+				signature( x = "integer" ),
+				'
+				IntegerVector xx(x);
+				IntegerVector yy = rev( xx * xx );
+				return yy ;
+				'
 				)
 			
+			
 		)
 		
 		signatures <- lapply( sugar.functions, "[[", 1L )
@@ -755,8 +764,8 @@
 	checkEquals( fx( x, y), list( 
 		"vec_vec"   = ifelse( x<y, x*x, -(y*y) ), 
 		"vec_prim"  = ifelse( x<y, 1.0, -(y*y) ), 
-		"prim_vec"  = ifelse( x<y, x*x, 1.0    )
-		# , "prim_prim" = ifelse( x<y, 1.0, 2.0    )
+		"prim_vec"  = ifelse( x<y, x*x, 1.0    ), 
+		"prim_prim" = ifelse( x<y, 1.0, 2.0    )
 	) )
 }
 
@@ -955,3 +964,9 @@
 	)
 }
 
+test.sugar.rev <- function(){
+	fx <- .rcpp.sugar$runit_rev
+	print( fx( 1:10 ) )
+	checkEquals( fx(1:10), rev( 1:10 * 1:10 ) )
+}
+