R函数参数的有关问题
1. args 可以用来查看某个函数包含了哪些参数
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)
#> NULL2. 匹配参数— match.arg()
我们经常看见函数中有多个可选的字符串，用来做不同的模型，比如：这里的例子没有意义，但是做法值得注意。
方法一：
## 方法一：
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方法二：
## 方法二：
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")) :
#> 缺少参数"type",也没有缺省值match.arg()函数的功能是，根据输入来进行匹配, 比如，上面的式子，我们输入的type是“mean”，然后经过match.arg()以后通过switch可以直接调用该mean函数。
还可以这样操作，（方法三）
# 检查一个参数在函数内部是否已被初始化。
# 对参数进行默认值处理，当然为了更方面也可以直接在函数参数处直接赋予默认值
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()
# 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函数输入一个字符串，返回一个函数对象
# 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 只能返回函数类型
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: 0x7f949cb73610>
#> <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: 0x7f949cb73610>
#> <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: 0x7f949cb73610>
#> <environment: namespace:base>4. 以字符串作为函数名 — call()函数
call函数，可以直接通过字符串的形式调用某个函数(只要环境空间中存在)，
get("rnorm")(5,mean = 300)
#> [1] 301.3528 298.3687 300.8820 299.3037 299.4093
eval( call('rnorm',5,mean=300) ) # 执行函数调用，本质上call是创建一个函数调用，最后通过eval进行执行
#> [1] 300.2455 300.3797 299.1558 298.9484 298.8372
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(函数参数))
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')
sessionInfo()
#> R version 4.0.2 (2020-06-22)
#> Platform: x86_64-apple-darwin17.0 (64-bit)
#> Running under: macOS Mojave 10.14.5
#>
#> Matrix products: default
#> BLAS: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
#> LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
#>
#> locale:
#> [1] zh_CN.UTF-8/zh_CN.UTF-8/zh_CN.UTF-8/C/zh_CN.UTF-8/zh_CN.UTF-8
#>
#> attached base packages:
#> [1] stats graphics grDevices utils datasets methods base
#>
#> loaded via a namespace (and not attached):
#> [1] compiler_4.0.2 magrittr_1.5 bookdown_0.20 tools_4.0.2
#> [5] htmltools_0.5.0 yaml_2.2.1 stringi_1.4.6 rmarkdown_2.3
#> [9] blogdown_0.20 knitr_1.29 stringr_1.4.0 digest_0.6.25
#> [13] xfun_0.17 rlang_0.4.7 evaluate_0.14