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

Commit MetaInfo

• Revisión: 3a489fb6339d1748bd331dc3133de7ed31bfa55f (tree)
• Tiempo: 2022-11-24 00:53:33
• Autor: Lorenzo Isella <lorenzo.isella@gmai...>
• Commiter: Lorenzo Isella

Log Message

A rewriting of the arima code using the map function instead of loops. The final step will be the parallelized version of map.

Cambiar Resumen

• add: R-codes/arima_simple1_parallel.R

Diferencia incremental

diff -r 9eca22cd1b5f -r 3a489fb6339d R-codes/arima_simple1_parallel.R
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/R-codes/arima_simple1_parallel.R	Wed Nov 23 16:53:33 2022 +0100
@@ -0,0 +1,151 @@
+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(workflowsets)
+library(furrr)
+
+tidymodels_prefer()
+
+plan(multisession, workers = 4)
+
+source("/home/lorenzo/myprojects-hg/R-codes/stat_lib.R")
+
+
+choose_log <- 1
+
+
+present_month <- month(today())
+
+price_series <- readRDS("price.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")
+
+
+tic()
+
+out.total <- c()
+
+
+set.seed(1234)
+
+
+ff <- function( ms){
+
+    res <- price_series |>
+        filter(geo==ms)|>
+    select(-geo) 
+
+    if (choose_log==1){
+        res <- res|>
+            mutate(value=log(value))
+        
+    }
+    
+}
+
+
+ms_data <- map(ms_list,  ff )
+
+
+splits_parallel <- map( ms_data, 
+ function(x)  time_series_split(x, assess = "3 months", cumulative = TRUE)
+)
+
+
+
+arima_parallel <- function(splits){ arima_reg() |> 
+    set_engine("auto_arima") |> 
+    fit(value ~ date, training(splits))
+}
+
+model_fit_arima_parallel <- map(splits_parallel, function(x) arima_parallel(x))
+
+
+model_table_parallel <-map(model_fit_arima_parallel, modeltime_table)
+
+## calibration_table_parallel <- map2( model_table,
+                                   
+##   modeltime_calibrate(testing(splits)))
+
+testing_splits <- map(splits_parallel,testing )
+
+calibration_table_parallel <- map2(  model_table_parallel,  
+testing_splits,  modeltime_calibrate
+)
+
+refit_parallel <-map2( calibration_table_parallel,  ms_data, 
+                         modeltime_refit
+                     )
+
+
+new_forecast_parallel <- map2(refit_parallel, ms_data,
+ function(x,y)   modeltime_forecast(x,h = "3 months", actual_data = y)
+)
+
+
+ff2 <- function(x,y){
+    res <-  x |>     filter(.key=="prediction") |>
+    select(.index, .value)  |>
+    mutate(geo=y)
+
+return(res)
+    
+}
+
+out.total <- map2_df(new_forecast_parallel, ms_list,  ff2)
+
+
+
+
+## out.total <- out.forecast_parallel |>
+##         filter(.key=="prediction") |>
+##         select(.index, .value) |>
+##         mutate(geo=sel_ms)
+
+
+
+
+    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_price_month_", present_month, ".xlsx", sep="" )
+
+save_excel(out.total, fn)
+
+######################################################################
+
+
+
+
+
+
+
+
+
+print("So far so good")