vctrs:: based summarise() filter() slice() mutate() (#4523)

vctrs based versions of summarise(), mutate(), filter() and slice()

R/RcppExports.R

@@ -88,12 +88,8 @@ expand_groups <- function(old_groups, positions, nr) {
     .Call(`_dplyr_expand_groups`, old_groups, positions, nr)
 }
 
-filter_impl <- function(df, quo) {
-    .Call(`_dplyr_filter_impl`, df, quo)
-}
-
-slice_impl <- function(df, quosure) {
-    .Call(`_dplyr_slice_impl`, df, quosure)
+filter_update_rows <- function(n_rows, group_indices, keep, new_rows_sizes) {
+    .Call(`_dplyr_filter_update_rows`, n_rows, group_indices, keep, new_rows_sizes)
 }
 
 group_data_grouped_df <- function(data) {
@@ -108,14 +104,6 @@ grouped_indices_grouped_df_impl <- function(gdf) {
     .Call(`_dplyr_grouped_indices_grouped_df_impl`, gdf)
 }
 
-group_size_grouped_cpp <- function(gdf) {
-    .Call(`_dplyr_group_size_grouped_cpp`, gdf)
-}
-
-hybrids <- function() {
-    .Call(`_dplyr_hybrids`)
-}
-
 semi_join_impl <- function(x, y, by_x, by_y, na_match, frame) {
     .Call(`_dplyr_semi_join_impl`, x, y, by_x, by_y, na_match, frame)
 }
@@ -144,10 +132,6 @@ full_join_impl <- function(x, y, by_x, by_y, aux_x, aux_y, na_match, frame) {
     .Call(`_dplyr_full_join_impl`, x, y, by_x, by_y, aux_x, aux_y, na_match, frame)
 }
 
-mutate_impl <- function(df, dots, caller_env) {
-    .Call(`_dplyr_mutate_impl`, df, dots, caller_env)
-}
-
 select_impl <- function(df, vars) {
     .Call(`_dplyr_select_impl`, df, vars)
 }
@@ -196,10 +180,6 @@ test_length_wrap <- function() {
     .Call(`_dplyr_test_length_wrap`)
 }
 
-materialize_binding <- function(idx, mask_proxy_xp) {
-    .Call(`_dplyr_materialize_binding`, idx, mask_proxy_xp)
-}
-
 check_valid_names <- function(names, warn_only = FALSE) {
     invisible(.Call(`_dplyr_check_valid_names`, names, warn_only))
 }

R/tbl-df.r

@@ -160,7 +160,6 @@ regroup <- function(data) {
   data
 }
 
-
 #' @export
 filter.tbl_df <- function(.data, ..., .preserve = FALSE) {
   dots <- enquos(...)

inst/include/dplyr/checks.h

@@ -0,0 +1,96 @@
+#ifndef dplyr_checks_H
+#define dplyr_checks_H
+
+#include <tools/SymbolString.h>
+#include <tools/bad.h>
+
+namespace dplyr {
+
+enum SupportedType {
+  DPLYR_LGLSXP = LGLSXP,
+  DPLYR_INTSXP = INTSXP,
+  DPLYR_REALSXP = REALSXP,
+  DPLYR_CPLXSXP = CPLXSXP,
+  DPLYR_STRSXP = STRSXP,
+  DPLYR_VECSXP = VECSXP,
+  DPLYR_RAWSXP = RAWSXP
+};
+
+inline std::string type_name(SEXP x) {
+  switch (TYPEOF(x)) {
+  case NILSXP:
+    return "NULL";
+  case SYMSXP:
+    return "symbol";
+  case S4SXP:
+    return "S4";
+  case LGLSXP:
+    return "logical vector";
+  case INTSXP:
+    return "integer vector";
+  case REALSXP:
+    return "double vector";
+  case STRSXP:
+    return "character vector";
+  case CPLXSXP:
+    return "complex vector";
+  case RAWSXP:
+    return "raw vector";
+  case VECSXP:
+    return "list";
+  case LANGSXP:
+    return "quoted call";
+  case EXPRSXP:
+    return "expression";
+  case ENVSXP:
+    return "environment";
+
+  case SPECIALSXP:
+  case BUILTINSXP:
+  case CLOSXP:
+    return "function";
+
+  // Everything else can fall back to R's default
+  default:
+    return std::string(Rf_type2char(TYPEOF(x)));
+  }
+}
+
+inline SupportedType check_supported_type(SEXP x, const SymbolString& name = Rcpp::String()) {
+  switch (TYPEOF(x)) {
+  case LGLSXP:
+    return DPLYR_LGLSXP;
+  case INTSXP:
+    return DPLYR_INTSXP;
+  case REALSXP:
+    return DPLYR_REALSXP;
+  case CPLXSXP:
+    return DPLYR_CPLXSXP;
+  case STRSXP:
+    return DPLYR_STRSXP;
+  case VECSXP:
+    return DPLYR_VECSXP;
+  case RAWSXP:
+    return DPLYR_RAWSXP;
+  default:
+    if (name.is_empty()) {
+      Rcpp::stop("is of unsupported type %s", type_name(x));
+    } else {
+      bad_col(name, "is of unsupported type {type}",
+              Rcpp::_["type"] = type_name(x));
+    }
+  }
+}
+
+inline void check_length(const int actual, const int expected, const char* comment, const SymbolString& name) {
+  if (actual == expected || actual == 1) return;
+
+  static Rcpp::Function check_length_col("check_length_col", Rcpp::Environment::namespace_env("dplyr"));
+  static Rcpp::Function identity("identity", Rcpp::Environment::base_env());
+  Rcpp::String message = check_length_col(actual, expected, Rcpp::CharacterVector::create(name.get_sexp()), std::string(comment), Rcpp::_[".abort"] = identity);
+  message.set_encoding(CE_UTF8);
+  Rcpp::stop(message.get_cstring());
+}
+
+}
+#endif

inst/include/dplyr/dplyr.h

@@ -0,0 +1,21 @@
+#ifndef dplyr_dplyr_dplyr_H
+#define dplyr_dplyr_dplyr_H
+
+#include <dplyr/allow_list.h>
+#include <dplyr/checks.h>
+#include <dplyr/visitor_set/visitor_set.h>
+#include <tools/BoolResult.h>
+#include <dplyr/data/GroupedDataFrame.h>
+#include <dplyr/data/RowwiseDataFrame.h>
+
+#include <tools/comparisons.h>
+#include <dplyr/visitors/join/join_match.h>
+#include <dplyr/visitors/join/JoinVisitor.h>
+#include <dplyr/visitors/join/JoinVisitorImpl.h>
+#include <dplyr/visitors/join/DataFrameJoinVisitors.h>
+#include <dplyr/visitors/order/Order.h>
+#include <tools/default_value.h>
+#include <dplyr/Collecter.h>
+#include <tools/train.h>
+
+#endif // #ifndef dplyr_dplyr_dplyr_H