[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