（2）apply函数及其源码

时间：2022-06-26 22:48:32
  本文原创，转载请注明出处，本人Q1273314690（交流学习）
总结：
就是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.  
  4. apply(test,c(1,2),mean)
  5.  
  6. # [,1] [,2] [,3] [,4]
  7. # [1,] 1 6 11 16
  8. # [2,] 2 7 12 17
  9. # [3,] 3 8 13 18
  10. # [4,] 4 9 14 19
  11. # [5,] 5 10 15 20
  12.  
  13. apply(test,1,mean)
  14.  
  15. # [1] 8.5 9.5 10.5 11.5 12.5
  16. # 返回的是一个向量
 
 
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")
  7.  
  8.   if(is.object(X)) #盘判断是否class属性
  9.     X <-if(dl ==2L) #维度为2，则转化为矩阵
  10.       as.matrix(X)
  11.     else 
  12. as.array(X) #否则转发转化为数组
  13.  
  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
  17.  
  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.   }
  25.  
  26.   s.call <- ds[-MARGIN] #MARGIN是1或2，假设MARGIN=1 s.call=2
  27.   s.ans <- ds[MARGIN] #s.ans=1
  28.  
  29.   d.call <- d[-MARGIN] #d.call=3
  30.   d.ans <- d[MARGIN] #第MARGIN个维度的位数 d.ans=2
  31.  
  32.   dn.call <- dn[-MARGIN] #NULL 不考虑
  33.   dn.ans <- dn[MARGIN] #NULL 不考虑
  34.   d2 <- prod(d.ans) #连乘 d2=2
  35.  
  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 elseif(length(d.ans)<
  42.       2L) ans[1L][-1L]else array(ans, d.ans, dn.ans))
  43.   }
  44.  
  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
  49.  
  50.   dim(newX)<- c(prod(d.call), d2) # 3,2
  51.  
  52.  
  53.   ans <-vector("list", d2) #创建一个包含两个组件的列表
  54. [[1]] NULL [[2]] NULL
  55.  
  56.   if(length(d.call)<2L){ #d.call=3,不成立
  57.     if(length(dn.call))
  58.       dimnames(newX)<- c(dn.call,list(NULL))
  59.     for(i in 1L:d2){
  60.       tmp <- forceAndCall(1, FUN, newX[, i],...)
  61.       if(!is.null(tmp))
  62.         ans[[i]]<- tmp
  63.     }
  64.   }
  65.   elsefor(i in 1L:d2){ #d2=2 #执行
  66.     tmp <- forceAndCall(1, FUN, array(newX[, i], d.call,dn.call),...)
  67. #传给apply的要被处理的数据是在这里才被传递给FUN的
  68.     if(!is.null(tmp)) #判断是否为空
  69.       ans[[i]]<- tmp
  70.   }
  71. #此时ans
  72. [[1]] [1] 3 #newX第一列的均值 [[2]] [1] 4
  73.  
  74.   ans.list<- is.recursive(ans[[1L]]) #[1] FALSE
  75.  
  76.   l.ans <- length(ans[[1L]]) # l.ans=1
  77.  
  78.   ans.names <- names(ans[[1L]]) #ans.names=NULL
  79.  
  80.   if(!ans.list) #成立
  81.     ans.list<- any(lengths(ans)!= l.ans)
  82. #lengths(ans) [1] 1 1 即每个组件中的元素的个数
  83. #[1] FALSE FALSE ----> ans.list = FALSE
  84.   if(!ans.list&& length(ans.names)){ #length(ans.names)=0 所以整个是F，不成立
  85.     all.same <- vapply(ans, function(x) identical(names(x),
  86.       ans.names), NA)
  87.     if(!all(all.same))
  88.       ans.names <- NULL
  89.   }
  90.   len.a <-if(ans.list) #不成立
  91.  
  92.     d2
  93.   else length(ans <- unlist(ans, recursive = FALSE)) # len.a=2
  94.  
  95.   if(length(MARGIN)==1L&& len.a == d2){ #满足
  96.     names(ans)<-if(length(dn.ans[[1L]])) #dn.ans是null
  97.       dn.ans[[1L]] #不会执行
  98.     ans # [1] 3 4 最终整个作为返回值
  99.   }
  100.   elseif(len.a == d2)
  101.     array(ans, d.ans, dn.ans)
  102.   elseif(len.a && len.a%%d2 ==0L){
  103.     if(is.null(dn.ans))
  104.       dn.ans <-vector(mode ="list", length(d.ans))
  105.     dn1 <-list(ans.names)
  106.     if(length(dn.call)&&!is.null(n1 <- names(dn <- dn.call[1]))&&
  107.       nzchar(n1)&& length(ans.names)== length(dn[[1]]))
  108.       names(dn1)<- n1
  109.     dn.ans <- c(dn1, dn.ans)
  110.     array(ans, c(len.a%/%d2, d.ans),if(!is.null(names(dn.ans))||
  111.       !all(vapply(dn.ans, is.null, NA)))
  112.       dn.ans)
  113.   }
  114.   else ans
  115. }
 
补充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"
  33.   dn.ans <- dn[MARGIN]
  34. # [[1]]
  35. # [1] "x1" "x2"
  36.   d2 <- prod(d.ans)      #d2=2
  37.   if(d2 ==0L){        #跳过
  38.     newX <- array(vector(typeof(X),1L), dim = c(prod(d.call), 
  39.                                                  1L))
  40.     ans <- forceAndCall(1, FUN,if(length(d.call)<2L) newX[, 
  41.                                                               1]else array(newX[,1L], d.call, dn.call),...)
  42.     return(if(is.null(ans)) ans elseif(length(d.ans)< 
  43.                                           2L) ans[1L][-1L]else array(ans, d.ans, dn.ans))
  44.   }
  45.   newX <- aperm(X, c(s.call, s.ans))  #perm=c(1,2),所以相当于没变
  46. #   x1 x2
  47. # a  3  4
  48. # b  3  3
  49. # c  3  2
  50. # d  3  1
  51. # e  3  2
  52. # f  3  3
  53. # g  3  4
  54. # h  3  5
  55.   dim(newX)<- c(prod(d.call), d2)  #8,2
  56. #      [,1] [,2]
  57. # [1,]    3    4
  58. # [2,]    3    3
  59. # [3,]    3    2
  60. # [4,]    3    1
  61. # [5,]    3    2
  62. # [6,]    3    3
  63. # [7,]    3    4
  64. # [8,]    3    5
  65. #重定义了下维度就没有dimnames属性啦？
  66.   ans <-vector("list", d2)
  67. # [[1]]
  68. # NULL
  69. # 
  70. # [[2]]
  71. # NULL
  72.   if(length(d.call)<2L){#d.call=8
  73.     if(length(dn.call)) 
  74.       dimnames(newX)<- c(dn.call,list(NULL))
  75.     for(i in 1L:d2){
  76.       tmp <- forceAndCall(1, FUN, newX[, i],...)
  77.       if(!is.null(tmp)) 
  78.         ans[[i]]<- tmp
  79.     }
  80.   }
  81.   elsefor(i in 1L:d2){    #执行
  82.     tmp <- forceAndCall(1, FUN, array(newX[, i], d.call, 
  83.                                       dn.call),...)
  84.  
  85. #我经过反复的测试，得到trim = .2这个参数其实是传递给了...
  86.  
  87. #只不过这里不巧的是mean(newX)和mean(newX,.2)的结果都是3
  88.     if(!is.null(tmp)) 
  89.       ans[[i]]<- tmp
  90.   }
  91.   ans.list<- is.recursive(ans[[1L]])
  92.   l.ans <- length(ans[[1L]])
  93.   ans.names <- names(ans[[1L]])
  94.   if(!ans.list) 
  95.     ans.list<- any(lengths(ans)!= l.ans)
  96.   if(!ans.list&& length(ans.names)){
  97.     all.same <- vapply(ans, function(x) identical(names(x), 
  98.                                                   ans.names), NA)
  99.     if(!all(all.same)) 
  100.       ans.names <- NULL
  101.   }
  102.   len.a <-if(ans.list) 
  103.     d2
  104.   else length(ans <- unlist(ans, recursive = FALSE))
  105.   if(length(MARGIN)==1L&& len.a == d2){
  106.     names(ans)<-if(length(dn.ans[[1L]])) 
  107.       dn.ans[[1L]]
  108.     ans
  109.   }
  110.   elseif(len.a == d2) 
  111.     array(ans, d.ans, dn.ans)
  112.   elseif(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. 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"
  26.   dn.ans <- dn[MARGIN]
  27. # [[1]]
  28. # [1] "x1" "x2"
  29.   d2 <- prod(d.ans)      #d2=2
  30.   newX <- aperm(X, c(s.call, s.ans))  #perm=c(1,2),所以相当于没变
  31. #   x1 x2
  32. # a  3  4
  33. # b  3  3
  34. # c  3  2
  35. # d  3  1
  36. # e  3  2
  37. # f  3  3
  38. # g  3  4
  39. # h  3  5
  40.   dim(newX)<- c(prod(d.call), d2)  #8,2
  41. #      [,1] [,2]
  42. # [1,]    3    4
  43. # [2,]    3    3
  44. # [3,]    3    2
  45. # [4,]    3    1
  46. # [5,]    3    2
  47. # [6,]    3    3
  48. # [7,]    3    4
  49. # [8,]    3    5
  50. #重定义了下维度就没有dimnames属性啦？
  51.   ans <-vector("list", d2)
  52. # [[1]]
  53. # NULL
  54. # 
  55. # [[2]]
  56. # NULL
  57.   if(length(d.call)<2L){#d.call=8
  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.   elsefor(i in 1L:d2){    #执行
  67.     tmp <- forceAndCall(1, FUN, array(newX[, i], d.call, 
  68.                                       dn.call),...)
  69.  
  70.  
  71. #我经过反复的测试，得到trim = .2这个参数其实是传递给了...
  72.  
  73. #只不过这里不巧的是mean(newX)和mean(newX,.2)的结果都是3
  74. }
 
 
###############################################
余下的例子：
  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
  29.  
  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  23
  8. B-2115
  9. C-3  79
  10. D-4132
  11. > apply(m,2,sort)
  12.       a b
  13. [1,]  22
  14. [2,]  73
  15. [3,]115
  16. [4,]139
  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
  12.  
  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
  28.  
  29. x3 <- array(x, dim = c(dim(x),3),
  30.  
  31.             dimnames = c(dimnames(x), 
  32.             list(C = paste0("cop.",1:3))))
  33. x3
  34. # , , C = cop.1
  35. # 
  36. #       col
  37. # row   x1 x2
  38. # [1,]  3  4
  39. # [2,]  3  3
  40. # [3,]  3  2
  41. # [4,]  3  1
  42. # [5,]  3  2
  43. # [6,]  3  3
  44. # [7,]  3  4
  45. # [8,]  3  5
  46. # 
  47. # , , C = cop.2
  48. # 
  49. #       col
  50. # row   x1 x2
  51. # [1,]  3  4
  52. # [2,]  3  3
  53. # [3,]  3  2
  54. # [4,]  3  1
  55. # [5,]  3  2
  56. # [6,]  3  3
  57. # [7,]  3  4
  58. # [8,]  3  5
  59. # 
  60. # , , C = cop.3
  61. # 
  62. #       col
  63. # row   x1 x2
  64. # [1,]  3  4
  65. # [2,]  3  3
  66. # [3,]  3  2
  67. # [4,]  3  1
  68. # [5,]  3  2
  69. # [6,]  3  3
  70. # [7,]  3  4
  71. # [8,]  3  5
  72. identical(x,  apply( x,  2,  identity))
  73. # [1] TRUE
  74. identical(x3, apply(x3,2:3, identity))
  75. # [1] TRUE
  76.  
  77. > apply( x,  2,  identity)
  78.       col
  79. row    x1 x2
  80.   [1,]  3  4
  81.   [2,]  3  3
  82.   [3,]  3  2
  83.   [4,]  3  1
  84.   [5,]  3  2
  85.   [6,]  3  3
  86.   [7,]  3  4
  87.   [8,]  3  5
  88. > apply(x3,2:3, identity) #对数组的列和层引用identity函数
  89. ,, C = cop.1
  90.       col
  91. row    x1 x2
  92.   [1,]  3  4
  93.   [2,]  3  3
  94.   [3,]  3  2
  95.   [4,]  3  1
  96.   [5,]  3  2
  97.   [6,]  3  3
  98.   [7,]  3  4
  99.   [8,]  3  5
  100. ,, C = cop.2
  101.       col
  102. row    x1 x2
  103.   [1,]  3  4
  104.   [2,]  3  3
  105.   [3,]  3  2
  106.   [4,]  3  1
  107.   [5,]  3  2
  108.   [6,]  3  3
  109.   [7,]  3  4
  110.   [8,]  3  5 ###下面这段输出结果第一次忘了插入了
    1. ,, C = cop.3
    2. col
    3. row x1 x2
    4. [1,]34
    5. [2,]33
    6. [3,]32
    7. [4,]31
    8. [5,]32
    9. [6,]33
    10. [7,]34
    11. [8,]35
     
这里我比较奇怪的是，为什么输出的都是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
  12.  
  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"))
  17.  
  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")))
  2.  
  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. }
  9.  
  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,]1317
  5. [2,]2468
  6.  
  7. > apply(ma,1, table)#--> a list of length 2
  8. [[1]]
  9. 137
  10. 211
  11. [[2]]
  12. 2468
  13. 1111
  14. > apply(ma,1, stats::quantile)# 5 x n matrix with rownames
  15. [,1][,2]
  16. 0%12.0
  17. 25%13.5
  18. 50%25.0
  19. 75%46.5
  20. 100%78.0
  21. > dim(ma)== dim(apply(ma,1:2, sum)) #判断是否相等
  22. [1] TRUE TRUE
  23. > ma
  24. [,1][,2][,3][,4]
  25. [1,]1317
  26. [2,]2468
apply(ma, 1:2, sum)其实1:2的意思相当于每次把一个元素传给sum了，我们可以自己编写个函数试验下是否是真的传递了8次。
 
 
 
 

（2）apply函数及其源码的更多相关文章

  1. Generator函数执行器-co函数库源码解析

    一.co函数是什么 co 函数库是著名程序员 TJ Holowaychuk 于2013年6月发布的一个小工具,用于 Generator 函数的自动执行.短小精悍只有短短200余行,就可以免去手动编写G ...

  2. 7z文件格式及其源码linux&sol;windows编译

    7z文件格式及其源码的分析(二) 一. 准备工作: 1. 源码下载: 可以从官方中文主页下载:http://sparanoid.com/lab/7z/． 为了方便, 这里直接给出下载链接: http: ...

  3. Javascript中call、apply函数浅析

    call/apply函数作用其实就是改变this的取值,有一句话是:谁调用的这个方法那方法里的this就是指谁,而有时我们会需要改变this值,所以call/apply就能派上用场. 下面我写个方法来 ...

  4. JavaScript中bind、call、apply函数使用方法具体解释

    在给我们项目组的其它程序介绍 js 的时候,我准备了非常多的内容,但看起来效果不大,果然光讲还是不行的,必须动手. 前几天有人问我关于代码里 call() 函数的使用方法.我让他去看书,这里推荐用js ...

  5. 详解CopyOnWrite容器及其源码

    详解CopyOnWrite容器及其源码 在jave.util.concurrent包下有这样两个类:CopyOnWriteArrayList和CopyOnWriteArraySet.其中利用到了Cop ...

  6. js中bind、call、apply函数的用法

    最近一直在用 js 写游戏服务器,我也接触 js 时间不长,大学的时候用 js 做过一个 H3C 的 web的项目,然后在腾讯实习的时候用 js 写过一些奇怪的程序,自己也用 js 写过几个的网站.但 ...

  7. 关于call和apply函数的区别及用法

    call和apply函数是function函数的基本属性,都可以用于更改函数对象和传递参数,是前端工程师常用的函数.具体使用方法请参考以下案列: 例如: 申明函数: var fn = function ...

  8. Javascript中bind、call、apply函数用法

    js 里函数调用有 4 种模式:方法调用.正常函数调用.构造器函数调用.apply/call 调用. 同时,无论哪种函数调用除了你声明时定义的形参外,还会自动添加 2 个形参,分别是 this 和ar ...

  9. Javascript中call函数和apply函数的使用

    Javascript 中call函数和apply的使用: Javascript中的call函数和apply函数是对执行上下文进行切换,是将一个函数从当前执行的上下文切换到另一个对象中执行,例如: so ...

随机推荐

  1. Resource governor2：Configuration query

    SQL Server Engine 当前使用的configuration,称作 In-memory configuration,使用DMV:sys.dm_resource_governor_XXX查看 ...

  2. &lbrack;Java 实现AES加密解密&rsqb;

    今天同学请教我这个问题,被坑了次…… 实现的功能是2个Java类:一个读取源文件生成加密文件,另一个类读取加密文件来解密. 整个过程其实很简单,java有AES的工具包,设好秘钥,设好输入内容,就得到 ...

  3. Leetcode 65 Valid Number 字符串处理

    由于老是更新简单题,我已经醉了,所以今天直接上一道通过率最低的题. 题意:判断字符串是否是一个合法的数字 定义有符号的数字是(n),无符号的数字是(un),有符号的兼容无符号的 合法的数字只有下列几种 ...

  4. ArcGis 获取地理、平面坐标系

                                         ESRI.ArcGIS.Geometry.ISpatialReference spatialReference = spati ...

  5. 使用SMSManager短信管理器发送短信

    import android.os.Bundle;import android.app.Activity;import android.app.PendingIntent;import android ...

  6. c&num; 任意多个数，求最大值

    c#  任意多个数,求最大值 使用parms: 正在研究中,如果有好的方案,可评论,共同进步,共同提高,谢谢!

  7. Android源代码之Gallery专题研究（1）

    前言 时光飞逝,从事Android系统开发已经两年了,总想写点什么来安慰自己.思考了非常久总是无法下笔,认为没什么好写的.如今最终决定写一些符合大多数人需求的东西,想必使用过Android手机的人们一 ...

  8. 实用的透明背景mark图标

  9. win10下安装通过Hyper-v安装Ubuntu

    一直也来在做C#的开发,Winform及Web都有所涉及,想在闲暇之余学习下Python,拓展一下自己的知识.既然决定学习Python那么就直接在Linux下进行吧,由于Ubuntu最近很火而且也有方 ...

  10. html5中cookie介绍，封装以及添加，获取，删除

    cookie是储存在用户本地终端上的数据. 在我们登陆网站时有记录密码,也有时间限制比如说7天,5天等等这都是我们利用cookie来写的, 这就是利用了cookie的会话周期,但cookie同时又是不 ...

相关文章