Использование purrr для применения фильтра и изменения на основе другого набора данных

#r #dataframe #purrr

#r #фрейм данных #purrr

Вопрос:

Я пытаюсь использовать purrr для применения фильтра и изменения переменной, оба на основе значений другого фрейма данных.

 # This is the original table
set.seed(100)
dfOriginal <- data.table(age = sample(10:60, 10))

# Following is the second data frame containing one variable which 
# I would like to filter by - age criterion
# and then to mutate with - age band
dfAgeBands <- data.table(ageCriterion = c("age > 0 amp; age <= 20", "age > 20 amp; age <= 30"),
              ageBand = c("Young Adults", "Adults"))

finalDf <- map2(dfAgeBands$ageCriterion, dfAgeBands$ageBand, function(x,y){dfOriginal[.x, ageBands := .y]})

Редактировать: просто исправил код (который был создан для другого набора данных!)
Но это все еще не работает.

Ожидаемый результат будет таким, как показано ниже, в соответствии с правилами, определенными ageCriterion в dfAgeBands dataframe.

     age      ageBand
 1:  56         <NA>
 2:  51         <NA>
 3:  41         <NA>
 4:  36         <NA>
 5:  44         <NA>
 6:  32         <NA>
 7:  19 Young Adults
 8:  53         <NA>
 9:  28       Adults
10:  29       Adults

1. Было бы здорово, если бы вы показали нам ожидаемый результат.

2. Я думаю, вам нужно for(i in seq_len(nrow(dfAgeBands))) dfOriginal[eval(parse(text = dfAgeBands$ageCriterion[i])), ageBand := dfAgeBands$ageBand[i]]

3. @akrun, как обычно, приходит на помощь 🙂 Но было бы здорово, если бы у вас тоже было время для purrr решения! Как только вы опубликуете это, я могу проверить это как ответ

4. Если эти данные поступают из внешнего источника, то я очень настоятельно рекомендую вам не использовать eval(parse(…)) . Это огромная дыра в безопасности. И, возможно, сегодня не существует сценария, в котором это можно было бы использовать. Но что насчет завтра? Именно так происходит большинство нарушений безопасности.

Ответ №1:

решение с использованием неравнозначного соединения из data.table ..

сначала получите минимальный и максимальный возраст для каждой группы, извлечение из описания

 library(dplyr)
library(stringr)
#get minimum and maximum age grom group
dfAgebands <- dfAgeBands %>% mutate( minAge = stringr::str_extract( ageCriterion, "(?<=\> )[0-9] (?= amp;)") %>% as.numeric(),
                                     maxAge = stringr::str_extract( ageCriterion, "(?<=\<= )[0-9] (?=$)") %>% as.numeric() )

           ageCriterion      ageBand minAge maxAge
1  age > 0 amp; age <= 20 Young Adults      0     20
2 age > 20 amp; age <= 30       Adults     20     30

теперь вы можете легко выполнить неравнозначное объединение

 library(data.table)
dfOriginal[ dfAgebands, ageBand := i.ageBand, on = c("age > minAge", "age <= maxAge")]

#     age      ageBand
#  1:  55         <NA>
#  2:  40         <NA>
#  3:  41         <NA>
#  4:  33         <NA>
#  5:  56         <NA>
#  6:  25       Adults
#  7:  11 Young Adults
#  8:  13 Young Adults
#  9:  28       Adults
# 10:  27       Adults

Ответ №2:

Обычно лучше не проходить через eval(parse , но приведенное здесь выражение вызывает соблазн использовать именно это. Одним из вариантов является eval изменение выражения в i путем перебора каждого элемента ‘ageCriterion’ и присвоения ( := ) значения ‘ageBand’ тем, которые удовлетворяют условию в i

 library(data.table)
for(i in seq_len(nrow(dfAgeBands)))  {

   dfOriginal[eval(parse(text = dfAgeBands$ageCriterion[i])), 
           ageBand := dfAgeBands$ageBand[i]]
  }

dfOriginal[]

Или использование purrr

 library(purrr)
pwalk(dfAgeBands, ~ dfOriginal[eval(parse(text = .x)), ageBand := .y])
dfOriginal[]
#    age      ageBand
# 1:  25       Adults
# 2:  22       Adults
# 3:  37         <NA>
# 4:  12 Young Adults
# 5:  32         <NA>
# 6:  56         <NA>
# 7:  46         <NA>
# 8:  26       Adults
# 9:  33         <NA>
#10:  17 Young Adults

Ответ №3:

Как бы то ни было — т.Е. мое решение в дополнение к решению гигантов, таких как akrun и других гениев, таких как Wimpel — вот решение с map2:

 map2(ageBands$AgeCriteria, ageBands$AgeBand, 
          function(x,y){df1[eval(parse_expr(x)), ageBands := y]})