if (params$target == "nhsn") {
scaled_WIS_plot <- knitr::knit_expand(
text = c(
"## Mean WIS per capita\n",
"\n",
"```{r moving_average_wis_rate, echo=FALSE, message=FALSE, out.width='100%'}\n",
"plotting_score(sliding_ordered, mean_wis_rate) %>% gplot()\n",
"```\n",
"\n")
)
plot2 <- knitr::knit_expand(
text = c(
"## All by WIS per capita\n",
"```{r plotting_all_recent_forecasts, out.width='300%', fig.dim=c(12,60), fig.align = 'center', message=FALSE, eval = params$target == 'nhsn'}\n",
"plotting_forecasts(plotting_window = this_week - 12 * 7, score_window = 8, geo_score_rate_order, n_plotting = 60)\n",
"```\n",
"\n"
))
}
The states most likely to be subject to total revisions requiring substitution.
recent_archive$DT %<>% mutate(geo_value = factor(geo_value, levels = av_re_spread$geo_value))
recent_archive %>%
autoplot("value") +
facet_wrap(~geo_value, ncol = 3, scales = "free") +
theme(strip.text.x = element_text(size = 8)) +
ylim(0, NA) +
labs(title = "States with the largest mean revision")
Plotting the forecasts from 8 weeks ago until 3 weeks ago for each geography, sorted by WIS or population scaled WIS.
if (params$target == "nhsn") {
plot1 <- knitr::knit_expand(
text = c(
"## Worst 5 by WIS per capita\n",
"```{r plotting_recent_forecasts, out.width='300%', fig.dim=c(10,5), fig.align = 'center', echo=FALSE, message=FALSE, eval = params$target == 'nhsn'}\n",
"plotting_forecasts(plotting_window = this_week - 12 * 7, score_window = 8, geo_score_rate_order, n_plotting = 5)\n",
"```\n",
"\n")
)
plot2 <- knitr::knit_expand(
text = c(
"## All by WIS per capita\n",
"```{r plotting_all_recent_forecasts, out.width='300%', fig.dim=c(12,60), fig.align = 'center', message=FALSE, eval = params$target == 'nhsn'}\n",
"plotting_forecasts(plotting_window = this_week - 12 * 7, score_window = 8, geo_score_rate_order, n_plotting = 60)\n",
"```\n",
"\n"
))
}
plotting_forecasts(plotting_window = this_week - 12 * 7, score_window = 8, geo_score_rate_order, n_plotting = 60)
geo_score_order <- scores %>%
filter(forecast_date > this_week - score_window * 7) %>%
scores_by_state() %>%
filter(forecaster == "CMU-TimeSeries") %>%
arrange(desc(mean_wis)) %>% pull(geo_value)
plotting_forecasts(plotting_window = this_week - 12 * 7, score_window = 8, geo_score_order, n_plotting = 60)