Tidyeval和应用家族向数据框架添加新的变量。

Question

我想写一个函数，用tidyverse工具自动创建一些新的变量。我想明白了我的问题涉及到tidyeval，但我还没有完全想明白我在下面的代码中哪里出了问题，这只是重现了变量名。作为第二步，我想做一些除了for循环以外的事情，把函数应用一堆。我已经阅读了足够多的StackOverflow答案来羞辱循环，但我找不到一个使用某种应用函数在现有数据框架上创建新变量的工作实例。谢谢！我想写一个函数，在现有的数据框架上使用apply函数创建新的变量。

library(tidyverse)
x = c(0,1,2,3,4)
y = c(0,2,4,5,8)
df <- data.frame(x,y)
df
simple_func <- function(x) {
  var_name <- paste0("pre_", x, "_months")
  var_name <-  enquo(var_name)
  df <- df %>%
    mutate(!! var_name := ifelse(x==y,1,0)) %>%
    mutate(!! var_name := replace_na(!! var_name))
  return(df)
}
simple_func(1)
#Desired result
temp <- data.frame("pre_1_months" = c(1,0,0,0,0))
temp
bind_cols(df,temp)

#Step 2, use some kind of apply function rather than a loop to apply this function sequentially
nums <- seq(1:10)
for (i in seq_along(nums)) {
  df <- simple_func(nums[i])
}
df

Answer 1

因为它是一个字符串，我们可以使用 sym 转化为符号，然后评估(!!

simple_func <- function(x) {
    var_name <- paste0("pre_", x, "_months")
    var_name <-  rlang::sym(var_name)
    df %>%
      mutate(!! var_name := ifelse(x==y,1,0)) %>%
      mutate(!! var_name := replace_na(!! var_name))

    }

核对上级的代码

nums <- seq(1:10)
for (i in seq_along(nums)) {
   df <- simple_func(nums[i])
 }

df
#  x y pre_1_months pre_2_months pre_3_months pre_4_months pre_5_months pre_6_months pre_7_months pre_8_months
#1 0 0            1            1            1            1            1            1            1            1
#2 1 2            0            0            0            0            0            0            0            0
#3 2 4            0            0            0            0            0            0            0            0
#4 3 5            0            0            0            0            0            0            0            0
#5 4 8            0            0            0            0            0            0            0            0
#  pre_9_months pre_10_months
#1            1             1
#2            0             0
#3            0             0
#4            0             0
#5            0             0

---

我们可以用 map 并改变 mutate 到 transmute

simple_func <- function(x) {
    var_name <- paste0("pre_", x, "_months")
    var_name <-  rlang::sym(var_name)
    df %>%
      transmute(!! var_name := ifelse(x==y,1,0)) %>%
      transmute(!! var_name := replace_na(!! var_name))

    }

library(purrr)
library(dplyr)
map_dfc(1:10, simple_func) %>% 
       bind_cols(df,.)

Answer 2

在 @akrun 的回答基础上，更习惯的做法是通过 df 作为函数的第一个参数，并将 x 作为第二个参数。你可以通过在函数内部设置循环，使x中的每个元素都能运行一次，从而实现函数的向量化。rlang::syms 而不是 sym. 它也使代码更短，你可以把它添加到管道中，就像它是一个 dplyr 功能。

simple_func <- function(df, x) 
{
    for(var_name in rlang::syms(paste0("pre_", x, "_months")))
    {
      df <- mutate(df, !! var_name := replace_na(ifelse(x==y,1,0)))
    }
    df
}

所以，现在你可以做。

df %>% simple_fun(1:5)
#>   x y pre_1_months pre_2_months pre_3_months pre_4_months pre_5_months
#> 1 0 0            1            1            1            1            1
#> 2 1 2            0            0            0            0            0
#> 3 2 4            0            0            0            0            0
#> 4 3 5            0            0            0            0            0
#> 5 4 8            0            0            0            0            0

---

编辑

根据Lionel Henry的评论，同时也注意到OPs希望避免循环，这里有一个没有循环的单一函数，可以在管子中使用。x 的任意长度，并且不依赖于转换为符号。

simple_func <- function(df, x) {
  f <- function(v) df <<- mutate(df, !!v := replace_na(ifelse(x == y, 1, 0)))
  lapply(paste0("pre_", x, "_months"), f)
  return(df)
}

这也是同样的方法。

df %>% simple_fun(1:10)
#>   x y pre_1_months pre_2_months pre_3_months pre_4_months pre_5_months pre_6_months
#> 1 0 0            1            1            1            1            1            1
#> 2 1 2            0            0            0            0            0            0
#> 3 2 4            0            0            0            0            0            0
#> 4 3 5            0            0            0            0            0            0
#> 5 4 8            0            0            0            0            0            0
#>   pre_7_months pre_8_months pre_9_months pre_10_months
#> 1            1            1            1             1
#> 2            0            0            0             0
#> 3            0            0            0             0
#> 4            0            0            0             0
#> 5            0            0            0             0