• R/O
  • SSH

Commit

Tags
No Tags

Frequently used words (click to add to your profile)

javac++androidlinuxc#windowsobjective-cqtcocoa誰得pythonphprubygameguibathyscaphec翻訳計画中(planning stage)omegatframeworktwittertestdomvb.netdirectxbtronarduinopreviewerゲームエンジン

Commit MetaInfo

Revisión3e9941d67444cd63b4118f8f14efddcd5e79a600 (tree)
Tiempo2022-11-24 21:57:52
AutorLorenzo Isella <lorenzo.isella@gmai...>
CommiterLorenzo Isella

Log Message

I parallelized other 2 codes.

Cambiar Resumen

Diferencia incremental

diff -r daeea01ae90b -r 3e9941d67444 R-codes/arima_simple2_parallel.R
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/R-codes/arima_simple2_parallel.R Thu Nov 24 13:57:52 2022 +0100
@@ -0,0 +1,148 @@
1+rm(list=ls())
2+
3+library(tidyverse)
4+library(janitor)
5+library(tidymodels)
6+library(modeltime)
7+library(lubridate)
8+library(forecast) # for `auto.arima`
9+library(timetk) # for `tk_ts`
10+library(tictoc)
11+library(openxlsx)
12+library(furrr)
13+
14+tidymodels_prefer()
15+
16+
17+source("/home/lorenzo/myprojects-hg/R-codes/stat_lib.R")
18+
19+
20+extract_ms_data <- function( ms, log_trans){
21+
22+ res <- price_series |>
23+ filter(geo==ms)|>
24+ select(-geo)
25+
26+ if (log_trans==1){
27+ res <- res|>
28+ mutate(value=log(value))
29+
30+ }
31+
32+}
33+
34+arima_parallel <- function(splits){ arima_reg() |>
35+ set_engine("auto_arima") |>
36+ fit(value ~ date, training(splits))
37+}
38+
39+
40+extract_results <- function(x,y){
41+ res <- x |> filter(.key=="prediction") |>
42+ select(.index, .value) |>
43+ mutate(geo=y)
44+
45+return(res)
46+
47+}
48+
49+
50+###################################################################
51+###################################################################
52+###################################################################
53+###################################################################
54+
55+
56+
57+
58+
59+tic()
60+
61+set.seed(1234)
62+
63+
64+plan(multisession, workers = 3)
65+
66+choose_log <- 1
67+
68+
69+present_month <- month(today())
70+
71+price_series <- readRDS("production.RDS") |>
72+ arrange(geo, time_period) |>
73+ rename("value"="obs_value",
74+ "date"="time_period") |>
75+ filter(geo %in% iso_map_eu27$iso2)
76+
77+
78+ms_list <- price_series |>
79+ pull(geo) |>
80+ su()
81+
82+## ms_list <- c("DE", "AT", "FI")
83+
84+ms_data <- future_map2(ms_list,choose_log, extract_ms_data )
85+
86+
87+splits_parallel <- future_map( ms_data,
88+ function(x) time_series_split(x, assess = "3 months", cumulative = TRUE)
89+)
90+
91+
92+
93+
94+model_fit_arima_parallel <- future_map(splits_parallel, function(x) arima_parallel(x))
95+
96+
97+model_table_parallel <-future_map(model_fit_arima_parallel, modeltime_table)
98+
99+
100+testing_splits <- future_map(splits_parallel,testing )
101+
102+calibration_table_parallel <- future_map2( model_table_parallel,
103+testing_splits, modeltime_calibrate
104+)
105+
106+refit_parallel <-future_map2( calibration_table_parallel, ms_data,
107+ modeltime_refit
108+ )
109+
110+
111+new_forecast_parallel <- future_map2(refit_parallel, ms_data,
112+ function(x,y) modeltime_forecast(x,h = "3 months", actual_data = y)
113+)
114+
115+
116+
117+out.total <- future_map2_dfr(new_forecast_parallel, ms_list, extract_results)
118+
119+
120+
121+if (choose_log==1){
122+
123+ out.total <- out.total |>
124+ mutate(.value=exp(.value))
125+ }
126+
127+out.total <- out.total |>
128+ mutate(month_nowcast=month(.index)) |>
129+ filter(month_nowcast==present_month) |>
130+ select(geo, month_nowcast, .value) |>
131+ rename("value"=".value")
132+
133+fn <- paste("nowcast_production_month_", present_month, ".xlsx", sep="" )
134+
135+save_excel(out.total, fn)
136+
137+
138+fn2 <- paste("nowcast_PVI_month_", present_month, ".RDS", sep="" )
139+
140+saveRDS(out.total, fn2)
141+
142+
143+
144+toc()
145+
146+######################################################################
147+
148+print("So far so good")
diff -r daeea01ae90b -r 3e9941d67444 R-codes/arima_simple3_parallel.R
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/R-codes/arima_simple3_parallel.R Thu Nov 24 13:57:52 2022 +0100
@@ -0,0 +1,152 @@
1+rm(list=ls())
2+
3+library(tidyverse)
4+library(janitor)
5+library(tidymodels)
6+library(modeltime)
7+library(lubridate)
8+library(forecast) # for `auto.arima`
9+library(timetk) # for `tk_ts`
10+library(tictoc)
11+library(openxlsx)
12+library(furrr)
13+
14+tidymodels_prefer()
15+
16+
17+source("/home/lorenzo/myprojects-hg/R-codes/stat_lib.R")
18+
19+
20+extract_ms_data <- function( ms, log_trans){
21+
22+ res <- price_series |>
23+ filter(geo==ms)|>
24+ select(-geo)
25+
26+ if (log_trans==1){
27+ res <- res|>
28+ mutate(value=log(value))|>
29+ pattern_to_na(-Inf) |>
30+ ## see https://stackoverflow.com/questions/40040834/replace-na-with-previous-or-next-value-by-group-using-dplyr
31+ fill(date, value, .direction = "downup")
32+
33+
34+ }
35+
36+}
37+
38+arima_parallel <- function(splits){ arima_reg() |>
39+ set_engine("auto_arima") |>
40+ fit(value ~ date, training(splits))
41+}
42+
43+
44+extract_results <- function(x,y){
45+ res <- x |> filter(.key=="prediction") |>
46+ select(.index, .value) |>
47+ mutate(geo=y)
48+
49+return(res)
50+
51+}
52+
53+
54+###################################################################
55+###################################################################
56+###################################################################
57+###################################################################
58+
59+
60+
61+
62+
63+tic()
64+
65+set.seed(1234)
66+
67+
68+plan(multisession, workers = 3)
69+
70+choose_log <- 1
71+
72+
73+present_month <- month(today())
74+
75+price_series <- readRDS("tourism.RDS") |>
76+ arrange(geo, time_period) |>
77+ rename("value"="obs_value",
78+ "date"="time_period") |>
79+ filter(geo %in% iso_map_eu27$iso2,
80+ geo!="MT")
81+
82+ms_list <- price_series |>
83+ pull(geo) |>
84+ su()
85+
86+## ms_list <- c("DE", "AT", "FI")
87+
88+ms_data <- future_map2(ms_list,choose_log, extract_ms_data )
89+
90+
91+splits_parallel <- future_map( ms_data,
92+ function(x) time_series_split(x, assess = "3 months", cumulative = TRUE)
93+)
94+
95+
96+
97+
98+model_fit_arima_parallel <- future_map(splits_parallel, function(x) arima_parallel(x))
99+
100+
101+model_table_parallel <-future_map(model_fit_arima_parallel, modeltime_table)
102+
103+
104+testing_splits <- future_map(splits_parallel,testing )
105+
106+calibration_table_parallel <- future_map2( model_table_parallel,
107+testing_splits, modeltime_calibrate
108+)
109+
110+refit_parallel <-future_map2( calibration_table_parallel, ms_data,
111+ modeltime_refit
112+ )
113+
114+
115+new_forecast_parallel <- future_map2(refit_parallel, ms_data,
116+ function(x,y) modeltime_forecast(x,h = "3 months", actual_data = y)
117+)
118+
119+
120+
121+out.total <- future_map2_dfr(new_forecast_parallel, ms_list, extract_results)
122+
123+
124+
125+if (choose_log==1){
126+
127+ out.total <- out.total |>
128+ mutate(.value=exp(.value))
129+ }
130+
131+out.total <- out.total |>
132+ mutate(month_nowcast=month(.index)) |>
133+ filter(month_nowcast==present_month) |>
134+ select(geo, month_nowcast, .value) |>
135+ rename("value"=".value")
136+
137+fn <- paste("nowcast_hotel_nights_month_", present_month, ".xlsx", sep="" )
138+
139+save_excel(out.total, fn)
140+
141+
142+fn2 <- paste("nowcast_tourism_month_", present_month, ".RDS", sep="" )
143+
144+saveRDS(out.total, fn2)
145+
146+
147+
148+toc()
149+
150+######################################################################
151+
152+print("So far so good")