我在大约120万次观测中运行了大约45,000个局部线性回归(基本上),所以我很感激一些帮助试图加快速度,因为我很不耐烦 .
我基本上是在为一堆公司构建逐年工资 Contract - 职能工资(给予公司,年份,职位的经验) .
这是我正在使用的数据集(基本结构):
> wages
firm year position exp salary
1: 0007 1996 4 1 20029
2: 0007 1996 4 1 23502
3: 0007 1996 4 1 22105
4: 0007 1996 4 2 23124
5: 0007 1996 4 2 22700
---
1175141: 994 2012 5 2 47098
1175142: 994 2012 5 2 45488
1175143: 994 2012 5 2 47098
1175144: 994 2012 5 3 45488
1175145: 994 2012 5 3 47098
我想为所有公司构建0到40经验水平的工资函数,a:
> salary_scales
firm year position exp salary
1: 0007 1996 4 0 NA
2: 0007 1996 4 1 21878.67
3: 0007 1996 4 2 23401.33
4: 0007 1996 4 3 23705.00
5: 0007 1996 4 4 24260.00
---
611019: 9911 2015 4 36 NA
611020: 9911 2015 4 37 NA
611021: 9911 2015 4 38 NA
611022: 9911 2015 4 39 NA
611023: 9911 2015 4 40 NA
为此,我一直在工作(在@BondedDust here的建议下)使用COBS(COnstrained B-Spline)软件包,这使我能够 Build 工资 Contract 的单调性 .
仍有一些问题;特别是,当我需要推断时(无论何时某个公司没有任何非常年轻或非常老的员工),都有一种倾向,即失去单调性或低于0 .
为了解决这个问题,我一直在数据边界外使用简单的线性外推 - 将拟合曲线扩展到 min_exp
和 max_exp
之外,以便它通过两个最低(或最高)的拟合点 - 不完美,但似乎做得很好 .
考虑到这一点,到目前为止's how I'这样做(请记住我是一个狂热的人):
#get the range of experience for each firm
wages[,min_exp:=min(exp),by=.(year,firm,position)]
wages[,max_exp:=max(exp),by=.(year,firm,position)]
#Can't interpolate if there are only 2 or 3 unique experience cells represented
wages[,node_count:=length(unique(exp)),by=.(year,firm,position)]
#Nor if there are too few teachers
wages[,ind_count:=.N,by=.(year,firm,position)]
#Also troublesome when there is little variation in salaries like so:
wages[,sal_scale_flag:=mean(abs(salary-mean(salary)))<50,by=.(year,firm,position)]
wages[,sal_count_flag:=length(unique(salary))<5,by=.(year,firm,position)]
cobs_extrap<-function(exp,salary,min_exp,max_exp,
constraint="increase",print.mesg=F,nknots=8,
keep.data=F,maxiter=150){
#these are passed as vectors
min_exp<-min_exp[1]
max_exp<-min(max_exp[1],40)
#get in-sample fit
in_sample<-predict(cobs(x=exp,y=salary,
constraint=constraint,
print.mesg=print.mesg,nknots=nknots,
keep.data=keep.data,maxiter=maxiter),
z=min_exp:max_exp)[,"fit"]
#append by linear extension below min_exp
c(if (min_exp==1) NULL else in_sample[1]-
(min_exp:1)*(in_sample[2]-in_sample[1]),in_sample,
#append by linear extension above max_exp
if (max_exp==40) NULL else in_sample[length(in_sample)]+(1:(40-max_exp))*
(in_sample[length(in_sample)]-in_sample[length(in_sample)-1]))
}
salary_scales<-
wages[node_count>=7&ind_count>=10
&sal_scale_flag==0&sal_count_flag==0,
.(exp=0:40,
salary=cobs_extrap(exp,salary,min_exp,max_exp)),
by=.(year,firm,position)]
注意任何可能会减慢我的代码的特别之处?还是我被迫耐心?
在这里玩一些较小的公司位置组合:
firm year position exp salary count
1: 0063 2010 5 2 37433 10
2: 0063 2010 5 2 38749 10
3: 0063 2010 5 4 38749 10
4: 0063 2010 5 8 42700 10
5: 0063 2010 5 11 47967 10
6: 0063 2010 5 15 50637 10
7: 0063 2010 5 19 51529 10
8: 0063 2010 5 23 50637 10
9: 0063 2010 5 33 52426 10
10: 0063 2010 5 37 52426 10
11: 9908 2006 4 1 26750 10
12: 9908 2006 4 6 36043 10
13: 9908 2006 4 7 20513 10
14: 9908 2006 4 8 45023 10
15: 9908 2006 4 13 33588 10
16: 9908 2006 4 15 46011 10
17: 9908 2006 4 15 37179 10
18: 9908 2006 4 22 43704 10
19: 9908 2006 4 28 56078 10
20: 9908 2006 4 29 44866 10
1 回答
您的代码中有很多东西可以改进,但让我们关注这里的主要瓶颈 . 手头的问题可以被认为是一个_1207342问题 . 这意味着您的数据可以分成多个较小的部分,每个部分可以在不同的线程上单独计算,而无需任何额外开销 .
要查看当前问题的并行化可能性,您应该首先注意到,您正在分别为每个公司和/或年份执行完全相同的计算 . 例如,您可以将每个年份的较小子任务中的计算分开,然后将这些子任务分配给不同的CPU / GPU核心 . 以这种方式可以获得显着的性能增益 . 最后,当完成子任务的处理时,您仍然需要做的唯一事情就是合并结果 .
但是,R及其所有内部库作为单个线程运行 . 您必须明确地拆分数据,然后将子任务分配给不同的核心 . 为了实现这一点,存在许多支持多线程的R包 . 我们将在此示例中使用
doparallel
包 .您没有提供足够大的显式数据集来有效地测试性能,因此我们将首先创建一些随机数据:
现在,让我们运行代码的第一部分:
我们现在将像以前一样以单线程方式处理
wages
. 请注意,我们首先保存原始数据,以便稍后可以对其执行多线程操作并比较结果:处理所有事情花了大约1分8秒 . 请注意,我们的虚拟示例中只有10个不同的公司,这就是为什么处理时间与本地结果相比并不重要的原因 .
现在,让我们尝试以并行方式执行此任务 . 如上所述,对于我们的示例,我们希望每年拆分数据并将较小的子部分分配给单独的核心 . 我们将使用
doParallel
包来实现此目的:我们需要做的第一件事是创建一个具有特定内核数的集群 . 在我们的示例中,我们将尝试使用所有可用的核心 . 接下来,我们必须注册集群并将一些变量导出到子节点的全局环境中 . 在这种情况下,子节点只需要访问
wages
. 此外,还需要在节点上对某些依赖库进行评估,以使其工作 . 在这种情况下,节点需要访问data.frame
和cobs
库 . 代码如下所示:我们现在有一个数据表列表
salary_scales_2
,其中包含每个每年的子结果 . 注意处理时间的加速:这次只用了23秒而不是原来的1.1分钟( 65% improvement ) . 我们现在唯一需要做的就是合并结果 . 我们可以使用do.call("rbind", salary_scales_2)
来合并行的行 table 在一起(这几乎没有时间 - 一次运行的.002秒) . 最后,我们还执行一个小的检查来验证多线程结果是否确实与单线程运行的结果相同:REPLY TO COMMENT 这确实是一个非常有趣的例子,但我认为你可能会错过这里更重要的问题 .
data.table
确实执行与内存和结构相关的优化,以便您以更有效的方式查询和访问数据 . 但是,在此示例中,没有主要内存或搜索相关的瓶颈,尤其是在与cobs
函数中的实际总数据运算时间进行比较时 . 例如,当您计时时,您更改的行subSet <- wages[year==uniqueYears[i],]
每次调用仅需0.04秒 .如果您在运行中使用分析器,那么您会注意到它不是
data.table
或其任何操作或分组要求并行化,它是cobs
函数占用几乎所有的处理时间(并且此函数不会'甚至使用data.table
作为输入) . 我们在示例中尝试做的是将cobs
函数的总工作负载重新分配给不同的核心,以实现我们的加速 . 我们的意图是 not 分拆data.table
操作,因为它们根本不是昂贵的 . 但是,由于我们需要拆分单独的cobs
函数运行的数据,我们确实必须拆分data.table . 实际上,我们甚至利用了data.table
在分割和合并表格时在所有方面都很有效的事实 . 这根本不需要额外的时间 .