From 8415e2b09f619f214e03217e7210e265bd2b9f2b Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 21:27:32 -0700 Subject: [PATCH 1/3] Closes #1568. Implemented `to_basic` for `fabletools:::autoplot.fbl_ts`. --- R/layers2traces.R | 35 +++++++++++++++++++++++++++++++++++ 1 file changed, 35 insertions(+) diff --git a/R/layers2traces.R b/R/layers2traces.R index 0387d34c5c..c0636b671f 100644 --- a/R/layers2traces.R +++ b/R/layers2traces.R @@ -613,6 +613,41 @@ to_basic.GeomQuantile <- function(data, prestats_data, layout, params, p, ...){ dat } +to_basic.GeomHiloLinerange <- function(data, ...){ + prefix_class(data, "GeomPath") +} + +transform_hiloribbon <- function(data) { + data <- data[order(data$x), ] + data$hilo <- NULL + + data$x_plotlyDomain <- as.character(data$x_plotlyDomain) + + maximum_lev <- max(data$level) + 1 + + data$alpha <- (maximum_lev * (maximum_lev - data$level) - 1 )/ maximum_lev**3 + data$colour <- data$alpha + + unused_aes <- ! names(data) %in% c("x", "y", "ymin", "ymax") + + row_number <- nrow(data) + + data_rev <- data[row_number:1L, ] + structure(rbind( + cbind(x = data$x, y = data$ymin, data[unused_aes]), + cbind(x = data$x[row_number], y = data$ymin[row_number], data[row_number, unused_aes]), + cbind(x = data_rev$x, y = data_rev$ymax, data_rev[unused_aes]) + ), class = class(data)) +} + +to_basic.GeomHiloRibbon <- function(data, ...){ + prefix_class(transform_hiloribbon(data), "GeomPolygon") +} + +#' @export +to_basic.data.frame <- function(data, prestats_data, layout, params, p, ...) { + prefix_class(data, "GeomPath") +} #' @export to_basic.default <- function(data, prestats_data, layout, params, p, ...) { data From c876c1d50b2f0da8514349aa1b40cd47d3db3c34 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 21:42:58 -0700 Subject: [PATCH 2/3] Added visual tests. --- tests/testthat/_snaps/fabletools/autoplot-fable.svg | 1 + tests/testthat/test-fabletools.R | 12 ++++++++++++ 2 files changed, 13 insertions(+) create mode 100644 tests/testthat/_snaps/fabletools/autoplot-fable.svg create mode 100644 tests/testthat/test-fabletools.R diff --git a/tests/testthat/_snaps/fabletools/autoplot-fable.svg b/tests/testthat/_snaps/fabletools/autoplot-fable.svg new file mode 100644 index 0000000000..b735428d81 --- /dev/null +++ b/tests/testthat/_snaps/fabletools/autoplot-fable.svg @@ -0,0 +1 @@ +50075010005007501000501001502002502000 Q12005 Q12010 Q12015 Q12020 Q1500750100012501500level.model(arima,1)(arima,2)(arima,3)(arima,4)(ets,1)(ets,2)(ets,3)(ets,4)QuarterTripsMelbourneVictoriaBusinessMelbourneVictoriaHolidayMelbourneVictoriaOtherMelbourneVictoriaVisiting diff --git a/tests/testthat/test-fabletools.R b/tests/testthat/test-fabletools.R new file mode 100644 index 0000000000..bf25a88f4b --- /dev/null +++ b/tests/testthat/test-fabletools.R @@ -0,0 +1,12 @@ +test_that("mimics the autoplot output", { + # taken from https://fable.tidyverts.org/articles/fable.html + p <- tsibble::tourism %>% + filter(Region == "Melbourne") %>% + model( + ets = ETS(Trips ~ trend("A")), + arima = ARIMA(Trips) + ) %>% + forecast(h = "5 years") %>% + autoplot(tourism_melb) + expect_doppelganger(ggplotly(p), "autoplot-fable") +}) \ No newline at end of file From c240972c2b92bd672551bb46ce77c0cf305f4c29 Mon Sep 17 00:00:00 2001 From: Abdessabour Moutik Date: Tue, 12 Oct 2021 22:05:33 -0700 Subject: [PATCH 3/3] Modified the visual tests to better showcase the functionality. --- tests/testthat/_snaps/fabletools/autoplot-fable.svg | 2 +- tests/testthat/test-fabletools.R | 9 ++++++--- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/tests/testthat/_snaps/fabletools/autoplot-fable.svg b/tests/testthat/_snaps/fabletools/autoplot-fable.svg index b735428d81..f9eedd87b0 100644 --- a/tests/testthat/_snaps/fabletools/autoplot-fable.svg +++ b/tests/testthat/_snaps/fabletools/autoplot-fable.svg @@ -1 +1 @@ -50075010005007501000501001502002502000 Q12005 Q12010 Q12015 Q12020 Q1500750100012501500level.model(arima,1)(arima,2)(arima,3)(arima,4)(ets,1)(ets,2)(ets,3)(ets,4)QuarterTripsMelbourneVictoriaBusinessMelbourneVictoriaHolidayMelbourneVictoriaOtherMelbourneVictoriaVisiting +2000 Q12005 Q12010 Q12015 Q12020 Q15007501000QuarterTrips diff --git a/tests/testthat/test-fabletools.R b/tests/testthat/test-fabletools.R index bf25a88f4b..c7f4e8547c 100644 --- a/tests/testthat/test-fabletools.R +++ b/tests/testthat/test-fabletools.R @@ -1,12 +1,15 @@ test_that("mimics the autoplot output", { # taken from https://fable.tidyverts.org/articles/fable.html - p <- tsibble::tourism %>% + data <- tsibble::tourism %>% filter(Region == "Melbourne") %>% + `[`(, c("Quarter", "Trips", "Region")) %>% + distinct(Quarter, .keep_all = TRUE) %>% + as_tsibble(key = Region) + p <- data %>% model( ets = ETS(Trips ~ trend("A")), - arima = ARIMA(Trips) ) %>% forecast(h = "5 years") %>% - autoplot(tourism_melb) + autoplot(data) expect_doppelganger(ggplotly(p), "autoplot-fable") }) \ No newline at end of file