hybrid fix. closes tidyverse#1134

NikNakk · Jul 15, 2015 · cf5733f · cf5733f
1 parent b30c2b6
commit cf5733f
Show file tree

Hide file tree

Showing 4 changed files with 40 additions and 12 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -31,6 +31,8 @@
 * `summarise` handles expression returning heterogenous outputs depending on inputs, 
   e.g. `median` that sometimes returns `integer` sometimes `numeric`. (#893). 
 
+* update hybrid evaluation to handle `$` better (#1134).   
+
 # dplyr 0.4.2
 
 This is a minor release containing fixes for a number of crashes and issues identified by R CMD CHECK. There is one new "feature": dplyr no longer complains about unrecognised attributes, and instead just copies them over to the output.

diff --git a/inst/include/dplyr/Result/GroupedCallProxy.h b/inst/include/dplyr/Result/GroupedCallProxy.h
@@ -33,17 +33,17 @@ namespace dplyr {
         template <typename Container>
         SEXP get(const Container& indices){
             subsets.clear();
+
             if( TYPEOF(call) == LANGSXP){
                 if( can_simplify(call) ) {
                     HybridCall hybrid_eval( call, indices, subsets, env ) ;
                     return hybrid_eval.eval() ;
                 }
-
+                
                 int n = proxies.size() ;
                 for( int i=0; i<n; i++){
                     proxies[i].set( subsets.get(proxies[i].symbol, indices ) ) ;
                 }
-
                 return call.eval(env) ;
             } else if( TYPEOF(call) == SYMSXP ) {
                 if(subsets.count(call)){
@@ -110,6 +110,7 @@ namespace dplyr {
                     if( Rf_length(head) == 3 ){
                         SEXP symb = CAR(head) ;
                         if( symb == R_DollarSymbol || symb == Rf_install("@") || symb == Rf_install("::") || symb == Rf_install(":::") ){
+
                             // for things like : foo( bar = bling )$bla
                             // so that `foo( bar = bling )` gets processed
                             if( TYPEOF(CADR(head)) == LANGSXP ){

diff --git a/inst/include/dplyr/Result/GroupedHybridCall.h b/inst/include/dplyr/Result/GroupedHybridCall.h
@@ -29,22 +29,42 @@ namespace dplyr {
 
         void substitute( SEXP obj){
             if( ! Rf_isNull(obj) ){ 
-                 SEXP head = CAR(obj) ;
-                 switch( TYPEOF( head ) ){
-                 case LISTSXP:
-                 case LANGSXP: 
-                     substitute( CDR(head) ) ;
-                     break ;
-                 case SYMSXP:
+                SEXP head = CAR(obj) ;
+                switch( TYPEOF( head ) ){
+                case LISTSXP:
+                    substitute( CDR(head) ) ;
+                    break ;
+
+                case LANGSXP:
+                    {
+                        SEXP symb = CAR(head) ;
+                        if( symb == R_DollarSymbol || symb == Rf_install("@") || symb == Rf_install("::") || symb == Rf_install(":::") ){
+
+                            if( TYPEOF(CADR(head)) == LANGSXP ){
+                                substitute( CDR(head) ) ;    
+                            }
+
+                            // deal with foo$bar( bla = boom )
+                            if( TYPEOF(CADDR(head)) == LANGSXP ){
+                                substitute( CDDR(head) ) ;
+                            }
+
+                            break ;
+                        }
+
+                        substitute( CDR(head) ) ;
+                        break ;
+                    }
+                case SYMSXP:
                     if( TYPEOF(obj) != LANGSXP ){
                        if( subsets.count(head) ){
                            SETCAR(obj, subsets.get(head, indices) ) ;
                        } 
                     }
                     break ;
-                 }
-                 substitute( CDR(obj) ) ;
-             }        
+                }
+                substitute( CDR(obj) ) ;
+            }        
         }
 
         bool simplified(){

diff --git a/tests/testthat/test-filter.r b/tests/testthat/test-filter.r
@@ -221,6 +221,11 @@ test_that("filter does not alter expression (#971)", {
   expect_equal( my_filter[[2]][[2]], as.name("am") )
 })
 
+test_that("hybrid evaluation handles $ correctly (#1134)", {
+  df <- data_frame( x = 1:10, g = rep(1:5, 2 ) )
+  res <- df %>% group_by(g) %>% filter( x > min(df$x) )
+  expect_equal( nrow(res), 9L )
+})
 
 # data.table --------------------------------------------------------------