将应用函数与用户定义的函数一起使用，将变量添加到数据框

Question

我已经定义了一个函数，它将在数据框中动态创建新变量。对于此函数，输入是一个字符串，然后将其与其他字符串一起粘贴以创建数据框中已经存在的变量名称，然后在 mutate 中使用 case_when 进行比较。该函数的输出是数据帧，其末尾附加了新变量。我想将此函数应用于输入向量，并在数据框中创建多个新列。我已经使用 iris 数据集创建了一个与我正在做的非常相似的函数。

func <- function(x) {
  a <- paste0("Sepal.", x)
  b <- paste0("Petal.", x)
  x <- iris %>% 
    mutate(
      !!(paste0("Compare.", x)) :=
        case_when(
          iris[[a]] > iris[[b]] ~ "Sepal",
          iris[[a]] < iris[[b]] ~ "Petal",
          TRUE ~ "Equal"
      )
    )
  return(x)
}

inputVector <- c("Length", "Width")

我想将此函数应用于 inputVector 并返回一个数据帧，其中包含两个新变量，最好没有循环。我正在寻找使用类似的东西

iris <- lapply(inputVector, func)

但这会返回一个包含两个数据框的列表。我也知道我可以在func 中使用<<-，但我想避免这种情况。

Answer 1

您想要构建输出的方式略有变化 -

func <- function(x) {
  a <- paste0("Sepal", x)
  b <- paste0("Petal", x)
  x1 <- iris %>% 
    mutate(
      !!(paste0("Compare.", x)) :=
        case_when(
          a > b ~ "Sepal",
          a < b ~ "Petal",
          TRUE ~ "Equal"
        )
    )
  return(x1[[paste0('Compare.',x)]])
}

inputVector <- c("Length", "Width")
op <- iris
op[,paste0('Compare.',inputVector)] <- lapply(inputVector, func)

输出

> head(op)
  Sepal.Length Sepal.Width Petal.Length Petal.Width Species Compare.Length Compare.Width
1          5.1         3.5          1.4         0.2  setosa          Sepal         Sepal
2          4.9         3.0          1.4         0.2  setosa          Sepal         Sepal
3          4.7         3.2          1.3         0.2  setosa          Sepal         Sepal
4          4.6         3.1          1.5         0.2  setosa          Sepal         Sepal
5          5.0         3.6          1.4         0.2  setosa          Sepal         Sepal
6          5.4         3.9          1.7         0.4  setosa          Sepal         Sepal

Answer 2

一个更简单的选择是只生成函数中的新列，方法是用transmute 替换mutate，使用map_dfc 将它们迭代并加入一个数据框，然后使用bind_cols 将它们添加到原文：

library(tidyverse)

func <- function(x) {
  a <- sym(paste0("Sepal.", x))    # these need to be quosures to refer to variables
  b <- sym(paste0("Petal.", x))
  iris %>% transmute(
      !!paste0("Compare.", x) := case_when(
          !!a > !!b ~ "Sepal",    # unquote quosures
          !!a < !!b ~ "Petal",
          TRUE ~ "Equal"
      )
    )
}

inputVector <- c("Length", "Width")

iris %>% bind_cols(map_dfc(inputVector, func)) %>% head()
#>   Sepal.Length Sepal.Width Petal.Length Petal.Width Species Compare.Length
#> 1          5.1         3.5          1.4         0.2  setosa          Sepal
#> 2          4.9         3.0          1.4         0.2  setosa          Sepal
#> 3          4.7         3.2          1.3         0.2  setosa          Sepal
#> 4          4.6         3.1          1.5         0.2  setosa          Sepal
#> 5          5.0         3.6          1.4         0.2  setosa          Sepal
#> 6          5.4         3.9          1.7         0.4  setosa          Sepal
#>   Compare.Width
#> 1         Sepal
#> 2         Sepal
#> 3         Sepal
#> 4         Sepal
#> 5         Sepal
#> 6         Sepal

稍微更优雅的方法是构造函数以获取向量，将所有迭代移动到内部。您可以使用上面的方法，或者只生成向量并在有多个时将它们组装成一个数据框：

func2 <- function(x) {
  columns <- map_dfc(x, function(y){
    a <- paste0("Sepal.", y)
    b <- paste0("Petal.", y)
    column <- list(case_when(
      iris[[a]] > iris[[b]] ~ "Sepal",    # base notation is simpler than quosures
      iris[[a]] < iris[[b]] ~ "Petal",
      TRUE ~ "Equal"
    ))
    names(column) <- paste0("Compare.", y)
    column
  })
  iris %>% bind_cols(columns)
}

func2(inputVector) %>% tail()
#>     Sepal.Length Sepal.Width Petal.Length Petal.Width   Species
#> 145          6.7         3.3          5.7         2.5 virginica
#> 146          6.7         3.0          5.2         2.3 virginica
#> 147          6.3         2.5          5.0         1.9 virginica
#> 148          6.5         3.0          5.2         2.0 virginica
#> 149          6.2         3.4          5.4         2.3 virginica
#> 150          5.9         3.0          5.1         1.8 virginica
#>     Compare.Length Compare.Width
#> 145          Sepal         Sepal
#> 146          Sepal         Sepal
#> 147          Sepal         Sepal
#> 148          Sepal         Sepal
#> 149          Sepal         Sepal
#> 150          Sepal         Sepal

Answer 3

多玩一点，我确实找到了这个问题的答案。我没有让func 输出数据帧，而是将其更改为仅输出向量，然后使用do.call 和lapply

func <- function(x) {
  a <- paste0("Sepal", x)
  b <- paste0("Petal", x)
  x <- iris %>% 
    transmute(
      !!(paste0("Compare.", x)) :=
        case_when(
          a > b ~ "Sepal",
          a < b ~ "Petal",
          TRUE ~ "Equal"
      )
    )
  return(x)
}

do.call(cbind, c(iris, lapply(inputVector, func)))

我绝对愿意接受替代解决方案，因为我认为这可能不是最好的。

Answer 4

您的结果是两个数据框（如您所示）：

• iris[[1]] 是第一个数据帧
• iris[[2]] 是第二个数据帧。

您可以使用merge 将两个数据框合并为一个，如下所示：

comp.iris <- lapply(inputVector, func) 
comp.iris <- merge(comp.iris[[1]], comp.iris[[2]], sort = FALSE)

希望对你有帮助。