Added as_fable.forecast

Resolves #239

NAMESPACE

@@ -18,6 +18,7 @@ S3method(aggregate_key,tbl_ts)
 S3method(as_dable,tbl_df)
 S3method(as_dable,tbl_ts)
 S3method(as_fable,fbl_ts)
+S3method(as_fable,forecast)
 S3method(as_fable,grouped_df)
 S3method(as_fable,grouped_ts)
 S3method(as_fable,tbl_df)

NEWS.md

@@ -9,6 +9,8 @@
   always match regardless of the value used.
 * Using `summarise()` with a fable will now retain the fable class if the 
   distribution still exists under the same variable name.
+* Added `as_fable.forecast()` to convert forecast objects from the forecast
+  package to work with fable.
 * Documentation improvements
 * Performance improvements
 

R/fable.R

@@ -79,6 +79,47 @@ as_fable.fbl_ts <- function(x, response, distribution, ...){
 #' @export
 as_fable.grouped_df <- as_fable.tbl_df
 
+#' @inheritParams forecast.mdl_df
+#' @rdname as-fable
+#' @export
+as_fable.forecast <- function(x, ..., point_forecast = list(.mean = mean)){
+  if(is.null(x$upper)){
+    # Without intervals, the best guess is the point forecast
+    dist <- distributional::dist_degenerate(x$mean)
+  } else {
+    if(!is.null(x$lambda)){
+      x$upper <- box_cox(x$upper, x$lambda)
+      x$lower <- box_cox(x$lower, x$lambda)
+    }
+    warn("Assuming intervals are computed from a normal distribution.")
+    level <- colnames(x$upper)[1]
+    level <- as.numeric(gsub("^[^0-9]+|%", "", level))/100
+    mid <- (x$upper[,1] - x$lower[,1])/2
+    mu <- x$lower[,1] + mid
+    sigma <- mid/(qnorm((1+level)/2))
+    dist <- distributional::dist_normal(mu = as.numeric(mu), sigma = as.numeric(sigma))
+    if(!is.null(x$lambda)){
+      dist <- distributional::dist_transformed(
+        dist, 
+        transform = purrr::partial(inv_box_cox, lambda = x$lambda), 
+        inverse = purrr::partial(box_cox, lambda = x$lambda)
+      )
+    }
+  }
+  out <- as_tsibble(x$mean)
+  dimnames(dist) <- "value"
+  out[["value"]] <- dist
+
+  point_fc <- compute_point_forecasts(dist, point_forecast)
+  out[names(point_fc)] <- point_fc
+
+  build_fable(
+    out,
+    response = "value",
+    distribution = "value"
+  )
+}
+
 build_fable <- function (x, response, distribution) {
   # If the response (from user input) needs converting
   response <- eval_tidy(enquo(response))