From 4b21c95b0a564f1d2e914b86afe804a5f4e90303 Mon Sep 17 00:00:00 2001 From: rqthomas Date: Sun, 12 Nov 2023 10:56:06 -0500 Subject: [PATCH] fixing beetles null --- baseline_models/models/beetles_mean.R | 49 ++++++++++++++------------- 1 file changed, 25 insertions(+), 24 deletions(-) diff --git a/baseline_models/models/beetles_mean.R b/baseline_models/models/beetles_mean.R index 055e2dc467..09c9f1b1e6 100644 --- a/baseline_models/models/beetles_mean.R +++ b/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)