Suppress warning when printing cals. Fixes #30

R/cal.R

@@ -115,15 +115,15 @@ pillar_shaft.c14_cal <- function(x, ...) {
 #' @noRd
 #' @keywords internal
 circa_point_yr <- function(x) {
-  y <- cal_point(x)
+  y <- cal_point(x, quiet = TRUE)
   ret <- sprintf("c. %s", y)
   format(ret, justify = "right")
 }
 
 #' @noRd
 #' @keywords internal
 circa_point_yr_colour <- function(x) {
-  y <- cal_point(x)
+  y <- cal_point(x, quiet = TRUE)
   ret <- sprintf(
     "%s %d %s",
     pillar::style_subtle("c."),

R/cal_summary.R

@@ -12,7 +12,7 @@
 #' function or an interval estimate is not appropriate, in which case
 #' `method = "mode"` (the default) is recommended.
 #'
-#' @param x `cal` object. A vector of calibrated radiocarbon dates.
+#' @param x `cal` object. A vector of calibrated radiocarbon dates
 #' @param method Character. Method of estimation:
 #'   \describe{
 #'     \item{`"mode"` (default)}{age corresponding to the maximum peak of the probability distribution}
@@ -27,6 +27,7 @@
 #'   }
 #' @param interval Numeric. Only used for `method = "local_mode"` and
 #'  `method = "central"`.
+#' @param quiet Set `quiet = TRUE` to suppress warnings and messages
 #'
 #' @details
 #'
@@ -48,7 +49,8 @@
 #' cal_point(c14_calibrate(10000, 30))
 cal_point <- function(x,
                       method = c("mode", "median", "mean", "local_mode", "central"),
-                      interval = 0.954) {
+                      interval = 0.954,
+                      quiet = FALSE) {
   # TODO: Check/cast x
   method <- rlang::arg_match(method)
 
@@ -62,7 +64,7 @@ cal_point <- function(x,
   )
 
   # Flatten to era_yr
-  vec_c(!!!furrr::future_map(x, f, interval))
+  vec_c(!!!furrr::future_map(x, f, interval = interval, quiet = quiet))
 }
 
 #' Mode of a calibrated radiocarbon date
@@ -74,11 +76,11 @@ cal_point <- function(x,
 #'
 #' @noRd
 #' @keywords internal
-cal_mode <- function(x, ...) {
+cal_mode <- function(x, quiet = FALSE, ...) {
   y <- x$age[x$pdens == max(x$pdens, na.rm = TRUE) & !is.na(x$pdens)]
   if (length(y) > 1) {
     y <- y[1]
-    rlang::warn(
+    if (!isTRUE(quiet)) rlang::warn(
       "`x` has more than one modal value. Only the first will be returned.",
          "c14_ambiguous_summary"
     )

README.md

@@ -51,8 +51,6 @@ ppnd |>
   filter(site == "Ganj Dareh") |>
   select(lab_id, cra, error) |>
   mutate(cal = c14_calibrate(cra, error))
-#> Warning: `x` has more than one modal value. Only the first will be returned.
-#> `x` has more than one modal value. Only the first will be returned.
 #> # A tibble: 9 × 4
 #>   lab_id     cra error             cal
 #>   <chr>    <int> <int>           <cal>

tests/testthat/test-cal.R

@@ -4,6 +4,13 @@ y <- c14_calibrate(c(6000, 5000, 3000), rep(10, 3))
 y_era <- era::yr_era(cal_age(y)[[1]])
 y_yr_ptype <- era::yr(era = y_era)
 
+test_that("warning is suppressed when printing a multimodal cal", {
+  multimodal_cal <- c14_calibrate(10400, 20)
+  expect_no_warning(multimodal_cal, class = "c14_ambiguous_summary")
+  expect_no_warning(tibble::tibble(cal = multimodal_cal),
+                    class = "c14_ambiguous_summary")
+})
+
 test_that("cal_crop() with default min_pdens does nothing", {
   expect_equal(x, cal_crop(x))
 })
@@ -20,3 +27,8 @@ test_that("cal_age_common() returns a yr vector", {
 test_that("cal_interpolate() is normalised", {
   expect_equal(sum(cal_pdens(cal_interpolate(x))[[1]]), 1)
 })
+
+test_that("cal_interpolate() does not propagate NAs", {
+  cal_with_nas <- cal_interpolate(c14_calibrate(5000, 10), seq(5500, 6000, 10))
+  expect_false(rlang::is_na(cal_with_nas))
+})

tests/testthat/test-cal_summary.R

@@ -1,10 +1,10 @@
-
-
 # Point estimates ---------------------------------------------------------
 
-test_that("cal_mode() does not propagate NAs", {
-  cal_with_nas <- cal_interpolate(c14_calibrate(5000, 10), seq(5500, 6000, 10))
-  expect_false(rlang::is_na(cal_with_nas))
+test_that("cal_point() warns about multiple modes unless quiet = TRUE", {
+  multimodal_cal <- c14_calibrate(10400, 20)
+  expect_warning(cal_point(multimodal_cal), class = "c14_ambiguous_summary")
+  expect_no_warning(cal_point(multimodal_cal, quiet = TRUE),
+                    class = "c14_ambiguous_summary")
 })
 
 # Simple ranges -----------------------------------------------------------