First pass at adding Rcpp::algorithm

inst/include/Rcpp.h

@@ -80,4 +80,6 @@
 
 #include <Rcpp/platform/solaris.h>
 #include <Rcpp/api/meat/meat.h>
+
+#include <Rcpp/algorithm.h>
 #endif

inst/include/Rcpp/algorithm.h

@@ -0,0 +1,142 @@
+#if __cplusplus >= 201103L
+#    define RCPP_CONSTEXPR constexpr
+#else
+#    define RCPP_CONSTEXPR const
+#endif
+
+namespace Rcpp {
+namespace algorithm {
+
+namespace helpers {
+    template< typename T >
+    struct rtype_helper {
+        static RCPP_CONSTEXPR int RTYPE = REALSXP;
+        static inline double NA() { return NA_REAL; }
+        static inline RCPP_CONSTEXPR double ZERO() { return 0.0; }
+        static inline RCPP_CONSTEXPR double ONE() { return 1.0; }
+    };
+
+    template<>
+    struct rtype_helper< double > {
+        static RCPP_CONSTEXPR int RTYPE = REALSXP;
+        static inline double NA() { return NA_REAL; }
+        static inline RCPP_CONSTEXPR double ZERO() { return 0.0; }
+        static inline RCPP_CONSTEXPR double ONE() { return 1.0; }
+    };
+
+    template<>
+    struct rtype_helper< int > {
+        static RCPP_CONSTEXPR int RTYPE = INTSXP;
+        static inline int NA() { return NA_INTEGER; }
+        static inline RCPP_CONSTEXPR int ZERO() { return 0; }
+        static inline RCPP_CONSTEXPR int ONE() { return 1; }
+    };
+
+    template< typename T >
+    struct rtype {
+        static RCPP_CONSTEXPR int RTYPE =
+            rtype_helper< typename traits::remove_const_and_reference< T >::type >::RTYPE;
+        static inline T NA() { return rtype_helper< typename traits::remove_const_and_reference< T >::type >::NA(); }
+        static inline RCPP_CONSTEXPR T ZERO() { return rtype_helper< typename traits::remove_const_and_reference< T >::type >::ZERO(); }
+        static inline RCPP_CONSTEXPR T ONE() { return rtype_helper< typename traits::remove_const_and_reference< T >::type >::ONE(); }
+    };
+
+    struct log {
+        template< typename T >
+        inline double operator()(T val) {
+            if (!Vector< rtype< T >::RTYPE >::is_na(val)) {
+                return std::log(val);
+            }
+
+            return rtype< double >::NA();
+        }
+    };
+
+    struct exp {
+        template< typename T >
+        inline double operator()(T val) {
+            if (!Vector< rtype< T >::RTYPE >::is_na(val)) {
+                return std::exp(val);
+            }
+
+            return rtype< double >::NA();
+        }
+    };
+
+    struct sqrt {
+        template< typename T >
+        inline double operator()(T val) {
+            if (!Vector< rtype< T >::RTYPE >::is_na(val)) {
+                return std::sqrt(val);
+            }
+
+            return rtype< double >::NA();
+        }
+    };
+} // namespace helpers
+
+template< typename InputIterator >
+typename std::iterator_traits< InputIterator >::value_type sum(InputIterator begin, InputIterator end) {
+
+    typedef typename std::iterator_traits< InputIterator >::value_type value_type;
+    typedef typename helpers::rtype< value_type > rtype;
+
+    if (begin != end) {
+         value_type start = rtype::ZERO();
+
+        while (begin != end) {
+            if (!Vector< rtype::RTYPE >::is_na(*begin)) {
+                start += *begin++;
+            } else {
+                return rtype::NA();
+            }
+        }
+
+        return start;
+    }
+
+    return rtype::ZERO();
+}
+
+template< typename InputIterator >
+typename std::iterator_traits< InputIterator >::value_type prod(InputIterator begin, InputIterator end) {
+
+    typedef typename std::iterator_traits< InputIterator >::value_type value_type;
+    typedef typename helpers::rtype< value_type > rtype;
+
+    if (begin != end) {
+        value_type start = rtype::ONE();
+
+        while (begin != end) {
+            if (!Vector< rtype::RTYPE >::is_na(*begin)) {
+                start *= *begin++;
+            } else {
+                return rtype::NA();
+            }
+        }
+
+        return start;
+    }
+
+    return rtype::ZERO();
+}
+
+template< typename InputIterator, typename OutputIterator >
+void log(InputIterator begin, InputIterator end, OutputIterator out) {
+    std::transform(begin, end, out, helpers::log());
+}
+
+template< typename InputIterator, typename OutputIterator >
+void exp(InputIterator begin, InputIterator end, OutputIterator out) {
+    std::transform(begin, end, out, helpers::exp());
+}
+
+template< typename InputIterator, typename OutputIterator >
+void sqrt(InputIterator begin, InputIterator end, OutputIterator out) {
+    std::transform(begin, end, out, helpers::sqrt());
+}
+
+} // namespace algorithm
+} // namespace Rcpp
+
+#undef RCPP_CONSTEXPR

inst/unitTests/cpp/algorithms.cpp

@@ -0,0 +1,32 @@
+#include <Rcpp.h>
+
+// [[Rcpp::export]]
+double sumTest(Rcpp::NumericVector v, int begin, int end) {
+	return Rcpp::algorithm::sum(v.begin() + (begin - 1), v.begin() + end);
+}
+
+// [[Rcpp::export]]
+double prodTest(Rcpp::NumericVector v, int begin, int end) {
+	return Rcpp::algorithm::prod(v.begin() + (begin - 1), v.begin() + end);
+}
+
+// [[Rcpp::export]]
+Rcpp::NumericVector logTest(Rcpp::NumericVector v) {
+	Rcpp::NumericVector x = Rcpp::clone(v);
+	Rcpp::algorithm::log(v.begin(), v.end(), x.begin());
+	return x;
+}
+
+// [[Rcpp::export]]
+Rcpp::NumericVector expTest(Rcpp::NumericVector v) {
+	Rcpp::NumericVector x = Rcpp::clone(v);
+	Rcpp::algorithm::exp(v.begin(), v.end(), x.begin());
+	return x;
+}
+
+// [[Rcpp::export]]
+Rcpp::NumericVector sqrtTest(Rcpp::NumericVector v) {
+	Rcpp::NumericVector x = Rcpp::clone(v);
+	Rcpp::algorithm::sqrt(v.begin(), v.end(), x.begin());
+	return x;
+}

inst/unitTests/runit.algorithms.R

@@ -0,0 +1,50 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2010 - 2015  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/>.
+
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+
+if (.runThisTest) {
+
+    .setUp <- Rcpp:::unitTestSetup("algorithms.cpp")
+
+    test.sum <- function() {
+        v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
+        checkEquals(sum(v), sumTest(v, 1, 5))
+    }
+
+    test.prod <- function() {
+        v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
+        checkEquals(prod(v), prodTest(v, 1, 5))
+    }
+
+    test.log <- function() {
+        v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
+        checkEquals(log(v), logTest(v))
+    }
+
+    test.exp <- function() {
+        v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
+        checkEquals(exp(v), expTest(v))
+    }
+
+    test.sqrt <- function() {
+        v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
+        checkEquals(sqrt(v), sqrtTest(v))
+    }
+}