Skip to content

Instantly share code, notes, and snippets.

@jpshanno
Created October 9, 2018 17:08
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save jpshanno/d03668c547620d2b2f9220319787141a to your computer and use it in GitHub Desktop.
Save jpshanno/d03668c547620d2b2f9220319787141a to your computer and use it in GitHub Desktop.
Custom Mutate Functions that Respect Groups
library(dplyr)
#> Warning: package 'dplyr' was built under R version 3.5.1
#> 
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#> 
#>     filter, lag
#> The following objects are masked from 'package:base':
#> 
#>     intersect, setdiff, setequal, union

# It looks like nrow() is a tough choice to use as your example because it 
# doesn't respect groups inside mutate():
  
mtcars %>% 
  head() %>% 
  group_by(cyl) %>% 
  mutate(n = nrow(.))
#> Warning: package 'bindrcpp' was built under R version 3.5.1
#> # A tibble: 6 x 12
#> # Groups:   cyl [3]
#>     mpg   cyl  disp    hp  drat    wt  qsec    vs    am  gear  carb     n
#>   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
#> 1  21       6   160   110  3.9   2.62  16.5     0     1     4     4     6
#> 2  21       6   160   110  3.9   2.88  17.0     0     1     4     4     6
#> 3  22.8     4   108    93  3.85  2.32  18.6     1     1     4     1     6
#> 4  21.4     6   258   110  3.08  3.22  19.4     1     0     3     1     6
#> 5  18.7     8   360   175  3.15  3.44  17.0     0     0     3     2     6
#> 6  18.1     6   225   105  2.76  3.46  20.2     1     0     3     1     6

# But if you look at the code for add_tally it has some good hints for how to 
# get the functionality you want. Essentially you have to wrap your custom
# function inside of quo(). In this example you can provide an input column just
# like you were using a regular mutate call.
    
paste_unique <- function(df, col) {
  col <- 
    enquo(col)
  
  paste_unique <- 
    quo(paste(!!col, collapse = ", "))
  
  out <- mutate(df, 
                n = !! paste_unique)
  
  grouped_df(out, group_vars(df))
}


mtcars %>% 
  head() %>%
  paste_unique(hp) %>% 
  select(cyl, n)
#> # A tibble: 6 x 2
#>     cyl n                          
#>   <dbl> <chr>                      
#> 1     6 110, 110, 93, 110, 175, 105
#> 2     6 110, 110, 93, 110, 175, 105
#> 3     4 110, 110, 93, 110, 175, 105
#> 4     6 110, 110, 93, 110, 175, 105
#> 5     8 110, 110, 93, 110, 175, 105
#> 6     6 110, 110, 93, 110, 175, 105

mtcars %>% 
  head() %>%
  group_by(cyl) %>% 
  paste_unique(hp) %>% 
  select(cyl, n)
#> # A tibble: 6 x 2
#> # Groups:   cyl [3]
#>     cyl n                 
#>   <dbl> <chr>             
#> 1     6 110, 110, 110, 105
#> 2     6 110, 110, 110, 105
#> 3     4 93                
#> 4     6 110, 110, 110, 105
#> 5     8 175               
#> 6     6 110, 110, 110, 105

Created on 2018-10-09 by the reprex package (v0.2.1)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment