Fixed signed comparison in IndexHash; unit tests for unique() (closes #574)

Author: nathan-russell

ChangeLog

@@ -1,3 +1,12 @@
+2016-11-03  Nathan Russell     <russell.nr2012@gmail.com>
+
+        * inst/include/Rcpp/hash/IndexHash.h: Add casts to eliminate 
+        signed / unsigned comparison warning
+        * inst/include/Rcpp/hash/SelfHash.h: Idem
+        * inst/unitTests/cpp/sugar.cpp: Added unit tests for sugar function 
+        unique()
+        * inst/unitTests/runit.sugar.R: Idem
+
 2016-10-30  Dirk Eddelbuettel  <edd@debian.org>
 
         * src/api.cpp: New capabilities field for new date(time) vectors

inst/include/Rcpp/hash/IndexHash.h

@@ -170,7 +170,7 @@ namespace Rcpp{
             unsigned int addr = get_addr(val) ;
             while (data[addr] && not_equal( src[data[addr] - 1], val)) {
               addr++;
-              if (addr == m) {
+              if (addr == static_cast<unsigned int>(m)) {
                 addr = 0;
               }
             }
@@ -191,7 +191,7 @@ namespace Rcpp{
               if (src[data[addr] - 1] == value)
                 return data[addr];
               addr++;
-              if (addr == m) addr = 0;
+              if (addr == static_cast<unsigned int>(m)) addr = 0;
             }
             return NA_INTEGER;
         }

inst/include/Rcpp/hash/SelfHash.h

@@ -65,7 +65,7 @@ namespace sugar{
             unsigned int addr = get_addr(val) ;
             while (data[addr] && src[data[addr] - 1] != val) {
               addr++;
-              if (addr == m) addr = 0;
+              if (addr == static_cast<unsigned int>(m)) addr = 0;
             }
             if (!data[addr]) {
                 data[addr] = i ;
@@ -81,7 +81,7 @@ namespace sugar{
               if (src[data[addr] - 1] == value)
                 return data[addr];
               addr++;
-              if (addr == m) addr = 0;
+              if (addr == static_cast<unsigned int>(m)) addr = 0;
             }
             return NA_INTEGER;
         }

inst/unitTests/cpp/sugar.cpp

@@ -595,6 +595,21 @@ IntegerVector runit_self_match( CharacterVector x){
     return self_match( x ) ;
 }
 
+// [[Rcpp::export]]
+Rcpp::IntegerVector runit_unique_int(Rcpp::IntegerVector x) {
+    return Rcpp::unique(x);
+}
+
+// [[Rcpp::export]]
+Rcpp::NumericVector runit_unique_dbl(Rcpp::NumericVector x) {
+    return Rcpp::unique(x);
+}
+
+// [[Rcpp::export]]
+Rcpp::CharacterVector runit_unique_ch(Rcpp::CharacterVector x) {
+    return Rcpp::unique(x);
+}
+
 // [[Rcpp::export]]
 IntegerVector runit_table( CharacterVector x){
     return table( x ) ;

inst/unitTests/runit.sugar.R

@@ -638,6 +638,50 @@ if (.runThisTest) {
         x <- sample( letters, 1000, replace = TRUE )
         checkEquals( runit_self_match(x), match(x,unique(x)) )
     }
+    
+    test.unique <- function() {
+        x <- sample(LETTERS[1:5], 10, TRUE)
+        checkEquals(
+            sort(unique(x)),
+            sort(runit_unique_ch(x)),
+            "unique / character / without NA"
+        )
+        
+        x <- c(x, NA, NA)
+        checkEquals(
+            sort(unique(x), na.last = TRUE),
+            sort(runit_unique_ch(x), na.last = TRUE),
+            "unique / character / with NA"
+        )
+        
+        x <- sample(1:5, 10, TRUE)
+        checkEquals(
+            sort(unique(x)),
+            sort(runit_unique_int(x)),
+            "unique / integer / without NA"
+        )
+        
+        x <- c(x, NA, NA)
+        checkEquals(
+            sort(unique(x), na.last = TRUE),
+            sort(runit_unique_int(x), na.last = TRUE),
+            "unique / integer / with NA"
+        )
+        
+        x <- sample(1:5 + 0.5, 10, TRUE)
+        checkEquals(
+            sort(unique(x)),
+            sort(runit_unique_dbl(x)),
+            "unique / numeric / without NA"
+        )
+        
+        x <- c(x, NA, NA)
+        checkEquals(
+            sort(unique(x), na.last = TRUE),
+            sort(runit_unique_dbl(x), na.last = TRUE),
+            "unique / numeric / with NA"
+        )
+    }
 
     test.table <- function(){
         x <- sample( letters, 1000, replace = TRUE )