diff --git a/DESCRIPTION b/DESCRIPTION index aed619c5..8fff143b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -17,6 +17,9 @@ Authors@R: role = "ctb"), person(given = "George", family = "Athanasopoulos", + role = "ctb"), + person(given = "David", + family = "Holt", role = "ctb")) Description: Provides tools, helpers and data structures for developing models and time series functions for 'fable' and extension diff --git a/NEWS.md b/NEWS.md index f1757ed2..c0275904 100644 --- a/NEWS.md +++ b/NEWS.md @@ -30,7 +30,8 @@ allowing unbalanced hierarchies to be reconciled. * Produce unique names for unnamed features used with `features()` (#258). * Documentation improvements -* Performance improvements +* Performance improvements, including using `future.apply()` to parallelize + `forecast()` when the `future` package is attached (#268). ## Breaking changes diff --git a/R/forecast.R b/R/forecast.R index ae10226d..6da48efc 100644 --- a/R/forecast.R +++ b/R/forecast.R @@ -105,13 +105,38 @@ forecast.mdl_df <- function(object, new_data = NULL, h = NULL, object <- bind_new_data(object, new_data) } - # Evaluate forecasts - object <- dplyr::mutate_at(as_tibble(object), vars(!!!mdls), - forecast, object[["new_data"]], - h = h, point_forecast = point_forecast, ..., - key_data = key_data(object)) + object <- tidyr::pivot_longer(object, !!mdls, names_to = ".model", values_to = ".mdl") - object <- tidyr::pivot_longer(object, !!mdls, names_to = ".model", values_to = ".fc") + # Evaluate forecasts + if(is_attached("package:future")){ + require_package("future.apply") + + object[[".fc"]] <- future.apply::future_mapply( + FUN = forecast, + object[[".mdl"]], + MoreArgs = list( + h = h, + point_forecast = point_forecast, + ..., + key_data = key_data(object) + ), + SIMPLIFY = FALSE, + future.globals = FALSE + ) + } + else{ + object[[".fc"]] <- mapply( + FUN = forecast, + object[[".mdl"]], + MoreArgs = list( + h = h, + point_forecast = point_forecast, + ..., + key_data = key_data(object) + ), + SIMPLIFY = FALSE + ) + } # Combine and re-construct fable fbl_attr <- attributes(object$.fc[[1]])