4

私は約 120 万回の観測で (本質的に) 約 45,000 のローカル線形回帰を実行しています。

私は基本的に、多くの企業に対して、年ごとの賃金契約、つまり機能賃金 (企業、年、地位を与えられた経験) を構築しようとしています。

私が扱っているデータ(の基本構造)セットは次のとおりです。

> 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 の賃金関数を構築したいと思います。

> 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 (COstrained B-Spline) パッケージを使用して作業してきました。これにより、賃金契約の単調性を組み込むことができます。

いくつかの問題が残っています。特に、外挿する必要がある場合 (特定の企業に非常に若い従業員や非常に年配の従業員がいない場合)、適合度が単調性を失うか、0 を下回る傾向があります。

これを回避するために、データ境界の外側で単純な線形外挿を使用してきました-フィット曲線を外側に拡張min_expmax_exp、2つの最低(または最高)フィットポイントを通過するようにします-完璧ではありませんが、うまくいっているようですかなりよく。

それを念頭に置いて、これまでのところ私がこれをどのように行っているかを示します(私はdata.table狂信者であることを覚えておいてください):

#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
4

1 に答える 1

5

コードには改善できる点がたくさんありますが、ここでは主なボトルネックに焦点を当てましょう。目の前の問題は、恥ずかしいほど並列の問題と見なすことができます。これは、データを複数の小さな断片に分割して、それぞれを別のスレッドで個別に計算できることを意味します。余分なオーバーヘッドはありません。

現在の問題の並列化の可能性を確認するには、最初に、個々の企業および/または年ごとにまったく同じ計算を個別に実行していることに注意する必要があります。たとえば、個々の年ごとに計算を小さなサブタスクに分割し、これらのサブタスクを異なる CPU/GPU コアに割り当てることができます。このようにして、パフォーマンスを大幅に向上させることができます。最後に、サブタスクの処理が完了したら、あとは結果をマージするだけです。

ただし、R とそのすべての内部ライブラリは単一のスレッドとして実行されます。データを明示的に分割してから、サブタスクを異なるコアに割り当てる必要があります。これを実現するために、マルチスレッドをサポートする多くの R パッケージが存在します。doparallelこの例では、パッケージを使用します。

パフォーマンスを効果的にテストするのに十分な大きさの明示的なデータセットを提供しなかったため、最初にいくつかのランダム データを作成します。

set.seed(42)
wages<-data.table(firm=substr(10001:10010,2,5)[sample(10,size=1e6,replace=T)],
                  year=round(unif(1e6,1996,2015)),
                  position=round(runif(1e6,4,5)),
                  exp=round(runif(1e6,1,40)),
                  salary=round(exp(rnorm(1e6,mean=10.682,sd=.286))))
> wages
         firm year position exp salary
      1: 0001 1996        4  14  66136
      2: 0001 1996        4   3  42123
      3: 0001 1996        4   9  46528
      4: 0001 1996        4  11  35195
      5: 0001 1996        4   2  43926
     ---                              
 999996: 0010 2015        5  11  43140
 999997: 0010 2015        5  23  64025
 999998: 0010 2015        5  31  35266
 999999: 0010 2015        5  11  36267
1000000: 0010 2015        5   7  44315

それでは、コードの最初の部分を実行してみましょう:

#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)]
> wages
         firm year position exp salary min_exp max_exp node_count ind_count sal_scale_flag sal_count_flag
      1: 0001 1996        4  14  66136       1      40         40      1373          FALSE          FALSE
      2: 0001 1996        4   3  42123       1      40         40      1373          FALSE          FALSE
      3: 0001 1996        4   9  46528       1      40         40      1373          FALSE          FALSE
      4: 0001 1996        4  11  35195       1      40         40      1373          FALSE          FALSE
      5: 0001 1996        4   2  43926       1      40         40      1373          FALSE          FALSE
     ---                                                                                                 
 999996: 0010 2015        5  11  43140       1      40         40      1326          FALSE          FALSE
 999997: 0010 2015        5  23  64025       1      40         40      1326          FALSE          FALSE
 999998: 0010 2015        5  31  35266       1      40         40      1326          FALSE          FALSE
 999999: 0010 2015        5  11  36267       1      40         40      1326          FALSE          FALSE
1000000: 0010 2015        5   7  44315       1      40         40      1326          FALSE          FALSE

wages以前に行ったように、シングル スレッド方式で を処理します。後でマルチスレッド操作を実行して結果を比較できるように、最初に元のデータを保存することに注意してください。

start <- Sys.time()
salary_scales_1 <-
  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=.(firm,year,position)]
print(paste("No Parallelisation time: ",Sys.time()-start))
> print(paste("No Parallelisation time: ",Sys.time()-start))
[1] "No Parallelisation time:  1.13971961339315"
> salary_scales_1
       firm year position exp   salary
    1: 0001 1996        4   0 43670.14
    2: 0001 1996        4   1 43674.00
    3: 0001 1996        4   2 43677.76
    4: 0001 1996        4   3 43681.43
    5: 0001 1996        4   4 43684.99
   ---                                
16396: 0010 2015        5  36 44464.02
16397: 0010 2015        5  37 44468.60
16398: 0010 2015        5  38 44471.35
16399: 0010 2015        5  39 44472.27
16400: 0010 2015        5  40 43077.70

すべてを処理するのに約 1 分 8 秒かかりました。ダミーの例には 10 社の異なる企業しかないことに注意してください。これが、ローカルの結果と比較して処理時間がそれほど重要ではない理由です。

それでは、このタスクを並列化して実行してみましょう。前述のように、この例では、データを年ごとに分割し、小さなサブパートを別々のコアに割り当てたいと考えています。doParallelこの目的のためにパッケージを使用します。

最初に行う必要があるのは、特定の数のコアを持つクラスターを作成することです。この例では、利用可能なすべてのコアを使用しようとします。次に、クラスターを登録し、いくつかの変数をサブノードのグローバル環境にエクスポートする必要があります。この場合、サブノードは へのアクセスのみが必要ですwages。さらに、一部の依存ライブラリは、機能させるためにノード上で評価する必要があります。この場合、ノードはdata.framecobsライブラリの両方にアクセスする必要があります。コードは次のようになります。

library(doParallel)
start <- Sys.time()
cl <- makeCluster(detectCores()); 
registerDoParallel(cl); 
clusterExport(cl,c("wages"),envir=environment());
clusterEvalQ(cl,library("data.table"));
clusterEvalQ(cl,library("cobs"));
salary_scales_2 <- foreach(i = 1996:2015) %dopar%
  {
    subSet <- wages[.(i)] # binary subsetting
    subSet[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=.(firm,year,position)]
  }
stopCluster(cl)
print(paste("With parallelisation time: ",Sys.time()-start))
> print(paste("With parallelisation time: ",Sys.time()-start))
[1] "With parallelisation time:  23.4177722930908"

salary_scales_2これで、個々の年のサブ結果を含むデータ テーブルのリストができました。処理時間の高速化に注目してください。今回は、元の 1.1 分の代わりに 23 秒しかかかりませんでした ( 65% の改善)。あとは、結果をマージするだけです。テーブルの行を一緒にマージするためにを使用できますdo.call("rbind", salary_scales_2)(これにはほとんど時間がかかりません。1 回の実行で 0.002 秒かかります)。最後に、小さなチェックを実行して、マルチスレッドの結果がシングル スレッドの実行の結果と実際に同一であることを確認します。

salary_scales_2<-do.call("rbind",salary_scales_2)
identical(salary_scales_1,salary_scales_2)
> identical(salary_scales_1,salary_scales_2)
[1] TRUE

コメントへ の返信 確かに非常に興味深い例ですが、ここでより重要な問題を見落としている可能性があると思います。はdata.table、より効率的な方法でデータのクエリとアクセスを行うために、メモリと構造に関連する最適化を実際に実行します。ただし、この例では、特に関数での実際の合計データ処理時間と比較する場合に、大きなメモリまたは検索関連のボトルネックはありませんcobs。たとえば、変更した回線は、subSet <- wages[year==uniqueYears[i],]時間を計ると、呼び出しごとに約 0.04 秒しかかかりません。

実行時にプロファイラーを使用するとdata.table、並列化を要求するのはその操作やグループ化ではなくcobs、処理時間のほとんどすべてを占めるのは関数であることに気付くでしょう (そして、この関数はadata.tableを入力として使用します)。この例でやろうとしているのは、cobs高速化を達成するために、関数の総ワークロードを異なるコアに再割り当てすることです。私たちの意図は、コストがまったくかからないため、操作分割することではありません。ただし、個別の関数実行data.tableのためにデータを分割する必要があるため、実際には data.table を分割する必要があります。cobs実際、私たちは、data.tableテーブルを分割およびマージする際に、あらゆる点で効率的です。これにはまったく時間がかかりませんでした。

于 2015-04-25T20:19:21.357 に答える