如何将相同的函数应用于 R 中的多个变量？

Question

我知道已经有人问过类似的问题（例如 Passing list element names as a variable to functions within lapply 或 R - iteratively apply a function of a list of variables），但我无法根据这些帖子找到解决问题的方法。

我有一个事件数据集（约 100 个变量，>2000 个观察值），其中包含包含有关参与者信息的变量。一个变量只能包含一个参与者，因此如果事件中涉及多个参与者，则它们会分布在多个变量中（例如 actor1、actor2、...）。这些演员可以分为两组（“s”和“nons”）。为了以后的使用，我需要两个演员列表：一个包含“s”类别的所有演员，另一个包含“nons”类别的所有演员。 “s”只有三个演员，而“nons”有几十个演员。

# create example data
df <- data.frame(id = c(1:8),
                 actor1 = c("A", "B", "D", "E", "F", "G", "H", NA),
                 actor2 = c("A", NA, "B", "C", "E", "I", "D", "G"))

df <-  
  df %>%
  mutate(actor1 = as.character(actor1),
         actor2 = as.character(actor2))

由于我要准备的脚本将来应该用于数据集的更新版本，我想尽可能地自动化，并将脚本中需要调整的部分保持在有限的范围内尽可能。我的想法是为每个类别创建一个函数，从列表中的一个变量（例如 actor1）中提取相应类别的参与者（例如“nons”），然后将该函数“循环”到另一个变量（最好使用 apply 系列）。

我知道每个参与者属于哪个类别（“A”、“B”和“C”是类别“s”），这使我可以定义如下函数中使用的分隔规则（过滤器命令）。

# create function
nons_function <- function(col) {
  col_ <- enquo(col)
  nons_list <-
    df %>%
    filter(!is.na(!!col_), !!col_ != "A", !!col_ != "B", !!col_ != "C") %>%
    distinct(!!col_) %>%
    pull()
  nons_list
}

# create list of variables to "loop" over
actorlist <- c("actor1", "actor2")

这会导致以下结果。我得到一个包含变量名称作为字符串的列表，而不是两个演员列表。

> lapply(actorlist, nons_function)
[[1]]
[1] "actor1"

[[2]]
[1] "actor2"

我想得到如下内容：

> lapply(actorlist, nons_function)
[[1]]
[1] "D" "E" "F" "G" "H"

[[2]]
[1] "E" "I" "D" "G"

问题可能是我在 lapply 中将变量名称传递给我的函数的方式。显然，我的函数不能使用字符输入作为变量名。但是，我还没有找到一种方法来调整我的函数以允许字符输入，或者为我的函数提供一个变量列表，以便以它可以消化的方式循环。

任何帮助表示赞赏！

编辑：最初我以一种误导性的方式命名了演员（演员名称表明演员属于哪个类别），这导致答案对我的情况没有真正帮助。我现在将演员名称从“s1”、“s2”、“nons1”、“nons2”等更改为“A”、“B”、“C”等。

Answer 1

这是一个选项

library(dplyr)
library(stringr)
library(purrr)
map(actorlist, ~ df %>% 
                  select(.x) %>%
                  filter(!str_detect(!! rlang::sym(.x), "^s\\d+$")) %>% 
                   pull(1))
#[[1]]
#[1] "nons1" "nons2" "nons3" "nons4" "nons5"

#[[2]]
#[1] "nons2" "nons6" "nons1" "nons4"

它也可以被包装成一个函数。请注意，输入是字符串，所以不要使用enquo，而是使用sym 转换为符号然后求值（!!）

f1 <- function(dat, colNm) {
                dat %>%
                  select(colNm) %>%
                   filter(!str_detect(!! rlang::sym(colNm), "^s\\d+$")) %>%
                    pull(1) %>%
                    unique
         }

map(actorlist, f1, dat = df)

注意：这可以更轻松地完成，但这里我们使用来自 OP 帖子的类似代码

---

另一种选择是在base R 中使用split 和grepl，并在删除NAs 后返回'nons' 和's' 的list

lapply(df[2:3], function(x)  {
           x1 <- x[!is.na(x)]
            split(x1, grepl("nons", x1))})

Answer 2

这是一个使用 base r 的选项。

对于非演员：

lapply( df[, 2:3], function(x) grep( "^nons", x, value = TRUE ) )

#$actor1
#[1] "nons1" "nons2" "nons3" "nons4" "nons5"
#
#$actor2
#[1] "nons2" "nons6" "nons1" "nons4"

对于 s 演员：

lapply( df[, 2:3], function(x) grep( "^s", x, value = TRUE ) )

# $actor1
# [1] "s1" "s2"
# 
# $actor2
# [1] "s1" "s2" "s3"

Answer 3

检查我的解决方案，看看它是否适合你。

require("dplyr")


# create example data
df <- data.frame(id = c(1:8),
                 actor1 = c("s1", "s2", "nons1", "nons2", "nons3", "nons4", "nons5", NA),
                 actor2 = c("s1", NA, "s2", "s3", "nons2", "nons6", "nons1", "nons4"))

df <-  
  df %>%
  mutate(actor1 = as.character(actor1),
         actor2 = as.character(actor2))


# Function for getting the category
category_function <- function(col,categ){

  if(categ == "non"){
    outp = grep("^non",col,value = T)
  }else{
    outp = grep("^s",col,value = T)
  }

  return(outp)  

}

# Apply the function to all variables whose name starts with "actor"
sapply(df[grep("actor",names(df),value=T)],category_function,categ="non")
sapply(df[grep("actor",names(df),value=T)],category_function,categ="s")

我的输出如下：

> sapply(df[grep("actor",names(df),value=T)],category_function,categ="non")
$actor1
[1] "nons1" "nons2" "nons3" "nons4" "nons5"

$actor2
[1] "nons2" "nons6" "nons1" "nons4"

> sapply(df[grep("actor",names(df),value=T)],category_function,categ="s")
$actor1
[1] "s1" "s2"

$actor2
[1] "s1" "s2" "s3"