mutate_rows() and mutate_when()

mutate-rows-and-mutate-when.r

# ------------------------------------------------------------------------------
library(tidyverse)
library(rlang)

# ------------------------------------------------------------------------------
# Create some sample data
set.seed(1)
ex <- tibble(site = sample(1:6, 50, replace=T),
                 space = sample(1:4, 50, replace=T),
                 measure = sample(c('cfl', 'led', 'linear', 'exit'), 50, 
                                  replace=T),
                 qty = round(runif(50) * 30),
                 qty.exit = 0,
                 delta.watts = sample(10.5:100.5, 50, replace=T),
                 cf = runif(50))

# ------------------------------------------------------------------------------
# Mutate a subset of rows, based on a single predicate
mutate_rows <- function(.data, .predicate, ...) {
  .predicate <- rlang::enquo(.predicate)
  .predicate_lgl <- rlang::eval_tidy(.predicate, .data)
  .data[.predicate_lgl, ] <- dplyr::mutate(.data[.predicate_lgl, ], ...)
  .data
}

# A mix of mutate_rows() and the idea of case_when()
# Mutate subsets of rows based on a number of conditions, 
# applied from top to bottom.
# I'm sure this could be more efficient / have better error catching
mutate_when <- function(.data, ...) {
  
  formulas <- rlang::dots_list(...)
  n <- length(formulas)
  
  query <- vector("list", n)
  value <- vector("list", n)
  
  for(i in seq_len(n)) {
    f <- formulas[[i]]
    
    env <- environment(f)
    
    query[[i]] <- rlang::new_quosure(f[[2]], env)
    value[[i]] <- rlang::eval_tidy(f[[3]], .data, env)
    
    .data <- mutate_rows(.data, !! query[[i]], !!! value[[i]])
  }
  
  .data
}

# ------------------------------------------------------------------------------
### What can you do with this?

# Update multiple columns at once based on 1 condition
# When measure == "exit", update qty.exit, cf, and delta.watts
ex %>%
  mutate_rows(measure == "exit", qty.exit = qty, cf = 0, delta.watts = 13) %>%
  head(n = 5)
#> # A tibble: 5 x 7
#>    site space measure   qty qty.exit delta.watts    cf
#>   <int> <int> <chr>   <dbl>    <dbl>       <dbl> <dbl>
#> 1     2     2 linear    18.       0.        34.5 0.762
#> 2     3     4 led       17.       0.        29.5 0.933
#> 3     4     2 led       10.       0.        57.5 0.471
#> 4     6     1 exit      14.      14.        13.0 0.   
#> 5     2     1 linear    15.       0.        26.5 0.485

# Update using multiple conditions. Wrapping in vars() is necessary
# as LHS ~ qty.exit = 4 is not an allowed syntax
ex %>% mutate_when(
  measure == "exit" ~ vars(qty.exit = qty, cf = 0, delta.watts = 13),
  measure == "linear" ~ vars(qty.exit = 4)
)
#> # A tibble: 50 x 7
#>     site space measure   qty qty.exit delta.watts    cf
#>    <int> <int> <chr>   <dbl>    <dbl>       <dbl> <dbl>
#>  1     2     2 linear    18.       4.        34.5 0.762
#>  2     3     4 led       17.       0.        29.5 0.933
#>  3     4     2 led       10.       0.        57.5 0.471
#>  4     6     1 exit      14.      14.        13.0 0.   
#>  5     2     1 linear    15.       4.        26.5 0.485
#>  6     6     1 cfl        5.       0.        57.5 0.109
#>  7     6     2 cfl       16.       0.        61.5 0.248
#>  8     4     3 led        2.       0.        21.5 0.499
#>  9     4     3 exit       8.       8.        13.0 0.   
#> 10     1     2 linear     6.       4.        75.5 0.935
#> # ... with 40 more rows

#' Created on 2018-04-11 by the [reprex package](http://reprex.tidyverse.org) (v0.2.0).

This is great. Many thanks for sharing!