Merge pull request #783 from RcppCore/bugfix/issue781

newDate(time)Vector gets is_na()  (closes #781)

Author: eddelbuettel

ChangeLog

@@ -1,3 +1,11 @@
+2017-12-03  Dirk Eddelbuettel  <[email protected]>
+
+        * inst/include/Rcpp/sugar/functions/is_na.h: Correct test for NA to work
+        with new as well as old Date(time)Vectors
+
+        * inst/unitTests/cpp/dates.cpp (has_na): Added tests
+        * inst/unitTests/runit.Date.R (test.NA): Idem
+
 2017-11-30  James J Balamuta  <[email protected]>
 
         * src/attributes.cpp: Fixed missing Rcpp namespace in export interface

inst/include/Rcpp/date_datetime/date_datetime.h

@@ -2,7 +2,7 @@
 //
 // date_datetime.h: Rcpp R/C++ interface class library -- Date and Datetime support
 //
-// Copyright (C) 2016         Dirk Eddelbuettel
+// Copyright (C) 2016 - 2017  Dirk Eddelbuettel
 //
 // This file is part of Rcpp.
 //
@@ -32,7 +32,7 @@
 
 namespace Rcpp {
 
-    // this will not be on by default 
+    // this is on by default since Rcpp 0.12.14
     #if defined(RCPP_NEW_DATE_DATETIME_VECTORS)
 
         typedef newDateVector DateVector;

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

@@ -72,7 +72,11 @@ class IsNa_Vector_is_na : public Rcpp::VectorBase<LGLSXP, false, IsNa_Vector_is_
        IsNa_Vector_is_na( const T& x) : ref(x){}
 
        inline int operator[]( R_xlen_t i) const {
+       #if defined(RCPP_NEW_DATE_DATETIME_VECTORS)
+           return ::Rcpp::traits::is_na<T>(ref[i]);
+       #else
            return ref[i].is_na() ;
+       #endif
        }
 
        inline R_xlen_t size() const { return ref.size() ; }
@@ -84,16 +88,25 @@ class IsNa_Vector_is_na : public Rcpp::VectorBase<LGLSXP, false, IsNa_Vector_is_
 } // sugar
 
 template <int RTYPE, bool NA, typename T>
-inline sugar::IsNa<RTYPE,NA,T> is_na( const Rcpp::VectorBase<RTYPE,NA,T>& t){
-	return sugar::IsNa<RTYPE,NA,T>( t ) ;
+inline sugar::IsNa<RTYPE,NA,T> is_na( const Rcpp::VectorBase<RTYPE,NA,T>& t) {
+    return sugar::IsNa<RTYPE,NA,T>(t);
 }
 
-inline sugar::IsNa_Vector_is_na<DatetimeVector> is_na( const DatetimeVector& x){
-    return sugar::IsNa_Vector_is_na<DatetimeVector>( x ) ;
+inline sugar::IsNa_Vector_is_na<oldDatetimeVector> is_na(const oldDatetimeVector& x) {
+    return sugar::IsNa_Vector_is_na<oldDatetimeVector>( x ) ;
 }
-inline sugar::IsNa_Vector_is_na<DateVector> is_na( const DateVector& x){
-    return sugar::IsNa_Vector_is_na<DateVector>( x ) ;
+
+inline sugar::IsNa_Vector_is_na<oldDateVector> is_na(const oldDateVector& x) {
+    return sugar::IsNa_Vector_is_na<oldDateVector>(x);
+}
+
+inline sugar::IsNa_Vector_is_na<NumericVector> is_na(newDatetimeVector& x) {
+    return sugar::IsNa_Vector_is_na<NumericVector>(x);
 }
+inline sugar::IsNa_Vector_is_na<NumericVector> is_na(newDateVector& x) {
+    return sugar::IsNa_Vector_is_na<NumericVector>(x);
+}
+
 
 } // Rcpp
 #endif

inst/unitTests/cpp/dates.cpp

@@ -234,3 +234,15 @@ Date test_gmtime(double d) {
     Date nd(tm.tm_year, tm.tm_mon + 1, tm.tm_mday);
     return nd;
 }
+
+// [[Rcpp::export]]
+bool has_na_dv(const Rcpp::DateVector d) {
+    return Rcpp::is_true(Rcpp::any(Rcpp::is_na(d)));
+}
+
+// [[Rcpp::export]]
+bool has_na_dtv(const Rcpp::DatetimeVector d) {
+    return Rcpp::is_true(Rcpp::any(Rcpp::is_na(d)));
+}
+
+

inst/unitTests/runit.Date.R

@@ -1,7 +1,7 @@
 #!/usr/bin/env r
 # -*- mode: R; tab-width: 4; -*-
 #
-# Copyright (C) 2010 - 2016   Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2017   Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -264,4 +264,16 @@ if (.runThisTest) {
         checkEquals(test_gmtime(-489024000), as.Date("1954-07-04"), msg="Date.test_gmtime.1954")
         Sys.setenv(TZ=oldTZ)
     }
+
+    test.NA <- function() {
+        dv <- Sys.Date() + 0:2
+        checkTrue(has_na_dv(dv) == FALSE, msg="DateVector.NAtest.withoutNA")
+        dv[1] <- NA
+        checkTrue(has_na_dv(dv) == TRUE, msg="DateVector.NAtest.withNA")
+
+        dvt <- Sys.time() + 0:2
+        checkTrue(has_na_dtv(dvt) == FALSE, msg="DatetimeVector.NAtest.withoutNA")
+        dvt[1] <- NA
+        checkTrue(has_na_dtv(dvt) == TRUE, msg="DatetimeVector.NAtest.withNA")
+    }
 }