beetles.qmd

---
title: "Beetles"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message=FALSE, warning=FALSE)
source("R/plot-utils.R")
score4cast::ignore_sigpipe()

```

```{r}
theme <- "beetles"
cutoff <- as.character(Sys.Date() - 120)
combined <- arrow::open_dataset(glue("cache/parquet/{theme}")) |>
  filter(date >= cutoff) |> collect()

```

## Forecasts

These plots show forecasts that were submitted on `r cutoff` for which we have at least 10 observations.\
Models which did not submit a forecast on the given reference date are not shown.
```{r}
sites <- combined |>
  distinct(site_id) |>
  collect() |> 
  pull(site_id)
## with at least n observations to compare!
n_data <- 30
who <- combined |>
  filter(!is.na(observation)) |> 
  distinct(reference_datetime) |> 
  arrange(desc(reference_datetime)) |>
  collect()

ref <- as.character (who[1,"reference_datetime"]) # 
```

### richness

::: panel-tabset
```{r}
richness <- combined |> 
  filter(reference_datetime == ref, variable == "richness")
```

## Sites 1 - 8

```{r}
richness |>  filter(site_id %in% sites[1:8]) |> forecast_plots(ncol=4)
```

## Sites 9 - 16

```{r}
richness |> filter(site_id %in% sites[9:16]) |> forecast_plots(ncol=4)
```

## Sites 17 - 24

```{r}
richness |>  filter(site_id %in% sites[17:24]) |> forecast_plots(ncol=4)
```

## Sites 25 - 32

```{r}
richness |> filter(site_id %in% sites[25:32]) |> forecast_plots(ncol=4)
```

## Sites 33 - 40

```{r}
richness |>  filter(site_id %in% sites[33:40]) |> forecast_plots(ncol=4)
```

## Sites 41 - 47

```{r}
richness |> filter(site_id %in% sites[41:47]) |> forecast_plots(ncol=4)
```
:::

### abundance

::: panel-tabset
```{r}
abundance <- combined |> 
  filter(reference_datetime == ref, variable == "abundance")
```

## Sites 1 - 8

```{r}
abundance |>  filter(site_id %in% sites[1:8]) |> forecast_plots(ncol=4)
```

## Sites 9 - 16

```{r}
abundance |> filter(site_id %in% sites[9:16]) |> forecast_plots(ncol=4)
```

## Sites 17 - 24

```{r}
abundance |>  filter(site_id %in% sites[17:24]) |> forecast_plots(ncol=4)
```

## Sites 25 - 32

```{r}
abundance |> filter(site_id %in% sites[25:32]) |> forecast_plots(ncol=4)
```

## Sites 33 - 40

```{r}
abundance |>  filter(site_id %in% sites[33:40]) |> forecast_plots(ncol=4)
```

## Sites 41 - 47

```{r}
abundance |> filter(site_id %in% sites[41:47]) |> forecast_plots(ncol=4)
```
:::

## Leaderboard

Average skill scores of each model across all sites.\
Scores are shown by reference date and forecast horizon (in days).\
Scores are averaged across all submissions of the model with a given horizon or a given `reference_datetime` out of submissions made since the cutoff date.

::: panel-tabset
## richness

```{r}
leaderboard_plots(combined, "richness", horizon_cutoff=100)

```

## abundance

```{r}
leaderboard_plots(combined, "abundance", horizon_cutoff=100)
```
:::

## Submission statistics

```{r}
n_models <- combined |> distinct(model_id) |> nrow()
n_forecasts <- combined |> distinct(reference_datetime, model_id) |> nrow()
```

Between `r cutoff` and `r Sys.Date()`:

- `r n_models` models have submitted a total of `r n_forecasts` forecasts to this challenge

```{r}
current_day <- Sys.Date()

combined |> 
  distinct(model_id, reference_datetime) |>
  count(model_id, sort=TRUE) |>
  filter(n > 1) |>
  mutate(model_id = fct_reorder(model_id, n)) |>
  ggplot(aes(model_id, n, fill=model_id)) +
  geom_col(show.legend = FALSE) + 
  coord_flip() + 
  theme_bw() + 
  theme(axis.text=element_text(size=6)) +
  ggtitle(glue("Number of forecast submissions since {cutoff}"))
```