Merge pull request #492 from artemklevtsov/patch-1

Improve na_omit for vectors without NA

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,10 @@
+2016-06-14  Artem Klevtsov <[email protected]>
+
+        * inst/include/Rcpp/sugar/functions/na_omit.h: Improve na_omit for
+        vectors without NA
+        * inst/unitTests/cpp/sugar.cpp: Add unit test for the na_omit
+        * inst/unitTests/runit.sugar.R: Ditto
+
 2016-06-02  Kirill Müller <[email protected]>
 
         * inst/include/Rcpp/algorithm.h: Use "long long" only if available

inst/include/Rcpp/sugar/functions/na_omit.h

@@ -30,7 +30,9 @@ namespace sugar{
         R_xlen_t n = x.size() ;
         R_xlen_t n_out = n - sum( is_na(x) ) ;
 
-        Vector<RTYPE> out(n_out) ;
+        if( n_out == n ) return x ;
+
+        Vector<RTYPE> out = no_init(n_out) ;
         for( R_xlen_t i=0, j=0; i<n; i++){
             if( Vector<RTYPE>::is_na( x[i] ) ) continue ;
             out[j++] = x[i];
@@ -43,7 +45,10 @@ namespace sugar{
         R_xlen_t n = x.size() ;
         R_xlen_t n_out = n - sum( is_na(x) ) ;
 
-        Vector<RTYPE> out(n_out) ;
+        if( n_out == n ) return x;
+
+        Vector<RTYPE> out = no_init(n_out) ;
+
         bool has_name = x.attr("names") != R_NilValue ;
         if( has_name ){
             CharacterVector names = x.attr("names") ;

inst/unitTests/cpp/sugar.cpp

@@ -216,6 +216,11 @@ LogicalVector runit_any_isna( NumericVector xx){
     return any( is_na( xx ) ) ;
 }
 
+// [[Rcpp::export]]
+NumericVector runit_na_omit( NumericVector xx ){
+    return na_omit( xx ) ;
+}
+
 // [[Rcpp::export]]
 List runit_lapply( IntegerVector xx){
     List res = lapply( xx, seq_len );

inst/unitTests/runit.sugar.R

@@ -290,6 +290,16 @@ if (.runThisTest) {
 	checkEquals( fx( c(1:5,NA,7:10) ) , TRUE )
     }
 
+    test.sugar.na_omit.na <- function( ){
+        fx <- runit_na_omit
+        checkEquals( fx( c(1:5,NA,7:10) ), fx( c(1:5,7:10) ) )
+    }
+
+    test.sugar.na_omit.nona <- function( ){
+        fx <- runit_na_omit
+        checkEquals( fx( c(1:10) ), fx( c(1:10) ) )
+    }
+
     test.sugar.lapply <- function( ){
 	fx <- runit_lapply
 	checkEquals( fx( 1:10 ), lapply( 1:10, seq_len ) )