```r}-setup} if (interactive()) { this_id <- sample(mt$id, 1) } else { this_id <- "{{id}}" } mt %>% filter(id == this_id) -> selection index %>% filter(id == this_id) -> this_index wintermax %>% filter(id == this_id) -> this_wm avg_wintermax %>% filter(id == this_id) %>% mutate(end = max(this_wm$Parameter), start = end - 4) -> this_avg_wm if (max(selection$data[[1]]$UCL, na.rm = TRUE) > 1e4) { selection$data[[1]] %>% mutate_at(c("Estimate", "LCL", "UCL"), "/", 1e3) -> selection$data[[1]] this_index %>% mutate_at(vars(starts_with("p")), "/", 1e3) -> this_index this_wm %>% mutate_at(c("Estimate", "LCL", "UCL"), "/", 1e3) -> this_wm this_avg_wm %>% mutate_at(vars(starts_with("p")), "/", 1e3) -> this_avg_wm extra_lab <- "(x 1000)" } else { extra_lab <- "" } location_effect %>% filter(id == this_id) -> this_location imputations %>% filter(id == this_id) -> this_imputations
`r selection$title` ### Monthly totals (ref:mt-{{id}}) Monthly totals as subplots for _`r selection$scientific_name[1]`_ in `r selection$LocationGroup[1]`. ```r}-plot, fig.cap = "(ref:mt-{{id}})"} selection$data[[1]] %>% mutate(type = str_remove(type, " total") %>% factor(levels = c("observed", "imputed"))) %>% ggplot(aes(x = winter, y = Estimate, ymin = LCL, ymax = UCL)) + geom_ribbon(alpha = 0.2, aes(group = type)) + geom_line(aes(colour = type)) + facet_wrap(~month, scales = "free_y") + scale_y_continuous(paste("Monthly total after imputation", extra_lab), limits = c(0, NA)) + theme(axis.title.x = element_blank())
(ref:mt-{{id}}-2) Imputed monthly totals in a single plot for r selection$scientific_name[1]
in r selection$LocationGroup[1]
.
```r}-plot2, fig.cap = "(ref:mt-{{id}}-2)"} selection$data[[1]] %>% filter(type == "imputed total") %>% ggplot(aes(x = winter, y = Estimate, ymin = LCL, ymax = UCL)) + geom_ribbon(alpha = 0.2, aes(fill = month)) + geom_line(aes(colour = month)) + scale_y_continuous(paste("Monthly total after imputation", extra_lab), limits = c(0, NA)) + theme(axis.title.x = element_blank())
(ref:mt-{{id}}-3) Monthly totals (blue) combined with the yearly average (green) for _`r selection$scientific_name[1]`_ in `r selection$LocationGroup[1]`. ```r}-plot3, fig.cap = "(ref:mt-{{id}}-3)"} selection$data[[1]] %>% filter(type == "imputed total") %>% ggplot(aes(x = winter)) + stat_fan(data = this_index, aes(y = Estimate, link_sd = SE), fill = inbo.steun.geelgroen, link = "log") + geom_ribbon(aes(ymin = LCL, ymax = UCL), alpha = 0.2) + geom_line(aes(y = Estimate)) + geom_line( data = this_index, aes(y = Estimate), colour = inbo_steun_geelgroen ) + facet_wrap(~month, scales = "free_y") + scale_y_continuous(paste("Monthly total after imputation", extra_lab), limits = c(0, NA)) + theme(axis.title.x = element_blank())
(ref:wm-{{id}}) Winter maximum after imputation for r selection$scientific_name[1]
in r selection$LocationGroup[1]
.
```r}-plot, fig.cap = "(ref:wm-{{id}})"} ggplot(this_wm, aes(x = Parameter, y = Estimate, ymin = LCL, ymax = UCL)) + geom_ribbon(alpha = 0.2) + geom_line() + scale_y_continuous(paste("Winter maximum after imputation", extra_lab)) + theme(axis.title.x = element_blank())
(ref:wm-{{id}}-2) Winter maximum after imputation with indication of the average over the last five years for _`r selection$scientific_name[1]`_ in `r selection$LocationGroup[1]`. ```r}-plot2, fig.cap = "(ref:wm-{{id}}-2)"} tibble( Parameter = this_avg_wm$start:this_avg_wm$end, Estimate = this_avg_wm$Estimate, SE = this_avg_wm$SE ) -> this_avg_wm ggplot(this_wm, aes(x = Parameter, y = Estimate)) + stat_fan(data = this_avg_wm, aes(link_sd = SE), fill = inbo.steun.geelgroen) + geom_ribbon(aes(ymin = LCL, ymax = UCL), alpha = 0.2) + geom_line() + geom_line(data = this_avg_wm, colour = inbo.steun.geelgroen) + scale_y_continuous(paste("Winter maximum after imputation", extra_lab)) + theme(axis.title.x = element_blank())
if (nrow(this_location)) { cat("### Importance of locations") }
(ref:location-{{id}}) Histogram of the relative importance of the sites for r selection$scientific_name[1]
in r selection$LocationGroup[1]
.
```r}, fig.cap = "(ref:location-{{id}})"} if (nrow(this_location)) { cat("### Importance of locations\n\n") this_location %>% ggplot(aes(x = Estimate)) + geom_histogram(binwidth = 0.05) + scale_x_continuous("Relative importance of a site", labels = percent) + ylab("number of sites") }
```r}, results = "asis"} if (nrow(this_location)) { this_location %>% arrange(desc(Estimate)) %>% head(20) %>% transmute( location, effect = sprintf("%.1f%% (%.1f%%; %.1f%%)", 100 * Estimate, 100 * LCL, 100 * UCL)) %>% pandoc.table( caption = sprintf("Most important sites for _%s_ in %s.", selection$scientific_name[1], selection$LocationGroup[1]), split.cells = 60, split.table = Inf) }
r}, warnings = FALSE, echo = FALSE, message = FALSE}
if (nrow(this_imputations)) {
this_imputations %>%
group_by(location) %>%
nest() %>%
mutate(plot = map2(
data, location,
~ggplot(.x, aes(x = year, y = Estimate, ymin = LCL, ymax = UCL)) +
geom_errorbar(data = filter(.x, !is.na(LCL))) +
geom_line() +
geom_point(aes(colour = factor(is.na(LCL), levels = c(TRUE, FALSE),
labels = c("observed", "imputed")))) +
facet_wrap(~month, scales = "free_y") +
labs(y = "count", title = .y, colour = "status") +
theme(axis.title.x = element_blank())) %>%
map(print)
) -> junk
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.