Add automatic report of radiocarbon calibration

DESCRIPTION

@@ -19,7 +19,8 @@ Imports:
     arkhe (>= 1.7.0),
     graphics,
     grDevices,
-    methods
+    methods,
+    utils
 Suggests: 
     knitr,
     markdown,
@@ -45,6 +46,7 @@ Collate:
     'c14_validate.R'
     'coerce.R'
     'data.R'
+    'describe.R'
     'interval_hdr.R'
     'mutators.R'
     'pb_age.R'

NAMESPACE

@@ -35,6 +35,7 @@ exportMethods(c14_ensemble)
 exportMethods(c14_spd)
 exportMethods(c14_uncalibrate)
 exportMethods(c14_validate)
+exportMethods(describe)
 exportMethods(interval_hdr)
 exportMethods(labels)
 exportMethods(mean)
@@ -64,4 +65,5 @@ importFrom(methods,new)
 importFrom(methods,setGeneric)
 importFrom(methods,setMethod)
 importFrom(methods,setValidity)
+importMethodsFrom(arkhe,describe)
 importMethodsFrom(arkhe,interval_hdr)

R/AllGenerics.R

@@ -4,6 +4,7 @@ NULL
 
 # Import S4 generics ===========================================================
 #' @importMethodsFrom arkhe interval_hdr
+#' @importMethodsFrom arkhe describe
 NULL
 
 # Tools ========================================================================
@@ -90,10 +91,10 @@ NULL
 #'
 #' \tabular{ll}{
 #'  **Curve**    \tab **Reference** \cr
-#'  `bomb04NH1`  \tab Hua and Barbetti 2004 \cr
-#'  `bomb04NH2`  \tab Hua and Barbetti 2004 \cr
-#'  `bomb04NH3`  \tab Hua and Barbetti 2004 \cr
-#'  `bomb04SH`   \tab Hua and Barbetti 2004 \cr
+#'  `bomb04nh1`  \tab Hua and Barbetti 2004 \cr
+#'  `bomb04nh2`  \tab Hua and Barbetti 2004 \cr
+#'  `bomb04nh3`  \tab Hua and Barbetti 2004 \cr
+#'  `bomb04sh`   \tab Hua and Barbetti 2004 \cr
 #'  `bomb13nh1`  \tab Hua, Berbetti and Rakowski 2013 \cr
 #'  `bomb13nh2`  \tab Hua, Berbetti and Rakowski 2013 \cr
 #'  `bomb13nh3`  \tab Hua, Berbetti and Rakowski 2013 \cr
@@ -105,17 +106,17 @@ NULL
 #'  `bomb21sh12` \tab Hua et al. 2022 \cr
 #'  `bomb21sh3`  \tab Hua et al. 2022 \cr
 #'  `cariaco04`  \tab Hughen et al. 2004 \cr
+#'  `intcal98`   \tab Stuiver et al. 1998 \cr
 #'  `intcal04`   \tab Reimer et al. 2004 \cr
 #'  `intcal09`   \tab Reimer et al. 2009 \cr
 #'  `intcal13`   \tab Reimer et al. 2013 \cr
 #'  `intcal20`   \tab Reimer et al. 2020 \cr
-#'  `intcal98`   \tab Stuiver et al. 1998 \cr
-#'  `Kueppers04` \tab Kueppers et al. 2004 \cr
+#'  `kueppers04` \tab Kueppers et al. 2004 \cr
+#'  `marine98`   \tab Stuiver, Reimer and Braziunas 1998 \cr
 #'  `marine04`   \tab Hughen et al. 2004 \cr
 #'  `marine09`   \tab Reimer et al. 2009 \cr
 #'  `marine13`   \tab Reimer et al. 2013 \cr
 #'  `marine20`   \tab Heaton et al. 2020 \cr
-#'  `marine98`   \tab Stuiver, Reimer and Braziunas 1998 \cr
 #'  `shcal04`    \tab McCormac et al. 2004 \cr
 #'  `shcal13`    \tab Hogg et al. 2013 \cr
 #'  `shcal20`    \tab Hogg et al. 2020 \cr
@@ -707,3 +708,23 @@ NULL
 #' @name median
 #' @rdname median
 NULL
+
+# Summary ======================================================================
+#' Data Description
+#'
+#' @param x A [`CalibratedAges-class`] object.
+#' @param level A length-one [`numeric`] vector giving the confidence level.
+#' @param calendar An [`aion::TimeScale-class`] object specifying the target
+#'  calendar (see [aion::calendar()]).
+#' @return
+#'  `describe()` is called for its side-effects. Invisibly returns `x`.
+#' @references
+#'  Millard, A. R. (2014). Conventions for Reporting Radiocarbon Determinations.
+#'  *Radiocarbon*, 56(2): 555-559. \doi{10.2458/56.17455}.
+#' @example inst/examples/ex-describe.R
+#' @author N. Frerebeau
+#' @family summary
+#' @docType methods
+#' @rdname describe
+#' @name describe
+NULL

R/c14_curve.R

@@ -44,6 +44,42 @@ read_curve <- function(x) {
   curve
 }
 
+cite_curve <- function(x) {
+  curve <- c(
+    bomb04nh1 = "Hua and Barbetti 2004",
+    bomb04nh2 = "Hua and Barbetti 2004",
+    bomb04nh3 = "Hua and Barbetti 2004",
+    bomb04sh = "Hua and Barbetti 2004",
+    bomb13nh1 = "Hua, Berbetti and Rakowski 2013",
+    bomb13nh2 = "Hua, Berbetti and Rakowski 2013",
+    bomb13nh3 = "Hua, Berbetti and Rakowski 2013",
+    bomb13sh12 = "Hua, Berbetti and Rakowski 2013",
+    bomb13sh3 = "Hua, Berbetti and Rakowski 2013",
+    bomb21nh1 = "Hua et al. 2022",
+    bomb21nh2 = "Hua et al. 2022",
+    bomb21nh3 = "Hua et al. 2022",
+    bomb21sh12 = "Hua et al. 2022",
+    bomb21sh3 = "Hua et al. 2022",
+    cariaco04 = "Hughen et al. 2004",
+    intcal98 = "Stuiver et al. 1998",
+    intcal04 = "Reimer et al. 2004",
+    intcal09 = "Reimer et al. 2009",
+    intcal13 = "Reimer et al. 2013",
+    intcal20 = "Reimer et al. 2020",
+    kueppers04 = "Kueppers et al. 2004",
+    marine98 = "Stuiver, Reimer and Braziunas 1998",
+    marine04 = "Hughen et al. 2004",
+    marine09 = "Reimer et al. 2009",
+    marine13 = "Reimer et al. 2013",
+    marine20 = "Heaton et al. 2020",
+    shcal04 = "McCormac et al. 2004",
+    shcal13 = "Hogg et al. 2013",
+    shcal20 = "Hogg et al. 2020"
+  )
+
+  curve[x]
+}
+
 # Approximate curve ============================================================
 #' Interpolate 14C Calibration Curve
 #'

R/describe.R

@@ -0,0 +1,63 @@
+# DESCRIBE
+#' @include AllGenerics.R
+NULL
+
+#' @export
+#' @rdname describe
+#' @aliases describe,CalibratedAges-method
+setMethod(
+  f = "describe",
+  signature = signature(x = "CalibratedAges"),
+  definition = function(x, calendar = getOption("ananke.calendar"), level = 0.954) {
+    ## Get data
+    lab <- labels(x)
+    val <- x@values
+    err <- x@errors
+    crv <- x@curves
+    reservoir_off <- x@reservoir_offsets
+    reservoir_err <- x@reservoir_errors
+    F14C <- x@F14C
+
+    ## Laboratory code
+    if (F14C) {
+      txt_uncal <- "Sample %s contains %.0f +/- %.0f F14C,"
+    } else {
+      txt_uncal <- "Sample %s is dated to %.0f +/- %.0f BP,"
+    }
+    msg_uncal <- sprintf(txt_uncal, lab, val, err)
+
+    ## Calibration results
+    hdr <- interval_hdr(x, level = level, calendar = calendar)
+    msg_cal <- lapply(
+      X = hdr,
+      FUN = function(x, calendar, level) {
+        if (is.null(x)) return("but is out of the calibration range of")
+        p <- if (NROW(x) > 1) sprintf(" (%.1f%%)", x[, 3] * 100) else ""
+        msg_hdr <- sprintf("[%.0f,%.0f]%s", x[, 1], x[, 2], p)
+        txt_cal <- "calibrated to %s %s (%.1f%% HPD interval) with"
+        sprintf(txt_cal, paste0(msg_hdr, collapse = " or "), calendar, level)
+      },
+      calendar = calendar@label,
+      level = level * 100
+    )
+
+    ## Calibration curve
+    txt_curve <- "%s (%s)."
+    msg_curve <- sprintf(txt_curve, crv, cite_curve(crv))
+
+    ## Text
+    msg <- paste(msg_uncal, msg_cal, msg_curve, sep = " ")
+
+    ## Software
+    txt_soft <- "Calibration was computed with R %s.%s (R Core Team %s) and package ananke %s (Frerebeau %s)."
+    date_soft <- utils::packageDate("ananke")
+    date_soft <- if (is.na(date_soft)) Sys.Date() else date_soft
+    msg_soft <- sprintf(txt_soft, R.version$major, R.version$minor,
+                        R.version$year, utils::packageVersion("ananke"),
+                        format(date_soft, format = "%Y"))
+
+    cat(unlist(msg), msg_soft, sep = "\n\n")
+
+    invisible(x)
+  }
+)

inst/examples/ex-describe.R

@@ -0,0 +1,9 @@
+## Calibrate multiple dates
+cal <- c14_calibrate(
+  values = c(5000, 4500),
+  errors = c(45, 35),
+  names = c("X", "Y")
+)
+
+## Full text description
+describe(cal)

inst/tinytest/test_radiocarbon.R

@@ -96,3 +96,6 @@
   # plot_cal_BP <- function() plot(cal, calendar = BP())
 
   # plot_cal_b2k <- function() plot(cal, calendar = b2k())
+
+  # FIXME: check text
+  tinytest::expect_stdout(describe(cal))

pkgdown/_pkgdown.yml

@@ -16,6 +16,7 @@ reference:
 - title: Statistics
   contents:
   - has_concept("statistics")
+  - has_concept("summary")
 - title: Mutators
   contents:
   - has_concept("mutators")

vignettes/bibliography.bib

@@ -232,6 +232,21 @@ @article{mccormac2004
   langid = {english}
 }
 
+@article{millard2014,
+  title = {Conventions for {{Reporting Radiocarbon Determinations}}},
+  author = {Millard, Andrew R},
+  date = {2014},
+  journaltitle = {Radiocarbon},
+  volume = {56},
+  number = {2},
+  pages = {555--559},
+  issn = {0033-8222, 1945-5755},
+  doi = {10.2458/56.17455},
+  url = {https://www.cambridge.org/core/product/identifier/S0033822200049596/type/journal_article},
+  urldate = {2020-08-21},
+  langid = {english}
+}
+
 @article{reimer2004,
   title = {Intcal04 {{Terrestrial Radiocarbon Age Calibration}}, 0–26 Cal Kyr {{BP}}},
   author = {Reimer, Paula J and Baillie, Mike G L and Bard, Edouard and Bayliss, Alex and Beck, J Warren and Bertrand, Chanda J H and Blackwell, Paul G and Buck, Caitlin E and Burr, George S and Cutler, Kirsten B and Damon, Paul E and Edwards, R Lawrence and Fairbanks, Richard G and Friedrich, Michael and Guilderson, Thomas P and Hogg, Alan G and Konrad, A. Hughen and Kromer, Bernd and McCormac, Gerry and Manning, Sturt and Bronk Ramsey, Christopher and Reimer, Ron W and Remmele, Sabine and Southon, John R and Stuiver, Minze and Talamo, Sahra and Taylor, F W and family=Plicht, given=Johannes, prefix=van der, useprefix=true and Weyhenmeyer, Constanze E},