(2)apply函数及其源码
test<-matrix(1:20,ncol=4)
#既然给定了列数,会自动计算行数
apply(test,c(1,2),mean)
# [,1] [,2] [,3] [,4]
# [1,] 1 6 11 16
# [2,] 2 7 12 17
# [3,] 3 8 13 18
# [4,] 4 9 14 19
# [5,] 5 10 15 20
apply(test,1,mean)
# [1] 8.5 9.5 10.5 11.5 12.5
# 返回的是一个向量
x<-matrix(1:6,2)
function (X, MARGIN, FUN,...)
{
FUN <- match.fun(FUN) #找到匹配的函数
dl <- length(dim(X)) #取到X中是几维 dl=2
if(!dl)
stop("dim(X) must have a positive length")
if(is.object(X)) #盘判断是否class属性
X <-
if(dl ==2L) #维度为2,则转化为矩阵as.matrix(X)
else
as.array(X) #否则转发转化为数组
d <- dim(X) #d是一个向量,里面存放着X的每一个维度 d=[1] 2 3
dn <- dimnames(X) #如果没有指定维度名,则dn=NULL,一般都是NULL
ds <- seq_len(dl) # 产生一个1到dl的向量 ds=[1] 1 2
if(is.character(MARGIN)){ #
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] #MARGIN是1或2,假设MARGIN=1 s.call=2
s.ans <- ds[MARGIN] #s.ans=1
d.call <- d[-MARGIN] #d.call=3
d.ans <- d[MARGIN] #第MARGIN个维度的位数 d.ans=2
dn.call <- dn[-MARGIN] #NULL 不考虑
dn.ans <- dn[MARGIN]
#NULL 不考虑d2 <- prod(d.ans) #连乘 d2=2
if(d2 ==0L){ #我们的一般情况不会出现该维度为0
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 elseif(length(d.ans)<
2L) ans[1L][-1L]else array(ans, d.ans, dn.ans))
}
newX <- aperm(X, c(s.call, s.ans)) #c(2,1)
#理解aperm函数就知道,当X是一个矩阵的时候,其实这等价于一个转置
[,1] [,2] [1,] 1 2 [2,] 3 4 [3,] 5 6
dim(newX)<- c(prod(d.call), d2) # 3,2
ans <-vector("list", d2) #创建一个包含两个组件的列表
[[1]] NULL [[2]] NULL
if(length(d.call)<2L){ #d.call=3,不成立
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
}
}
elsefor(i in 1L:d2){ #d2=2 #执行
tmp <- forceAndCall(1, FUN, array(newX[, i], d.call,
dn.call),...)- #传给apply的要被处理的数据是在这里才被传递给FUN的
if(!is.null(tmp)) #判断是否为空
ans[[i]]<- tmp
}
#此时ans
[[1]] [1] 3 #newX第一列的均值 [[2]] [1] 4
ans.list<- is.recursive(ans[[1L]])
#[1] FALSEl.ans <- length(ans[[1L]]) # l.ans=1
ans.names <- names(ans[[1L]]) #ans.names=NULL
if(!ans.list) #成立
ans.list<- any(lengths(ans)!= l.ans)
#lengths(ans) [1] 1 1 即每个组件中的元素的个数
#[1] FALSE FALSE ----> ans.list = FALSE
if(!ans.list&& length(ans.names)){ #length(ans.names)=0 所以整个是F,不成立
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)) # len.a=2
if(length(MARGIN)==1L&& len.a == d2){ #满足
names(ans)<-if(length(dn.ans[[1L]])) #dn.ans是null
dn.ans[[1L]] #不会执行
ans # [1] 3 4 最终整个作为返回值
}
elseif(len.a == d2)
array(ans, d.ans, dn.ans)
elseif(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
}
x <- cbind(x1 =3, x2 = c(4:1,2:5))
dimnames(x)[[1]]<- letters[1:8]
x
x1 x2
a 3 4
b 3 3
c 3 2
d 3 1
e 3 2
f 3 3
g 3 4
h 3 5
apply(x,2, mean, trim =.2)
x1 x2
3 3
function (X, MARGIN, FUN,...)
{
FUN <- match.fun(FUN)
dl <- length(dim(X)) #dl=2
if(!dl)
stop("dim(X) must have a positive length")
if(is.object(X))
X <-if(dl ==2L)
as.matrix(X) #例子中x本就是matrix
else as.array(X)
d <- dim(X) #d=[1] 8 2
dn <- dimnames(X)
# [[1]]
# [1] "a" "b" "c" "d" "e" "f" "g" "h"
#
# [[2]]
# [1] "x1" "x2"
ds <- seq_len(dl) #ds=1 2
if(is.character(MARGIN)){ #MARGIN=2,不是字符
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.call=1
s.ans <- ds[MARGIN] #s.ans=2
d.call <- d[-MARGIN] #d.call=8
d.ans <- d[MARGIN] #d.ans=2
dn.call <- dn[-MARGIN]
# [[1]]
# [1] "a" "b" "c" "d" "e" "f" "g" "h"
dn.ans <- dn[MARGIN]
# [[1]]
# [1] "x1" "x2"
d2 <- prod(d.ans) #d2=2
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 elseif(length(d.ans)<
2L) ans[1L][-1L]else array(ans, d.ans, dn.ans))
}
newX <- aperm(X, c(s.call, s.ans)) #perm=c(1,2),所以相当于没变
# x1 x2
# a 3 4
# b 3 3
# c 3 2
# d 3 1
# e 3 2
# f 3 3
# g 3 4
# h 3 5
dim(newX)<- c(prod(d.call), d2) #8,2
# [,1] [,2]
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
#重定义了下维度就没有dimnames属性啦?
ans <-vector("list", d2)
# [[1]]
# NULL
#
# [[2]]
# NULL
if(length(d.call)<2L){#d.call=8
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
}
}
elsefor(i in 1L:d2){ #执行
tmp <- forceAndCall(1, FUN, array(newX[, i], d.call,
dn.call),...)
#我经过反复的测试,得到trim = .2这个参数其实是传递给了...
#只不过这里不巧的是mean(newX)和mean(newX,.2)的结果都是3
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
}
elseif(len.a == d2)
array(ans, d.ans, dn.ans)
elseif(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
}
function (X, MARGIN, FUN,...)
{
FUN <- match.fun(FUN)
dl <- length(dim(X)) #dl=2
if(!dl)
stop("dim(X) must have a positive length")
if(is.object(X))
X <-if(dl ==2L)
as.matrix(X) #例子中x本就是matrix
else as.array(X)
d <- dim(X) #d=[1] 8 2
dn <- dimnames(X)
# [[1]]
# [1] "a" "b" "c" "d" "e" "f" "g" "h"
#
# [[2]]
# [1] "x1" "x2"
ds <- seq_len(dl) #ds=1 2
s.call <- ds[-MARGIN] #s.call=1
s.ans <- ds[MARGIN] #s.ans=2
d.call <- d[-MARGIN] #d.call=8
d.ans <- d[MARGIN] #d.ans=2
dn.call <- dn[-MARGIN]
# [[1]]
# [1] "a" "b" "c" "d" "e" "f" "g" "h"
dn.ans <- dn[MARGIN]
# [[1]]
# [1] "x1" "x2"
d2 <- prod(d.ans) #d2=2
newX <- aperm(X, c(s.call, s.ans)) #perm=c(1,2),所以相当于没变
# x1 x2
# a 3 4
# b 3 3
# c 3 2
# d 3 1
# e 3 2
# f 3 3
# g 3 4
# h 3 5
dim(newX)<- c(prod(d.call), d2) #8,2
# [,1] [,2]
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
#重定义了下维度就没有dimnames属性啦?
ans <-vector("list", d2)
# [[1]]
# NULL
#
# [[2]]
# NULL
if(length(d.call)<2L){#d.call=8
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
}
}
elsefor(i in 1L:d2){ #执行
tmp <- forceAndCall(1, FUN, array(newX[, i], d.call,
dn.call),...)
#我经过反复的测试,得到trim = .2这个参数其实是传递给了...
#只不过这里不巧的是mean(newX)和mean(newX,.2)的结果都是3
}
## Compute row and column sums for a matrix:
x <- cbind(x1 =3, x2 = c(4:1,2:5))
dimnames(x)[[1]]<- letters[1:8]
#求列均值
apply(x,2, mean, trim =.2)
#求每一列的和
col.sums <- apply(x,2, sum)
# x1 x2
# 24 24
#求每一行的和
row.sums <- apply(x,1, sum)
# a b c d e f g h
# 7 6 5 4 5 6 7 8
rbind(cbind(x,Rtot= row.sums),Ctot= c(col.sums, sum(col.sums)))
# x1 x2 Rtot
# a 3 4 7
# b 3 3 6
# c 3 2 5
# d 3 1 4
# e 3 2 5
# f 3 3 6
# g 3 4 7
# h 3 5 8
# Ctot 24 24 48
> apply(x,2, is.vector)
x1 x2
TRUE TRUE
## Sort the columns of a matrix
- #按列排序,排序完了列名就木有啦?
apply(x,2, sort)
# x1 x2
# [1,] 3 1
# [2,] 3 2
# [3,] 3 2
# [4,] 3 3
# [5,] 3 3
# [6,] 3 4
# [7,] 3 4
# [8,] 3 5
> a<-c(2,11,7,13)
> b<-c(3,5,9,2)
> m<-cbind(a=a,b=b)
> dimnames(m)<-list(paste(LETTERS[1:4],1:4,sep ="-"),c(letters[1:2]))
> m
a b
A-1 23
B-2115
C-3 79
D-4132
> apply(m,2,sort)
a b
[1,] 22
[2,] 73
[3,]115
[4,]139
> apply(m,1,sort)
A-1 B-2 C-3 D-4
[1,] 2 5 7 2
[2,] 3 11 9 13
- x <- cbind(x1 =3, x2 = c(4:1,2:5))
x
# x1 x2
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
## keeping named dimnames
#给维度命名
names(dimnames(x))<- c("row","col")
#给维度命名
x
# col
# row x1 x2
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
x3 <- array(x, dim = c(dim(x),3),
dimnames = c(dimnames(x),
list(C = paste0("cop.",1:3))))
x3
# , , C = cop.1
#
# col
# row x1 x2
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
#
# , , C = cop.2
#
# col
# row x1 x2
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
#
# , , C = cop.3
#
# col
# row x1 x2
# [1,] 3 4
# [2,] 3 3
# [3,] 3 2
# [4,] 3 1
# [5,] 3 2
# [6,] 3 3
# [7,] 3 4
# [8,] 3 5
identical(x, apply( x, 2, identity))
# [1] TRUE
identical(x3, apply(x3,2:3, identity))
# [1] TRUE
> apply( x, 2, identity)
col
row x1 x2
[1,] 3 4
[2,] 3 3
[3,] 3 2
[4,] 3 1
[5,] 3 2
[6,] 3 3
[7,] 3 4
[8,] 3 5
> apply(x3,2:3, identity) #对数组的列和层引用identity函数
,, C = cop.1
col
row x1 x2
[1,] 3 4
[2,] 3 3
[3,] 3 2
[4,] 3 1
[5,] 3 2
[6,] 3 3
[7,] 3 4
[8,] 3 5
,, C = cop.2
col
row x1 x2
[1,] 3 4
[2,] 3 3
[3,] 3 2
[4,] 3 1
[5,] 3 2
[6,] 3 3
[7,] 3 4
[8,] 3 5 ###下面这段输出结果第一次忘了插入了
,, C = cop.3
col
row x1 x2
[1,]34
[2,]33
[3,]32
[4,]31
[5,]32
[6,]33
[7,]34
[8,]35
x <- cbind(x1 =3, x2 = c(4:1,2:5))
> x
x1 x2
[1,] 3 4
[2,] 3 3
[3,] 3 2
[4,] 3 1
[5,] 3 2
[6,] 3 3
[7,] 3 4
[8,] 3 5
cave <- function(x, c1, c2){
c(mean(x[c1]), mean(x[c2]))
}
apply(x,1, cave, c1 ="x1", c2 = c("x1","x2"))
[,1][,2][,3][,4][,5][,6][,7][,8]
[1,] 3.0 3 3.0 3 3.0 3 3.0 3
[2,] 3.5 3 2.5 2 2.5 3 3.5 4
>class(apply(x,1, cave, c1 ="x1", c2 = c("x1","x2")))
[1]"matrix"
x <- cbind(x1 =3, x2 = c(4:1,2:5))
##- function with extra args:
cave <- function(x, c1, c2){
print("##q##")
print(x)
print("==b==")
c(mean(x[c1]), mean(x[c2]))
}
apply(x,1, cave, c1 ="x1", c2 = c("x1","x2"))
[1]"##q##"
x1 x2
3 4
[1]"==b=="
[1]"##q##"
x1 x2
3 3
[1]"==b=="
[1]"##q##"
x1 x2
3 2
[1]"==b=="
[1]"##q##"
x1 x2
3 1
[1]"==b=="
[1]"##q##"
x1 x2
3 2
[1]"==b=="
[1]"##q##"
x1 x2
3 3
[1]"==b=="
[1]"##q##"
x1 x2
3 4
[1]"==b=="
[1]"##q##"
x1 x2
3 5
[1]"==b=="
[,1][,2][,3][,4][,5][,6][,7][,8]
[1,] 3.0 3 3.0 3 3.0 3 3.0 3
[2,] 3.5 3 2.5 2 2.5 3 3.5 4
> ma <- matrix(c(1:4,1,6:8), nrow =2)
> ma
[,1][,2][,3][,4]
[1,]1317
[2,]2468
> apply(ma,1, table)#--> a list of length 2
[[1]]
137
211
[[2]]
2468
1111
> apply(ma,1, stats::quantile)# 5 x n matrix with rownames
[,1][,2]
0%12.0
25%13.5
50%25.0
75%46.5
100%78.0
> dim(ma)== dim(apply(ma,1:2, sum)) #判断是否相等
[1] TRUE TRUE
> ma
[,1][,2][,3][,4]
[1,]1317
[2,]2468
(2)apply函数及其源码的更多相关文章
- Generator函数执行器-co函数库源码解析
一.co函数是什么 co 函数库是著名程序员 TJ Holowaychuk 于2013年6月发布的一个小工具,用于 Generator 函数的自动执行.短小精悍只有短短200余行,就可以免去手动编写G ...
- 7z文件格式及其源码linux/windows编译
7z文件格式及其源码的分析(二) 一. 准备工作: 1. 源码下载: 可以从官方中文主页下载:http://sparanoid.com/lab/7z/. 为了方便, 这里直接给出下载链接: http: ...
- Javascript中call、apply函数浅析
call/apply函数作用其实就是改变this的取值,有一句话是:谁调用的这个方法那方法里的this就是指谁,而有时我们会需要改变this值,所以call/apply就能派上用场. 下面我写个方法来 ...
- JavaScript中bind、call、apply函数使用方法具体解释
在给我们项目组的其它程序介绍 js 的时候,我准备了非常多的内容,但看起来效果不大,果然光讲还是不行的,必须动手. 前几天有人问我关于代码里 call() 函数的使用方法.我让他去看书,这里推荐用js ...
- 详解CopyOnWrite容器及其源码
详解CopyOnWrite容器及其源码 在jave.util.concurrent包下有这样两个类:CopyOnWriteArrayList和CopyOnWriteArraySet.其中利用到了Cop ...
- Qt QComboBox之setEditable和currentTextChanged及其源码分析
目录 Qt QComboBox之setEditable和currentTextChanged以及其源码分析 前言 问题的出现 问题分析 currentTextChanged信号触发 源码分析 Qt Q ...
- js中bind、call、apply函数的用法
最近一直在用 js 写游戏服务器,我也接触 js 时间不长,大学的时候用 js 做过一个 H3C 的 web的项目,然后在腾讯实习的时候用 js 写过一些奇怪的程序,自己也用 js 写过几个的网站.但 ...
- 关于call和apply函数的区别及用法
call和apply函数是function函数的基本属性,都可以用于更改函数对象和传递参数,是前端工程师常用的函数.具体使用方法请参考以下案列: 例如: 申明函数: var fn = function ...
- Javascript中bind、call、apply函数用法
js 里函数调用有 4 种模式:方法调用.正常函数调用.构造器函数调用.apply/call 调用. 同时,无论哪种函数调用除了你声明时定义的形参外,还会自动添加 2 个形参,分别是 this 和ar ...
随机推荐
- 关于AWR报告命中率指标的解释(转)
文章转自:http://blog.itpub.net/24558279/viewspace-762371/ 从Oracle 10g开始,Oracle给广大DBA提供了一个性能优化的利器,那便是Auto ...
- 使用convert来批量处理图片
这是个神奇的工具,居然使用命令行就可以这么方便的处理图片.功能有待挖掘. 这个是把图片批量进行 resize 的脚本. #!/bin/sh counter= root=mypict resolutio ...
- hibernate关联映射学习
- ACM程序对拍
有时候在OJ刷题目的时候,总是会遇到不知名bug,题目总不能AC,自己测试的一些数据又都能得出正确的结果,又或是直接暴力会TLE,改了算法,但是仍然WA,这时候进行程序对拍测试数据不失为一个好办法.程 ...
- Apache 优雅重启 Xampp开机自启 - 【环境变量】用DOS命令在任意目录下启动服务
D:\xampp\apache\bin\httpd.exe" -k runservice Apache 优雅重启 :httpd -k graceful Xampp开机自启动 参考文献:ht ...
- PL/0编译器(java version) – SymbolTable.java
1: package compiler; 2: //竟然没有对符号表检查大小,会溢出的. 3: 4: import java.io.IOException; 5: 6: public clas ...
- Linux Shell 从入门到删除根目录跑路指南
1.变量为空导致误删文件base_path=/usr/sbintmp_file=`cmd_invalid`# rm -rf $base_path/$tmp_file这种情况下如果 cmd 执行出错或者 ...
- .net 运用YUI相关的dll压缩js (按照自己的规则,想想都觉得强大和有趣)
写在前面 不管是做前端的还是做后台的,不管是懂javaScript的还是不太懂JavaScript的人,我想都或多或想的知道些许js压缩对于页面性能提升的效应吧. 之前老喜欢用在线压缩工具去压缩js, ...
- 【原】react+redux实战
摘要:因为最近搞懂了redux的异步操作,所以觉得可以用react+redux来做一个小小的项目了,以此来加深一下印象.切记,是小小的项目,所以项目肯定是比较简单的啦,哈哈. 项目效果图如图所示:(因 ...
- css002 创建样式和样式表
创建样式和样式表 一个样式表包含多个样式 样式表的种类 1.内部样式表,存放在<head></head>之间.如: <head> <style> ( ...