记一次R语言程序的优化

作者: 李佶澳   转载请保留:原文地址   发布时间:2015/05/02 16:07:14

摘要

有一个数据分析的任务, 决定使用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。 :)

限时活动,每邀请一人即返回25元!

Copyright @2011-2018 All rights reserved. 转载请添加原文连接,合作请加微信lijiaocn或者发送邮件: lijiaocn@foxmail.com,备注网站合作 友情链接: lijiaocn github.com