Added Rcpp::algorithm::mean

Author: Daniel C. Dillon

inst/include/Rcpp/algorithm.h

@@ -245,6 +245,59 @@ typename std::iterator_traits< InputIterator >::value_type min_nona(InputIterato
     return std::numeric_limits< typename rtype::type >::infinity();
 }
 
+// for REALSXP
+template< typename InputIterator >
+typename traits::enable_if< traits::same_type< typename std::iterator_traits< InputIterator >::value_type, double >::value, double >::type
+mean(InputIterator begin, InputIterator end)
+{
+    if (begin != end)
+    {
+        std::size_t n = end - begin;
+        long double s = std::accumulate(begin, end, 0.0L);
+        s /= n;
+
+        if (R_FINITE((double) s)) {
+            long double t = 0.0L;
+            while (begin != end) {
+                t += *begin++ - s;
+            }
+
+            s += t / n;
+        }
+
+        return (double) s;
+    }
+
+    return helpers::rtype< double >::NA();
+}
+
+// for LGLSXP and INTSXP
+template< typename InputIterator >
+typename traits::enable_if< traits::same_type< typename std::iterator_traits< InputIterator >::value_type, int >::value, double >::type
+mean(InputIterator begin, InputIterator end)
+{
+    if (begin != end)
+    {
+        std::size_t n = end - begin;
+        long double s = std::accumulate(begin, end, 0.0L);
+        s /= n;
+
+        if (R_FINITE((double) s)) {
+            long double t = 0.0L;
+            while (begin != end) {
+                if (*begin == helpers::rtype< int >::NA()) return helpers::rtype< double >::NA();
+                t += *begin++ - s;
+            }
+
+            s += t / n;
+        }
+
+        return (double) s;
+    }
+
+    return helpers::rtype< double >::NA();
+}
+
 template< typename InputIterator, typename OutputIterator >
 void log(InputIterator begin, InputIterator end, OutputIterator out) {
     std::transform(begin, end, out, helpers::log());

inst/unitTests/cpp/algorithm.cpp

@@ -80,3 +80,18 @@ int minTest_int_nona(Rcpp::IntegerVector v) {
 int maxTest_int_nona(Rcpp::IntegerVector v) {
 	return Rcpp::algorithm::max_nona(v.begin(), v.end());
 }
+
+// [[Rcpp::export]]
+double meanTest(Rcpp::NumericVector v) {
+	return Rcpp::algorithm::mean(v.begin(), v.end());
+}
+
+// [[Rcpp::export]]
+double meanTest_int(Rcpp::IntegerVector v) {
+	return Rcpp::algorithm::mean(v.begin(), v.end());
+}
+
+// [[Rcpp::export]]
+double meanTest_logical(Rcpp::LogicalVector v) {
+	return Rcpp::algorithm::mean(v.begin(), v.end());
+}

inst/unitTests/runit.algorithm.R

@@ -115,4 +115,34 @@ if (.runThisTest) {
         v <- c(1, 2, 3, 4, 5)
         checkEquals(max(v), maxTest_int_nona(v))
     }
+
+    test.mean <- function() {
+        v <- c(1.0, 2.0, 3.0, 4.0, 5.0)
+        checkEquals(mean(v), meanTest(v))
+        v <- c(1.0, 2.0, 3.0, 4.0, NA)
+        checkEquals(mean(v), meanTest(v))
+        v <- c(1.0, 2.0, 3.0, 4.0, NaN)
+        checkEquals(mean(v), meanTest(v))
+        v <- c(1.0, 2.0, 3.0, 4.0, 1.0/0.0)
+        checkEquals(mean(v), meanTest(v))
+        v <- c(1.0, 2.0, 3.0, 4.0, -1.0/0.0)
+        checkEquals(mean(v), meanTest(v))
+        v <- c(1.0, 2.0, 1.0/0.0, NA, NaN)
+        checkEquals(mean(v), meanTest(v))
+        v <- c(1.0, 2.0, 1.0/0.0, NaN, NA)
+    }
+
+    test.mean.int <- function() {
+        v <- c(1, 2, 3, 4, 5)
+        checkEquals(mean(v), meanTest_int(v))
+        v <- c(1, 2, 3, 4, NA)
+        checkEquals(mean(v), meanTest_int(v))
+    }
+
+    test.mean.logical <- function() {
+        v <- c(TRUE, FALSE, FALSE)
+        checkEquals(mean(v), meanTest_logical(v))
+        v <- c(TRUE, FALSE, FALSE, NA)
+        checkEquals(mean(v), meanTest_logical(v))
+    }
 }