fixing backtest truth data plot

Author: dsweber2

README.Rmd

@@ -330,7 +330,8 @@ And as a tibble of quantile level-value pairs:
 ```{r pivot_wider}
 four_week_ahead$predictions |>
   select(-.pred) |>
-  pivot_quantiles_longer(.pred_distn)
+  pivot_quantiles_longer(.pred_distn) |>
+  select(geo_value, forecast_date, target_date, quantile = .pred_distn_quantile_level, value = .pred_distn_value)
 ```
 
 The yellow dot gives the median prediction, while the blue intervals give the

README.md

@@ -294,16 +294,17 @@ And as a tibble of quantile level-value pairs:
 ``` r
 four_week_ahead$predictions |>
   select(-.pred) |>
-  pivot_quantiles_longer(.pred_distn)
+  pivot_quantiles_longer(.pred_distn) |>
+  select(geo_value, forecast_date, target_date, quantile = .pred_distn_quantile_level, value = .pred_distn_value)
 #> # A tibble: 20 × 5
-#>   geo_value values quantile_levels forecast_date target_date
-#>   <chr>      <dbl>           <dbl> <date>        <date>     
-#> 1 ca        0.0425            0.1  2021-08-01    2021-08-29 
-#> 2 ca        0.0803            0.25 2021-08-01    2021-08-29 
-#> 3 ca        0.115             0.5  2021-08-01    2021-08-29 
-#> 4 ca        0.150             0.75 2021-08-01    2021-08-29 
-#> 5 ca        0.187             0.9  2021-08-01    2021-08-29 
-#> 6 ma        0                 0.1  2021-08-01    2021-08-29 
+#>   geo_value forecast_date target_date quantile  value
+#>   <chr>     <date>        <date>         <dbl>  <dbl>
+#> 1 ca        2021-08-01    2021-08-29      0.1  0.198 
+#> 2 ca        2021-08-01    2021-08-29      0.25 0.285 
+#> 3 ca        2021-08-01    2021-08-29      0.5  0.345 
+#> 4 ca        2021-08-01    2021-08-29      0.75 0.405 
+#> 5 ca        2021-08-01    2021-08-29      0.9  0.491 
+#> 6 ma        2021-08-01    2021-08-29      0.1  0.0277
 #> # ℹ 14 more rows
 ```
 

man/figures/README-date-1.png

@@ -320,17 +320,27 @@ geo_choose <- "ca"
 forecasts_filtered <- forecasts |>
   filter(geo_value == geo_choose) |>
   mutate(time_value = version)
+# we need to add the ground truth data to the version faithful plot as well
+plotting_data <- bind_rows(
+  percent_cli_data,
+  percent_cli_data %>%
+    filter(version_faithful == "Version un-faithful") %>%
+    mutate(version_faithful = "Version faithful")
+)
 
 p1 <- # first plotting the forecasts as bands, lines and points
   ggplot(data = forecasts_filtered, aes(x = target_date, group = time_value)) +
   geom_ribbon(aes(ymin = `0.05`, ymax = `0.95`, fill = factor(time_value)), alpha = 0.4) +
   geom_line(aes(y = .pred, color = factor(time_value)), linetype = 2L) +
   geom_point(aes(y = .pred, color = factor(time_value)), size = 0.75) +
   # the forecast date
-  geom_vline(data = percent_cli_data |> filter(geo_value == geo_choose) |> select(-version_faithful), aes(color = factor(version), xintercept = version), lty = 2) +
+  geom_vline(
+    data = percent_cli_data |> filter(geo_value == geo_choose) |> select(-version_faithful),
+    aes(color = factor(version), xintercept = version),
+    lty = 2) +
   # the underlying data
   geom_line(
-    data = percent_cli_data |> filter(geo_value == geo_choose),
+    data = plotting_data |> filter(geo_value == geo_choose),
     aes(x = time_value, y = percent_cli, color = factor(version)),
     inherit.aes = FALSE, na.rm = TRUE
   ) +
@@ -357,7 +367,7 @@ p2 <-
     aes(color = factor(version), xintercept = version), lty = 2
   ) +
   geom_line(
-    data = percent_cli_data |> filter(geo_value == geo_choose),
+    data = plotting_data |> filter(geo_value == geo_choose),
     aes(x = time_value, y = percent_cli, color = factor(version)),
     inherit.aes = FALSE, na.rm = TRUE
   ) +

man/figures/README-show-processed-data-1.png

@@ -1,8 +1,8 @@
 ---
-title: "Get started with epipredict"
+title: "Get started with `epipredict`"
 output: rmarkdown::html_vignette
 vignette: >
-  %\VignetteIndexEntry{Get started with `{epipredict}`}
+  %\VignetteIndexEntry{Get started with `epipredict`}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---