记一次R语言程序的优化
目录
摘要
有一个数据分析的任务, 决定使用R来完成, 这里记录其中的一次优化过程。
任务描述
有一个dataframe,假设如下：
col1 col2
1 10
2 10
2 30
2 10
以col1中的值”2“为例， 我需要得到的是，对于col1中的值2： 10 （2次） 30（1次）
我需要对col1中的每一个值都做类似的统计，总计500多万条记录。
最开始…
最开始的两版程序如下:
第一版:
func_col2_distr<-function(col1,col2,df)
{
col2s<-list()
for (i in levels(factor(df[[col1]]))){
col2s[i]<-subset(df,df[[col1]]==i,select=col2)
}
return (col2s)
}
第二版:
func_col2_distr<-function(col1,col2,df)
{
l<-list()
v1=df[[col1]]
v2=df[[col2]]
i=0
while(i < length(v2)){
i=i+1
x=as.character(v1[i])
if(v1[i] %in% names(l)){
l[[x]]=append(l[[x]],v2[i])
}else{
l[[x]]=c(v2[i])
}
}
return (l)
}
第一版的效率很低，猜测是因为subset()内部实现也进行了一次遍历,所以第一版的程序可能是一个O(n^2)的，而总共有500多万条数据, 循环次数惊人。因此做了改动，修改为第二版，但是第二版只有一次遍历，但是性能方面依旧不可接受。
第二阶段
到cos.name求助后,得到了一个先将数据进行排序的思路。试验了一下，500多万排条记录排序很快。于是有了下一版:
func_col2_distr_v3<-function(col1,col2,df)
{
l<-list()
ndf<-df[order(df[[col1]]),]
v1=ndf[[col1]]
v2=ndf[[col2]]
i=1
last=v1[1]
element=c(v2[1])
len=length(v2)
while(i < len){
i=i+1
if(v1[i] == last){
element=append(element,v2[i])
}else{
l[[as.character(last)]]=element
element=c(v2[i])
last=v1[i]
}
}
return (l)
}
性能有所提升，但是依然不可接受，因为我的三个数据文件中，一个依然需要六七个小时才算的出来，另外两个文件依然是完全算不完的状态。
探索..
然后就进入到了恍惚的探索状态…难道是R中的循环本来就很慢吗?
用下面的函数试验一下，
func_try_loop_v2<-function(times)
{
i=1
ele=c(1)
while(i<times){
i=i+1
ele=append(ele,i)
}
return (ele)
}
果然很慢，10万次循环就明显要耗费很长时间！100万就迟迟等不到结果。但是,会不会是append()导致的?因为R是动态类型的语言,重复的赋值的开销是不是很大?先用下面的函数，单纯的测试下循环的时间。
func_try_loop_v1<-function(times)
{
i=1
ele=c(1)
while(i<times){
i=i+1
}
return (ele)
}
500万次循环瞬间完成！那么问题果然就是在append()上面了！丢弃append, 用下面的函数再试:
func_try_loop_v3<-function(times)
{
i=1
ele=c(1)
while(i<times){
i=i+1
ele[i]=i
}
return (ele)
}
还是不行，性能依然很差！然后就重新陷入了恍惚的状态….
会不会是vector的成员增加时的内存分配有问题?因为在前面的操作时，当times为10万次的时候，耗时明显增加了，而times增长到10万次时，除了循环次数显著变化外，另一个显著变化的就是存放vector需要的内存的大小了。
高度怀疑是随着vector中成员的增加, R会不停的去申请新的内存空间, 可能是一小块一小卡的申请, 也可能是不停将数据拷贝的新申请的更大的内存中, 不管具体的实现是怎样的, 这个过程很可能是一个非常耗时的操作。有没有办法可先将vector需要的内存一次申请完成？
试验了一下，可以通过设置vector的length属性达到目的.用下面的函数再试:
func_try_loop_v4<-function(times)
{
i=1
ele=c(1)
ele[times]=1 //和length(ele)<-times的效果相当
while(i<times){
ele[i]=i
i=i+1
}
return (ele)
}
哈哈, 猜测完全正确！500万次很快就完成了:)
接下来的目标就明确了, 预先分配vector的内存就可以了。当然,这里还是有插曲的，最开始只对vector的做了修改，发现性能有提升, 但还是不理想，和单纯的500万次循环相差的时间太大了。后来发现是list也存在类型vector的问题, 试验下面两个函数就可以发现了
func_try_loop_list_v1<-function(times)
{
i=1
ele=list()
while(i<times){
i=i+1
ele[[i]]<-c(1,3,34)
}
return (ele)
}
func_try_loop_list_v2<-function(times)
{
i=1
ele<-list()
length(ele)<-times
while(i<times){
i=i+1
ele[[i]]<-c(1,3,34)
}
return (ele)
}
最终
用下面的函数:
func_col2_distr_v9<-function(col1,col2,df)
{
v1=df[[col1]]
v2=df[[col2]]
len=length(v2)
element=c()
length(element)<-len
l<-list()
length(l)<-len
level<-c()
length(level)<-len
i=1
last=v1[1]
n=1
element[n]=v2[1]
ch=0
while(i < len){
i=i+1
if(v1[i] == last){
n=n+1
element[n]=v2[i]
}else{
ch=ch+1
length(element)<-n
l[[ch]]=element
level[ch]=last
last=v1[i]
length(element)<-len
n=1
element[n]=v2[i]
}
}
length(level)<-ch
ch=ch+1
l[[ch]]=level
length(l)<-ch
return (l)
}
原先需要接近8小时时间的处理，只需要不到半个小时了，而且包含了我后续绘制8万多张图片的时间。
用这个函数去进行下一项任务, 依然是同样的三个文件, 只不过col1选取另外的一列, levels都是19万左右。三个文件分别都用了2个小时左右的时间就完成了,包含了为个level绘制一张分布图的时间。而且根据观察，处理一个文件使用的2个小时的时间中，至少有半个小时在绘制图片。
最后的最后..
得到近60万张分布图后，发现里面与大量level在全部记录中只出现了一次, 例如文章开头处的例子中的第一行数据(1,10)。我不需要这样的数据, 于是添加了限制:
func_col2_distr_v9_limit<-function(col1,col2,df,low)
{
v1=df[[col1]]
v2=df[[col2]]
len=length(v2)
element=c()
length(element)<-len
l<-list()
length(l)<-len
level<-c()
length(level)<-len
i=1
last=v1[1]
n=1
element[n]=v2[1]
ch=0
while(i < len){
i=i+1
if(v1[i] == last){
n=n+1
element[n]=v2[i]
}else{
if(n>low){
ch=ch+1
length(element)<-n
l[[ch]]=element
level[ch]=last
last=v1[i]
length(element)<-len
n=1
element[n]=v2[i]
}else{
last=v1[i]
n=1
element[n]=v2[i]
}
}
}
length(level)<-ch
ch=ch+1
l[[ch]]=level
length(l)<-ch
return (l)
}
low取值为20，得到了16471张图片，也说col1的19万个取值中，我需要的是16471个。关键是…
只用了10分钟多一点….好了,我先去检查下是不是有bug。 :)
