[Rcpp-commits] r1614 - in pkg/Rcpp/inst: include/Rcpp/sugar/functions unitTests

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

Author: romain
Date: 2010-06-19 11:19:19 +0200 (Sat, 19 Jun 2010)
New Revision: 1614

Added:
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/lapply.h
   pkg/Rcpp/inst/unitTests/runit.sugar.lapply.R
Modified:
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h
   pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R
Log:
lapply

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h	2010-06-18 20:39:30 UTC (rev 1613)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/functions.h	2010-06-19 09:19:19 UTC (rev 1614)
@@ -27,6 +27,7 @@
 #include <Rcpp/sugar/functions/is_na.h>
 #include <Rcpp/sugar/functions/seq_along.h>
 #include <Rcpp/sugar/functions/sapply.h>
+#include <Rcpp/sugar/functions/lapply.h>
 #include <Rcpp/sugar/functions/ifelse.h>
 
 #endif

Added: pkg/Rcpp/inst/include/Rcpp/sugar/functions/lapply.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/lapply.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/lapply.h	2010-06-19 09:19:19 UTC (rev 1614)
@@ -0,0 +1,61 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// lapply.h: Rcpp R/C++ interface class library -- lapply
+//
+// 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__sugar__lapply_h
+#define Rcpp__sugar__lapply_h
+
+namespace Rcpp{
+namespace sugar{
+
+template <int RTYPE, bool NA, typename T, typename Function>
+class Lapply : public VectorBase< 
+	VECSXP , 
+	true ,
+	Lapply<RTYPE,NA,T,Function>
+> {
+public:         
+	typedef Rcpp::VectorBase<RTYPE,NA,T> VEC ;
+	typedef typename ::Rcpp::traits::result_of<Function>::type result_type ;
+	
+	Lapply( const VEC& vec_, Function fun_ ) : 
+		vec(vec_), fun(fun_){}
+	
+	inline SEXP operator[]( int i ) const {
+		return Rcpp::wrap( fun( vec[i] ) );
+	}
+	inline int size() const { return vec.size() ; }
+	         
+private:
+	const VEC& vec ;
+	Function fun ;
+} ;
+	
+} // sugar
+
+template <int RTYPE, bool _NA_, typename T, typename Function >
+inline sugar::Lapply<RTYPE,_NA_,T,Function> 
+lapply( const Rcpp::VectorBase<RTYPE,_NA_,T>& t, Function fun ){
+	return sugar::Lapply<RTYPE,_NA_,T,Function>( t, fun ) ;
+}
+
+} // Rcpp
+
+#endif

Added: pkg/Rcpp/inst/unitTests/runit.sugar.lapply.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.lapply.R	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.lapply.R	2010-06-19 09:19:19 UTC (rev 1614)
@@ -0,0 +1,31 @@
+#!/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/>.
+
+test.sugar.lapply <- function( ){
+
+	fx <- cxxfunction( signature( x = "integer" ), '
+		IntegerVector xx(x) ;
+		List res = lapply( xx, seq_len );
+		return res ;
+	
+	', plugin = "Rcpp" )
+	
+	checkEquals( fx( 1:10 ), lapply( 1:10, seq_len ) )
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R	2010-06-18 20:39:30 UTC (rev 1613)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R	2010-06-19 09:19:19 UTC (rev 1614)
@@ -77,4 +77,3 @@
 	checkTrue( fx(1:10)  )
 }
 
-