Merge pull request #166 from birdflow-science/no-abundance

Author: ethanplunkett

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: BirdFlowR
 Title: Predict and Visualize Bird Movement
-Version: 0.1.0.9048
+Version: 0.1.0.9049
 Authors@R: 
     c(person("Ethan", "Plunkett",  email = "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-4405-2251")),

NEWS.md

@@ -1,3 +1,29 @@
+# BirdFlowR 0.1.0.9049
+2023-01-11
+
+#### Drop "_clip"
+
+ Drop "_clip" from name when clipping with preprocess_species() 
+See issue #165, but note I haven't added the extra metadata item yet.  
+
+#### Zero abundance for some timesteps
+
+ `validate_birdflow()` and thus also `preprocess_species()` now throw errors
+if any distribution doesn't sum to 1 or if the dynamic mask excludes all cells
+for a timestep. This addresses a problem discovered when attempting to fit 
+models with species: "antnig" (Antillean Nighthawk) where for some timesteps
+the abundance grids from status and trends are all zero.  Prior to this change
+it was possible to preprocess Antillean Nighthawk but then during fitting with
+BirdFlowPy confusing errors were thrown.  
+
+The change can be observed with:
+```{r}
+preprocess_species("antnig", res = 150, hdf5 = FALSE, 
+                    skip_quality_checks = TRUE)`
+```
+
+
+
 # BirdFlowR 0.1.0.9048
 2023-12-22
 

R/preprocess_species.R

@@ -357,8 +357,6 @@ preprocess_species <- function(species = NULL,
   if (any_output) {
     out_base <-
       file.path(out_dir, paste0(download_species, "_", st_year, "_", res, "km"))
-    if (!is.null(clip))
-      out_base <- paste0(out_base, "_clip")
 
     paths <- list()
     if (hdf5) {

R/validate_BirdFlow.R

@@ -62,12 +62,12 @@ validate_BirdFlow <- function(x, error = TRUE, allow_incomplete = FALSE) {
     if (error) {
       if (allow_incomplete) {
         if (any(p$type == "error"))
-          message <- paste0("Problems found by validate_BirdFlow:",
+          message <- paste0("Problems found by validate_BirdFlow:\n\t",
                             paste(p$problem[p$type == "error"],
-                                  collapse = "; "))
+                                  collapse = ";\n\t"))
       } else { # Don't allow incomplete:
         if (nrow(p) > 0)
-          message <- paste("Problems found by validate_BirdFlow:\n\t",
+          message <- paste0("Problems found by validate_BirdFlow:\n\t",
                           paste(p$problem, collapse = "; \n\t"))
       }
     }
@@ -136,6 +136,48 @@ validate_BirdFlow <- function(x, error = TRUE, allow_incomplete = FALSE) {
   }
 
 
+
+
+  # check dates
+  if (!"dates" %in% names(x) || !is.data.frame(x$dates)) {
+    p <- add_prob("x$dates is missing, NA or not a dataframe", "error", p)
+    report_problems()
+  } else { # dates exists and is data.frame
+
+    if (x$metadata$ebird_version_year < 2022) {
+      # 2021 ebirdst models have use older dates format
+      required_cols <- c("interval", "date", "doy", "start", "midpoint", "end")
+    } else {
+      #2022_ ebirdst models use newer dates format
+      required_cols <- names(make_dates())
+    }
+    if (!all(required_cols  %in% names(x$dates))) {
+      p <- add_prob(paste0("x$dates is missing columns:",
+                           paste(setdiff(required_cols, names(x$dates)))),
+                    "error", p)
+      report_problems()
+    } # end if dates missing columns
+    rm(required_cols)
+
+
+    if ("distr" %in% names(x)) {
+      if (is.null(dim(x$distr)) ||
+          !length(dim(x$distr)) == 2 ||
+          !is.numeric(x$distr)) {
+        p <- add_prob("distr has wrong format", "error", p)
+        report_problems()
+      }
+
+      if (nrow(x$dates) != ncol(x$distr)) {
+        p <- add_prob(paste0("x$dates and x$distr do not represent the same ",
+                             "number of timesteps."), "error", p)
+        report_problems()
+      }
+    }
+  } # end dates is data.frame
+
+
+
   # check consistancy of has_ (transitions, marginals, distr)
   components <- c("transitions", "marginals", "distr")
   for (i in seq_along(components)) {
@@ -144,13 +186,26 @@ validate_BirdFlow <- function(x, error = TRUE, allow_incomplete = FALSE) {
       p <- add_prob(paste0("has_", components[i], " is not TRUE or FALSE"),
                     "error", p)
   }
+
   if (has_distr(x)) {
     if (!is.matrix(x$distr))
       p <- add_prob("distr is not a matrix", "error", p)
+    sums_to_one <- get_distr(x) |>
+      apply(2, sum) |>
+      sapply(function(x) isTRUE(all.equal(x, 1)))
+    if(!all(sums_to_one)){
+      p <- add_prob("not all distributions sum to one",
+                    "error", p)
+    }
   }
   if (has_dynamic_mask(x)) {
-    if (!is.matrix(x$geom$dynamic_mask))
+    if (!is.matrix(x$geom$dynamic_mask)){
       p <- add_prob("dynamic mask is not a matrix", "error", p)
+    } else {
+      if(!all(apply(get_dynamic_mask(x), 2, sum) > 0)){
+        p <- add_prob("dynamic mask eliminates all cells for some timesteps", "error", p)
+      }
+    }
   }
 
   if (has_marginals(x)) {
@@ -203,44 +258,6 @@ validate_BirdFlow <- function(x, error = TRUE, allow_incomplete = FALSE) {
 
 
 
-  # check dates
-  if (!"dates" %in% names(x) || !is.data.frame(x$dates)) {
-    p <- add_prob("x$dates is missing, NA or not a dataframe", "error", p)
-    report_problems()
-  } else { # dates exists and is data.frame
-
-    if (x$metadata$ebird_version_year < 2022) {
-      # 2021 ebirdst models have use older dates format
-      required_cols <- c("interval", "date", "doy", "start", "midpoint", "end")
-    } else {
-      #2022_ ebirdst models use newer dates format
-      required_cols <- names(make_dates())
-    }
-    if (!all(required_cols  %in% names(x$dates))) {
-      p <- add_prob(paste0("x$dates is missing columns:",
-                           paste(setdiff(required_cols, names(x$dates)))),
-                    "error", p)
-      report_problems()
-    } # end if dates missing columns
-    rm(required_cols)
-
-
-    if ("distr" %in% names(x)) {
-      if (is.null(dim(x$distr)) ||
-         !length(dim(x$distr)) == 2 ||
-         !is.numeric(x$distr)) {
-        p <- add_prob("distr has wrong format", "error", p)
-        report_problems()
-      }
-
-      if (nrow(x$dates) != ncol(x$distr)) {
-        p <- add_prob(paste0("x$dates and x$distr do not represent the same ",
-                             "number of timesteps."), "error", p)
-      }
-    }
-  } # end dates is data.frame
-
-
   # consistency on n_active
   if (is.na(n_active(x))) {
     if (has_transitions(x) || has_marginals(x) || has_distr(x) ||

tests/testthat/test-preprocess_species.R

@@ -184,8 +184,8 @@ test_that("preprocess_species() works with clip", {
 
   # Test that expect file was created
   created_files <- list.files(dir)
-  expect_in(created_files,  c("example_data_2021_30km_clip.hdf5",  # ebird 2021
-                              "yebsap-example_2022_30km_clip.hdf5")) # 2022
+  expect_in(created_files,  c("example_data_2021_30km.hdf5",  # ebird 2021
+                              "yebsap-example_2022_30km.hdf5")) # 2022
 
   skip_if_wrong_ebirdst_for_snapshot()
 

tests/testthat/test-validate_BirdFlow.R

@@ -64,5 +64,18 @@ test_that("validate_BirdFlow throws expected errors", {
   expect_error(validate_BirdFlow(bad),
                "Not all marginals have a sum of one")
 
+  # Distributions don't sum to 1
+  bad <- bf
+  bad$distr[ , 1] <- 0
+  expect_error(validate_BirdFlow(bad),
+               "not all distributions sum to one")
+
+
+  # Empty dynamic mask (for any timestep)
+  bad <- bf
+  bad$geom$dynamic_mask[ , 1] <- 0
+  expect_error(validate_BirdFlow(bad),
+               "dynamic mask eliminates all cells for some timesteps")
+
 
 })