[Rcpp-commits] r1004 - in pkg/RcppGSL: R inst/include inst/unitTests src

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

Author: romain
Date: 2010-04-06 09:30:55 +0200 (Tue, 06 Apr 2010)
New Revision: 1004

Modified:
   pkg/RcppGSL/R/zzz.R
   pkg/RcppGSL/inst/include/RcppGSL.h
   pkg/RcppGSL/inst/include/RcppGSLForward.h
   pkg/RcppGSL/inst/unitTests/runit.gsl.R
   pkg/RcppGSL/src/RcppGSL.cpp
Log:
added support for gsl_vector_float

Modified: pkg/RcppGSL/R/zzz.R
===================================================================
--- pkg/RcppGSL/R/zzz.R	2010-04-06 07:18:55 UTC (rev 1003)
+++ pkg/RcppGSL/R/zzz.R	2010-04-06 07:30:55 UTC (rev 1004)
@@ -1,5 +1,2 @@
 .onLoad <- function(libname,pkgname){}
 
-test_gsl_vector <- function(){
-	.Call( "test_gsl_vector", PACKAGE = "RcppGSL" )
-}

Modified: pkg/RcppGSL/inst/include/RcppGSL.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSL.h	2010-04-06 07:18:55 UTC (rev 1003)
+++ pkg/RcppGSL/inst/include/RcppGSL.h	2010-04-06 07:30:55 UTC (rev 1004)
@@ -29,6 +29,10 @@
 	return wrap( x.data, x.data + x.size ) ;
 }
 
+template <> SEXP wrap( const gsl_vector_float& x){
+	return wrap( x.data, x.data + x.size ) ;
+}
+
 } 
 
 #endif

Modified: pkg/RcppGSL/inst/include/RcppGSLForward.h
===================================================================
--- pkg/RcppGSL/inst/include/RcppGSLForward.h	2010-04-06 07:18:55 UTC (rev 1003)
+++ pkg/RcppGSL/inst/include/RcppGSLForward.h	2010-04-06 07:30:55 UTC (rev 1004)
@@ -1,4 +1,4 @@
-// RcppGSL.h: Rcpp/GSL glue
+// RcppGSLForward.h: Rcpp/GSL glue
 //
 // Copyright (C)  2010 Romain Francois and Dirk Eddelbuettel
 //
@@ -26,6 +26,7 @@
 /* forward declarations */
 namespace Rcpp{
 	template <> SEXP wrap( const gsl_vector& ) ;
+	template <> SEXP wrap( const gsl_vector_float& ) ;
 }
 
 #endif

Modified: pkg/RcppGSL/inst/unitTests/runit.gsl.R
===================================================================
--- pkg/RcppGSL/inst/unitTests/runit.gsl.R	2010-04-06 07:18:55 UTC (rev 1003)
+++ pkg/RcppGSL/inst/unitTests/runit.gsl.R	2010-04-06 07:30:55 UTC (rev 1004)
@@ -19,6 +19,11 @@
 
 test.gsl.vector <- function(){
 	res <- .Call( "test_gsl_vector", PACKAGE = "RcppGSL" )
-	checkEquals( res, numeric(10) , msg = "wrap( gsl_vector )" )
+	checkEquals( res, 
+		list( 
+			"gsl_vector" = numeric(10), 
+			"gsl_vector_float" = numeric(10) 
+		), 
+		msg = "wrap( gsl_vector )" )
 }
 

Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp	2010-04-06 07:18:55 UTC (rev 1003)
+++ pkg/RcppGSL/src/RcppGSL.cpp	2010-04-06 07:30:55 UTC (rev 1004)
@@ -1,15 +1,20 @@
 #include <RcppGSL.h>
 
+using namespace Rcpp ;
+
 extern "C" SEXP test_gsl_vector(){
-	gsl_vector * x = gsl_vector_alloc (10);
-	gsl_vector_set_zero( x ) ;
+	gsl_vector * x_double = gsl_vector_calloc (10);
+	gsl_vector_float * x_float = gsl_vector_float_calloc(10) ;
 	
-	// we cannot have Rcpp::NumericVector xx = x ; 
-	// because this does not involve the assignment operator
-	// but the constructor and Vector only had templated assignement
-	// operator, not templated constructor, so we have to do this in two steps
-	Rcpp::NumericVector xx ;
-	xx = *x  ;
-	gsl_vector_free (x);
-	return xx ;
+	/* create an R list containing copies of gsl data */
+	List res = List::create( 
+		_["gsl_vector"] = *x_double, 
+		_["gsl_vector_float"] = *x_float 
+		) ;
+	
+	/* cleanup gsl data */
+	gsl_vector_free(x_double);
+	gsl_vector_float_free( x_float);
+	
+	return res ;
 }