R函数参数的有关问题

r
作者

zsc

发布日期

2019年5月1日

1. args 可以用来查看某个函数包含了哪些参数

Show the code
args(sin)
#> function (x) 
#> NULL
args(lm)
#> function (formula, data, subset, weights, na.action, method = "qr", 
#>     model = TRUE, x = FALSE, y = FALSE, qr = TRUE, singular.ok = TRUE, 
#>     contrasts = NULL, offset, ...) 
#> NULL
args(paste)
#> function (..., sep = " ", collapse = NULL, recycle0 = FALSE) 
#> NULL

2. 匹配参数— match.arg()

我们经常看见函数中有多个可选的字符串，用来做不同的模型，比如：这里的例子没有意义，但是做法值得注意。

方法一：

Show the code
## 方法一：
center <- function(x, type = c("mean", "median", "trimmed")) {
  type <- match.arg(type)
  switch(type,
         mean = mean(x),
         median = median(x),
         trimmed = mean(x, trim = .1))
}
center(c(1:4,100),"mean") # 返回向量的均值
#> [1] 22
center(c(1:4,100),"median") # 返回向量的中位数
#> [1] 3
center(c(1:4,100)) # 默认为第一个候选值，
#> [1] 22

方法二：

Show the code
## 方法二：
center <- function(x, type) {
  type <- match.arg(type,choices = c("mean", "median", "trimmed"))
  switch(type,
         mean = mean(x),
         median = median(x),
         trimmed = mean(x, trim = .1))
}
center(c(1:4,100),"mean") # 返回向量的均值
#> [1] 22
center(c(1:4,100),"median") # 返回向量的中位数
#> [1] 3
try( center(c(1:4,100)) )# 这里由于没有默认值会报错
#> Error in match.arg(type, choices = c("mean", "median", "trimmed")) : 
#>   argument "type" is missing, with no default

match.arg()函数的功能是，根据输入来进行匹配, 比如，上面的式子，我们输入的type是”mean”，然后经过match.arg()以后通过switch可以直接调用该mean函数。

还可以这样操作，（方法三）

Show the code
# 检查一个参数在函数内部是否已被初始化。
# 对参数进行默认值处理，当然为了更方面也可以直接在函数参数处直接赋予默认值
h = function(x,y){
  args = as.list(match.call())
  if(is.null(args$y)){
    y = 10
  }
  x+y
}
h(2)
#> [1] 12
h(2,19)
#> [1] 21

类似的还有 match.call() 和match.fun()

Show the code
# match.call()创建一个只使用命名参数的调用， 常用于某些指定参数的更新
# sys.call() 准确地捕获用户的输入。

f <- function(abc = 1, def = 2, ghi = 3){
  list(s = sys.call(),m = match.call())
}
f(d =2,2)
#> $s
#> f(d = 2, 2)
#> 
#> $m
#> f(abc = 2, def = 2)

match.fun() 类似下面介绍的get()函数, 都可以把字符串变成我们想要调用的对象。

3. 以字符串作为函数名 — get函数

巧妙的利用get函数，把字符串变成我们想要调用的函数，因为get函数输入一个字符串，返回一个函数对象

Show the code
# eg： 前面的函数---可以进行对比
center <- function(x, type = c("mean", "median", "trimmed")) {
  type <- match.arg(type)
  f = get(type)
  f(x)
}
center(c(1:4,100),"mean")
#> [1] 22
center(c(1:4,100),"median")
#> [1] 3
center(c(1:4,100))
#> [1] 22



# eg： 用match.fun  来替代get()
center2 <- function(x, type = c("mean", "median", "trimmed")) {
  type <- match.arg(type)
  f = match.fun(type)
  f(x)
}
center2(c(1:4,100),"mean")
#> [1] 22
center2(c(1:4,100),"median")
#> [1] 3
center2(c(1:4,100))
#> [1] 22

两者的区别是get还可以返回某个对象，比如数据框、向量等，而match.fun 只能返回函数类型

Show the code
v = 1:10
# match.fun('v') # 这里会报错
get('v')
#>  [1]  1  2  3  4  5  6  7  8  9 10


outer <- 1:5
try(match.fun(outer, descend = FALSE)) #-> Error:  not a function
#> function (X, Y, FUN = "*", ...) 
#> {
#>     if (is.array(X)) {
#>         dX <- dim(X)
#>         nx <- dimnames(X)
#>         no.nx <- is.null(nx)
#>     }
#>     else {
#>         dX <- length(X)
#>         no.nx <- is.null(names(X))
#>         if (!no.nx) 
#>             nx <- list(names(X))
#>     }
#>     if (is.array(Y)) {
#>         dY <- dim(Y)
#>         ny <- dimnames(Y)
#>         no.ny <- is.null(ny)
#>     }
#>     else {
#>         dY <- length(Y)
#>         no.ny <- is.null(names(Y))
#>         if (!no.ny) 
#>             ny <- list(names(Y))
#>     }
#>     robj <- if (is.character(FUN) && FUN == "*") {
#>         if (!missing(...)) 
#>             stop("using ... with FUN = \"*\" is an error")
#>         tcrossprod(as.vector(X), as.vector(Y))
#>     }
#>     else {
#>         FUN <- match.fun(FUN)
#>         Y <- rep(Y, rep.int(length(X), length(Y)))
#>         if (length(X)) 
#>             X <- rep(X, times = ceiling(length(Y)/length(X)))
#>         FUN(X, Y, ...)
#>     }
#>     dim(robj) <- c(dX, dY)
#>     if (!(no.nx && no.ny)) {
#>         if (no.nx) 
#>             nx <- vector("list", length(dX))
#>         else if (no.ny) 
#>             ny <- vector("list", length(dY))
#>         dimnames(robj) <- c(nx, ny)
#>     }
#>     robj
#> }
#> <bytecode: 0x122e9df78>
#> <environment: namespace:base>
match.fun(outer) # finds it anyway，由于outer是R内部的函数，只不过现在被覆盖了，但是还是能找到
#> function (X, Y, FUN = "*", ...) 
#> {
#>     if (is.array(X)) {
#>         dX <- dim(X)
#>         nx <- dimnames(X)
#>         no.nx <- is.null(nx)
#>     }
#>     else {
#>         dX <- length(X)
#>         no.nx <- is.null(names(X))
#>         if (!no.nx) 
#>             nx <- list(names(X))
#>     }
#>     if (is.array(Y)) {
#>         dY <- dim(Y)
#>         ny <- dimnames(Y)
#>         no.ny <- is.null(ny)
#>     }
#>     else {
#>         dY <- length(Y)
#>         no.ny <- is.null(names(Y))
#>         if (!no.ny) 
#>             ny <- list(names(Y))
#>     }
#>     robj <- if (is.character(FUN) && FUN == "*") {
#>         if (!missing(...)) 
#>             stop("using ... with FUN = \"*\" is an error")
#>         tcrossprod(as.vector(X), as.vector(Y))
#>     }
#>     else {
#>         FUN <- match.fun(FUN)
#>         Y <- rep(Y, rep.int(length(X), length(Y)))
#>         if (length(X)) 
#>             X <- rep(X, times = ceiling(length(Y)/length(X)))
#>         FUN(X, Y, ...)
#>     }
#>     dim(robj) <- c(dX, dY)
#>     if (!(no.nx && no.ny)) {
#>         if (no.nx) 
#>             nx <- vector("list", length(dX))
#>         else if (no.ny) 
#>             ny <- vector("list", length(dY))
#>         dimnames(robj) <- c(nx, ny)
#>     }
#>     robj
#> }
#> <bytecode: 0x122e9df78>
#> <environment: namespace:base>
match.fun("outer")
#> function (X, Y, FUN = "*", ...) 
#> {
#>     if (is.array(X)) {
#>         dX <- dim(X)
#>         nx <- dimnames(X)
#>         no.nx <- is.null(nx)
#>     }
#>     else {
#>         dX <- length(X)
#>         no.nx <- is.null(names(X))
#>         if (!no.nx) 
#>             nx <- list(names(X))
#>     }
#>     if (is.array(Y)) {
#>         dY <- dim(Y)
#>         ny <- dimnames(Y)
#>         no.ny <- is.null(ny)
#>     }
#>     else {
#>         dY <- length(Y)
#>         no.ny <- is.null(names(Y))
#>         if (!no.ny) 
#>             ny <- list(names(Y))
#>     }
#>     robj <- if (is.character(FUN) && FUN == "*") {
#>         if (!missing(...)) 
#>             stop("using ... with FUN = \"*\" is an error")
#>         tcrossprod(as.vector(X), as.vector(Y))
#>     }
#>     else {
#>         FUN <- match.fun(FUN)
#>         Y <- rep(Y, rep.int(length(X), length(Y)))
#>         if (length(X)) 
#>             X <- rep(X, times = ceiling(length(Y)/length(X)))
#>         FUN(X, Y, ...)
#>     }
#>     dim(robj) <- c(dX, dY)
#>     if (!(no.nx && no.ny)) {
#>         if (no.nx) 
#>             nx <- vector("list", length(dX))
#>         else if (no.ny) 
#>             ny <- vector("list", length(dY))
#>         dimnames(robj) <- c(nx, ny)
#>     }
#>     robj
#> }
#> <bytecode: 0x122e9df78>
#> <environment: namespace:base>

4. 以字符串作为函数名 — call()函数

call函数，可以直接通过字符串的形式调用某个函数(只要环境空间中存在)，

Show the code
get("rnorm")(5,mean = 300)
#> [1] 299.7240 300.7482 302.8964 299.5659 300.5361

eval( call('rnorm',5,mean=300) ) # 执行函数调用，本质上call是创建一个函数调用，最后通过eval进行执行
#> [1] 299.8097 300.0864 298.5465 299.4390 298.9760

call_1 = quote(rnorm(5,mean = 3))
call_2 = call("rnorm",5,mean = 3)
call_3 = as.call( list(quote(rnorm),5,mean = 3) )
# 这里call_1,call_2,call_3 完全等价，是一个表达式。需要进一步执行表达式需要利用eval来执行。

5. 把函数参数(不带字符串参数)转变为字符串

deparse(substitute(函数参数))

Show the code
nicePlot = function(X,Y,...){
  xlabel = deparse(substitute(X)) # 捕获X的输入
  ylabel = deparse(substitute(Y)) # 捕获Y的输入
  
  plot(X,Y,type ='o',xlab = xlabel,ylab = ylabel,main = paste(xlabel,ylabel,sep = '--'), ...)
}

Date = 1:7
Sales = c(100,120,150,130,160,210,120)
nicePlot(Date,Sales,col='red')

Show the code
sessionInfo()
#> R version 4.2.1 (2022-06-23)
#> Platform: aarch64-apple-darwin20 (64-bit)
#> Running under: macOS Monterey 12.5.1
#> 
#> Matrix products: default
#> BLAS:   /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib
#> LAPACK: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib
#> 
#> locale:
#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#> 
#> attached base packages:
#> [1] stats     graphics  grDevices utils     datasets  methods   base     
#> 
#> loaded via a namespace (and not attached):
#>  [1] digest_0.6.29     jsonlite_1.8.0    magrittr_2.0.3    evaluate_0.16    
#>  [5] rlang_1.0.4       stringi_1.7.8     cli_3.3.0         rstudioapi_0.14  
#>  [9] rmarkdown_2.16.1  tools_4.2.1       stringr_1.4.1     htmlwidgets_1.5.4
#> [13] xfun_0.32         yaml_2.3.5        fastmap_1.1.0     compiler_4.2.1   
#> [17] htmltools_0.5.3   knitr_1.40