[Rcpp-devel] Rcpp internal versions of lapply and sapply

[Romain Francois]

Hello,

As a follow up on this thread, I've now commited a lazy version of 
sapply. It can be used with a functor that has a nested result_type 
type, or raw functions as illustrated by these examples from the unit 
tests:

test.sugar.sapply <- function( ){

	inc <- '
	template <typename T>
	class square : public std::unary_function<T,T> {
	public:
		T operator()( T t) const { return t*t ; }
	} ;
	'
	
	fx <- cxxfunction( signature( x = "numeric" ), '
	
		NumericVector xx(x) ;
		NumericVector res = sapply( xx, square<double>() );
		
		return res ;
	
	', include = inc, plugin = "Rcpp" )
	
	checkEquals( fx(1:10) , (1:10)^2 )
}

test.sugar.sapply.rawfun <- function( ){

	inc <- '
	double square( double x){ return x*x; }
	'
	
	fx <- cxxfunction( signature( x = "numeric" ), '
	
		NumericVector xx(x) ;
		NumericVector res = sapply( xx, square );
		
		return res ;
	
	', include = inc, plugin = "Rcpp" )
	
	checkEquals( fx(1:10) , (1:10)^2 )
}


There is one more thing since this thread, sapply uses the new 
Rcpp::traits::result_of trait to find out the result type of the function.

namespace Rcpp{
namespace traits{

template <typename T>
struct result_of{
	typedef typename T::result_type type ;
} ;

template <typename RESULT_TYPE, typename INPUT_TYPE>
struct result_of< RESULT_TYPE (*)(INPUT_TYPE) >{
	typedef RESULT_TYPE type ;
} ;

}
}


This version of sapply is lazy, so for example this works :

test.sugar.sapply.square <- function( ){

	inc <- '
	template <typename T>
	class square : public std::unary_function<T,T> {
	public:
		T operator()( T t) const { return t*t ; }
	} ;
	'
	
	fx <- cxxfunction( signature( x = "numeric" ), '
	
		NumericVector xx(x) ;
		return all( sapply( xx * xx , square<double>() ) < 10 );
	
	', include = inc, plugin = "Rcpp" )
	
	checkTrue( fx(1:10)  )
}

and sapply only needs to calculate square( xx[0] * xx[0] ) and square( 
xx[1] * xx[1] ) to make its final decision.

Romain

Le 16/06/10 14:58, Douglas Bates a écrit :
>
> Ever since I read Phil Spector's book on S I have been a fan of
> functional programming in S and R.  When Jose Pinheiro and I were
> working on the nlme package there was a joke between us that you could
> tell which of us wrote which parts of the code because his parts
> always had an object named "aux" and my parts always had
> "unlist(lapply(list(...)))".
>
> Even within C++ I like to use the std:: algorithms like
> std::transform, but, of course, there are differences between a
> strongly typed language like C++ and a dynamically typed language like
> S.  Templates can get around these differences to some extent but I am
> still a bit of a novice regarding templates.
>
> Currently I want to apply some functions to lists but entirely within
> the C++ code (i.e. I don't want to create Rcpp Function objects and
> call back to R).  For the sake of argument, consider a function that
> extracts the lengths of the components of the lists.
>
>
> library(Rcpp)
> library(inline)
> inc<- '
> class length {
> public:
>      R_len_t operator() (RObject const&  x) {return Rf_length(SEXP(x));}
> };
> '
> code<- '
> List lst(ll);
> IntegerVector ans(lst.size());
> std::transform(lst.begin(), lst.end(), ans.begin(), length());
> return ans;
> '
> ltst<- cxxfunction(signature(ll = "list"), code, "Rcpp", inc)
> ll<- list(a = numeric(0), b = LETTERS[6:9], c = c)
> ltst(ll)
> sapply(ll, length)
>
> I would like to create a templated sapply function like
>
> template<int RTYPE>
> Vector<RTYPE>  sapply(List ll, ??) {
>      Vector<RTYPE>  ans(ll.size());
>      CharacterVector nms = ll.names();
>      if (nms.size() == ll.size()) ans.names() = nms;
>      std::transform(ll.begin(), ll.end(), ans.begin(), ??);
>      return ans;
> }
>
> but I don't know how to specify the second argument that is a function
> that returns the atomic element type of a Vector<RTYPE>  (is this as
> simple as Vector<RTYPE>::value_type?) and has a single argument which
> probably should be an RObject (although might be an SEXP, if that was
> more convenient).  Can someone (probably Romain) provide some
> guidance?
> _______________________________________________
> Rcpp-devel mailing list
> Rcpp-devel at lists.r-forge.r-project.org
> https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-devel
>
>


-- 
Romain Francois
Professional R Enthusiast
+33(0) 6 28 91 30 30
http://romainfrancois.blog.free.fr
|- http://bit.ly/98Uf7u : Rcpp 0.8.1
|- http://bit.ly/c6YnCi : graph gallery collage
`- http://bit.ly/bZ7ltC : inline 0.3.5