file3db455bd6a33.R

library(tidyverse)
library(rlang)
library(stringr)
replace_value <- function(.data, var, from, to) {
  var <- enquo(var)
  mutate(.data, !!quo_name(var) := if_else(UQ(var) == from, to, !!var))
}
mtcars %>% 
  replace_value(gear, 4, 8) %>% 
  replace_value(vs, 0, NA)

~gear > 3
value_replace <- function(.data, condition, to) {
  stopifnot(is.data.frame(.data))
  condition <- enquo(condition)
  substrings <- str_split(quo_name(condition),
                   pattern = "[^[:alnum:]]+",
                   simplify = TRUE)
  stopifnot(any(substrings %in% colnames(.data)))
  stopifnot(length(substrings[substrings %in% colnames(.data)]) == 1)
  var <- as.symbol(substrings[substrings %in% colnames(.data)])
  var <- enquo(var)
  mutate(.data, !!quo_name(var) := if_else(!!condition, to, !!var))
}
value_replace(mtcars, gear == 4, 8)
mtcars %>% 
  value_replace(gear == 4, 8) %>% 
  value_replace(vs<1, NA_real_)
mtcars %>% 
  value_replace(4 == gear, 8)
mtcars %>% 
  mutate(gear2 = gear^2) %>% 
  value_replace(gear2 %% 4 == 1, 2)
mtcars %>% 
  value_replace(hr == 2, 8)
mtcars %>% 
  value_replace(gear == 4 | vs == 1, 2)

gear == 4 ~ 8
quo(gear == 4 ~ 8)

vr <- function(.data, dbo) {
  dbo <- enquo(dbo)
  var <- all.vars(dbo)
  var.symbol <- as.symbol(var)
  rules <- exprs(!!dbo, TRUE ~ !!var.symbol)
  mutate(.data, !!quo_name(var) := case_when(UQS(rules)))
}
vr(mtcars, gear == 4 ~ 8)

dbo <- exprs(
  gear == 4 ~ 8,
  TRUE ~ gear
)

mutate(mtcars, gear = case_when(!!! dbo))

vrs <- function(.data, ...) {
  formulas <- dots_list(...)
  vr <- function(.data, dbo) {
    dbo <- enquo(dbo)
    var <- all.vars(dbo)
    var.symbol <- as.symbol(var)
    rules <- exprs(!!dbo, TRUE ~ !!var.symbol)
    #paste0(UQ(var.symbol), " = ", "case_when(", paste(UQ(rules), collapse =", "), ")")
    
  }
  
}

#Look at ..., extract vars from formulas, list of unique vars, call rcw for each var with matched
#formulae.
#rcw takes the current var and the matching formulas. It then produces rules for case_when
#Make a named list with vars as names and case_when expressions (unfolding rules) as value
#Relies on two stage unqouting, first inside build_cases, and finally in the mutate statement
library(tidyverse)
library(rlang)
meddle <- function(.data, ...) {
  formulas <- quos(...)
  xprs <- exprs(!!!formulas)
  vars <- map_chr(xprs, all.vars) #Extract variables from formulas
  build_cases <- function(var, formulas) { #Build case_when statements from the given formulas
    var_sym <- as.symbol(var)
    expr(case_when(!!!formulas, TRUE ~ !!var_sym))
  }
  rules <- map(unique(vars), ~ build_cases(.x, formulas[.x == vars])) #One statement pr var
  names(rules) <- unique(vars) #Naming the statements to direct mutate
  print(rules) #Just to show the workings for twitter
  mutate(.data, !!!rules)
}
meddle(mtcars, gear == 4 ~ 8, vs == 1 ~ NA_real_, gear == 3 ~ 7) %>% tail(10)
mutate(mtcars, gear = case_when(gear == 4 ~ 8, TRUE ~ gear),
       vs = case_when(vs == 1 ~ NA_real_, TRUE ~ vs))