Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Simplify code for ensemble of simulated paths #1

Merged
merged 1 commit into from
Aug 9, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 6 additions & 13 deletions README.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -94,23 +94,16 @@ Ensemble combining ETS and ARIMA sample paths

```{r ensemble, message=FALSE}
ensemble <- fit %>%
select(ETS, ARIMA) %>%
select(-SNAIVE) %>%
generate(times = 10000, h = "1 year") %>%
as_tibble() %>%
select(-.rep, -.model) %>%
nest(sample = -date) %>%
group_by(date) %>%
summarise(
.model = "ENSEMBLE",
sample = list(unname(unlist(sample)))
value = dist_sample(list(.sim)),
.mean = mean(value)
) %>%
ungroup() %>%
mutate(
value = dist_sample(sample),
.mean = mean(value),
) %>%
select(-sample) %>%
as_fable(index = date, key = ".model", distribution = value, response = "value")
.model = "ENSEMBLE"
) %>%
as_fable(distribution = value, response = "value")
```

CRPS calculations
Expand Down
23 changes: 8 additions & 15 deletions README.md
Original file line number Diff line number Diff line change
Expand Up @@ -83,23 +83,16 @@ Ensemble combining ETS and ARIMA sample paths

``` r
ensemble <- fit %>%
select(ETS, ARIMA) %>%
select(-SNAIVE) %>%
generate(times = 10000, h = "1 year") %>%
as_tibble() %>%
select(-.rep, -.model) %>%
nest(sample = -date) %>%
group_by(date) %>%
summarise(
.model = "ENSEMBLE",
sample = list(unname(unlist(sample)))
value = dist_sample(list(.sim)),
.mean = mean(value)
) %>%
ungroup() %>%
mutate(
value = dist_sample(sample),
.mean = mean(value),
) %>%
select(-sample) %>%
as_fable(index = date, key = ".model", distribution = value, response = "value")
.model = "ENSEMBLE"
) %>%
as_fable(distribution = value, response = "value")
#> Warning: The dimnames of the fable's distribution are missing and have been set
#> to match the response variables.
```
Expand All @@ -124,6 +117,6 @@ crps %>%
#> 1 SNAIVE Test 68.6 0
#> 2 ARIMA Test 32.9 52.0
#> 3 ETS Test 31.5 54.0
#> 4 ENSEMBLE Test 31.4 54.3
#> 5 COMBINATION Test 30.9 54.9
#> 4 COMBINATION Test 30.9 54.9
#> 5 ENSEMBLE Test 29.7 56.7
```
17 changes: 5 additions & 12 deletions quantile_ensembles.Rmd
Original file line number Diff line number Diff line change
Expand Up @@ -156,21 +156,14 @@ For the Australian café data, we can combine 10000 simulated sample paths from
ensemble <- fit %>%
select(-SNAIVE) %>%
generate(times = 10000, h = "1 year") %>%
as_tibble() %>%
select(-.rep, -.model) %>%
nest(sample = -date) %>%
group_by(date) %>%
summarise(
.model = "ENSEMBLE",
sample = list(unname(unlist(sample)))
value = dist_sample(list(.sim)),
.mean = mean(value)
) %>%
ungroup() %>%
mutate(
value = dist_sample(sample),
.mean = mean(value),
) %>%
select(-sample) %>%
as_fable(index = date, key = ".model", distribution = value, response = "value")
.model = "ENSEMBLE"
) %>%
as_fable(distribution = value, response = "value")
ensemble %>%
accuracy(cafe, measures = list(CRPS = CRPS)) %>%
mutate(
Expand Down