pure R implementation of summarise2()

R/RcppExports.R

@@ -144,10 +144,6 @@ summarise_impl <- function(df, dots, caller_env) {
     .Call(`_dplyr_summarise_impl`, df, dots, caller_env)
 }
 
-summarise_one <- function(df, summaries, quosure, caller_env) {
-    .Call(`_dplyr_summarise_one`, df, summaries, quosure, caller_env)
-}
-
 hybrid_impl <- function(df, quosure, caller_env) {
     .Call(`_dplyr_hybrid_impl`, df, quosure, caller_env)
 }

R/tbl-df.r

@@ -198,32 +198,78 @@ assert_all_size_one <- function(x) {
   }
 }
 
+summarise_data_mask <- function(data, rows) {
+  chunks_env <- env()
+  map2(data, names(data), function(col, nm) {
+    env_bind_lazy(chunks_env, !!nm := map(rows, vec_slice, x = col))
+  })
+
+  bottom <- env()
+  column_names <- set_names(names(data))
+
+  .current_group_index <- NA_integer_
+  env_bind_active(bottom, !!!map(column_names, function(column) {
+    function() {
+      chunks_env[[column]][[.current_group_index]]
+    }
+  }))
+
+  mask <- new_data_mask(bottom)
+  mask$.set_current_group <- function(group_index) {
+    .current_group_index <<- group_index
+  }
+  mask$.add_summarised <- function(name, chunks) {
+    env_bind_active(bottom, !!name := function() {
+      chunks[[.current_group_index]]
+    })
+  }
+
+  mask
+}
+
 #' @export
 summarise2 <- function(.data, ...) {
   dots <- enquos(...)
   dots_names <- names(dots)
 
+  rows <- group_rows(.data)
+  mask <- summarise_data_mask(.data, rows)
+  caller <- caller_env()
+
   summaries <- list()
   for (i in seq_along(dots)) {
-    # summarise_one() gives a list in which each element is the result of
+    # a list in which each element is the result of
     # evaluating the quosure in the "sliced data mask"
     #
-    # vec_c() simplifies it to a vctr (might be a data frame)
-    #
-    # TODO: implement an R version of summarise_one()
     # TODO: reinject hybrid evaluation at the R level
-    chunks <- summarise_one(.data, summaries, dots[[i]], caller_env())
+    chunks <- map(seq_along(rows), function(group) {
+      mask$.set_current_group(group)
+      eval_tidy(dots[[i]], mask, env = caller)
+    })
+
     assert_all_size_one(chunks)
+
+    # vec_c() simplifies it to a vctr (might be a data frame)
     result <- vec_c(!!!chunks)
 
     if (is.null(dots_names) || dots_names[i] == "") {
       # auto splice when the quosure is not named
       if (is.data.frame(result)) {
         summaries <- append(summaries, list2(!!!result))
+
+        # remember each result separately
+        map2(seq_along(result), names(result), function(i, nm) {
+          mask$.add_summarised(nm, map(chunks, i))
+        })
+      } else {
+        abort("cannot auto splice non data frame results")
       }
     } else {
       # treat as a single output otherwise
       summaries <- append(summaries, list2(!!dots_names[i] := result))
+
+      # remember
+      mask$.add_summarised(dots_names[i], chunks)
     }
 
   }

src/RcppExports.cpp

@@ -362,19 +362,6 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
-// summarise_one
-SEXP summarise_one(Rcpp::DataFrame df, Rcpp::List summaries, dplyr::Quosure quosure, SEXP caller_env);
-RcppExport SEXP _dplyr_summarise_one(SEXP dfSEXP, SEXP summariesSEXP, SEXP quosureSEXP, SEXP caller_envSEXP) {
-BEGIN_RCPP
-    Rcpp::RObject rcpp_result_gen;
-    Rcpp::traits::input_parameter< Rcpp::DataFrame >::type df(dfSEXP);
-    Rcpp::traits::input_parameter< Rcpp::List >::type summaries(summariesSEXP);
-    Rcpp::traits::input_parameter< dplyr::Quosure >::type quosure(quosureSEXP);
-    Rcpp::traits::input_parameter< SEXP >::type caller_env(caller_envSEXP);
-    rcpp_result_gen = Rcpp::wrap(summarise_one(df, summaries, quosure, caller_env));
-    return rcpp_result_gen;
-END_RCPP
-}
 // hybrid_impl
 SEXP hybrid_impl(Rcpp::DataFrame df, dplyr::Quosure quosure, SEXP caller_env);
 RcppExport SEXP _dplyr_hybrid_impl(SEXP dfSEXP, SEXP quosureSEXP, SEXP caller_envSEXP) {
@@ -546,7 +533,6 @@ static const R_CallMethodDef CallEntries[] = {
     {"_dplyr_mutate_impl", (DL_FUNC) &_dplyr_mutate_impl, 3},
     {"_dplyr_select_impl", (DL_FUNC) &_dplyr_select_impl, 2},
     {"_dplyr_summarise_impl", (DL_FUNC) &_dplyr_summarise_impl, 3},
-    {"_dplyr_summarise_one", (DL_FUNC) &_dplyr_summarise_one, 4},
     {"_dplyr_hybrid_impl", (DL_FUNC) &_dplyr_hybrid_impl, 3},
     {"_dplyr_test_comparisons", (DL_FUNC) &_dplyr_test_comparisons, 0},
     {"_dplyr_test_matches", (DL_FUNC) &_dplyr_test_matches, 0},

src/summarise.cpp

@@ -89,53 +89,6 @@ SEXP summarise_impl(Rcpp::DataFrame df, dplyr::QuosureList dots, SEXP caller_env
   }
 }
 
-namespace dplyr {
-
-template <typename SlicedTibble>
-SEXP summarise_one_impl(const Rcpp::DataFrame& df, const Rcpp::List& summaries, const dplyr::Quosure& quosure, SEXP caller_env) {
-  SlicedTibble gdf(df);
-
-  DataMask<SlicedTibble> mask(gdf);
-
-  // register the summaries
-  SEXP summaries_names = Rf_getAttrib(summaries, R_NamesSymbol);
-  for (int i = 0; i < summaries.size(); i++) {
-    mask.input_summarised(SymbolString(STRING_ELT(summaries_names, i)), summaries[i]);
-  }
-
-  mask.setup();
-
-  int ngroups = gdf.ngroups();
-  Rcpp::List result(ngroups);
-  typename SlicedTibble::group_iterator it = gdf.group_begin();
-  for (int i = 0; i < ngroups; i++, ++it) {
-    result[i] = mask.eval(quosure, *it);
-  }
-
-  return result;
-
-}
-
-}
-
-
-
-
-// [[Rcpp::export(rng = false)]]
-SEXP summarise_one(Rcpp::DataFrame df, Rcpp::List summaries, dplyr::Quosure quosure, SEXP caller_env) {
-
-  // check_valid_colnames(df);
-  if (Rcpp::is<dplyr::RowwiseDataFrame>(df)) {
-    return dplyr::summarise_one_impl<dplyr::RowwiseDataFrame>(df, summaries, quosure, caller_env);
-  } else if (Rcpp::is<dplyr::GroupedDataFrame>(df)) {
-    return dplyr::summarise_one_impl<dplyr::GroupedDataFrame>(df, summaries, quosure, caller_env);
-  } else {
-    return dplyr::summarise_one_impl<dplyr::NaturalDataFrame>(df, summaries, quosure, caller_env);
-  }
-}
-
-
-
 namespace dplyr {
 
 template <typename SlicedTibble>