Merge pull request #156 from brews/empty_composite_fix

Fix bug in composite, add unit tests, close #155

NEWS.md

@@ -14,7 +14,7 @@ Changes in this release:
 
 * Removed broken `site_stats()` function (Issue #138). Please use `intervals()` and `print()` to get the same statistics.
 
-* `composite()` now returns an empty `fhx` object if no composite-worthy events are found (Issue #131). Much better than throwing an obtuse error, which is what we used to do.
+* `composite()` now returns an empty `fhx` object if no composite-worthy events are found (Issue #131) or if there are no fire-events (Issue #155). Much better than throwing an obtuse error, which is what we used to do.
 
 * Updated in-package citation information (`citation("burnr")`). Please cite burnr if you use it in your work!
 

R/utils.R

@@ -16,7 +16,7 @@
 #'     This records the type of ring or record of each observation.
 #'
 #' @details
-#' Note that 'year', 'series', and 'rec_type' are pass through [as.numeric()], 
+#' Note that 'year', 'series', and 'rec_type' are pass through [as.numeric()],
 #' [as.factor()], and [make_rec_type()] the `fhx` object is created.
 #'
 #' @examples
@@ -515,9 +515,16 @@ composite <- function(x, filter_prop = 0.25, filter_min_rec = 2,
   if (injury_event) {
     event <- c(event, injury)
   }
-  event_count <- as.data.frame(
-    table(year = subset(x, x$rec_type %in% event)$year)
-  )
+
+  event_year <- subset(x, x$rec_type %in% event)$year
+  if (length(event_year) < 1) {
+    return(fhx(as.numeric(c()), as.factor(c()), make_rec_type(c())))
+  } else {
+    event_count <- as.data.frame(
+      table(year = event_year)
+    )
+  }
+
   recording_count <- yearly_recording(x, injury_event = injury_event)
   # `Var1` in the _count data.frames is the year, `Freq` is the count.
   counts <- merge(event_count, recording_count,

tests/testthat/test-utils.R

@@ -276,3 +276,30 @@ test_that("internal violates_canon catches bad, passes good", {
   expect_true(burnr:::violates_canon(test_case_bad))
 })
 
+
+test_that("composite returns empty fhx when no fire events", {
+  test_case <- fhx(
+    year = c(1850, 2010),
+    series = c("a", "a"),
+    rec_type = c("pith_year", "bark_year")
+  )
+  test_comp <- composite(test_case)
+
+  empty_fhx <- fhx(as.numeric(c()), as.factor(c()), make_rec_type(c()))
+
+  expect_equal(test_comp, empty_fhx)
+})
+
+
+test_that("composite returns empty fhx when no worthy fire events", {
+  test_case <- fhx(
+    year = c(1850, 2010, 1860, 2005),
+    series = c("a", "a", "b", "b"),
+    rec_type = c("pith_year", "unknown_fs", "inner_year", "unknown_fs")
+  )
+  test_comp <- composite(test_case)
+
+  empty_fhx <- fhx(as.numeric(c()), as.factor(c()), make_rec_type(c()))
+
+  expect_equal(test_comp, empty_fhx)
+})