[Rcpp-commits] r1366 - in pkg/Rcpp: R inst/doc inst/doc/snippets

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

Author: romain
Date: 2010-05-29 15:12:59 +0200 (Sat, 29 May 2010)
New Revision: 1366

Modified:
   pkg/Rcpp/R/Module.R
   pkg/Rcpp/inst/doc/Rcpp-modules.Rnw
   pkg/Rcpp/inst/doc/snippets/modulestdvec.cpp
Log:
special cases [[ and [[<-

Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R	2010-05-29 12:22:14 UTC (rev 1365)
+++ pkg/Rcpp/R/Module.R	2010-05-29 13:12:59 UTC (rev 1366)
@@ -68,12 +68,16 @@
 	new( out$cl, pointer = out$xp, cppclass = Class at pointer, module = Class at module )
 } )
 
+MethodInvoker <- function( x, name ){
+	function(...){
+		res <- .External( "Class__invoke_method", x at cppclass, name, x at pointer, ... , PACKAGE = "Rcpp" )
+		if( isTRUE( res$void ) ) invisible(NULL) else res$result
+	}
+}
+
 dollar_cppobject <- function(x, name){
 	if( .Call( "Class__has_method", x at cppclass, name, PACKAGE = "Rcpp" ) ){
-		function(...){
-			res <- .External( "Class__invoke_method", x at cppclass, name, x at pointer, ..., PACKAGE = "Rcpp" )
-			if( isTRUE( res$void ) ) invisible(NULL) else res$result
-		}
+		MethodInvoker( x, name )
 	} else{
 		stop( "no such method" )
 	}
@@ -81,6 +85,7 @@
 
 setMethod( "$", "C++Object", dollar_cppobject )
 
+
 Module <- function( module, PACKAGE = getPackageName(where), where = topenv(parent.frame()) ){
 	name <- sprintf( "_rcpp_module_boot_%s", module )
 	symbol <- getNativeSymbolInfo( name, PACKAGE )
@@ -89,10 +94,10 @@
 	if( length( classes ) ){
 		clnames <- names( classes )
 		for( i in seq_along(classes) ){
+			CLASS <- classes[[i]]
 			setClass( clnames[i], contains = "C++Object", where = where )
 			init <- function(.Object, ...){
 				if( .Call( "CppObject__needs_init", .Object at pointer, PACKAGE = "Rcpp" ) ){
-					CLASS <- classes[[i]]
 					out <- new_CppObject_xp( CLASS, ... )
 					.Object at pointer <- out$xp
 					.Object at cppclass <- CLASS at pointer
@@ -101,6 +106,21 @@
 				.Object
 			}
 			setMethod( "initialize", clnames[i], init , where = where )
+			
+			METHODS <- .Call( "CppClass__methods" , CLASS at pointer , PACKAGE = "Rcpp" )
+			if( "[[" %in% METHODS ){
+				setMethod( "[[", clnames[i], function(x, i, j, ...){
+					MethodInvoker( x, "[[" )( i )
+				}, where = where )
+			}
+			
+			if( "[[<-" %in% METHODS ){
+				setReplaceMethod( "[[", clnames[i], function(x, i, j, ..., exact = TRUE, value ){
+					MethodInvoker( x, "[[<-" )( i, value )
+					x
+				}, where = where )
+			}
+			
 		}
 	}
 	new( "Module", pointer = xp ) 

Modified: pkg/Rcpp/inst/doc/Rcpp-modules.Rnw
===================================================================
--- pkg/Rcpp/inst/doc/Rcpp-modules.Rnw	2010-05-29 12:22:14 UTC (rev 1365)
+++ pkg/Rcpp/inst/doc/Rcpp-modules.Rnw	2010-05-29 13:12:59 UTC (rev 1366)
@@ -230,11 +230,6 @@
 
 \InputIfFileExists{snippets/stdvectorback}{}{}
 
-The following example illustrates how to use Rcpp modules to expose
-the class \texttt{std::vector<double>} from the STL. 
-
-\InputIfFileExists{snippets/modulestdvec}{}{}
-
 \subsubsection{S4 dispatch}
 
 When a C++ class is exposed by the \texttt{class\_} template, 
@@ -244,6 +239,20 @@
 
 \InputIfFileExists{snippets/S4dispatch}{}{}
 
+\subsubsection{Special methods}
+
+\texttt{Rcpp} considers the methods \texttt{[[} and \texttt{[[<-} special, 
+and promote them to indexing methods on the R side. 
+
+\subsubsection{Full example}
+
+The following example illustrates how to use Rcpp modules to expose
+the class \texttt{std::vector<double>} from the STL. 
+
+\InputIfFileExists{snippets/modulestdvec}{}{}
+
+
+
 \section{Future extensions}
 
 \texttt{Boost.Python} has many more features that we would like to port 

Modified: pkg/Rcpp/inst/doc/snippets/modulestdvec.cpp
===================================================================
--- pkg/Rcpp/inst/doc/snippets/modulestdvec.cpp	2010-05-29 12:22:14 UTC (rev 1365)
+++ pkg/Rcpp/inst/doc/snippets/modulestdvec.cpp	2010-05-29 13:12:59 UTC (rev 1366)
@@ -15,6 +15,10 @@
 	return Rcpp::wrap( *obj ) ;
 }
 
+void vec_set( vec* obj, int i, double value ){
+	obj->at( i ) = value ;
+}
+
 RCPP_MODULE(yada){
 	using namespace Rcpp ;
 	
@@ -42,6 +46,11 @@
 		.method( "assign", &vec_assign )
 		.method( "insert", &vec_insert )
 		.method( "as.vector", &vec_asR ) 
+		
+		// special methods for indexing
+		.const_method( "[[", &vec::at )
+		.method( "[[<-", &vec_set )
+
 	;
 }