# sapply with variadic trailing arguments (…)

May 28, 2014
By

(This article was first published on R Enthusiast and R/C++ hero, and kindly contributed to R-bloggers)

## Motivation

In R, we can pass further arguments to sapply. The arguments are then passed the function to be applied over.

``````x <- seq(-3, 3, by=.2 )
sapply( x, dnorm, 0, 4, FALSE )
``````

Conceptually this does something like:

``````sapply( x, function(.){
dnorm(.,0,4,FALSE)
} )
``````

## Implementation in Rcpp11

sapply has been part of sugar for a long time, and is now very central to the modernized version of sugar in the devel version of `Rcpp11`, but until now we did not have a mechanism similar to R’s ellipsis.

variadic templates and `std::tuple` give us the tools to implement the feature in Rcpp11.

``````#include
using namespace Rcpp11 ;

// [[Rcpp::export]]
NumericVector bazinga(NumericVector x){
NumericVector res = sapply( x, ::Rf_dnorm4, 0.0, 4.0, false ) ;
return res ;
}

/*** R
x <- seq(-3, 3, by=.2 )
bazinga(x)
*/
``````

## Details

For the details, further arguments are tied together into a functor object SapplyFunctionBinder wrapping both the underlying function to be called `::Rf_dnorm4` and the data as `std::tuple`.

``````template
class SapplyFunctionBinder {
public:
typedef typename Rcpp::traits::storage_type::type storage_type ;
typedef typename std::tuple Tuple ;
typedef typename Rcpp::traits::index_sequence::type Sequence ;
typedef typename std::result_of::type fun_result_type ;

SapplyFunctionBinder( Function fun_, Args&&... args) :
fun(fun_), tuple(std::forward(args)...){}

inline fun_result_type operator()( storage_type x ) const {
return apply( x, Sequence() ) ;
}

private:
Function fun ;
Tuple tuple ;

template
inline fun_result_type apply( storage_type x, Rcpp::traits::sequence ) const {
return fun( x, std::get(tuple)... );
}

} ;
``````

## Alternatives

Alternatively, this can be done with lambda functions :

``````NumericVector res = sapply( x, [](double a){
return ::Rf_dnorm4(a, 0.0, 4.0, false ) ;
} ) ;
``````

We could also bind the function with `std::bind` :

``````using namespace std::placeholders ;
NumericVector res = sapply( x, std::bind(::Rf_dnorm4, _1, 0.0, 4.0, false) ) ;
``````

## Comparison. Cost of the abstraction

Let’s compare these alternatives through microbenchmark.

``````#include
using namespace Rcpp11 ;

// [[Rcpp::export]]
NumericVector res = sapply( x, ::Rf_dnorm4, 0.0, 4.0, false ) ;
return res ;
}

// [[Rcpp::export]]
NumericVector sapply_lambda(NumericVector x){
NumericVector res = sapply( x, [](double a){
return ::Rf_dnorm4(a, 0.0, 4.0, false ) ;
} ) ;
return res ;
}

// [[Rcpp::export]]
NumericVector sapply_bind(NumericVector x){
using namespace std::placeholders ;
NumericVector res = sapply( x, std::bind(::Rf_dnorm4, _1, 0.0, 4.0, false) ) ;
return res ;
}

// [[Rcpp::export]]
NumericVector sapply_loop(NumericVector x){
int n = x.size() ;
NumericVector res(n);
for( int i=0; i``````
``` Here are the results. \$ Rcpp11Script /tmp/test.cpp > x <- seq(-3, 3, length.out = 1e+06) > require(microbenchmark) Loading required package: microbenchmark > microbenchmark(sapply_variadic(x), sapply_lambda(x), + sapply_bind(x), sapply_loop(x)) Unit: milliseconds expr min lq median uq max neval sapply_variadic(x) 20.01696 20.11962 21.36856 22.07377 31.22063 100 sapply_lambda(x) 20.53550 20.63079 21.83883 22.55680 31.62075 100 sapply_bind(x) 19.96870 20.56051 21.32460 22.26086 30.66203 100 sapply_loop(x) 20.81417 20.92458 22.13156 22.84175 31.48991 100 All 4 solutions give pretty identical performance. This is abstraction we did not have to pay for. In comparisons, a direct call to the vectorised R function dnorm R_direct <- function(x){ dnorm(x, 0, 4, FALSE) } yields: > microbenchmark(sapply_variadic(x), sapply_lambda(x), + sapply_bind(x), sapply_loop(x), R_direct(x)) Unit: milliseconds expr min lq median uq max neval sapply_variadic(x) 20.05441 20.12312 21.35391 22.67544 31.34657 100 sapply_lambda(x) 20.28648 20.39238 21.60423 22.31166 30.66797 100 sapply_bind(x) 19.94212 20.02965 21.26132 21.92637 30.68198 100 sapply_loop(x) 20.25010 20.31937 21.57333 22.89537 31.75865 100 R_direct(x) 33.73723 33.89319 35.06729 36.05020 43.95266 100 I also intended to test the version using R’s sapply. sapply_R <- function(x){ sapply(x, dnorm, 0, 4, FALSE ) } But … life’s too short and I killed it. var vglnk = { key: '949efb41171ac6ec1bf7f206d57e90b8' }; (function(d, t) { var s = d.createElement(t); s.type = 'text/javascript'; s.async = true; s.src = '//cdn.viglink.com/api/vglnk.js'; var r = d.getElementsByTagName(t)[0]; r.parentNode.insertBefore(s, r); }(document, 'script')); Related ShareTweet To leave a comment for the author, please follow the link and comment on their blog: R Enthusiast and R/C++ hero. R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more... If you got this far, why not subscribe for updates from the site? Choose your flavor: e-mail, twitter, RSS, or facebook... ```
``` ```
``` Comments are closed. ```
``` Recent popular posts Deep Learning with R Add P-values and Significance Levels to ggplots Introducing the MonteCarlo Package How to create dot-density maps in R Get the best from ggplotly Most visited articles of the week How to write the first for loop in R Installing R packages Using apply, sapply, lapply in R How to Make a Histogram with Basic R Tutorials for learning R How to perform a Logistic Regression in R Freedman's paradox Shiny app to explore ggplot2 In-depth introduction to machine learning in 15 hours of expert videos Sponsors function createCookie(name,value,days) { var expires = ""; if (days) { var date = new Date(); date.setTime(date.getTime() + (days*24*60*60*1000)); expires = "; expires=" + date.toUTCString(); } document.cookie = name + "=" + value + expires + "; path=/"; } function readCookie(name) { var nameEQ = name + "="; var ca = document.cookie.split(';'); for(var i=0;i < ca.length;i++) { var c = ca[i]; while (c.charAt(0)==' ') c = c.substring(1,c.length); if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length); } return null; } function eraseCookie(name) { createCookie(name,"",-1); } function readTextFile(file) { // Helps people browse between pages without the need to keep downloading the same // ads txt page everytime. This way, it allows them to use their browser's cache. var random_number = readCookie("ad_random_number_cookie"); if(random_number == null) { var random_number = Math.floor(Math.random()*100*(new Date().getTime()/1000)); createCookie("ad_random_number_cookie",random_number,1) } file += '?t='+random_number; var rawFile = new XMLHttpRequest(); rawFile.onreadystatechange = function () { if(rawFile.readyState === 4) { if(rawFile.status === 200 || rawFile.status == 0) { // var allText = rawFile.responseText; // document.write(allText); document.write(rawFile.responseText); } } } rawFile.open("GET", file, false); rawFile.send(null); } // readTextFile('https://raw.githubusercontent.com/Raynos/file-store/master/temp.txt'); readTextFile("https://www.r-bloggers.com/wp-content/uploads/text-widget_anti-cache.txt"); Jobs for R usersData Scientist @ Garching bei München, Bayern, GermanySoftware DeveloperSenior Quantitative Analyst, Data ScientistR data wranglerSenior Data ScientistManager, Statistical Consulting & Data ScienceFinancial Controller Full list of contributing R-bloggers ```
``` R-bloggers was founded by Tal Galili, with gratitude to the R community. Is powered by WordPress using a bavotasan.com design. Copyright © 2017 R-bloggers. All Rights Reserved. Terms and Conditions for this website var snp_f = []; var snp_hostname = new RegExp(location.host); var snp_http = new RegExp("^(http|https)://", "i"); var snp_cookie_prefix = ''; var snp_separate_cookies = false; var snp_ajax_url = 'https://www.r-bloggers.com/wp-admin/admin-ajax.php'; var snp_ignore_cookies = false; var snp_enable_analytics_events = false; var snp_enable_mobile = false; var snp_use_in_all = false; var snp_excluded_urls = []; snp_excluded_urls.push(''); Never miss an update! Subscribe to R-bloggers to receive e-mails with the latest R posts. (You will not see this message again.) Click here to close (This popup will not appear again) .snp-pop-109583 .snp-theme6 { max-width: 700px;} .snp-pop-109583 .snp-theme6 h1 {font-size: 17px;} .snp-pop-109583 .snp-theme6 { color: #a0a4a9;} .snp-pop-109583 .snp-theme6 .snp-field ::-webkit-input-placeholder { color: #a0a4a9;} .snp-pop-109583 .snp-theme6 .snp-field :-moz-placeholder { color: #a0a4a9;} .snp-pop-109583 .snp-theme6 .snp-field :-ms-input-placeholder { color: #a0a4a9;} .snp-pop-109583 .snp-theme6 .snp-field input { border: 1px solid #a0a4a9;} .snp-pop-109583 .snp-theme6 .snp-field { color: #000000;} .snp-pop-109583 .snp-theme6 { background: #f2f2f2;} (function(){ var corecss = document.createElement('link'); var themecss = document.createElement('link'); var corecssurl = "https://www.r-bloggers.com/wp-content/plugins/syntaxhighlighter/syntaxhighlighter3/styles/shCore.css?ver=3.0.9b"; if ( corecss.setAttribute ) { corecss.setAttribute( "rel", "stylesheet" ); corecss.setAttribute( "type", "text/css" ); corecss.setAttribute( "href", corecssurl ); } else { corecss.rel = "stylesheet"; corecss.href = corecssurl; } document.getElementsByTagName("head")[0].insertBefore( corecss, document.getElementById("syntaxhighlighteranchor") ); var themecssurl = "https://www.r-bloggers.com/wp-content/plugins/syntaxhighlighter/syntaxhighlighter3/styles/shThemeDefault.css?ver=3.0.9b"; if ( themecss.setAttribute ) { themecss.setAttribute( "rel", "stylesheet" ); themecss.setAttribute( "type", "text/css" ); themecss.setAttribute( "href", themecssurl ); } else { themecss.rel = "stylesheet"; themecss.href = themecssurl; } //document.getElementById("syntaxhighlighteranchor").appendChild(themecss); document.getElementsByTagName("head")[0].insertBefore( themecss, document.getElementById("syntaxhighlighteranchor") ); })(); SyntaxHighlighter.config.strings.expandSource = '+ expand source'; SyntaxHighlighter.config.strings.help = '?'; SyntaxHighlighter.config.strings.alert = 'SyntaxHighlighter\n\n'; SyntaxHighlighter.config.strings.noBrush = 'Can\'t find brush for: '; SyntaxHighlighter.config.strings.brushNotHtmlScript = 'Brush wasn\'t configured for html-script option: '; SyntaxHighlighter.defaults['pad-line-numbers'] = false; SyntaxHighlighter.defaults['toolbar'] = false; SyntaxHighlighter.all(); _stq = window._stq || []; _stq.push([ 'view', {v:'ext',j:'1:4.7.1',blog:'11524731',post:'77116',tz:'-6',srv:'www.r-bloggers.com'} ]); _stq.push([ 'clickTrackerInit', '11524731', '77116' ]); /* <![CDATA[ */ jQuery(function(){ jQuery("ul.sf-menu").supersubs({ minWidth: 12, maxWidth: 27, extraWidth: 1 }).superfish({ delay: 100, speed: 250 }); }); /* ]]> */ ```