Sys.setlocale('LC_ALL','C')
## [1] "C"

R語言中創(chuàng)建函數(shù)參數(shù)的問題

R可以很方便的指定任意長(zhǎng)度的參數(shù)列表(…)可以表示將額外的參數(shù)傳遞給另外的一個(gè)函數(shù) - 再有就是可以表示參數(shù)可變

舉例說明

該計(jì)算會(huì)將 … 額外的參數(shù)傳給我們指定的函數(shù)計(jì)算

a=1
b=seq(1:20)
f<-function(x,...){
  print(x)
  mean(...)
}
##
f(a,b)
## [1] 1
## [1] 10.5

從可變參數(shù)列表中得到所有參數(shù)

需要在函數(shù)內(nèi)部將對(duì)象…轉(zhuǎn)換成列表

舉例說明：

我們編寫一個(gè)將所有參數(shù)相乘的函數(shù) 用…來獲取所有參數(shù) 輸入?yún)?shù) 1,2,3

multip<-function(x,...){
  args<-list(...)##獲取所有參數(shù)
  for(a in args) x<-x*a ##for循環(huán)以名稱循環(huán)
  x
}
multip(1,2,3) 
## [1] 6

函數(shù)參數(shù)

函數(shù)可以作為參數(shù)被調(diào)用 實(shí)例說明，對(duì)a向量加1這個(gè)需求完全可以通過 a+1實(shí)現(xiàn) 這里通過sapply這個(gè)迭代器來完成，它的優(yōu)勢(shì)是能夠調(diào)用函數(shù)作為參數(shù)來對(duì)每個(gè)元素處理

a<-1:10
sapply(a,function(x){
  x<-x+1
  x
})
##  [1]  2  3  4  5  6  7  8  9 10 11

args函數(shù)用來查看函數(shù)有哪些參數(shù)

args(paste)
## function (..., sep = " ", collapse = NULL) 
## NULL
# 例如我們熟悉的paste函數(shù)

args(apply)
## function (X, MARGIN, FUN, ...) 
## NULL

formals函數(shù)對(duì)函數(shù)的參數(shù)列表操作，返回一個(gè)配對(duì)列表 alist函數(shù)可以用于方便的構(gòu)建參數(shù)列表

f<-function(x,y=1){x+y+1}
f(1)
## [1] 3
formals(f)
## $x
## 
## 
## $y
## [1] 1
class(formals(f))##返回的是pairlist
## [1] "pairlist"

alist修改參數(shù)列表

formals(f)<-alist(x=,y=2)
f
## function (x, y = 2) 
## {
##     x + y + 1
## }

body函數(shù)返回函數(shù)的函數(shù)體

body(apply)
## {
##     FUN <- match.fun(FUN)
##     dl <- length(dim(X))
##     if (!dl) 
##         stop("dim(X) must have a positive length")
##     if (is.object(X)) 
##         X <- if (dl == 2L) 
##             as.matrix(X)
##         else as.array(X)
##     d <- dim(X)
##     dn <- dimnames(X)
##     ds <- seq_len(dl)
##     if (is.character(MARGIN)) {
##         if (is.null(dnn <- names(dn))) 
##             stop("'X' must have named dimnames")
##         MARGIN <- match(MARGIN, dnn)
##         if (anyNA(MARGIN)) 
##             stop("not all elements of 'MARGIN' are names of dimensions")
##     }
##     s.call <- ds[-MARGIN]
##     s.ans <- ds[MARGIN]
##     d.call <- d[-MARGIN]
##     d.ans <- d[MARGIN]
##     dn.call <- dn[-MARGIN]
##     dn.ans <- dn[MARGIN]
##     d2 <- prod(d.ans)
##     if (d2 == 0L) {
##         newX <- array(vector(typeof(X), 1L), dim = c(prod(d.call), 
##             1L))
##         ans <- forceAndCall(1, FUN, if (length(d.call) < 2L) newX[, 
##             1] else array(newX[, 1L], d.call, dn.call), ...)
##         return(if (is.null(ans)) ans else if (length(d.ans) < 
##             2L) ans[1L][-1L] else array(ans, d.ans, dn.ans))
##     }
##     newX <- aperm(X, c(s.call, s.ans))
##     dim(newX) <- c(prod(d.call), d2)
##     ans <- vector("list", d2)
##     if (length(d.call) < 2L) {
##         if (length(dn.call)) 
##             dimnames(newX) <- c(dn.call, list(NULL))
##         for (i in 1L:d2) {
##             tmp <- forceAndCall(1, FUN, newX[, i], ...)
##             if (!is.null(tmp)) 
##                 ans[[i]] <- tmp
##         }
##     }
##     else for (i in 1L:d2) {
##         tmp <- forceAndCall(1, FUN, array(newX[, i], d.call, 
##             dn.call), ...)
##         if (!is.null(tmp)) 
##             ans[[i]] <- tmp
##     }
##     ans.list <- is.recursive(ans[[1L]])
##     l.ans <- length(ans[[1L]])
##     ans.names <- names(ans[[1L]])
##     if (!ans.list) 
##         ans.list <- any(lengths(ans) != l.ans)
##     if (!ans.list && length(ans.names)) {
##         all.same <- vapply(ans, function(x) identical(names(x), 
##             ans.names), NA)
##         if (!all(all.same)) 
##             ans.names <- NULL
##     }
##     len.a <- if (ans.list) 
##         d2
##     else length(ans <- unlist(ans, recursive = FALSE))
##     if (length(MARGIN) == 1L && len.a == d2) {
##         names(ans) <- if (length(dn.ans[[1L]])) 
##             dn.ans[[1L]]
##         ans
##     }
##     else if (len.a == d2) 
##         array(ans, d.ans, dn.ans)
##     else if (len.a && len.a%%d2 == 0L) {
##         if (is.null(dn.ans)) 
##             dn.ans <- vector(mode = "list", length(d.ans))
##         dn1 <- list(ans.names)
##         if (length(dn.call) && !is.null(n1 <- names(dn <- dn.call[1])) && 
##             nzchar(n1) && length(ans.names) == length(dn[[1]])) 
##             names(dn1) <- n1
##         dn.ans <- c(dn1, dn.ans)
##         array(ans, c(len.a%/%d2, d.ans), if (!is.null(names(dn.ans)) || 
##             !all(vapply(dn.ans, is.null, NA))) 
##             dn.ans)
##     }
##     else ans
## }
body(mean)
## UseMethod("mean")
body(colMeans)
## {
##     if (is.data.frame(x)) 
##         x <- as.matrix(x)
##     if (!is.array(x) || length(dn <- dim(x)) < 2L) 
##         stop("'x' must be an array of at least two dimensions")
##     if (dims < 1L || dims > length(dn) - 1L) 
##         stop("invalid 'dims'")
##     n <- prod(dn[id <- seq_len(dims)])
##     dn <- dn[-id]
##     z <- if (is.complex(x)) 
##         .Internal(colMeans(Re(x), n, prod(dn), na.rm)) + (0+1i) * 
##             .Internal(colMeans(Im(x), n, prod(dn), na.rm))
##     else .Internal(colMeans(x, n, prod(dn), na.rm))
##     if (length(dn) > 1L) {
##         dim(z) <- dn
##         dimnames(z) <- dimnames(x)[-id]
##     }
##     else names(z) <- dimnames(x)[[dims + 1L]]
##     z
## }

我是白介素2，下期再見。

轉(zhuǎn)載請(qǐng)注明出處
相關(guān)閱讀:
R語言簡(jiǎn)單for循環(huán)(二)
R語言for循環(huán)批量計(jì)算相關(guān)系數(shù)(一)
R語言-相關(guān)系數(shù)計(jì)算(一)
R語言相關(guān)系數(shù)計(jì)算與可視化（二）
R語言with/within函數(shù)添加數(shù)據(jù)框到環(huán)境變量