|
распараллелить вычисления внутри цикла на R
#39484633
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
Ссылка на профиль пользователя:
|
Участник
Откуда: Moscow
Сообщения: 2 731
|
|
Добрый день!
Ниже прикрепляю свой шедевральный код на R. работает он медленно, но работает же!
очень хочется заставить его работать быстрее, в связи с чем прошу помочь мне организовать параллельные вычисления в данном примере. Разумеется, замена foreach(i=1:n) %do% {...} на foreach(i=1:n) %dopar% {...} c предшествующей организацией кластеров не помогают. Заранее спасибо за любые ответы!
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
#librarys for data
library(readxl)
library(dplyr)
library(doParallel)
#reading inner credit portfolio data from excel
inner_credport_data<-read_excel("C:/MYTABLE.xlsx")
#saving inner credit portfolio data as new t1 table -> View t1 and remowe inner data
#subset() function allows me to drop values of 100% provisions that don't affect on stress sum
t1<-subset(inner_credport_data, inner_credport_data$prov_calc_p<100);rm(inner_credport_data)
###########################variables to load###############################
dt<-t1$dt[1] #stress test date
id<-unique(t1$idclient) #list of unique id
nid<-NROW(id) #unique id count
n<-500000 #number of iterations of MC
n_iter<-as.numeric(n) #experiment num & seed parameter
prov_calcstress<-as.numeric(n) #all stress (not applicable in current scenario)
stress_result<-as.numeric(n) #stress resulting vector
###########################################################################$
system.time({ #measuring system.time
foreach(i=1:n) %do% { #cycle NOT parallel
set.seed(i);print(i) #setting seed number for random generators (replicable)
t2<-data.frame(id=id,r1=runif(nid),r2=runif(nid),r3=runif(nid)) #t2 table - generates random var's
t3<-left_join(t1,t2,by=c("idclient"="id")) #t3 table - main with random var's & all data
t31<-subset(t3,t3$r1<0.25) #t31 table contains only clients in stress
t31$prov_calcstress_p<-if_else(is.na(t31$pos_ind)==F, #
#правила для ПОС
if_else(t31$fl_ul=="ЮЛ",
#правила для ЮЛ
if_else(t31$prov_calc_p==0.5,1.5,
if_else(t31$prov_calc_p==1,3,
if_else(t31$prov_calc_p==1.5,10,
if_else(t31$prov_calc_p==3,20,
if_else(t31$prov_calc_p==10,35,
if_else(t31$prov_calc_p==20,50,
if_else(t31$prov_calc_p==35,75,
if_else(t31$prov_calc_p==50,75,t31$prov_calc_p)))))))),
#правила для ФЛ
if_else(t31$prov_calc_p>=0 & t31$prov_calc_p<1,1.5,
if_else(t31$prov_calc_p==1,3,
if_else(t31$prov_calc_p==1.5,10,
if_else(t31$prov_calc_p==2,6,
if_else(t31$prov_calc_p==3,if_else(t31$backet=="0 Без просрочки",8,20),
if_else(t31$prov_calc_p>3 & t31$prov_calc_p<10,20,
if_else(t31$prov_calc_p>=10 & t31$prov_calc_p<20,35,
if_else(t31$prov_calc_p>=20 & t31$prov_calc_p<35,50,
if_else(t31$prov_calc_p>=35 & t31$prov_calc_p<75,75,
if_else(t31$prov_calc_p>=75 & t31$prov_calc_p<=100,100,t31$prov_calc_p))))))))))
), 100)
###########################################условия заданы
#набор данных стресс-тестирования
#номер эксперимента
n_iter[i]<-i
#сумма всего стрессового резерва в деньгах
#prov_calcstress[i]<-sum(t3$ead*t3$prov_calcstress_p)/100
#сумма стресс-сценария (суммируются 25% клиентов из стресса, остальные берутся как были)
stress_result[i]<-(sum(t31$ead*t31$prov_calcstress_p)-(sum(t31$ead*t31$prov_calc_p)))/100
} #foreach()
}) #system.time()
|
|
|
