向函数传递向量或未定义数量的参数

use*_*230 6 arguments r function ellipsis

我希望能够通过函数传递未定义数量的参数,...而且还能够向其传递vector. 这是一个愚蠢的例子:

library(tidyverse)
df <- data.frame(gear = as.character(unique(mtcars$gear)),
                 id = 1:3)
myfun <- function(...) {
  ids_lst <- lst(...)
  df2 <- bind_rows(map(ids_lst, function(x) 
    mtcars %>% 
      filter(gear == x) %>% 
      select(mpg)), .id = "gear") %>% 
    left_join(df)
  df2
}
#these all work:
myfun(3)
myfun(3, 4)
myfun(3, 4, 5)
Run Code Online (Sandbox Code Playgroud)

但向它传递向量是行不通的:

myvector <- unique(mtcars$gear)
myfun(myvector)
Run Code Online (Sandbox Code Playgroud)

问题在于函数收集参数的方式以及返回参数的方式:

myfun_lst <- function(...) {
  ids_lst <- lst(...)
  ids_lst
}
myfun_lst(3, 4, 5)
# $`3`
# [1] 3

# $`4`
# [1] 4

# $`5`
# [1] 5

myfun_lst(myvector)
# $myvector
# [1] 4 3 5
Run Code Online (Sandbox Code Playgroud)

我认为修复方法是测试输入是否为 a vector,例如:

myfun_final <- function(...) {
  if(is.vector(...) & !is.list(...)) {
    ids_lst <- as.list(...)
    names(ids_lst) <- (...)
  } else { 
    ids_lst <- lst(...)
  }
  df2 <- bind_rows(map(ids_lst, function(x) 
    mtcars %>% 
      filter(gear == x) %>% 
      select(mpg)), .id = "gear") %>% 
    left_join(df)
  df2
}
Run Code Online (Sandbox Code Playgroud)

现在,向函数传递向量可以工作,但收集参数则不行:

myfun_final(3, 4, 5)
myfun_final(myvector)
Run Code Online (Sandbox Code Playgroud)

有什么好的方法可以解决这个问题呢?谢谢

eko*_*oam 4

...测试长度是否为 1 以及传递的唯一参数是否是向量怎么样?如果不是这样,请考虑...缩放器列表并使用 捕获它们lst(...)

myfun_final <- function(...) {
  if (...length() == 1L && is.vector(..1))
    ids_lst <- `names<-`(..1, ..1)
  else
    ids_lst <- lst(...)
  
  df2 <- bind_rows(map(ids_lst, function(x) 
    mtcars %>% 
      filter(gear == x) %>% 
      select(mpg)), .id = "gear") %>% 
    left_join(df)
  df2
}
Run Code Online (Sandbox Code Playgroud)

测试

> myfun_final(3)
Joining, by = "gear"
   gear  mpg id
1     3 21.4  2
2     3 18.7  2
3     3 18.1  2
4     3 14.3  2
5     3 16.4  2
6     3 17.3  2
7     3 15.2  2
8     3 10.4  2
9     3 10.4  2
10    3 14.7  2
11    3 21.5  2
12    3 15.5  2
13    3 15.2  2
14    3 13.3  2
15    3 19.2  2
> myfun_final(3,4,5)
Joining, by = "gear"
   gear  mpg id
1     3 21.4  2
2     3 18.7  2
3     3 18.1  2
4     3 14.3  2
5     3 16.4  2
6     3 17.3  2
7     3 15.2  2
8     3 10.4  2
9     3 10.4  2
10    3 14.7  2
11    3 21.5  2
12    3 15.5  2
13    3 15.2  2
14    3 13.3  2
15    3 19.2  2
16    4 21.0  1
17    4 21.0  1
18    4 22.8  1
19    4 24.4  1
20    4 22.8  1
21    4 19.2  1
22    4 17.8  1
23    4 32.4  1
24    4 30.4  1
25    4 33.9  1
26    4 27.3  1
27    4 21.4  1
28    5 26.0  3
29    5 30.4  3
30    5 15.8  3
31    5 19.7  3
32    5 15.0  3
> myfun_final(c(3,4,5))
Joining, by = "gear"
   gear  mpg id
1     3 21.4  2
2     3 18.7  2
3     3 18.1  2
4     3 14.3  2
5     3 16.4  2
6     3 17.3  2
7     3 15.2  2
8     3 10.4  2
9     3 10.4  2
10    3 14.7  2
11    3 21.5  2
12    3 15.5  2
13    3 15.2  2
14    3 13.3  2
15    3 19.2  2
16    4 21.0  1
17    4 21.0  1
18    4 22.8  1
19    4 24.4  1
20    4 22.8  1
21    4 19.2  1
22    4 17.8  1
23    4 32.4  1
24    4 30.4  1
25    4 33.9  1
26    4 27.3  1
27    4 21.4  1
28    5 26.0  3
29    5 30.4  3
30    5 15.8  3
31    5 19.7  3
32    5 15.0  3
Run Code Online (Sandbox Code Playgroud)