美文网首页R语言编程进阶R
R语言中创建函数参数的问题

R语言中创建函数参数的问题

作者: 医科研 | 来源:发表于2019-06-28 14:10 被阅读5次
    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
    ## }
    

    我是白介素2,下期再见。

    转载请注明出处
    相关阅读:
    R语言简单for循环(二)
    R语言for循环批量计算相关系数(一)
    R语言-相关系数计算(一)
    R语言相关系数计算与可视化(二)
    R语言with/within函数添加数据框到环境变量

    相关文章

      网友评论

        本文标题:R语言中创建函数参数的问题

        本文链接:https://www.haomeiwen.com/subject/mibscctx.html