zoukankan      html  css  js  c++  java

  • （2）apply函数及其源码


    总结：
    就是MARGIN决定了你的FUN调用几次，每次传递给你的是什么维度的内容，而...是传递给FUN的（每次调用的时候都会被传递给FUN）。apply的返回值结果可能是向量，数组（含矩阵）或列表（具体要根据条件分类讨论，但实际上我们没有必要，直接看一下返回的结果就知道是什么类型了）

    apply {base}
    Description
    Returns a vector or array or list of values obtained by applying a function to margins of an array or matrix.
    通过对数组或者矩阵的一个维度使用函数，并返回列表或者数组、向量。
    Usage
    apply(X, MARGIN, FUN, ...)
    Arguments
    X 数组，包括矩阵
    MARGIN  
    a vector giving the subscripts（下标 ）which the function will be applied over. E.g., for a matrix 1 indicates rows, 2 indicates columns, c(1, 2) indicates rows and columns. Where X has named dimnames, it can be a character vector selecting dimension names.
    1表示矩阵行，2表示矩阵列，也可以是c(1,2)（表示按行和按列,对每一个元素使用函数)
    当X通过维度指定了名字，则可以是字符向量（用于选择维度）（这里是维度名而不是行名列名）
    FUN   
    the function to be applied: see ‘Details’. In the case of functions like +, %*%, etc., the function name must be backquoted（backquote是反引用的意思） or quoted
    ...   
    optional arguments to FUN.
    Details
    If X is not an array but an object of a class with a non-null dim value (such as a data frame), apply attempts to coerce it to an array via as.matrix if it is two-dimensional (e.g., a data frame) or via as.array.
    如果X不是数组，但是一个有非空的dim属性值的类对象（如数据框），apply函数将试图使用as.matrix()（当X是二维的时候）或使用as.array()将其转化为数组
    FUN is found by a call to match.fun（这是一个函数） and typically is either a function or a symbol (e.g., a backquoted name) or a character string specifying a function to be searched for from the environment of the call to apply.
    注：match.fun(FUN, descend = TRUE)（Value（返回值）：A function matching FUN or an error is generated.）也就是返回一个function类型的与FUN匹配的函数
    FUN通常是通过调用math.fun的函数来找到的，通常是一个函数或一个符号（如一个反引用变量）或者一个字符串指定一个函数（从环境中搜索到然后调用）
    Arguments in ... cannot have the same name as any of the other arguments, and care may be needed to avoid partial matching to MARGIN or FUN. In general-purpose（通常） code it is good practice（习惯） to name the first three arguments if ... is passed through: this both avoids partial matching to MARGIN or FUN and ensures that a sensible（明显的） error message is given if arguments named X, MARGIN or FUN are passed through ....
    可变参数...中的参数不能和任何其他的参数名一样，并且要注意要避免与MARGIN或FUN部分匹配（就是名字不要和MARGIN或FUN形似咯？）给前三个传递过去的变量命名是个好习惯。
    Value
    If each call to FUN returns a vector of length n, then apply returns an array of dimension c(n, dim(X)[MARGIN]) if n > 1. If n equals 1, apply returns a vector if MARGIN has length 1 and an array of dimension dim(X)[MARGIN] otherwise（否则）. If n is 0, the result has length 0 but not necessarily the ‘correct’ dimension.
    每次调用FUN会返回一个长度为n的向量
    n>1，则apply返回一个维度为c(n,dim(X)[MARGIN])的数组
    n=1且MARGIN的长度为1（说明传入的是一个二维的矩阵），则apply返回一个向量，如果n=1，而MARGIN的长度不为1，则返回一个维度为dim(X)[MARGIN]的数组
    n=0，则返回0，但这未必是正确的维度。    
    If the calls to FUN return vectors of different lengths, apply returns a list of length prod(dim(X)[MARGIN]) with dim set to MARGIN if this has length greater than one.
    如果每次FUN返回的向量有不同的长度，则apply将返回一个长度为prod(dim(X)[MARGIN])的列表，如果其长度大于1，则将dim设置给MARGIN
    In all cases the result is coerced by as.vector to one of the basic vector types before the dimensions are set, so that (for example) factor results will be coerced to a character array.
    在被维度设定下来之前，这些结果都是被as.vector函数转换，所以因子的结果通常被转换为字符数组。
    例：
    1. test<-matrix(1:20,ncol=4)
    2.  
    3. #既然给定了列数，会自动计算行数

    5. apply(test,c(1,2),mean)

    7. #      [,1] [,2] [,3] [,4]
    8. # [1,]    1    6   11   16
    9. # [2,]    2    7   12   17
    10. # [3,]    3    8   13   18
    11. # [4,]    4    9   14   19
    12. # [5,]    5   10   15   20

    14. apply(test,1,mean)

    16. # [1]  8.5  9.5 10.5 11.5 12.5
    17. # 返回的是一个向量


    apply函数的源码（直接F2即可）
    为了方便理解源码，我们使用一个特例 
    1. x<-matrix(1:6,2)
    源码：
    1. function (X, MARGIN, FUN, ...)
    2. {
    3.   FUN <- match.fun(FUN)  #找到匹配的函数
    4.   dl <- length(dim(X))   #取到X中是几维  dl=2
    5.   if (!dl)
    6.     stop("dim(X) must have a positive length")

    8.   if (is.object(X))        #盘判断是否class属性
    9.     X <-if (dl == 2L)      #维度为2，则转化为矩阵
    10.          as.matrix(X)
    11.         else 
    12.          as.array(X)     #否则转发转化为数组

    14.   d <- dim(X)            #d是一个向量，里面存放着X的每一个维度  d=[1] 2 3
    15.   dn <- dimnames(X)      #如果没有指定维度名，则dn=NULL，一般都是NULL
    16.   ds <- seq_len(dl)      # 产生一个1到dl的向量 ds=[1] 1 2 

    18.   if (is.character(MARGIN)) {      #MARGIN是否为字符（我们没指定维度名，这个不考虑）
    19.     if (is.null(dnn <- names(dn)))
    20.       stop("'X' must have named dimnames")
    21.     MARGIN <- match(MARGIN, dnn)
    22.     if (anyNA(MARGIN))
    23.       stop("not all elements of 'MARGIN' are names of dimensions")
    24.   }

    26.   s.call <- ds[-MARGIN] #MARGIN是1或2，假设MARGIN=1   s.call=2 
    27.   s.ans <- ds[MARGIN]   #s.ans=1

    29.   d.call <- d[-MARGIN]  #d.call=3
    30.   d.ans <- d[MARGIN]    #第MARGIN个维度的位数 d.ans=2

    32.   dn.call <- dn[-MARGIN] #NULL 不考虑
    33.   dn.ans <- dn[MARGIN]   #NULL 不考虑
    34.   d2 <- prod(d.ans)      #连乘   d2=2

    36.   if (d2 == 0L) {       #我们的一般情况不会出现该维度为0
    37.     newX <- array(vector(typeof(X), 1L), dim = c(prod(d.call),
    38. 1L))
    39.     ans <- forceAndCall(1, FUN, if (length(d.call) < 2L) newX[,
    40.       1] else array(newX[, 1L], d.call, dn.call), ...)
    41.     return(if (is.null(ans)) ans else if (length(d.ans) <
    42.       2L) ans[1L][-1L] else array(ans, d.ans, dn.ans))
    43.   }

    45.   newX <- aperm(X, c(s.call, s.ans))  #c(2,1)
    46.   #理解aperm函数就知道，当X是一个矩阵的时候，其实这等价于一个转置
    47.   
    48.      [,1] [,2]
[1,]    1    2
[2,]    3    4
[3,]    5    6    

    50.   dim(newX) <- c(prod(d.call), d2)   # 3,2


    53.   ans <- vector("list", d2)  #创建一个包含两个组件的列表
    54.   [[1]]
  NULL
  [[2]]
  NULL  
    55.   

    57.   if (length(d.call) < 2L) {   #d.call=3,不成立
    58.     if (length(dn.call))
    59.       dimnames(newX) <- c(dn.call, list(NULL))
    60.     for (i in 1L:d2) {
    61.       tmp <- forceAndCall(1, FUN, newX[, i], ...)
    62.       if (!is.null(tmp))
    63.         ans[[i]] <- tmp
    64.     }
    65.   }
    66.   else for (i in 1L:d2) {      #d2=2  #执行
    67.     tmp <- forceAndCall(1, FUN, array(newX[, i], d.call,dn.call), ...)
    68.     #传给apply的要被处理的数据是在这里才被传递给FUN的
    69.    
    70.     if (!is.null(tmp))  #判断是否为空
    71.       ans[[i]] <- tmp
    72.   }
    73.  
    74.  
    75. #此时ans
    76. [[1]]
[1] 3  #newX第一列的均值

[[2]]
[1] 4 
    77.  


    80.   ans.list <- is.recursive(ans[[1L]])  #[1] FALSE

    82.   l.ans <- length(ans[[1L]])           # l.ans=1

    84.   ans.names <- names(ans[[1L]])        #ans.names=NULL

    86.   if (!ans.list)    #成立
    87.     ans.list <- any(lengths(ans) != l.ans)
    88.  
    89.   #lengths(ans) [1] 1 1  即每个组件中的元素的个数
    90.   #[1] FALSE FALSE ----> ans.list = FALSE
    91.  
    92.   if (!ans.list && length(ans.names)) { #length(ans.names)=0  所以整个是F，不成立
    93.     all.same <- vapply(ans, function(x) identical(names(x),
    94.       ans.names), NA)
    95.     if (!all(all.same))
    96.       ans.names <- NULL
    97.   }
    98.   len.a <- if (ans.list)      #不成立

    100.     d2
    101.   else length(ans <- unlist(ans, recursive = FALSE))     # len.a=2
    102.  
    103.  

    105.   if (length(MARGIN) == 1L && len.a == d2) {  #满足
    106.     names(ans) <- if (length(dn.ans[[1L]]))   #dn.ans是null
    107.                                dn.ans[[1L]]   #不会执行
    108.     ans                                       # [1] 3 4 最终整个作为返回值
    109.   }
    110.   else if (len.a == d2)
    111.     array(ans, d.ans, dn.ans)
    112.   else if (len.a && len.a%%d2 == 0L) {
    113.     if (is.null(dn.ans))
    114.       dn.ans <- vector(mode = "list", length(d.ans))
    115.     dn1 <- list(ans.names)
    116.     if (length(dn.call) && !is.null(n1 <- names(dn <- dn.call[1])) &&
    117.       nzchar(n1) && length(ans.names) == length(dn[[1]]))
    118.       names(dn1) <- n1
    119.     dn.ans <- c(dn1, dn.ans)
    120.     array(ans, c(len.a%/%d2, d.ans), if (!is.null(names(dn.ans)) ||
    121.       !all(vapply(dn.ans, is.null, NA)))
    122.       dn.ans)
    123.   }
    124.   else ans
    125. }

    补充1
    seq_len()函数是seq函数族中的一个，用法如下：
    seq_len(length.out) 
    length.out   
    desired length of the sequence. A non-negative number, which for seq and seq.int will be rounded up if fractional.（想要生成的序列的个数）
    其实就是seq_len(n)  产生n个数（从1到n）
    补充2
    aperm方法的用法详见笔记
    补充3
    补充4 
    补充5
    is.recursive returns TRUE if x has a recursive (list-like) structure（递归结构） and FALSE otherwise.



    ###################################################
    关于...参数是如何传递给FUN的
    事实上，上面的分析结合下面金的分析，我得出的结论是：
    forceAndCall将X和...传递给了FUN，事实上，我们可以将...看做一个一组不确定个数和名字的变量（或者把他当做一个记号吧~）
    1. x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
    2. dimnames(x)[[1]] <- letters[1:8]
    3. x
    4.   x1 x2
    5. a  3  4
    6. b  3  3
    7. c  3  2
    8. d  3  1
    9. e  3  2
    10. f  3  3
    11. g  3  4
    12. h  3  5
    13. apply(x, 2, mean, trim = .2)
    14. x1 x2
    15.  3  3 

    1. function (X, MARGIN, FUN, ...) 
    2. {
    3.   FUN <- match.fun(FUN)
    4.   dl <- length(dim(X))   #dl=2
    5.   if (!dl) 
    6.     stop("dim(X) must have a positive length")
    7.   if (is.object(X)) 
    8.     X <- if (dl == 2L) 
    9.       as.matrix(X)       #例子中x本就是matrix
    10.   else as.array(X)
    11.   d <- dim(X)            #d=[1] 8 2
    12.   dn <- dimnames(X)      
    13. # [[1]]
    14. # [1] "a" "b" "c" "d" "e" "f" "g" "h"
    15. # 
    16. # [[2]]
    17. # [1] "x1" "x2"
    18.   ds <- seq_len(dl)      #ds=1 2
    19.   if (is.character(MARGIN)) {      #MARGIN=2,不是字符
    20.     if (is.null(dnn <- names(dn))) 
    21.       stop("'X' must have named dimnames")
    22.     MARGIN <- match(MARGIN, dnn)
    23.     if (anyNA(MARGIN)) 
    24.       stop("not all elements of 'MARGIN' are names of dimensions")
    25.   }
    26.   s.call <- ds[-MARGIN]   #s.call=1
    27.   s.ans <- ds[MARGIN]     #s.ans=2
    28.   d.call <- d[-MARGIN]    #d.call=8
    29.   d.ans <- d[MARGIN]      #d.ans=2
    30.   dn.call <- dn[-MARGIN]
    31. # [[1]]
    32. # [1] "a" "b" "c" "d" "e" "f" "g" "h"
    34.   dn.ans <- dn[MARGIN]
    35. # [[1]]
    36. # [1] "x1" "x2"
    37.   d2 <- prod(d.ans)      #d2=2
    38.   if (d2 == 0L) {        #跳过
    39.     newX <- array(vector(typeof(X), 1L), dim = c(prod(d.call), 
    40.                                                  1L))
    41.     ans <- forceAndCall(1, FUN, if (length(d.call) < 2L) newX[, 
    42.                                                               1] else array(newX[, 1L], d.call, dn.call), ...)
    43.     return(if (is.null(ans)) ans else if (length(d.ans) < 
    44.                                           2L) ans[1L][-1L] else array(ans, d.ans, dn.ans))
    45.   }
    47.   newX <- aperm(X, c(s.call, s.ans))  #perm=c(1,2),所以相当于没变
    48. #   x1 x2
    49. # a  3  4
    50. # b  3  3
    51. # c  3  2
    52. # d  3  1
    53. # e  3  2
    54. # f  3  3
    55. # g  3  4
    56. # h  3  5
    57.   dim(newX) <- c(prod(d.call), d2)  #8,2
    58. #      [,1] [,2]
    59. # [1,]    3    4
    60. # [2,]    3    3
    61. # [3,]    3    2
    62. # [4,]    3    1
    63. # [5,]    3    2
    64. # [6,]    3    3
    65. # [7,]    3    4
    66. # [8,]    3    5
    67. #重定义了下维度就没有dimnames属性啦？
    68.   ans <- vector("list", d2)
    69. # [[1]]
    70. # NULL
    71. # 
    72. # [[2]]
    73. # NULL
    74.   if (length(d.call) < 2L) { #d.call=8
    75.     if (length(dn.call)) 
    76.       dimnames(newX) <- c(dn.call, list(NULL))
    77.     for (i in 1L:d2) {
    78.       tmp <- forceAndCall(1, FUN, newX[, i], ...)
    79.       if (!is.null(tmp)) 
    80.         ans[[i]] <- tmp
    81.     }
    82.   }
    83.   else for (i in 1L:d2) {    #执行
    84.     tmp <- forceAndCall(1, FUN, array(newX[, i], d.call, 
    85.                                       dn.call), ...)

    87. #我经过反复的测试，得到trim = .2这个参数其实是传递给了...

    89. #只不过这里不巧的是mean(newX)和mean(newX,.2)的结果都是3
    90.     if (!is.null(tmp)) 
    91.       ans[[i]] <- tmp
    92.   }
    93.   ans.list <- is.recursive(ans[[1L]])
    94.   l.ans <- length(ans[[1L]])
    95.   ans.names <- names(ans[[1L]])
    96.   if (!ans.list) 
    97.     ans.list <- any(lengths(ans) != l.ans)
    98.   if (!ans.list && length(ans.names)) {
    99.     all.same <- vapply(ans, function(x) identical(names(x), 
    100.                                                   ans.names), NA)
    101.     if (!all(all.same)) 
    102.       ans.names <- NULL
    103.   }
    104.   len.a <- if (ans.list) 
    105.     d2
    106.   else length(ans <- unlist(ans, recursive = FALSE))
    107.   if (length(MARGIN) == 1L && len.a == d2) {
    108.     names(ans) <- if (length(dn.ans[[1L]])) 
    109.       dn.ans[[1L]]
    110.     ans
    111.   }
    112.   else if (len.a == d2) 
    113.     array(ans, d.ans, dn.ans)
    114.   else if (len.a && len.a%%d2 == 0L) {
    115.     if (is.null(dn.ans)) 
    116.       dn.ans <- vector(mode = "list", length(d.ans))
    117.     dn1 <- list(ans.names)
    118.     if (length(dn.call) && !is.null(n1 <- names(dn <- dn.call[1])) && 
    119.         nzchar(n1) && length(ans.names) == length(dn[[1]])) 
    120.       names(dn1) <- n1
    121.     dn.ans <- c(dn1, dn.ans)
    122.     array(ans, c(len.a%/%d2, d.ans), if (!is.null(names(dn.ans)) || 
    123.                                          !all(vapply(dn.ans, is.null, NA))) 
    124.       dn.ans)
    125.   }
    126.   else ans
    127. }

    删掉了那些执行不到的代码和一些与我们的问题无关的代码
    1. function (X, MARGIN, FUN, ...) 
    2. {
    3.   FUN <- match.fun(FUN)
    4.   dl <- length(dim(X))   #dl=2
    5.   if (!dl) 
    6.     stop("dim(X) must have a positive length")
    7.   if (is.object(X)) 
    8.     X <- if (dl == 2L) 
    9.       as.matrix(X)       #例子中x本就是matrix
    10.   else as.array(X)
    11.   d <- dim(X)            #d=[1] 8 2
    12.   dn <- dimnames(X)      
    13. # [[1]]
    14. # [1] "a" "b" "c" "d" "e" "f" "g" "h"
    15. # 
    16. # [[2]]
    17. # [1] "x1" "x2"
    18.   ds <- seq_len(dl)      #ds=1 2
    19.   s.call <- ds[-MARGIN]   #s.call=1
    20.   s.ans <- ds[MARGIN]     #s.ans=2
    21.   d.call <- d[-MARGIN]    #d.call=8
    22.   d.ans <- d[MARGIN]      #d.ans=2
    23.   dn.call <- dn[-MARGIN]
    24. # [[1]]
    25. # [1] "a" "b" "c" "d" "e" "f" "g" "h"
    27.   dn.ans <- dn[MARGIN]
    28. # [[1]]
    29. # [1] "x1" "x2"
    30.   d2 <- prod(d.ans)      #d2=2
    31.   newX <- aperm(X, c(s.call, s.ans))  #perm=c(1,2),所以相当于没变
    32. #   x1 x2
    33. # a  3  4
    34. # b  3  3
    35. # c  3  2
    36. # d  3  1
    37. # e  3  2
    38. # f  3  3
    39. # g  3  4
    40. # h  3  5
    41.   dim(newX) <- c(prod(d.call), d2)  #8,2
    42. #      [,1] [,2]
    43. # [1,]    3    4
    44. # [2,]    3    3
    45. # [3,]    3    2
    46. # [4,]    3    1
    47. # [5,]    3    2
    48. # [6,]    3    3
    49. # [7,]    3    4
    50. # [8,]    3    5
    51. #重定义了下维度就没有dimnames属性啦？
    52.   ans <- vector("list", d2)
    53. # [[1]]
    54. # NULL
    55. # 
    56. # [[2]]
    57. # NULL
    58.   if (length(d.call) < 2L) { #d.call=8
    59.     if (length(dn.call)) 
    60.       dimnames(newX) <- c(dn.call, list(NULL))
    61.     for (i in 1L:d2) {
    62.       tmp <- forceAndCall(1, FUN, newX[, i], ...)
    63.       if (!is.null(tmp)) 
    64.         ans[[i]] <- tmp
    65.     }
    66.   }
    67.   else for (i in 1L:d2) {    #执行
    68.     tmp <- forceAndCall(1, FUN, array(newX[, i], d.call, 
    69.                                       dn.call), ...)


    72. #我经过反复的测试，得到trim = .2这个参数其实是传递给了...

    74. #只不过这里不巧的是mean(newX)和mean(newX,.2)的结果都是3
    75. }


    ###############################################
    余下的例子：
    1. ## Compute row and column sums for a matrix:
    2. x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
    3. dimnames(x)[[1]] <- letters[1:8]
    4. #求列均值
    5. apply(x, 2, mean, trim = .2)
    6. #求每一列的和
    7. col.sums <- apply(x, 2, sum)
    8. # x1 x2 
    9. # 24 24 
    10. #求每一行的和
    11. row.sums <- apply(x, 1, sum)
    12. # a b c d e f g h 
    13. # 7 6 5 4 5 6 7 8
    14. rbind(cbind(x, Rtot = row.sums), Ctot = c(col.sums, sum(col.sums)))
    15. #      x1 x2 Rtot
    16. # a     3  4    7
    17. # b     3  3    6
    18. # c     3  2    5
    19. # d     3  1    4
    20. # e     3  2    5
    21. # f     3  3    6
    22. # g     3  4    7
    23. # h     3  5    8
    24. # Ctot 24 24   48
    25. > apply(x, 2, is.vector)
    26.   x1   x2
    27. TRUE TRUE 
    28. ## Sort the columns of a matrix

    30. #按列排序，排序完了列名就木有啦？
    31. apply(x, 2, sort)
    32. #      x1 x2
    33. # [1,]  3  1
    34. # [2,]  3  2
    35. # [3,]  3  2
    36. # [4,]  3  3
    37. # [5,]  3  3
    38. # [6,]  3  4
    39. # [7,]  3  4
    40. # [8,]  3  5

    为了自己探索上面的行名在排序后消失的困惑，我自己写了如下的代码测试
    1. > a<-c(2,11,7,13)
    2. > b<-c(3,5,9,2)
    3. > m<-cbind(a=a,b=b)
    4. > dimnames(m)<-list(paste(LETTERS[1:4],1:4,sep = "-"),c(letters[1:2]))
    5. > m
    6.      a b
    7. A-1  2 3
    8. B-2 11 5
    9. C-3  7 9
    10. D-4 13 2
    11. > apply(m,2,sort)
    12.       a b
    13. [1,]  2 2
    14. [2,]  7 3
    15. [3,] 11 5
    16. [4,] 13 9
    17. > apply(m,1,sort)
    18.      A-1 B-2 C-3 D-4
    19. [1,]   2   5   7   2
    20. [2,]   3  11   9  13
    所以，你会发现，这种排序可能对于矩阵还有点用，对于数据框完全没有意义，因为他把行给拆开了，本来2对应3，现在变成了2对应2，所以说，他的行名自然也就消失了，因为这个行已经不是原来的那个行，自然也不能用原来的行名了（容易误导），同样的，按行排序也是。
    注意， LETTERS是一个常量而不是函数
    查看帮助文档会发现LETTERS是在Constants下的，Constants中存放的是R中的常量。只有四个（LETTERS，letters，month.abb，month.name，pi）
    LETTERS: the 26 upper-case letters of the Roman alphabet（拉丁字母/罗马字母）;
    26个大写英文字母
    letters: the 26 lower-case letters of the Roman alphabet;
    26个小写的英文字母
    month.abb: the three-letter abbreviations for the English month names;
    三个字母缩写的12月份名
    month.name: the English names for the months of the year;
    12月份名（全名）
    pi: the ratio of the circumference of a circle to its diameter.


    例子2：
    其实我不太清楚例子2想说明什么，想说明维度名会保存么？不过我们这还少学会了如何设置维度名
    1. x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
    2. x
    3. #      x1 x2
    4. # [1,]  3  4
    5. # [2,]  3  3
    6. # [3,]  3  2
    7. # [4,]  3  1
    8. # [5,]  3  2
    9. # [6,]  3  3
    10. # [7,]  3  4
    11. # [8,]  3  5

    13. ## keeping named dimnames
    14. #给维度命名
    15. names(dimnames(x)) <- c("row", "col")
    16. #给维度命名
    17. x
    18. #      col
    19. # row   x1 x2
    20. # [1,]  3  4
    21. # [2,]  3  3
    22. # [3,]  3  2
    23. # [4,]  3  1
    24. # [5,]  3  2
    25. # [6,]  3  3
    26. # [7,]  3  4
    27. # [8,]  3  5

    29. x3 <- array(x, dim = c(dim(x),3),

    31.             dimnames = c(dimnames(x), 
    32.             list(C = paste0("cop.",1:3))))
    33.  
    34. x3
    35. # , , C = cop.1
    36. # 
    37. #       col
    38. # row   x1 x2
    39. # [1,]  3  4
    40. # [2,]  3  3
    41. # [3,]  3  2
    42. # [4,]  3  1
    43. # [5,]  3  2
    44. # [6,]  3  3
    45. # [7,]  3  4
    46. # [8,]  3  5
    47. # 
    48. # , , C = cop.2
    49. # 
    50. #       col
    51. # row   x1 x2
    52. # [1,]  3  4
    53. # [2,]  3  3
    54. # [3,]  3  2
    55. # [4,]  3  1
    56. # [5,]  3  2
    57. # [6,]  3  3
    58. # [7,]  3  4
    59. # [8,]  3  5
    60. # 
    61. # , , C = cop.3
    62. # 
    63. #       col
    64. # row   x1 x2
    65. # [1,]  3  4
    66. # [2,]  3  3
    67. # [3,]  3  2
    68. # [4,]  3  1
    69. # [5,]  3  2
    70. # [6,]  3  3
    71. # [7,]  3  4
    72. # [8,]  3  5

    74. identical(x,  apply( x,  2,  identity))
    75. # [1] TRUE
    76. identical(x3, apply(x3, 2:3, identity))
    77. # [1] TRUE

    79. > apply( x,  2,  identity)
    80.       col
    81. row    x1 x2
    82.   [1,]  3  4
    83.   [2,]  3  3
    84.   [3,]  3  2
    85.   [4,]  3  1
    86.   [5,]  3  2
    87.   [6,]  3  3
    88.   [7,]  3  4
    89.   [8,]  3  5
    90. > apply(x3, 2:3, identity)  #对数组的列和层引用identity函数
    91. , , C = cop.1
    93.       col
    94. row    x1 x2
    95.   [1,]  3  4
    96.   [2,]  3  3
    97.   [3,]  3  2
    98.   [4,]  3  1
    99.   [5,]  3  2
    100.   [6,]  3  3
    101.   [7,]  3  4
    102.   [8,]  3  5
    104. , , C = cop.2
    106.       col
    107. row    x1 x2
    108.   [1,]  3  4
    109.   [2,]  3  3
    110.   [3,]  3  2
    111.   [4,]  3  1
    112.   [5,]  3  2
    113.   [6,]  3  3
    114.   [7,]  3  4
    115.   [8,]  3  5    ###下面这段输出结果第一次忘了插入了
      1. , , C = cop.3
      3.       col
      4. row    x1 x2
      5.   [1,]  3  4
      6.   [2,]  3  3
      7.   [3,]  3  2
      8.   [4,]  3  1
      9.   [5,]  3  2
      10.   [6,]  3  3
      11.   [7,]  3  4
      12.   [8,]  3  5

    这里我比较奇怪的是，为什么输出的都是TRUE（先用了identity再用identical函数判断，当然是TRUE了）
    查看了identity的说明：
    A trivial（琐碎的微小的） identity（识别） function returning its argument.
    这什么鬼？还不带例子
    identical的描述是：
    The safe and reliable way to test two objects for being exactly equal. It returns TRUE in this case, FALSE in every other case.
    安全而可靠的测试两个变量是否完全相同。

    例子3：
    1. x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
    2. > x
    3.      x1 x2
    4. [1,]  3  4
    5. [2,]  3  3
    6. [3,]  3  2
    7. [4,]  3  1
    8. [5,]  3  2
    9. [6,]  3  3
    10. [7,]  3  4
    11. [8,]  3  5

    13. cave <- function(x, c1, c2) {
    14.   c(mean(x[c1]), mean(x[c2]))
    15. }
    16. apply(x, 1, cave,  c1 = "x1", c2 = c("x1","x2"))

    18.       [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
    19. [1,]  3.0    3  3.0    3  3.0    3  3.0    3
    20. [2,]  3.5    3  2.5    2  2.5    3  3.5    4
    1. > class(apply(x, 1, cave,  c1 = "x1", c2 = c("x1","x2")))

    3. [1] "matrix"

    我通过下面的例子，来说明MARGIN=1和x以及c1和c2的传递方式
    1. x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
    2. ##- function with extra args:
    3. cave <- function(x, c1, c2) {
    4.   print("##q##")
    5.   print(x)
    6.   print("==b==")
    7.   c(mean(x[c1]), mean(x[c2]))
    8. }

    10. apply(x, 1, cave,  c1 = "x1", c2 = c("x1","x2"))
    11. [1] "##q##"
    12. x1 x2 
    13.  3  4 
    14. [1] "==b=="
    15. [1] "##q##"
    16. x1 x2 
    17.  3  3 
    18. [1] "==b=="
    19. [1] "##q##"
    20. x1 x2 
    21.  3  2 
    22. [1] "==b=="
    23. [1] "##q##"
    24. x1 x2 
    25.  3  1 
    26. [1] "==b=="
    27. [1] "##q##"
    28. x1 x2 
    29.  3  2 
    30. [1] "==b=="
    31. [1] "##q##"
    32. x1 x2 
    33.  3  3 
    34. [1] "==b=="
    35. [1] "##q##"
    36. x1 x2 
    37.  3  4 
    38. [1] "==b=="
    39. [1] "##q##"
    40. x1 x2 
    41.  3  5 
    42. [1] "==b=="
    43.      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
    44. [1,]  3.0    3  3.0    3  3.0    3  3.0    3
    45. [2,]  3.5    3  2.5    2  2.5    3  3.5    4
    我们发现，其实MARGIN并不是传递给FUN的（当然我们查看源码也知道了），
    我们发现，FUN被调用了8次（这个次数就是行数），而我们每次都传递了一行数据进去。
    结合上面的源码，我们发现，apply接受MARGIN函数后，会通过一些列的转化，最终决定FUN被调用几次，每次传递哪个维度的数据给FUN，最后才是在apply中重新组合为一个合适的向量/数组（数组包含矩阵），而...才是每次真正的传递给FUN的参数。

    例子4
    1. > ma <- matrix(c(1:4, 1, 6:8), nrow = 2)
    2. > ma
    3.      [,1] [,2] [,3] [,4]
    4. [1,]    1    3    1    7
    5. [2,]    2    4    6    8

    7. > apply(ma, 1, table)  #--> a list of length 2
    8. [[1]]
    10. 1 3 7 
    11. 2 1 1 
    13. [[2]]
    15. 2 4 6 8 
    16. 1 1 1 1 
    17.  
    18.  
    19.  
    20.  
    22. > apply(ma, 1, stats::quantile) # 5 x n matrix with rownames
    23.      [,1] [,2]
    24. 0%      1  2.0
    25. 25%     1  3.5
    26. 50%     2  5.0
    27. 75%     4  6.5
    28. 100%    7  8.0
    29.  
    30.  
    31.  
    32.  
    33. > dim(ma) == dim(apply(ma, 1:2, sum))   #判断是否相等 
    34. [1] TRUE TRUE
    35.  
    36. > ma
    37.      [,1] [,2] [,3] [,4]
    38. [1,]    1    3    1    7
    39. [2,]    2    4    6    8
    apply(ma, 1:2, sum)其实1:2的意思相当于每次把一个元素传给sum了，我们可以自己编写个函数试验下是否是真的传递了8次。








    苍茫大海，旅鼠它来！
  • 相关阅读:
    [转]资本经营董事长班告诉你：不只企业有商业模式，个人商业价值更重要
    [转]把人当成一个公司来经营，心就不会那么累
    [转]东方财智商学院告诉你如何写成功的商业计划书，按这23点来就好了
    [转]《穷爸爸富爸爸》作者破产了，他捧红了“财务自由”
    [转]人人店短信插件开发
    [转]简单的动态修改RDLC报表页边距和列宽的方法
    [转]程序员应打破牢笼，展望更高层次的世界
    jQuery validate and groups
    [转]C#利用反射实现两个类的对象之间相同属性的值的复制
    [转]ui-grid User can't select the row by clicking the select checkbox available in the respective row when enableFullRowSelection : true"
  • 原文地址：https://www.cnblogs.com/xuanlvshu/p/5297603.html
Copyright © 2011-2022 走看看