[Rcpp-commits] r1574 - in pkg/Rcpp: . inst/include inst/include/Rcpp/internal inst/include/Rcpp/traits inst/include/Rcpp/vector inst/unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 17 18:48:12 CEST 2010


Author: romain
Date: 2010-06-17 18:48:12 +0200 (Thu, 17 Jun 2010)
New Revision: 1574

Added:
   pkg/Rcpp/inst/include/Rcpp/traits/expands_to_logical.h
   pkg/Rcpp/inst/unitTests/runit.sugar.wrap.R
Modified:
   pkg/Rcpp/TODO
   pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
   pkg/Rcpp/inst/include/Rcpp/vector/VectorBase.h
   pkg/Rcpp/inst/include/RcppCommon.h
Log:
added the expands_to_logical trait to disambiguate sugar expressions that want to be logical vectors (the usual problem that int == Rboolean) 

Modified: pkg/Rcpp/TODO
===================================================================
--- pkg/Rcpp/TODO	2010-06-17 15:41:50 UTC (rev 1573)
+++ pkg/Rcpp/TODO	2010-06-17 16:48:12 UTC (rev 1574)
@@ -41,7 +41,7 @@
 		
 Syntactic sugar
 
-    o   duplicated, unique, is_na, count, sum
+    o   duplicated, unique, is_na, count, sum, seq_along, seq_len, rep
     
     o	for matrices: row, col, lower_tri, upper_tri
 	

Modified: pkg/Rcpp/inst/include/Rcpp/internal/wrap.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/internal/wrap.h	2010-06-17 15:41:50 UTC (rev 1573)
+++ pkg/Rcpp/inst/include/Rcpp/internal/wrap.h	2010-06-17 16:48:12 UTC (rev 1574)
@@ -395,6 +395,21 @@
 	return R_NilValue ; // -Wall
 }
 
+template <typename T>
+SEXP wrap_dispatch_unknown_iterable__logical( const T& object, ::Rcpp::traits::true_type){
+	size_t size = object.size() ;
+	SEXP x = PROTECT( Rf_allocVector( LGLSXP, size ) );
+	std::copy( object.begin(), object.end(), LOGICAL(x) ) ; 
+	UNPROTECT(1) ;
+	return x ;
+}
+
+template <typename T>
+SEXP wrap_dispatch_unknown_iterable__logical( const T& object, ::Rcpp::traits::false_type){
+	return range_wrap( object.begin(), object.end() ) ;
+}
+
+
 /**
  * Here we know for sure that type T has a T::iterator typedef
  * so we hope for the best and call the range based wrap with begin
@@ -409,7 +424,7 @@
  */
 template <typename T>
 SEXP wrap_dispatch_unknown_iterable(const T& object, ::Rcpp::traits::true_type){
-	return range_wrap( object.begin(), object.end() ) ;
+	return wrap_dispatch_unknown_iterable__logical( object, typename ::Rcpp::traits::expands_to_logical<T>::type() ) ;
 }
 
 template <typename T, typename elem_type>

Added: pkg/Rcpp/inst/include/Rcpp/traits/expands_to_logical.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/expands_to_logical.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/traits/expands_to_logical.h	2010-06-17 16:48:12 UTC (rev 1574)
@@ -0,0 +1,53 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */
+//
+// expands_to_logical.h: Rcpp R/C++ interface class library -- 
+//
+// 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__traits__expands_to_logical_h
+#define Rcpp__traits__expands_to_logical_h
+
+// helper trait to disambiguate things that want to be logical vectors
+// from containers of int
+
+namespace Rcpp{
+namespace traits{
+
+  template<typename T>
+  class _has_rtype_helper : __sfinae_types {
+      template<typename U> struct _Wrap_type { };
+
+      template<typename U>
+        static __one __test(_Wrap_type<typename U::r_type>*);
+
+      template<typename U>
+        static __two __test(...);
+
+    public:
+      static const bool value = sizeof(__test<T>(0)) == 1;
+    };
+		
+  template<typename T> struct expands_to_logical : 
+  	integral_constant<bool,_has_rtype_helper<T>::value & T::r_type::value == LGLSXP > { };
+    
+    
+} 
+}
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/vector/VectorBase.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/VectorBase.h	2010-06-17 15:41:50 UTC (rev 1573)
+++ pkg/Rcpp/inst/include/Rcpp/vector/VectorBase.h	2010-06-17 16:48:12 UTC (rev 1574)
@@ -23,6 +23,8 @@
 #define Rcpp__vector__VectorBase_h
 
 namespace Rcpp{
+
+
 	
 /** a base class for vectors, modelled after the CRTP */
 template <int RTYPE, bool na, typename VECTOR>

Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h	2010-06-17 15:41:50 UTC (rev 1573)
+++ pkg/Rcpp/inst/include/RcppCommon.h	2010-06-17 16:48:12 UTC (rev 1574)
@@ -217,6 +217,7 @@
 #include <Rcpp/traits/named_object.h>
 #include <Rcpp/traits/is_convertible.h>
 #include <Rcpp/traits/has_iterator.h>
+#include <Rcpp/traits/expands_to_logical.h>
 #include <Rcpp/traits/has_na.h>
 #include <Rcpp/traits/storage_type.h>
 #include <Rcpp/traits/r_sexptype_traits.h>

Added: pkg/Rcpp/inst/unitTests/runit.sugar.wrap.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.wrap.R	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.wrap.R	2010-06-17 16:48:12 UTC (rev 1574)
@@ -0,0 +1,37 @@
+#
+# 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/>.
+
+test.sugar.wrap <- function( ){
+
+	fx <- cxxfunction( signature( x = "numeric", y = "numeric", env = "environment" ), '
+	
+		NumericVector xx(x) ;
+		NumericVector yy(y) ;
+		Environment e(env) ;
+		
+		e["foo"] = xx < yy  ;
+		return R_NilValue ;
+		
+	', plugin = "Rcpp" )
+
+	e <- new.env() 
+	fx( 1:10, 2:11, e )
+	checkEquals( e[["foo"]], rep(TRUE, 10 ) )
+	
+}
+



More information about the Rcpp-commits mailing list