Collecters compatible with NA values (Closes tidyverse#2203)

This commit fixes tidyverse#2203 by allowing the collecters to accept logical missing values, replacing
them with the specific NA value for each Rtype as expected.

inst/include/dplyr/Collecter.h

@@ -9,6 +9,10 @@
 
 namespace dplyr {
 
+  static inline bool all_logical_na(SEXP x) {
+    return LGLSXP == TYPEOF(x) && all_na(x);
+  };
+
   class Collecter {
   public:
     virtual ~Collecter() {};
@@ -33,10 +37,16 @@ namespace dplyr {
     Collecter_Impl(int n_): data(n_, Rcpp::traits::get_na<RTYPE>()) {}
 
     void collect(const SlicingIndex& index, SEXP v) {
-      Vector<RTYPE> source(v);
-      STORAGE* source_ptr = Rcpp::internal::r_vector_start<RTYPE>(source);
-      for (int i=0; i<index.size(); i++) {
-        data[index[i]] = source_ptr[i];
+      if (all_logical_na(v)) {
+        for (int i=0; i<index.size(); i++) {
+          data[index[i]] = Rcpp::traits::get_na<RTYPE>();
+        }
+      } else {
+        Vector<RTYPE> source(v);
+        STORAGE* source_ptr = Rcpp::internal::r_vector_start<RTYPE>(source);
+        for (int i=0; i<index.size(); i++) {
+          data[index[i]] = source_ptr[i];
+        }
       }
     }
 
@@ -45,7 +55,7 @@ namespace dplyr {
     }
 
     inline bool compatible(SEXP x) {
-      return RTYPE == TYPEOF(x);
+      return RTYPE == TYPEOF(x) || all_logical_na(x);
     }
 
     bool can_promote(SEXP x) const {
@@ -109,6 +119,8 @@ namespace dplyr {
         collect_strings(index, v);
       } else if (Rf_inherits(v, "factor")) {
         collect_factor(index, v);
+      } else if (all_logical_na(v)) {
+        collect_logicalNA(index, v);
       } else {
         CharacterVector vec(v);
         collect_strings(index, vec);
@@ -120,7 +132,7 @@ namespace dplyr {
     }
 
     inline bool compatible(SEXP x) {
-      return (STRSXP == TYPEOF(x)) || Rf_inherits(x, "factor");
+      return (STRSXP == TYPEOF(x)) || Rf_inherits(x, "factor") || all_logical_na(x);
     }
 
     bool can_promote(SEXP x) const {
@@ -136,6 +148,14 @@ namespace dplyr {
 
   private:
 
+    void collect_logicalNA(const SlicingIndex& index, LogicalVector source) {
+      SEXP* p_data   = Rcpp::internal::r_vector_start<STRSXP>(data);
+      int n = index.size();
+      for (int i=0; i<n; i++) {
+        p_data[index[i]] = NA_STRING;
+      }
+    }
+
     void collect_strings(const SlicingIndex& index, CharacterVector source) {
       SEXP* p_source = Rcpp::internal::r_vector_start<STRSXP>(source);
       SEXP* p_data   = Rcpp::internal::r_vector_start<STRSXP>(data);
@@ -206,7 +226,7 @@ namespace dplyr {
 
     inline bool compatible(SEXP x) {
       String type = STRING_ELT(types,0);
-      return Rf_inherits(x, type.get_cstring());
+      return Rf_inherits(x, type.get_cstring()) || all_logical_na(x);
     }
 
     inline bool can_promote(SEXP x) const {
@@ -229,8 +249,12 @@ namespace dplyr {
       Parent(n), tz(tz_) {}
 
     void collect(const SlicingIndex& index, SEXP v) {
-      Parent::collect(index, v);
-      update_tz(v);
+      if (Rf_inherits(v, "POSIXct")) {
+        Parent::collect(index, v);
+        update_tz(v);
+      } else if (all_logical_na(v)) {
+        Parent::collect(index, v);
+      }
     }
 
     inline SEXP get() {
@@ -242,7 +266,7 @@ namespace dplyr {
     }
 
     inline bool compatible(SEXP x) {
-      return Rf_inherits(x, "POSIXct");
+      return Rf_inherits(x, "POSIXct") || all_logical_na(x);
     }
 
     inline bool can_promote(SEXP x) const {
@@ -295,19 +319,25 @@ namespace dplyr {
     }
 
     void collect(const SlicingIndex& index, SEXP v) {
-      // here we can assume that v is a factor with the right levels
-      // we however do not assume that they are in the same order
-      IntegerVector source(v);
-      CharacterVector levels = source.attr("levels");
-
-      SEXP* levels_ptr = Rcpp::internal::r_vector_start<STRSXP>(levels);
-      int* source_ptr = Rcpp::internal::r_vector_start<INTSXP>(source);
-      for (int i=0; i<index.size(); i++) {
-        if (source_ptr[i] == NA_INTEGER) {
+      if (Rf_inherits(v, "factor") && has_same_levels_as(v)) {
+        // here we can assume that v is a factor with the right levels
+        // we however do not assume that they are in the same order
+        IntegerVector source(v);
+        CharacterVector levels = source.attr("levels");
+
+        SEXP* levels_ptr = Rcpp::internal::r_vector_start<STRSXP>(levels);
+        int* source_ptr = Rcpp::internal::r_vector_start<INTSXP>(source);
+        for (int i=0; i<index.size(); i++) {
+          if (source_ptr[i] == NA_INTEGER) {
+            data[ index[i] ] = NA_INTEGER;
+          } else {
+            SEXP x = levels_ptr[ source_ptr[i] - 1 ];
+            data[ index[i] ] = levels_map.find(x)->second;
+          }
+        }
+      } else if (all_logical_na(v)) {
+        for (int i=0; i<index.size();i++) {
           data[ index[i] ] = NA_INTEGER;
-        } else {
-          SEXP x = levels_ptr[ source_ptr[i] - 1 ];
-          data[ index[i] ] = levels_map.find(x)->second;
         }
       }
     }
@@ -319,7 +349,7 @@ namespace dplyr {
     }
 
     inline bool compatible(SEXP x) {
-      return Rf_inherits(x, "factor") && has_same_levels_as(x);
+      return (Rf_inherits(x, "factor") && has_same_levels_as(x)) || all_logical_na(x);
     }
 
     inline bool can_promote(SEXP x) const {