Динамические столбцы в Dplyr с использованием NSE на RHS - PullRequest
Новая
       59

Динамические столбцы в Dplyr с использованием NSE на RHS

1 голос
/ 11 июля 2019

Я пытаюсь сослаться на существующие столбцы в dplyr через цикл. По сути, я хотел бы оценить операции из одной таблицы (оценка в примере ниже) для выполнения в другую таблицу (dt в примере ниже). Я не хочу жестко кодировать имена столбцов в RHS в mutate (). Я хотел бы контролировать оценки, проводимые из таблицы оценки ниже. Поэтому я пытаюсь сделать процесс динамичным.

Вот примерный кадр данных: 

dt = data.frame(
    A = c(1:20), 
    B = c(11:30), 
    C = c(21:40),
    AA = rep(1, 20), 
    BB = rep(2, 20)
)

Вот таблица примеров операций, которые нужно выполнить: 

evaluation = data.frame(
   New_Var = c("AA", "BB"), 
   Operation = c("(A*2) > B", "(B*2) <= C"), 
   Result = c("True", "False")
) %>% mutate_all(as.character)

Я пытаюсь сделать следующее: 

for (i in 1:nrow(evaluation)) {

  var = evaluation$New_Var[i]

  dt = dt %>% 
    rowwise() %>% 
    mutate(!!var := ifelse(eval(parse(text = evaluation$Operation[i])), 
                           evaluation$Result[i], 
                           !!var))

}

Мой желаемый результат будет примерно таким, за исключением того, что "AA" в столбце AA будет исходными числовыми значениями столбца AA 1, 1, 1, 1, 1.

ОБНОВЛЕНИЕ:

Я считаю, что мой синтаксис в "False" части оператора ifelse неверен. Каков правильный синтаксис для указания «!! var» в ложной части оператора ifelse?

enter image description here

Я знаю, что есть другие способы сделать это с использованием базы R, но я бы предпочел сделать это через dplyr, так как это более чистый код, чтобы на него смотреть. Я использую "rowise ()", чтобы сделать это элемент за элементом.

Ответы [ 4 ]

2 голосов
/ 11 июля 2019

Если предположить, что ответ Фелипе - это та функциональность, которую вы пожелали, вот вам более «нисходящий» / ориентированный на трубы / функциональный подход.

Данные 

library(rlang)
library(dplyr)
library(purrr)

operations <- tibble(
  old_var = exprs(A, B),
  new_var = exprs(AA, BB),
  test = exprs(2*A > B, 2*B <= C),
  result = exprs("True", "False")
)

original <- tibble(
  A = sample.int(30, 10), 
  B = sample.int(30, 10), 
  C = sample.int(30, 10)
)

original

# A tibble: 10 x 3
       A     B     C
   <int> <int> <int>
 1     4    20     5
 2    30    29    11
 3     1    27    14
 4     2    21     4
 5    17    19    24
 6    14    25     9
 7     5    22    22
 8     6    13     7
 9    25     4    21
10    12    11    12

Функции 

# Here's your reusable functions
generic_mutate <- function(dat, new_var, test, result, old_var) {
    dat %>% mutate(!!new_var := ifelse(!!test, !!result, !!old_var))
}

generic_ops <- function(dat, ops) {
  pmap(ops, generic_mutate, dat = dat) %>% 
    reduce(full_join)
}

generic_mutate принимает один исходный кадр данных, один new_var и т. Д. Он выполняет тест, добавляет новый столбец с соответствующимимя и значения.

generic_ops - это «векторизованная» версия.Первоначальный аргумент принимает исходный фрейм данных, а второй - фрейм данных операций.Затем он параллельно отображает каждый столбец с новыми именами переменных, тестами и т. Д. И вызывает generic_mutate для каждого из них.Это приводит к списку фреймов данных, каждый с одним добавленным столбцом.reduce затем объединяет их все вместе с последовательными full_join.

Результатами 

original %>%
  generic_ops(operations)

Joining, by = c("A", "B", "C")
# A tibble: 10 x 5
       A     B     C AA    BB   
   <int> <int> <int> <chr> <chr>
 1     4    20     5 4     20   
 2    30    29    11 True  29   
 3     1    27    14 1     27   
 4     2    21     4 2     21   
 5    17    19    24 True  19   
 6    14    25     9 True  25   
 7     5    22    22 5     22   
 8     6    13     7 6     13   
 9    25     4    21 True  False
10    12    11    12 True  11

Волшебство, которое здесь используетсяexprs(...), чтобы вы могли хранить имена и операции NSE в таблице, не форсируя их оценку.Я думаю, что это намного чище, чем хранить имена и операции в строках с кавычками.

1 голос
/ 11 июля 2019

Измененные данные для (a) обеспечения согласованности типов для столбцов AA и BB и (b) гарантируют, что хотя бы одна строка удовлетворяет второму условию. 

dt = tibble(
  A = c(1:20), 
  B = c(10:29),      ## Note the change
  C = c(21:40),
  AA = rep("a", 20), ## Note initialization with strings
  BB = rep("b", 20)  ## Ditto
)

Чтобы ваш цикл работал, вам нужно преобразовать строки кода в реальные выражения. Вы можете использовать rlang::sym() для имен переменных и rlang::parse_expr() для всего остального. 

for( i in 1:nrow(evaluation) )
{
  var <- rlang::sym(evaluation$New_Var[i])
  op <- rlang::parse_expr(evaluation$Operation[i])

  dt = dt %>% rowwise() %>% 
    mutate(!!var := ifelse(!!op, evaluation$Result[i],!!var))
}
# # A tibble: 20 x 5
#        A     B     C AA    BB   
#    <int> <int> <int> <chr> <chr>
#  1     1    10    21 a     False
#  2     2    11    22 a     False
#  3     3    12    23 a     b    
#  4     4    13    24 a     b    
#  5     5    14    25 a     b    
#  6     6    15    26 a     b    
#  7     7    16    27 a     b    
#  8     8    17    28 a     b    
#  9     9    18    29 a     b    
# 10    10    19    30 True  b    
# 11    11    20    31 True  b    
# 12    12    21    32 True  b    
# 13    13    22    33 True  b    
# 14    14    23    34 True  b    
# 15    15    24    35 True  b    
# 16    16    25    36 True  b    
# 17    17    26    37 True  b    
# 18    18    27    38 True  b    
# 19    19    28    39 True  b    
# 20    20    29    40 True  b
1 голос
/ 11 июля 2019

Как это: 

evaluation = data.frame(
   Old_Var = c('A', 'B'),
   New_Var = c("AA", "BB"), 
   Operation = c("(A*2) > B", "(B*2) <= C"), 
   Result = c("True", "False")
) %>% mutate_all(as.character)

for (i in 1:nrow(evaluation)) {

  old <- sym(evaluation$Old_Var[i])
  new <- sym(evaluation$New_Var[i])
  op <- sym(evaluation$Operation[i])
  res <- sym(evaluation$Result[i])

  dt <- dt %>% 
    mutate(!!new := ifelse(!!op, !!res, !!old))

}

РЕДАКТИРОВАТЬ: Мой последний ответ не работает, потому что rlang пытается найти переменную с именем !!op (например, с именем (A*2) > B) вместооценивая выражение.Я заставил это работать, используя сочетание tidyselect и base R. Конечно, вы можете последовать совету @ Brian и использовать это решение с pmap.Честно говоря, я не знаю, насколько хорошо это будет работать, поскольку я думаю, что он будет оценивать ifelse один раз в строке, и я не уверен, что это векторизованная операция ... 

dt <- tibble(
  A = c(1:20), 
  B = c(11:30), 
  C = c(21:40),
  AA = rep(1, 20), 
  BB = rep(2, 20)
)

evaluation = tibble(
  Old_Var = c('A', 'B'),
  New_Var = c("AA", "BB"), 
  Operation = c('(A*2) > B', '(B*2) <= C'), 
  Result = c("True", "False")
)

for (i in 1:nrow(evaluation)) {

  old <- evaluation$Old_Var[i]
  new <- evaluation$New_Var[i]
  op <- evaluation$Operation[i]
  res <- evaluation$Result[i]

  dt <- dt %>% 
    mutate(!!sym(new) := eval(parse(text = sprintf('ifelse(%s, "%s", %s)', op, res, old))))

}
0 голосов
/ 13 июля 2019

Один из способов - сначала переработать условия, а затем передать их на mutate: 

conds <- parse(text=evaluation$Operation) %>%
  as.list() %>%
  setNames(evaluation$New_Var) %>%
  imap(~expr(ifelse(!!.,"True", !!sym(.y))))
conds  
#> $AA
#> ifelse((A * 2) > B, "True", AA)
#> 
#> $BB
#> ifelse((B * 2) <= C, "True", BB)

dt %>% mutate(!!!conds)
#>     A  B  C   AA BB
#> 1   1 11 21    1  2
#> 2   2 12 22    1  2
#> 3   3 13 23    1  2
#> 4   4 14 24    1  2
#> 5   5 15 25    1  2
#> 6   6 16 26    1  2
#> 7   7 17 27    1  2
#> 8   8 18 28    1  2
#> 9   9 19 29    1  2
#> 10 10 20 30    1  2
#> 11 11 21 31 True  2
#> 12 12 22 32 True  2
#> 13 13 23 33 True  2
#> 14 14 24 34 True  2
#> 15 15 25 35 True  2
#> 16 16 26 36 True  2
#> 17 17 27 37 True  2
#> 18 18 28 38 True  2
#> 19 19 29 39 True  2
#> 20 20 30 40 True  2
...