[Rcpp-commits] r3908 - in pkg/Rcpp: . inst/include/Rcpp inst/include/Rcpp/sugar/functions src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 7 15:40:18 CET 2012
Author: romain
Date: 2012-11-07 15:40:18 +0100 (Wed, 07 Nov 2012)
New Revision: 3908
Added:
pkg/Rcpp/inst/include/Rcpp/sugar/functions/unique.h
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/include/Rcpp/Language.h
pkg/Rcpp/inst/include/Rcpp/barrier.h
pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h
pkg/Rcpp/src/Language.cpp
pkg/Rcpp/src/barrier.cpp
Log:
sugar unique and sort_unique
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2012-11-07 13:24:26 UTC (rev 3907)
+++ pkg/Rcpp/ChangeLog 2012-11-07 14:40:18 UTC (rev 3908)
@@ -1,3 +1,10 @@
+2012-11-07 Romain Francois <romain at r-enthusiasts.com>
+
+ * src/Language.cpp: Language gains a fast_eval method, without the whole try/catch
+ * src/barrier.cpp: function char_nocheck to avoid the check in using CHAR
+ * include/Rcpp/sugar/functions/unique.h: sugar unique and sort_unique
+ using unordered_set (perhaps we could use it from c++11).
+
2012-11-06 JJ Allaire <jj at rstudio.org>
* R/Attributes.R: tweak whitespace in verbose mode
Modified: pkg/Rcpp/inst/include/Rcpp/Language.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Language.h 2012-11-07 13:24:26 UTC (rev 3907)
+++ pkg/Rcpp/inst/include/Rcpp/Language.h 2012-11-07 14:40:18 UTC (rev 3908)
@@ -137,6 +137,9 @@
*/
SEXP eval(SEXP env) ;
+ SEXP fast_eval() ;
+ SEXP fast_eval(SEXP env ) ;
+
~Language() ;
private:
Modified: pkg/Rcpp/inst/include/Rcpp/barrier.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/barrier.h 2012-11-07 13:24:26 UTC (rev 3907)
+++ pkg/Rcpp/inst/include/Rcpp/barrier.h 2012-11-07 14:40:18 UTC (rev 3908)
@@ -2,7 +2,7 @@
//
// barrier.h: Rcpp R/C++ interface class library -- crossin the write barrier
//
-// Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2010 - 2012 Dirk Eddelbuettel and Romain Francois
//
// This file is part of Rcpp.
//
@@ -31,5 +31,6 @@
SEXP get_vector_elt(SEXP, int) ;
void set_vector_elt(SEXP, int, SEXP ) ;
SEXP* get_vector_ptr(SEXP) ;
+const char* char_nocheck( SEXP ) ;
#endif
Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h 2012-11-07 13:24:26 UTC (rev 3907)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h 2012-11-07 14:40:18 UTC (rev 3908)
@@ -59,4 +59,6 @@
#include <Rcpp/sugar/functions/which_min.h>
#include <Rcpp/sugar/functions/which_max.h>
+#include <Rcpp/sugar/functions/unique.h>
+
#endif
Added: pkg/Rcpp/inst/include/Rcpp/sugar/functions/unique.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/unique.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/unique.h 2012-11-07 14:40:18 UTC (rev 3908)
@@ -0,0 +1,142 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// unique.h: Rcpp R/C++ interface class library -- unique
+//
+// 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/>.
+
+#ifndef Rcpp__sugar__unique_h
+#define Rcpp__sugar__unique_h
+
+#if __cplusplus >= 201103L
+ #define RCPP_UNIQUE_SET std::unordered_set
+#elseif defined(HAS_TR1_UNORDERED_SET)
+ #define RCPP_UNIQUE_SET std::tr1::unordered_set
+#else
+ #define RCPP_UNIQUE_SET std::set
+#endif
+
+namespace Rcpp{
+namespace sugar{
+
+class StringCompare {
+public:
+ inline bool operator()( SEXP x, SEXP y){
+ return strcmp( char_nocheck(x), char_nocheck(y) ) < 0 ;
+ }
+} ;
+
+template <int RTYPE, typename T>
+class Unique {
+public:
+ typedef typename Rcpp::traits::storage_type<RTYPE>::type STORAGE ;
+
+ Unique( const T& vec ) : set( vec.begin(), vec.end() ) {}
+
+ Vector<RTYPE> get( ) {
+ return Vector<RTYPE>( set.begin(), set.end() ) ;
+ }
+ Vector<RTYPE> get_sorted( ) {
+ Vector<RTYPE> out( set.begin(), set.end() ) ;
+ std::sort( out.begin(), out.end() ) ;
+ return out ;
+ }
+
+private:
+
+ RCPP_UNIQUE_SET<STORAGE> set ;
+
+} ;
+
+// for a character expression
+template <typename T>
+class Unique<STRSXP,T> {
+public:
+ Unique( const T& vec ) : set() {
+ std::string buffer ;
+ int n = vec.size() ;
+ for( int i=0; i<n; i++){
+ buffer = vec[i] ;
+ set.insert( buffer ) ;
+ }
+ }
+
+ CharacterVector get( ) {
+ return CharacterVector( set.begin(), set.end() ) ;
+ }
+ CharacterVector get_sorted( ) {
+ CharacterVector out( set.begin(), set.end() ) ;
+ SEXP* p_out = get_string_ptr(out) ;
+ std::sort( p_out, p_out + set.size(), StringCompare() );
+ return out ;
+ }
+
+private:
+
+ RCPP_UNIQUE_SET<std::string> set ;
+
+} ;
+
+// for a character vector
+template <>
+class Unique<STRSXP,CharacterVector> {
+public:
+ Unique( const CharacterVector& vec ) :
+ set( get_string_ptr(vec), get_string_ptr(vec) + vec.size() )
+ {
+ }
+
+ CharacterVector get( ) {
+ CharacterVector out(set.size()) ;
+ std::copy( set.begin(), set.end(), get_string_ptr(out) ) ;
+ return out ;
+ }
+
+ CharacterVector get_sorted( ) {
+ int n = set.size() ;
+ CharacterVector out(n) ;
+ SEXP* p_out = get_string_ptr(out) ;
+ std::copy( set.begin(), set.end(), p_out ) ;
+ std::sort( p_out, p_out+n, StringCompare() ) ;
+
+ return out ;
+ }
+private:
+
+ RCPP_UNIQUE_SET<SEXP> set ;
+
+} ;
+
+
+
+
+} // sugar
+
+template <int RTYPE, bool NA, typename T>
+inline Vector<RTYPE> unique( const VectorBase<RTYPE,NA,T>& t ){
+ return sugar::Unique<RTYPE,T>( t.get_ref() ).get() ;
+}
+template <int RTYPE, bool NA, typename T>
+inline Vector<RTYPE> sort_unique( const VectorBase<RTYPE,NA,T>& t ){
+ return sugar::Unique<RTYPE,T>( t.get_ref() ).get_sorted() ;
+}
+
+
+
+} // Rcpp
+#endif
+
Modified: pkg/Rcpp/src/Language.cpp
===================================================================
--- pkg/Rcpp/src/Language.cpp 2012-11-07 13:24:26 UTC (rev 3907)
+++ pkg/Rcpp/src/Language.cpp 2012-11-07 14:40:18 UTC (rev 3908)
@@ -78,5 +78,13 @@
SEXP Language::eval( SEXP env ) {
return internal::try_catch( m_sexp, env );
}
+
+ SEXP Language::fast_eval(){
+ return Rf_eval( m_sexp, R_GlobalEnv ) ;
+ }
+ SEXP Language::fast_eval(SEXP env ){
+ return Rf_eval( m_sexp, env ) ;
+ }
+
} // namespace Rcpp
Modified: pkg/Rcpp/src/barrier.cpp
===================================================================
--- pkg/Rcpp/src/barrier.cpp 2012-11-07 13:24:26 UTC (rev 3907)
+++ pkg/Rcpp/src/barrier.cpp 2012-11-07 14:40:18 UTC (rev 3908)
@@ -45,3 +45,6 @@
}
SEXP* get_vector_ptr(SEXP x){ return VECTOR_PTR(x) ; }
+// when we already know x is a CHARSXP
+const char* char_nocheck( SEXP x ){ return CHAR(x); }
+
More information about the Rcpp-commits
mailing list