[Rcpp-commits] r1175 - in pkg/Rcpp/inst: . include/Rcpp unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu May 6 08:59:05 CEST 2010


Author: romain
Date: 2010-05-06 08:59:05 +0200 (Thu, 06 May 2010)
New Revision: 1175

Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/DataFrame.h
   pkg/Rcpp/inst/unitTests/runit.DataFrame.R
   pkg/Rcpp/inst/unitTests/runit.clone.R
Log:
DataFrame( SlotProxy ), DataFrame( AttributeProxy )

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-05-06 06:18:06 UTC (rev 1174)
+++ pkg/Rcpp/inst/ChangeLog	2010-05-06 06:59:05 UTC (rev 1175)
@@ -1,3 +1,8 @@
+2010-05-06  Romain Francois <romain at r-enthusiasts.com>
+
+	* inst/include/Rcpp/DataFrame.h: DataFrame( RObject::SlotProxy ) and 
+	DataFrame( RObject::AttributeProxy ) constructors
+
 2010-05-05  Romain Francois <romain at r-enthusiasts.com>
 
 	* inst/include/Rcpp/S4.h: S4 gains a "is" method to identify if an object 
@@ -5,9 +10,9 @@
 	
 	* inst/include/RcppCommon.h: new STL-like algorithms Rcpp::any and Rcpp::any_if
 	
-	* inst/include/Rcpp/Vector.h: Vector gains a constructor taking a 
-	SlotProxy and a constructor taking an AttributeProxy, allowing this construct
-	NumericVector x( y.slot( "foo" ) )
+	* inst/include/Rcpp/Vector.h: Vector gains a constructor taking an 
+	RObject::SlotProxy and a constructor taking an RObject::AttributeProxy, 
+	allowing this construct NumericVector x( y.slot( "foo" ) )
 
 2010-05-04  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/include/Rcpp/DataFrame.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/DataFrame.h	2010-05-06 06:18:06 UTC (rev 1174)
+++ pkg/Rcpp/inst/include/Rcpp/DataFrame.h	2010-05-06 06:59:05 UTC (rev 1175)
@@ -38,21 +38,21 @@
 		DataFrame(): List( internal::empty_data_frame() ){}
 		
 		DataFrame(SEXP x) throw(not_compatible) : List(){
-			/* this might throw not_compatible */
-			SEXP y = internal::convert_using_rfunction( x, "as.data.frame" ) ;
-			setSEXP( y ) ;
+			set(x) ;
 		}
 		
 		DataFrame( const DataFrame& other): List(other.asSexp()) {}
 		
+		DataFrame( const RObject::SlotProxy& proxy ) throw(not_compatible){ set(proxy); }
+		DataFrame( const RObject::AttributeProxy& proxy ) throw(not_compatible){ set(proxy); }
+		
 		DataFrame& operator=( DataFrame& other){
 			setSEXP( other.asSexp() ) ;
 			return *this ;
 		}
 		
 		DataFrame& operator=( SEXP x) throw( not_compatible) {
-			SEXP y = internal::convert_using_rfunction( x, "as.data.frame" ) ;
-			setSEXP( y ); 
+			set(x) ;
 			return *this ;
 		}
 		
@@ -62,6 +62,12 @@
 		
 #include <Rcpp/DataFrame_generated.h>		
 
+	private:
+		void set(SEXP x) throw(not_compatible) {
+			SEXP y = internal::convert_using_rfunction( x, "as.data.frame" ) ;
+			setSEXP( y ) ;
+		}
+		
 	} ;
 	
 }

Modified: pkg/Rcpp/inst/unitTests/runit.DataFrame.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.DataFrame.R	2010-05-06 06:18:06 UTC (rev 1174)
+++ pkg/Rcpp/inst/unitTests/runit.DataFrame.R	2010-05-06 06:59:05 UTC (rev 1175)
@@ -17,6 +17,11 @@
 # 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( datasets ) )
+	data( iris )
+}
+
 test.DataFrame.FromSEXP <- function() {
     DF <- data.frame(a=1:3, b=c("a","b","c"))
     fun <- cppfunction( signature(x='ANY'), '
@@ -47,3 +52,29 @@
 	' )
     checkEquals( fun(), DF, msg = "DataFrame create2")
 }
+
+test.DataFrame.SlotProxy <- function(){
+	
+	setClass("track", representation(x="data.frame", y = "function"))
+	tr1 <- new( "track", x = iris, y = rnorm )                    
+	fun <- cppfunction( signature(x="ANY", y="character"), '
+		S4 o(x) ;
+		return DataFrame( o.slot( as<std::string>(y) )) ;
+	' )
+	checkTrue( identical( fun(tr1, "x"), iris ), msg = "DataFrame( SlotProxy )" )
+	checkException( fun(tr1, "y"), msg = "DataFrame( SlotProxy ) -> exception" )
+}
+
+test.DataFrame.AttributeProxy <- function(){
+	
+	tr1 <- structure( NULL, x = iris, y = rnorm )
+	fun <- cppfunction( signature(x="ANY", y="character"), '
+		List o(x) ;
+		return DataFrame( o.attr( as<std::string>(y) )) ;
+	' )
+	checkTrue( identical( fun(tr1, "x"), iris) , msg = "DataFrame( AttributeProxy )" )
+	checkException( fun(tr1, "y"), msg = "DataFrame( AttributeProxy ) -> exception" )
+	
+}
+
+

Modified: pkg/Rcpp/inst/unitTests/runit.clone.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.clone.R	2010-05-06 06:18:06 UTC (rev 1174)
+++ pkg/Rcpp/inst/unitTests/runit.clone.R	2010-05-06 06:59:05 UTC (rev 1175)
@@ -17,10 +17,6 @@
 # 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(){
-	require( inline )
-}
-
 test.clone <- function(){
 	
 	x <- 1:10



More information about the Rcpp-commits mailing list