将列名传递给 mutate_at 中的用户定义函数答案

【问题标题】：Passing column names to user defined function inside mutate_at将列名传递给 mutate_at 中的用户定义函数
【发布时间】：2018-09-28 13:44:18
【问题描述】：

在使用 dplyr - mutate_at 时，我正在努力在我的自定义函数中传递列名。我有一个包含数千列的数据集“dt”，我想对其中一些列执行变异，但方式取决于列名

我有这段代码

选项 1：

relevantcols = c("A", "B", "C")
myfunc <- function(colname, x) {
   #write different logic per column name
}
dt%>%
  mutate_at(relevantcols, funs(myfunc(<what should i give?>,.)))

我尝试以另一种方式解决问题，即通过迭代相关列并为向量的每个元素应用 mutate_at，如下所示

选项 2：

for (i in 1:length(relevantcols)){
  dt%>%
  mutate_at(relevantcols[i], funs(myfunc(relevantcols[i], .))
}

我在选项 2 中获得了列名，但它比选项 1 慢了 10 倍。我能以某种方式获得选项 1 中的列名吗？

添加一个例子更清楚

df = data.frame(employee=seq(1:5), Mon_channelA=runif(5,1,10), Mon_channelB=runif(5,1,10), Tue_channelA=runif(5,1,10),Tue_channelB=runif(5,1,10))
df
 employee Mon_channelA Mon_channelB Tue_channelA Tue_channelB
1        1     5.234383     6.857227     4.480943     7.233947
2        2     7.441399     3.777524     2.134075     6.310293
3        3     7.686558     8.598688     9.814882     9.192952
4        4     6.033345     5.658716     5.167388     3.018563
5        5     5.595006     7.582548     9.302917     6.071108
relevantcols = c("Mon_channelA", "Mon_channelB")
myfunc <- function(colname, x) {
#based on the channel and weekday, compare the data from corresponding column with  the same channel but different weekday and return T if higher else F
}
# required output
employee Mon_channelA Mon_channelB Tue_channelA Tue_channelB
1        1     T     F     4.480943     7.233947
2        2     T     F     2.134075     6.310293
3        3     F     F     9.814882     9.192952
4        4     T     T     5.167388     3.018563
5        5     F     T     9.302917     6.071108

【问题讨论】：

您能否举一个“每列名称不同的逻辑”的具体示例，所以我们有一个示例函数可以使用？拥有一个示例数据集以及您想要的输出也将有所帮助。您可以看到有关如何制作可重现示例的想法here。
完成，希望对了解情况有所帮助
我不清楚你想要的输出的部分逻辑。对于星期一，您想要真/假值，但对于星期二，您想要与星期二对应的值？为什么不全是真/假或全是数字？
@camille 你是对的。最后，所有值都将是布尔值或数字。所以星期二的值必须与星期三的值进行比较，周末有一些例外等等......我只是想解释一下将列名传递给 myfunc 的要求......注意在原始数据集中，我有 5000 多个列，包含各种渠道和工作日组合。

标签： r dplyr

【解决方案1】：

我留下了关于数据类型的评论，但假设这就是您要寻找的，这就是我对这类问题采取的方法。我在一个看似复杂的重塑过程中执行此操作几次，但它可以让您设置要比较的变量，而无需进行太多硬编码。我会把它分解成碎片。

library(tidyverse)

set.seed(928)
df <- data.frame(employee=seq(1:5), Mon_channelA=runif(5,1,10), Mon_channelB=runif(5,1,10), Tue_channelA=runif(5,1,10),Tue_channelB=runif(5,1,10))

首先，我将其重塑为长形并将“Mon_channelA”等拆分为一天和一个频道。这使您可以使用通道名称来匹配值以进行比较。

df %>%
  gather(key, value, -employee) %>%
  separate(key, into = c("day", "channel"), sep = "_") %>%
  head()
#>   employee day  channel    value
#> 1        1 Mon channelA 2.039619
#> 2        2 Mon channelA 8.153684
#> 3        3 Mon channelA 9.027932
#> 4        4 Mon channelA 1.161967
#> 5        5 Mon channelA 3.583353
#> 6        1 Mon channelB 7.102797

然后，根据天数将其恢复为宽格式。现在，对于员工和渠道的每个组合，您每天都有一个列。

df %>%
  gather(key, value, -employee) %>%
  separate(key, into = c("day", "channel"), sep = "_") %>%
  spread(key = day, value = value) %>%
  head()
#>   employee  channel      Mon      Tue
#> 1        1 channelA 2.039619 9.826677
#> 2        1 channelB 7.102797 7.388568
#> 3        2 channelA 8.153684 5.848375
#> 4        2 channelB 6.299178 9.452274
#> 5        3 channelA 9.027932 5.458906
#> 6        3 channelB 7.029408 7.087011

然后进行比较，并再次获取数据。请注意，由于value 列具有数值，因此所有内容都变为数字，并且逻辑值将转换为 1 或 0。

df %>%
  gather(key, value, -employee) %>%
  separate(key, into = c("day", "channel"), sep = "_") %>%
  spread(key = day, value = value) %>%
  mutate(Mon = Mon > Tue) %>%
  gather(key = day, value = value, Mon, Tue) %>%
  head()
#>   employee  channel day value
#> 1        1 channelA Mon     0
#> 2        1 channelB Mon     0
#> 3        2 channelA Mon     1
#> 4        2 channelB Mon     0
#> 5        3 channelA Mon     1
#> 6        3 channelB Mon     0

最后几个步骤是将日期和频道重新组合在一起，使标签保持原样，展开回宽格式，并将所有以 "Mon" 开头的列重新转换为逻辑。

df %>%
  gather(key, value, -employee) %>%
  separate(key, into = c("day", "channel"), sep = "_") %>%
  spread(key = day, value = value) %>%
  mutate(Mon = Mon > Tue) %>%
  gather(key = day, value = value, Mon, Tue) %>%
  unite("variable", day, channel) %>%
  spread(key = variable, value = value) %>%
  mutate_at(vars(starts_with("Mon")), as.logical)
#>   employee Mon_channelA Mon_channelB Tue_channelA Tue_channelB
#> 1        1        FALSE        FALSE     9.826677     7.388568
#> 2        2         TRUE        FALSE     5.848375     9.452274
#> 3        3         TRUE        FALSE     5.458906     7.087011
#> 4        4        FALSE        FALSE     8.854263     8.946458
#> 5        5        FALSE        FALSE     6.933054     8.450741

^{由reprex package (v0.2.1) 于 2018 年 9 月 28 日创建}

【讨论】：

谢谢，会试试你的方法；我唯一担心的是收集的性能是我最终可能会拥有数亿行，并且不确定后续转换会受到怎样的影响。但仍然会尝试并得到结果。

【解决方案2】：

您可以执行以下操作：

L <- c("A","B")
df <- data.frame(A=rep(1:3,2),B=1:6,C=7:12)
df
#  A B  C
#1 1 1  7
#2 2 2  8
#3 3 3  9
#4 1 4 10
#5 2 5 11
#6 3 6 12

f <- function(x,y) x^y

df %>% mutate_at(L,funs(f(.,2)))
#  A  B  C
#1 1  1  7
#2 4  4  8
#3 9  9  9
#4 1 16 10
#5 4 25 11
#6 9 36 12

【讨论】：

谢谢，但我仍然不明白 f 如何为 A 和 B 返回不同的值（这是我想要的）

【解决方案3】：

这是一个老问题，但我偶然发现了一种可能的方法来解决它，它使用自定义 mutate/case_when 函数和 purrr::reduce 结合使用。

在mutate/case_when 语句中使用非标准评估 (NSE) 来匹配自定义函数所需的变量名称非常重要。

我不知道用mutate_at 做类似的事情的方法。

下面我提供了两个示例，最基本的形式（使用您的原始数据）和更高级的版本（包含三个工作日和两个频道），它创建了两个以上的变量。后者需要使用例如switch 进行初始设置。

基本示例

library(tidyverse)

# your data
df <- data.frame(employee=seq(1:5),
                Mon_channelA=runif(5,1,10),
                Mon_channelB=runif(5,1,10),
                Tue_channelA=runif(5,1,10),
                Tue_channelB=runif(5,1,10)
                )

# custom function which takes two arguments, df and a string variable name
myfunc <- function(df, x) {

  mutate(df,
         # overwrites all "Mon_channel" variables ...
         !! paste0("Mon_", x) := case_when(  
           # ... with TRUE, when Mon_channel is smaller than Tue_channel, and FALSE else
            !! sym(paste0("Mon_", x)) < !! sym(paste0("Tue_", x))  ~ T,
            T ~ F
           )
         )
}

# define the variables you want to loop over
var_ls <- c("channelA", "channelB")

# use var_ls and myfunc with reduce on your data
df %>% 
  reduce(var_ls, myfunc, .init = .)
#>   employee Mon_channelA Mon_channelB Tue_channelA Tue_channelB
#> 1        1        FALSE        FALSE     3.437975     2.458389
#> 2        2        FALSE         TRUE     3.686903     4.772390
#> 3        3         TRUE         TRUE     5.158234     5.378021
#> 4        4         TRUE         TRUE     5.338950     3.109760
#> 5        5         TRUE        FALSE     6.365173     3.450495

^{由reprex package (v0.3.0) 于 2020 年 2 月 3 日创建}

更高级的示例

library(tidyverse)
#> Warning: package 'ggplot2' was built under R version 3.5.2
#> Warning: package 'purrr' was built under R version 3.5.2
#> Warning: package 'forcats' was built under R version 3.5.2

# your data plus one weekday with two channels
df <- data.frame(employee=seq(1:5),
                Mon_channelA=runif(5,1,10),
                Mon_channelB=runif(5,1,10),
                Tue_channelA=runif(5,1,10),
                Tue_channelB=runif(5,1,10),
                Wed_channelA=runif(5,1,10),
                Wed_channelB=runif(5,1,10)
                )

# custom function which takes two argument, df and a string variable name
myfunc <- function(df, x) {

  # an initial set-up is needed

  # id gets the original day
  id <- str_extract(x, "^\\w{3}")

  # based on id the day of comparison is mapped with switch
  y <- switch(id,
              "Mon" = "Tue",
              "Tue" = "Wed")

  # j extracts the channel name including the underscore
  j <- str_extract(x, "_channel[A-Z]{1}")

  # this makes the function definition rather easy:
  mutate(df,
         !! x := case_when(  
            !! sym(x) < !! sym(paste0(y, j))  ~ T,
            T ~ F
           )
         )
}

# define the variables you want to loop over
var_ls <- c("Mon_channelA",
            "Mon_channelB",
            "Tue_channelA",
            "Tue_channelB")

# use var_ls and myfunc with reduce on your data
df %>% 
  reduce(var_ls, myfunc, .init = .)
#>   employee Mon_channelA Mon_channelB Tue_channelA Tue_channelB
#> 1        1         TRUE         TRUE         TRUE        FALSE
#> 2        2        FALSE         TRUE         TRUE        FALSE
#> 3        3        FALSE         TRUE        FALSE         TRUE
#> 4        4        FALSE         TRUE         TRUE        FALSE
#> 5        5         TRUE        FALSE        FALSE        FALSE
#>   Wed_channelA Wed_channelB
#> 1     9.952454     5.634686
#> 2     9.356577     4.514683
#> 3     2.721330     7.107316
#> 4     4.410240     2.740289
#> 5     5.394057     4.772162

^{由reprex package (v0.3.0) 于 2020 年 2 月 3 日创建}

【讨论】：