Skip to content

Commit 25cfda1

Browse files
committed
fix: shiny needs ensembles (halfway there)
1 parent c16ec13 commit 25cfda1

File tree

3 files changed

+15
-121
lines changed

3 files changed

+15
-121
lines changed

R/targets_utils.R

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -28,14 +28,14 @@ make_target_param_grid <- function(param_grid) {
2828
#' @param ONE_AHEAD_FORECAST_NAME the extra bit of name that is shared by all
2929
#' @export
3030
#' @importFrom rlang syms
31-
make_target_ensemble_grid <- function(param_grid, ONE_AHEAD_ENSEMBLE_NAME = "ensemble_by_ahead") {
31+
make_target_ensemble_grid <- function(param_grid, ONE_AHEAD_FORECASTER_NAME = "forecast_by_ahead") {
3232
param_grid$ensemble_params <- map(param_grid$ensemble_params, sym_subset)
3333
param_grid %<>%
3434
mutate(ensemble = syms(ensemble)) %>%
3535
mutate(ensemble_params_names = list(names(ensemble_params))) %>%
3636
select(-forecasters) %>%
3737
relocate(id, .before = everything()) %>%
38-
mutate(forecaster_ids = list(syms(paste(ONE_AHEAD_ENSEMBLE_NAME, forecaster_ids, sep = "_"))))
38+
mutate(forecaster_ids = list(syms(paste(ONE_AHEAD_FORECASTER_NAME, forecaster_ids, sep = "_"))))
3939
return(param_grid)
4040
}
4141
#' function to map
@@ -307,7 +307,7 @@ make_ensemble_targets_and_scores <- function() {
307307
}
308308
),
309309
tar_target(
310-
name = score,
310+
name = ensemble_score,
311311
command = {
312312
bind_rows(score_component_ids) %>%
313313
mutate(parent_ensemble = parent_id)

covid_hosp_explore.R

Lines changed: 10 additions & 116 deletions
Original file line numberDiff line numberDiff line change
@@ -40,21 +40,21 @@ make_unique_ensemble_grid <- function() {
4040
),
4141
# median forecaster
4242
"ensemble_average",
43-
list(
44-
forecaster = "scaled_pop",
45-
trainer = "linreg",
46-
pop_scaling = FALSE,
47-
lags = c(0, 3, 5, 7, 14)
48-
),
43+
list(average_type = "median"),
4944
list(
5045
list(
5146
forecaster = "scaled_pop",
5247
trainer = "linreg",
5348
pop_scaling = TRUE,
5449
lags = c(0, 3, 5, 7, 14)
5550
),
51+
list(
52+
forecaster = "scaled_pop",
53+
trainer = "linreg",
54+
pop_scaling = FALSE,
55+
lags = c(0, 3, 5, 7, 14)
56+
)
5657
),
57-
list(average_type = "median"),
5858
)
5959
}
6060

@@ -155,7 +155,7 @@ ensembles_and_scores_by_ahead <- tar_map(
155155
priority = .9999
156156
),
157157
tar_target(
158-
name = ONE_AHEAD_SCORE_NAME,
158+
name = score_by_ahead,
159159
command = {
160160
run_evaluation_measure(
161161
data = ensemble_by_ahead,
@@ -169,113 +169,7 @@ ensembles_and_scores_by_ahead <- tar_map(
169169
}
170170
)
171171
)
172-
## env <- list(ensemble_forecast_name = as.symbol(paste(ONE_AHEAD_ENSEMBLE_NAME,
173-
## target_ensemble_grid[[i_ensemble, "id"]],
174-
## sep = "_"
175-
## )))
176-
177-
## make_ensemble_targets_by_ahead <- function() {
178-
## ensembles_by_ahead <- list()
179-
## ensemble_scores_by_ahead <- list()
180-
## for (i_ensemble in 1:nrow(target_ensemble_grid)) {
181-
## ensemble <- target_ensemble_grid[[i_ensemble, "ensemble"]][[1]]
182-
## models_to_ensemble <-
183-
## map(paste(ONE_AHEAD_FORECAST_NAME, target_ensemble_grid[[i_ensemble, "forecaster_ids"]][[1]], sep = "_"), as.symbol)
184-
## ensemble_params <-
185-
## target_ensemble_grid[[i_ensemble, "ensemble_params"]][[1]]
186-
## ensemble_params_names <-
187-
## target_ensemble_grid[[i_ensemble, "ensemble_params_names"]]
188-
## archive <- sym("joined_archive_data_2022")
189-
## ensemble_id <- (target_ensemble_grid[[i_ensemble, "id"]])
190-
191-
## ## passed_on_variables <- list(
192-
## ## ensemble = target_ensemble_grid[[i_ensemble, "ensemble"]][[1]],
193-
## ## models_to_ensemble =
194-
## ## map(paste(ONE_AHEAD_FORECAST_NAME, target_ensemble_grid[[i_ensemble, "forecaster_ids"]][[1]], sep = "_"), sym),
195-
## ## ensemble_params =
196-
## ## target_ensemble_grid[[i_ensemble, "ensemble_params"]][[1]],
197-
## ## ensemble_params_names =
198-
## ## target_ensemble_grid[[i_ensemble, "ensemble_params_names"]],
199-
## ## archive = sym("joined_archive_data_2022")
200-
## ## )
201-
202-
## ## (ensembles_by_ahead[[i_ensemble]] <- tar_combine_raw(
203-
## ## name = "DO THE NEEDFUL",
204-
## ## !!models_to_ensemble,
205-
## ## command = {
206-
## ## browser()
207-
## ## !!!.x
208-
## ## }
209-
## ## ))
210-
211-
## ensembles_by_ahead[[i_ensemble]] <- tar_target_raw(
212-
## name = paste(ONE_AHEAD_ENSEMBLE_NAME, ensemble_id, sep = "_"),
213-
## command = eval(
214-
## substitute(
215-
## ensemble(archive,
216-
## models_to_ensemble,
217-
## "hhs",
218-
## extra_sources = "chng",
219-
## ensemble_params,
220-
## ensemble_params_names
221-
## )
222-
## ),
223-
## env = passed_on_variables
224-
## ),
225-
## priority = .9999
226-
## )
227-
## ## ensemble_name <- target_ensemble_grid[[i_ensemble, "id"]]
228-
## ## list_of_dependent_forecasters <- target_ensemble_grid[[i_ensemble, "ensemble"]][[1]]
229-
## ## ensembles_by_ahead[[i_ensemble]] <- tar_target(
230-
## ## name = paste(!!ONE_AHEAD_ENSEMBLE_NAME, !!ensemble_name, sep = "_"),
231-
## ## command = {
232-
## ## !!()(archive,
233-
## ## list_of_dependent_forecasters,
234-
## ## models_to_ensemble,
235-
## ## "hhs",
236-
## ## extra_sources = "chng",
237-
## ## !!(target_ensemble_grid[[i_ensemble, "ensemble_params"]][[1]]),
238-
## ## !!(target_ensemble_grid[[i_ensemble, "ensemble_params"]][[1]])
239-
## ## )
240-
## ## }
241-
## ## )
242-
243-
## ## ensembles_by_ahead[[i_ensemble]] <- tar_target_raw(
244-
## ## name = paste(!!ONE_AHEAD_ENSEMBLE_NAME, !!(target_ensemble_grid[[i_ensemble, "id"]]), sep = "_"),
245-
## ## command = substitute(
246-
## ## ensemble(archive,
247-
## ## models_to_ensemble,
248-
## ## "hhs",
249-
## ## extra_sources = "chng",
250-
## ## ensemble_params,
251-
## ## ensemble_params_names
252-
## ## ),
253-
## ## env = passed_on_variables
254-
## ## )
255-
## ## )
256-
## ## ensemble_scores_by_ahead[[i_ensemble]] <- tar_target_raw(
257-
## ## name = paste(ONE_AHEAD_SCORE_NAME, target_ensemble_grid[[i_ensemble, "id"]], sep = "_"),
258-
## ## command = substitute(
259-
## ## run_evaluation_measure(
260-
## ## data = ensemble_forecast_name,
261-
## ## evaluation_data = hhs_evaluation_data,
262-
## ## measure = list(
263-
## ## wis = weighted_interval_score,
264-
## ## ae = absolute_error,
265-
## ## cov_80 = interval_coverage(0.8)
266-
## ## )
267-
## ## ),
268-
## ## env = list(ensemble_forecast_name = as.symbol(paste(ONE_AHEAD_ENSEMBLE_NAME,
269-
## ## target_ensemble_grid[[i_ensemble, "id"]],
270-
## ## sep = "_"
271-
## ## )))
272-
## ## )
273-
## ## )
274-
## }
275-
## return(c(ensembles_by_ahead, ensemble_scores_by_ahead))
276-
## }
277-
# ensembles_and_scores_by_ahead <- make_ensemble_targets_by_ahead()
278-
# ensembles_and_scores <- make_ensemble_targets_and_scores()
172+
ensembles_and_scores <- make_ensemble_targets_and_scores()
279173
# other sources
280174
external_names_and_scores <- make_external_names_and_scores()
281175

@@ -286,6 +180,6 @@ list(
286180
forecasts_and_scores,
287181
ensembles_params_grid_target,
288182
ensembles_and_scores_by_ahead,
289-
# ensembles_and_scores,
183+
ensembles_and_scores,
290184
external_names_and_scores
291185
)

run.R

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -119,12 +119,12 @@ if (use_shiny == "y") {
119119
)
120120

121121
# Add ensembles
122-
ensemble_options <- tar_read(ensembles)[["a"]]
122+
ensemble_options <- tar_read(ensemble_forecasters)[["parent_id"]]
123123
ensemble_options <- setNames(
124124
# File names
125125
paste0("ensemble_score_", ensemble_options),
126126
# Display names
127-
paste0("ensemble score ", ensemble_options)
127+
paste0("ensemble.", ensemble_options)
128128
)
129129

130130
external_options <- tar_read(external_names)

0 commit comments

Comments
 (0)