Commit: 3e9941d67444cd63b4118f8f14efddcd5e79a600 - myprojects-hg-reborn (hg)

Commit MetaInfo

• Revisión: 3e9941d67444cd63b4118f8f14efddcd5e79a600 (tree)
• Tiempo: 2022-11-24 21:57:52
• Autor: Lorenzo Isella <lorenzo.isella@gmai...>
• Commiter: Lorenzo Isella

Log Message

I parallelized other 2 codes.

Cambiar Resumen

• add: R-codes/arima_simple2_parallel.R
• add: R-codes/arima_simple3_parallel.R

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 @@
+rm(list=ls())
+
+library(tidyverse)
+library(janitor)
+library(tidymodels)
+library(modeltime)
+library(lubridate)
+library(forecast)  # for `auto.arima`
+library(timetk)    # for `tk_ts`
+library(tictoc)
+library(openxlsx)
+library(furrr)
+
+tidymodels_prefer()
+
+
+source("/home/lorenzo/myprojects-hg/R-codes/stat_lib.R")
+
+
+extract_ms_data <- function( ms, log_trans){
+
+    res <- price_series |>
+        filter(geo==ms)|>
+    select(-geo) 
+
+    if (log_trans==1){
+        res <- res|>
+            mutate(value=log(value))
+        
+    }
+    
+}
+
+arima_parallel <- function(splits){ arima_reg() |> 
+    set_engine("auto_arima") |> 
+    fit(value ~ date, training(splits))
+}
+
+
+extract_results <- function(x,y){
+    res <-  x |>     filter(.key=="prediction") |>
+    select(.index, .value)  |>
+    mutate(geo=y)
+
+return(res)
+    
+}
+
+
+###################################################################
+###################################################################
+###################################################################
+###################################################################
+
+
+
+
+
+tic()
+
+set.seed(1234)
+
+
+plan(multisession, workers = 3)
+
+choose_log <- 1
+
+
+present_month <- month(today())
+
+price_series <- readRDS("production.RDS") |>
+    arrange(geo, time_period) |>
+    rename("value"="obs_value",
+           "date"="time_period") |>
+    filter(geo %in% iso_map_eu27$iso2)
+
+
+ms_list <- price_series |>
+    pull(geo) |>
+    su()
+
+## ms_list <- c("DE", "AT", "FI")
+
+ms_data <- future_map2(ms_list,choose_log,  extract_ms_data )
+
+
+splits_parallel <- future_map( ms_data, 
+ function(x)  time_series_split(x, assess = "3 months", cumulative = TRUE)
+)
+
+
+
+
+model_fit_arima_parallel <- future_map(splits_parallel, function(x) arima_parallel(x))
+
+
+model_table_parallel <-future_map(model_fit_arima_parallel, modeltime_table)
+
+
+testing_splits <- future_map(splits_parallel,testing )
+
+calibration_table_parallel <- future_map2(  model_table_parallel,  
+testing_splits,  modeltime_calibrate
+)
+
+refit_parallel <-future_map2( calibration_table_parallel,  ms_data, 
+                         modeltime_refit
+                     )
+
+
+new_forecast_parallel <- future_map2(refit_parallel, ms_data,
+ function(x,y)   modeltime_forecast(x,h = "3 months", actual_data = y)
+)
+
+
+
+out.total <- future_map2_dfr(new_forecast_parallel, ms_list,  extract_results)
+
+
+
+if (choose_log==1){
+
+        out.total <- out.total |>
+            mutate(.value=exp(.value))
+    }
+
+out.total <- out.total |>
+    mutate(month_nowcast=month(.index)) |>
+    filter(month_nowcast==present_month) |>
+    select(geo, month_nowcast, .value) |>
+    rename("value"=".value")
+
+fn <- paste("nowcast_production_month_", present_month, ".xlsx", sep="" )
+
+save_excel(out.total, fn)
+
+
+fn2 <- paste("nowcast_PVI_month_", present_month, ".RDS", sep="" )
+
+saveRDS(out.total, fn2)
+
+
+
+toc()
+
+######################################################################
+
+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 @@
+rm(list=ls())
+
+library(tidyverse)
+library(janitor)
+library(tidymodels)
+library(modeltime)
+library(lubridate)
+library(forecast)  # for `auto.arima`
+library(timetk)    # for `tk_ts`
+library(tictoc)
+library(openxlsx)
+library(furrr)
+
+tidymodels_prefer()
+
+
+source("/home/lorenzo/myprojects-hg/R-codes/stat_lib.R")
+
+
+extract_ms_data <- function( ms, log_trans){
+
+    res <- price_series |>
+        filter(geo==ms)|>
+    select(-geo) 
+
+    if (log_trans==1){
+        res <- res|>
+            mutate(value=log(value))|>
+            pattern_to_na(-Inf) |> 
+            ## see https://stackoverflow.com/questions/40040834/replace-na-with-previous-or-next-value-by-group-using-dplyr
+            fill(date, value, .direction = "downup")
+
+        
+    }
+    
+}
+
+arima_parallel <- function(splits){ arima_reg() |> 
+    set_engine("auto_arima") |> 
+    fit(value ~ date, training(splits))
+}
+
+
+extract_results <- function(x,y){
+    res <-  x |>     filter(.key=="prediction") |>
+    select(.index, .value)  |>
+    mutate(geo=y)
+
+return(res)
+    
+}
+
+
+###################################################################
+###################################################################
+###################################################################
+###################################################################
+
+
+
+
+
+tic()
+
+set.seed(1234)
+
+
+plan(multisession, workers = 3)
+
+choose_log <- 1
+
+
+present_month <- month(today())
+
+price_series <- readRDS("tourism.RDS") |>
+    arrange(geo, time_period) |>
+    rename("value"="obs_value",
+           "date"="time_period") |>
+    filter(geo %in% iso_map_eu27$iso2,
+           geo!="MT") 
+
+ms_list <- price_series |>
+    pull(geo) |>
+    su()
+
+## ms_list <- c("DE", "AT", "FI")
+
+ms_data <- future_map2(ms_list,choose_log,  extract_ms_data )
+
+
+splits_parallel <- future_map( ms_data, 
+ function(x)  time_series_split(x, assess = "3 months", cumulative = TRUE)
+)
+
+
+
+
+model_fit_arima_parallel <- future_map(splits_parallel, function(x) arima_parallel(x))
+
+
+model_table_parallel <-future_map(model_fit_arima_parallel, modeltime_table)
+
+
+testing_splits <- future_map(splits_parallel,testing )
+
+calibration_table_parallel <- future_map2(  model_table_parallel,  
+testing_splits,  modeltime_calibrate
+)
+
+refit_parallel <-future_map2( calibration_table_parallel,  ms_data, 
+                         modeltime_refit
+                     )
+
+
+new_forecast_parallel <- future_map2(refit_parallel, ms_data,
+ function(x,y)   modeltime_forecast(x,h = "3 months", actual_data = y)
+)
+
+
+
+out.total <- future_map2_dfr(new_forecast_parallel, ms_list,  extract_results)
+
+
+
+if (choose_log==1){
+
+        out.total <- out.total |>
+            mutate(.value=exp(.value))
+    }
+
+out.total <- out.total |>
+    mutate(month_nowcast=month(.index)) |>
+    filter(month_nowcast==present_month) |>
+    select(geo, month_nowcast, .value) |>
+    rename("value"=".value")
+
+fn <- paste("nowcast_hotel_nights_month_", present_month, ".xlsx", sep="" )
+
+save_excel(out.total, fn)
+
+
+fn2 <- paste("nowcast_tourism_month_", present_month, ".RDS", sep="" )
+
+saveRDS(out.total, fn2)
+
+
+
+toc()
+
+######################################################################
+
+print("So far so good")