R语言中创建函数参数的问题
欢迎来到医科研，这里是白介素2的读书笔记，跟我一起聊临床与科研的故事, 生物医学数据挖掘，R语言，TCGA、GEO数据挖掘。
Sys.setlocale('LC_ALL','C')
## [1] "C"
R语言中创建函数参数的问题
R可以很方便的指定任意长度的参数列表(…)可以表示将额外的参数传递给另外的一个函数 - 再有就是可以表示参数可变
举例说明：
该计算会将 … 额外的参数传给我们指定的函数计算
a=1
b=seq(1:20)
f<-function(x,...){
print(x)
mean(...)
}
##
f(a,b)
## [1] 1
## [1] 10.5
从可变参数列表中得到所有参数
需要在函数内部将对象…转换成列表
举例说明：
我们编写一个将所有参数相乘的函数 用…来获取所有参数 输入参数 1,2,3
multip<-function(x,...){
args<-list(...)##获取所有参数
for(a in args) x<-x*a ##for循环以名称循环
x
}
multip(1,2,3)
## [1] 6
函数参数
函数可以作为参数被调用 实例说明，对a向量加1这个需求完全可以通过 a+1实现 这里通过sapply这个迭代器来完成，它的优势是能够调用函数作为参数来对每个元素处理
a<-1:10
sapply(a,function(x){
x<-x+1
x
})
## [1] 2 3 4 5 6 7 8 9 10 11
args函数用来查看函数有哪些参数
args(paste)
## function (..., sep = " ", collapse = NULL)
## NULL
# 例如我们熟悉的paste函数
args(apply)
## function (X, MARGIN, FUN, ...)
## NULL
formals函数对函数的参数列表操作，返回一个配对列表 alist函数可以用于方便的构建参数列表
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修改参数列表
formals(f)<-alist(x=,y=2)
f
## function (x, y = 2)
## {
## x + y + 1
## }
body函数返回函数的函数体
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
## }
END