fixing beetles null

baseline_models/models/beetles_mean.R

@@ -4,7 +4,7 @@ library(distributional)
 library(tidyverse)
 
 
-## Get the latest beetle target data.  
+## Get the latest beetle target data.
 download.file("https://data.ecoforecast.org/neon4cast-targets/beetles/beetles-targets.csv.gz",
               "beetles-targets.csv.gz")
 targets <-  read_csv("beetles-targets.csv.gz")
@@ -25,53 +25,54 @@ last_day_abundance <- tibble(site_id = site_list,
                             variable = "abundance",
                             observation = NA)
 
-targets_richness <- targets |> 
-  filter(variable == "richness") |> 
-  bind_rows(last_day_richness) |> 
-  rename(richness = observation) |> 
-  select(-variable) |> 
+targets_richness <- targets |>
+  filter(variable == "richness") |>
+  bind_rows(last_day_richness) |>
+  rename(richness = observation) |>
+  select(-variable) |>
   as_tsibble(index = datetime, key = site_id)
 
-targets_abundance <- targets |> 
-  filter(variable == "abundance") |> 
-  bind_rows(last_day_abundance) |> 
-  rename(abundance = observation) |> 
-  select(-variable) |> 
+targets_abundance <- targets |>
+  filter(variable == "abundance") |>
+  bind_rows(last_day_abundance) |>
+  rename(abundance = observation) |>
+  select(-variable) |>
   as_tsibble(index = datetime, key = site_id)
 
 ## a single mean per site... obviously silly
-fc_richness <- targets_richness  %>% 
+fc_richness <- targets_richness  %>%
   model(null = MEAN(log(richness + 1))) %>%
-  generate(times = 500, h = "1 year", bootstrap = TRUE) |> 
+  generate(times = 500, h = "1 year", bootstrap = TRUE) |>
   dplyr::rename(ensemble = .rep,
-                prediction = .sim) |> 
-  mutate(variable = "richness")
+                prediction = .sim) |>
+  mutate(variable = "richness",
+         family = "ensemble")
 
 fc_abundance <- targets_abundance  %>%
   model(null = MEAN(log(abundance + 1))) %>%
-  generate(times = 500, h = "1 year", bootstrap = TRUE) |> 
+  generate(times = 500, h = "1 year", bootstrap = TRUE) |>
   dplyr::rename(parameter = .rep,
-                prediction = .sim) |> 
+                prediction = .sim) |>
   mutate(variable = "abundance",
          family = "ensemble")
 
-fc_richness |> 
-  filter(site_id %in% site_list[1:10], variable == "richness") |> 
+fc_richness |>
+  filter(site_id %in% site_list[1:10], variable == "richness") |>
   ggplot(aes(x = datetime, y = prediction, group = ensemble)) +
   geom_line() +
   facet_wrap(~site_id)
 
-targets |> 
-  filter(site_id %in% site_list[1:10], variable == "richness") |> 
+targets |>
+  filter(site_id %in% site_list[1:10], variable == "richness") |>
   ggplot(aes(x = datetime, y = observation)) +
   geom_point() +
   facet_wrap(~site_id)
 
 team_name <- "mean"
 
-forecast <- bind_rows(as_tibble(fc_richness), as_tibble(fc_abundance)) |> 
+forecast <- bind_rows(as_tibble(fc_richness), as_tibble(fc_abundance)) |>
   mutate(reference_datetime = lubridate::as_date(min(datetime)) - lubridate::weeks(1),
-         model_id = team_name) |> 
+         model_id = team_name) |>
   select(model_id, datetime, reference_datetime, site_id, family, parameter, variable, prediction)
 
 ## Create the metadata record, see metadata.Rmd
@@ -83,7 +84,7 @@ filename <- paste0(theme_name, "-", file_date, "-", team_name, ".csv.gz")
 ## Store the forecast products
 readr::write_csv(forecast, filename)
 
-neon4cast::submit(forecast_file = filename, 
+neon4cast::submit(forecast_file = filename,
                   ask = FALSE)
 
 unlink(filename)