Last active
March 7, 2021 20:51
-
-
Save DavisVaughan/24cbc404c09e75d3bf23467d15a7d42d to your computer and use it in GitHub Desktop.
mutate_rows() and mutate_when()
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
# ------------------------------------------------------------------------------ | |
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). |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
This is great. Many thanks for sharing!