使用purrr和预定义函数添加多个输出变量

Question

采用这个简单的数据集和函数（代表更复杂的问题）：

x <- data.frame(a = 1:3, b = 2:4)
mult <- function(a,b,n) (a + b) * n

使用base R的Map我可以这样做以向量化的方式添加2个新列：

ns <- 1:2
x[paste0("new",seq_along(ns))] <- Map(mult, x["a"], x["b"], n=ns)
x
#  a b new1 new2
#1 1 2    3    6
#2 2 3    5   10
#3 3 4    7   14

purrr尝试通过pmap得到一个列表输出：

library(purrr)
library(dplyr)
x %>% select(a,b) %>% pmap(mult, n=1:2)
#[[1]]
#[1] 3 6
#
#[[2]]
#[1]  5 10
#
#[[3]]
#[1]  7 14

我在这里与pmap_dfr等的尝试似乎都在试图将其映射回新列时出错。

我如何最终制作两个与我当前的"new1"/"new2"相匹配的变量？我确定有一个简单的咒语，但我显然忽略它或使用错误的*map*功能。

这里有一些有用的讨论 - How to use map from purrr with dplyr::mutate to create multiple new columns based on column pairs - 但它似乎过于苛刻和不灵活，我想象的是一个简单的问题。

Answer 1

我发现的最好的方法（仍然不是非常优雅）是管道进入bind_cols。要使pmap_dfr正常工作，该函数应返回一个命名列表（可能是也可能不是数据框）：

library(tidyverse)

x <- data.frame(a = 1:3, b = 2:4)
mult <- function(a,b,n) as.list(set_names((a + b) * n, paste0('new', n)))

x %>% bind_cols(pmap_dfr(., mult, n = 1:2))
#>   a b new1 new2
#> 1 1 2    3    6
#> 2 2 3    5   10
#> 3 3 4    7   14

为避免更改mult的定义，您可以将其包装在匿名函数中：

mult <- function(a,b,n) (a + b) * n

x %>% bind_cols(pmap_dfr(
    ., 
    ~as.list(set_names(
        mult(...), 
        paste0('new', 1:2)
    )), 
    n = 1:2
))
#>   a b new1 new2
#> 1 1 2    3    6
#> 2 2 3    5   10
#> 3 3 4    7   14

在这种特殊情况下，实际上并不需要迭代行，因为您可以对来自x的输入进行矢量化，而是迭代n。优点是通常n> p，因此迭代次数可能会更低。需要明确的是，这种方法是否可行取决于函数可以接受矢量参数的参数。

mult仍然需要调用x的变量。最简单的方法是明确地传递它们：

x %>% bind_cols(map_dfc(1:2, ~mult(x$a, x$b, .x)))
#>   a b V1 V2
#> 1 1 2  3  6
#> 2 2 3  5 10
#> 3 3 4  7 14

...但是这失去了pmap的好处，命名变量将自动传递给正确的参数。您可以使用purrr::lift来获取它，这是一个更改函数域的副词，因此它通过将其包装在do.call中来接受列表。可以在x上调用返回的函数，并为该迭代调用n的值：

x %>% bind_cols(map_dfc(1:2, ~lift(mult)(x, n = .x)))

这相当于

x %>% bind_cols(map_dfc(1:2, ~invoke(mult, x, n = .x)))

但前者的优点是它返回一个函数，可以partially应用于x所以它只剩下一个n参数，因此不需要显式引用x所以管道更好：

x %>% bind_cols(map_dfc(1:2, partial(lift(mult), .)))

所有回报都是一样的。如果你愿意的话，可以用%>% set_names(~sub('^V(\\d+)$', 'new\\1', .x))修改名称。

Answer 2

这是一种可能性。

library(purrr)
library(dplyr)
n <- 1:2
x %>%
    mutate(val = pmap(., mult, n = n)) %>%
    unnest() %>%
    mutate(var = rep(paste0("new", n), nrow(.) / length(n))) %>%
    spread(var, val)
#  a b new1 new2
#1 1 2    3    6
#2 2 3    5   10
#3 3 4    7   14

不漂亮，所以我也很想看到替代品。从unnesting list专栏和spreading到新专栏，大量过剩。

这是使用pmap_dfc加上一个丑陋的as.data.frame(t(...))电话的另一种可能性

bind_cols(x, as.data.frame(t(pmap_dfc(x, mult, n = n))))
#  a b V1 V2
#1 1 2  3  6
#2 2 3  5 10
#3 3 4  7 14

---

样本数据

x <- data.frame(a = 1:3, b = 2:4)
mult <- function(a,b,n) (a + b) * n

Answer 3

为了模仿Map的输入格式，我们可以用这种方式从pmap调用purrr：

x[paste0("new",seq_along(ns))] <- pmap(list(x['a'], x['b'], ns), mult)

要将其安装在管道中：

x %>%
    {list(.['a'], .['b'], ns)} %>%
    pmap(mult) %>%
    setNames(paste0('new', seq_along(ns))) %>%
    cbind(x)

#   new1 new2 a b
# 1    3    6 1 2
# 2    5   10 2 3
# 3    7   14 3 4

显然，与简洁的基本R代码相比，这看起来很丑陋。但我想不出更好的方法。