[Rcpp-commits] r279 - in pkg: inst/unitTests src src/Rcpp

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Jan 5 15:58:32 CET 2010


Author: romain
Date: 2010-01-05 15:58:31 +0100 (Tue, 05 Jan 2010)
New Revision: 279

Added:
   pkg/inst/unitTests/runit.IntegerVector.R
   pkg/src/IntegerVector.cpp
   pkg/src/Rcpp/IntegerVector.h
Modified:
   pkg/src/RObject.cpp
   pkg/src/Rcpp.h
   pkg/src/Rcpp/Function.h
   pkg/src/Rcpp/RObject.h
   pkg/src/RcppCommon.cpp
   pkg/src/RcppCommon.h
Log:
added Rcpp::IntegerVector

Added: pkg/inst/unitTests/runit.IntegerVector.R
===================================================================
--- pkg/inst/unitTests/runit.IntegerVector.R	                        (rev 0)
+++ pkg/inst/unitTests/runit.IntegerVector.R	2010-01-05 14:58:31 UTC (rev 279)
@@ -0,0 +1,55 @@
+#!/usr/bin/r -t
+#
+# 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/>.
+
+.setUp <- function(){
+	suppressMessages( require( inline ) )
+}
+
+test.IntegerVector <- function(){
+	funx <- cfunction(signature(), '
+	IntegerVector x(10) ;
+	for( int i=0; i<10; i++) x[i] = i ;
+	return x ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(), 0:9, msg = "IntegerVector" )
+}
+
+test.IntegerVector.INTSXP <- function(){
+	funx <- cfunction(signature(vec = "integer" ), '
+	IntegerVector x(vec) ;
+	for( int i=0; i<x.size(); i++) { 
+		x[i] = x[i]*2 ;
+	}
+	return x ;', 
+		Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkEquals( funx(0:9), 2*0:9, msg = "IntegerVector( INTSXP) " )
+}
+
+test.IntegerVector.initializer.list <- function(){
+	if( Rcpp:::capabilities()[["initializer lists"]] ){
+		funx <- cfunction(signature(), '
+		IntegerVector x = {0,1,2,3} ;
+		for( int i=0; i<x.size(); i++) x[i] = x[i]*2 ;
+		return x ;', 
+			Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+		checkEquals( funx(), 2*0:3, msg = "IntegerVector( initializer list) " )
+	}
+}
+
+

Added: pkg/src/IntegerVector.cpp
===================================================================
--- pkg/src/IntegerVector.cpp	                        (rev 0)
+++ pkg/src/IntegerVector.cpp	2010-01-05 14:58:31 UTC (rev 279)
@@ -0,0 +1,59 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// IntegerVector.h: Rcpp R/C++ interface class library -- integer vectors
+//
+// 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/>.
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+#include <Rcpp/IntegerVector.h>
+
+namespace Rcpp{
+	
+	IntegerVector::IntegerVector(SEXP x) throw(not_compatible) : RObject() {
+		if( TYPEOF( x ) == INTSXP ){
+			setSEXP( x ) ;
+		} else {
+			throw not_compatible( "cannot convert to intrger vector" ) ;
+		}
+	}
+	
+	IntegerVector::IntegerVector(int size) : RObject() {
+		setSEXP( Rf_allocVector(INTSXP, size) ) ;
+	}
+
+#ifdef HAS_INIT_LISTS	
+IntegerVector::IntegerVector( std::initializer_list<int> list ) {
+		SEXP x = PROTECT( Rf_allocVector( INTSXP, list.size() ) ) ;
+		std::copy( list.begin(), list.end(), INTEGER(x) ); 
+		setSEXP(x) ;
+		UNPROTECT( 1 ); /* x */
+	}
+#endif
+
+int& IntegerVector::operator[]( int i ) const { 
+	return INTEGER(m_sexp)[i] ;
+}
+int* IntegerVector::begin() const { 
+	return INTEGER(m_sexp) ;
+}
+int* IntegerVector::end() const { 
+	return INTEGER(m_sexp) + LENGTH(m_sexp);
+}
+
+} // namespace 

Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp	2010-01-05 12:06:11 UTC (rev 278)
+++ pkg/src/RObject.cpp	2010-01-05 14:58:31 UTC (rev 279)
@@ -278,6 +278,11 @@
 	return Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) );
 }
 
+const char* RObject::not_compatible::what( ) const throw() {
+	return message.c_str() ;
+}
+RObject::not_compatible::~not_compatible() throw() {}
+			
 
 } // namespace Rcpp
 

Modified: pkg/src/Rcpp/Function.h
===================================================================
--- pkg/src/Rcpp/Function.h	2010-01-05 12:06:11 UTC (rev 278)
+++ pkg/src/Rcpp/Function.h	2010-01-05 14:58:31 UTC (rev 279)
@@ -71,6 +71,8 @@
 #ifdef HAS_VARIADIC_TEMPLATES
 template<typename... Args> 
 	SEXP operator()( const Args&... args) {
+		
+		/* FIXME: we should use applyClosure instead */
 		Evaluator evaluator( Rf_lcons( m_sexp, pairlist(args...) ) ) ; 
 		evaluator.run() ;
 		if( evaluator.successfull() ){

Added: pkg/src/Rcpp/IntegerVector.h
===================================================================
--- pkg/src/Rcpp/IntegerVector.h	                        (rev 0)
+++ pkg/src/Rcpp/IntegerVector.h	2010-01-05 14:58:31 UTC (rev 279)
@@ -0,0 +1,62 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// IntegerVector.h: Rcpp R/C++ interface class library -- integer vectors
+//
+// 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_IntegerVector_h
+#define Rcpp_IntegerVector_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+#ifdef HAS_INIT_LISTS
+#include <initializer_list>
+#include <algorithm>
+#endif
+
+namespace Rcpp{ 
+
+class IntegerVector : public RObject {     
+public:
+
+	IntegerVector(SEXP x) throw(not_compatible);
+	IntegerVector( int size) ;
+	
+#ifdef HAS_INIT_LISTS	
+	IntegerVector( std::initializer_list<int> list ) ; 
+#endif
+	
+	/**
+	 * the length of the vector, uses Rf_length
+	 */
+	inline int length() const { return Rf_length( m_sexp ) ; }
+	
+	/**
+	 * alias of length
+	 */
+	inline int size() const { return Rf_length( m_sexp ) ; }
+	
+	int& operator[]( int i ) const ;
+	int* begin() const ; 
+	int* end() const ;
+} ;
+
+} // namespace
+
+#endif

Modified: pkg/src/Rcpp/RObject.h
===================================================================
--- pkg/src/Rcpp/RObject.h	2010-01-05 12:06:11 UTC (rev 278)
+++ pkg/src/Rcpp/RObject.h	2010-01-05 14:58:31 UTC (rev 279)
@@ -30,6 +30,21 @@
 class RObject{
 public:
 
+	/**
+   	 * Exception thrown when attempting to convert a SEXP
+   	 */
+   	class not_compatible: public std::exception{
+   		public:
+   			not_compatible(const std::string& message) throw() : message(message){};
+   			
+   			const char* what() const throw() ; 
+   			
+   			~not_compatible() throw() ;
+   		private:
+   			std::string message ;
+   	} ;
+	
+	
     /**
      * default constructor. uses R_NilValue
      */ 
@@ -62,7 +77,7 @@
      * and become subject to garbage collection. See preserve 
      * and release member functions.
      */
-    ~RObject() ;
+    virtual ~RObject() ;
    
     /**
      * implicit conversion to SEXP

Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h	2010-01-05 12:06:11 UTC (rev 278)
+++ pkg/src/Rcpp.h	2010-01-05 14:58:31 UTC (rev 279)
@@ -56,5 +56,6 @@
 #include <Rcpp/Named.h>
 #include <Rcpp/Pairlist.h>
 #include <Rcpp/Function.h>
+#include <Rcpp/IntegerVector.h>
 
 #endif

Modified: pkg/src/RcppCommon.cpp
===================================================================
--- pkg/src/RcppCommon.cpp	2010-01-05 12:06:11 UTC (rev 278)
+++ pkg/src/RcppCommon.cpp	2010-01-05 14:58:31 UTC (rev 279)
@@ -98,3 +98,35 @@
 	return R_NilValue ;
 #endif
 }
+
+const char * const sexp_to_name(int sexp_type) {
+    switch (sexp_type) {
+    case NILSXP:	return "NILSXP";
+    case SYMSXP:	return "SYMSXP";
+    case LISTSXP:	return "LISTSXP";
+    case CLOSXP:	return "CLOSXP";
+    case ENVSXP:	return "ENVSXP";
+    case PROMSXP:	return "PROMSXP";
+    case LANGSXP:	return "LANGSXP";
+    case SPECIALSXP:	return "SPECIALSXP";
+    case BUILTINSXP:	return "BUILTINSXP";
+    case CHARSXP:	return "CHARSXP";
+    case LGLSXP:	return "LGLSXP";
+    case INTSXP:	return "INTSXP";
+    case REALSXP:	return "REALSXP";
+    case CPLXSXP:	return "CPLXSXP";
+    case STRSXP:	return "STRSXP";
+    case DOTSXP:	return "DOTSXP";
+    case ANYSXP:	return "ANYSXP";
+    case VECSXP:	return "VECSXP";
+    case EXPRSXP:	return "EXPRSXP";
+    case BCODESXP:	return "BCODESXP";
+    case EXTPTRSXP:	return "EXTPTRSXP";
+    case WEAKREFSXP:	return "WEAKREFSXP";
+    case S4SXP:		return "S4SXP";
+    default:
+	return "<unknown>";
+    }
+}
+
+

Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h	2010-01-05 12:06:11 UTC (rev 278)
+++ pkg/src/RcppCommon.h	2010-01-05 14:58:31 UTC (rev 279)
@@ -82,4 +82,6 @@
 RcppExport SEXP test_named() ;
 RcppExport SEXP capabilities() ;
 
+const char * const sexp_to_name(int sexp_type); 
+
 #endif



More information about the Rcpp-commits mailing list