Merge pull request #527 from nathan-russell/master

Added decreasing option for Vector sort (#525)

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,11 @@
+2016-08-01 Nathan Russell <[email protected]>
+
+        * inst/include/Rcpp/vector/Vector.h: Added decreasing option for Vector 
+        sort 
+        * inst/include/Rcpp/internal/NAComparator.h: Idem
+        * inst/unitTests/cpp/Vector.cpp: Idem
+        * inst/unitTests/runit.Vector.R: Idem
+
 2016-07-31 Qiang Kou <[email protected]>
 
         * inst/examples/SugarPerformance/sugarBenchmarks.R: Remove usage of Rf_eval

inst/include/Rcpp/internal/NAComparator.h

@@ -23,7 +23,7 @@
 #ifndef Rcpp__internal__NAComparator__h
 #define Rcpp__internal__NAComparator__h
 
-namespace Rcpp{
+namespace Rcpp {
 
 namespace internal {
 
@@ -104,8 +104,16 @@ struct NAComparator<SEXP> {
     }
 };
 
-}
 
-}
+template <typename T>
+struct NAComparatorGreater {
+    inline bool operator()(T left, T right) const {
+        return NAComparator<T>()(right, left);
+    }
+};
+
+} // internal
+
+} // Rcpp
 
-#endif
+#endif // Rcpp__internal__NAComparator__h

inst/include/Rcpp/vector/Vector.h

@@ -382,21 +382,31 @@ class Vector :
         );
     }
 
-    Vector& sort(){
+    Vector& sort(bool decreasing = false) {
         // sort() does not apply to List, RawVector or ExpressionVector.
         //
         // The function below does nothing for qualified Vector types,
         // and is undefined for other types. Hence there will be a
         // compiler error when sorting List, RawVector or ExpressionVector.
         internal::Sort_is_not_allowed_for_this_type<RTYPE>::do_nothing();
 
-        typename traits::storage_type<RTYPE>::type* start = internal::r_vector_start<RTYPE>( Storage::get__() ) ;
-        std::sort(
-            start,
-            start + size(),
-            internal::NAComparator<typename traits::storage_type<RTYPE>::type >()
-        ) ;
-        return *this ;
+        typename traits::storage_type<RTYPE>::type* start = internal::r_vector_start<RTYPE>( Storage::get__() );
+        
+        if (!decreasing) {
+            std::sort(
+                start,
+                start + size(),
+                internal::NAComparator<typename traits::storage_type<RTYPE>::type>()
+            );            
+        } else {
+            std::sort(
+                start,
+                start + size(),
+                internal::NAComparatorGreater<typename traits::storage_type<RTYPE>::type>()
+            );     
+        }
+
+        return *this;
     }
 
     template <typename InputIterator>

inst/unitTests/cpp/Vector.cpp

@@ -747,22 +747,42 @@ CharacterVector CharacterVector_test_const_proxy(const CharacterVector x){
 
 // [[Rcpp::export]]
 NumericVector sort_numeric(NumericVector x) {
-  return x.sort();
+    return x.sort();
 }
 
 // [[Rcpp::export]]
 IntegerVector sort_integer(IntegerVector x) {
-  return x.sort();
+    return x.sort();
 }
 
 // [[Rcpp::export]]
 CharacterVector sort_character(CharacterVector x) {
-  return x.sort();
+    return x.sort();
 }
 
 // [[Rcpp::export]]
 LogicalVector sort_logical(LogicalVector x) {
-  return x.sort();
+    return x.sort();
+}
+
+// [[Rcpp::export]]
+NumericVector sort_numeric_desc(NumericVector x) {
+    return x.sort(true);
+}
+
+// [[Rcpp::export]]
+IntegerVector sort_integer_desc(IntegerVector x) {
+    return x.sort(true);
+}
+
+// [[Rcpp::export]]
+CharacterVector sort_character_desc(CharacterVector x) {
+    return x.sort(true);
+}
+
+// [[Rcpp::export]]
+LogicalVector sort_logical_desc(LogicalVector x) {
+    return x.sort(true);
 }
 
 // [[Rcpp::export]]

inst/unitTests/runit.Vector.R

@@ -672,6 +672,32 @@ if (.runThisTest) {
         checkIdentical( sort_logical(lgcl), sort(lgcl, na.last=TRUE) )
     }
 
+    test.sort_desc <- function() {
+        num <- setNames(c(1, -1, 4, NA, 5, NaN), letters[1:5])
+        checkIdentical(
+            sort_numeric_desc(num), 
+            sort(num, decreasing = TRUE, na.last = FALSE)
+        )
+        
+        int <- as.integer(num)
+        checkIdentical(
+            sort_integer_desc(int), 
+            sort(int, decreasing = TRUE, na.last = FALSE) 
+        )
+        
+        char <- setNames(sample(letters, 5), LETTERS[1:5])
+        checkIdentical(
+            sort_character_desc(char), 
+            sort(char, decreasing = TRUE, na.last = FALSE) 
+        )
+        
+        lgcl <- as.logical(int)
+        checkIdentical(
+            sort_logical_desc(lgcl), 
+            sort(lgcl, decreasing = TRUE, na.last = FALSE) 
+        )
+    }
+    
     test.List.assign.SEXP <- function() {
         l <- list(1, 2, 3)
         other <- list_sexp_assign(l)