From 578031435b7572af1a26c36a2f492547c8acc4a4 Mon Sep 17 00:00:00 2001
From: Joe Roe <git@joeroe.io>
Date: Fri, 4 Feb 2022 17:27:19 +0100
Subject: [PATCH] Vectorise c14_calibrate() with engine = "intcal"

Also recycle c14_age and c14_error.
---
 R/c14_calibrate.R    | 25 ++++++++++++++++++++++---
 man/c14_calibrate.Rd |  3 +++
 2 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/R/c14_calibrate.R b/R/c14_calibrate.R
index 549ffd4..1551129 100644
--- a/R/c14_calibrate.R
+++ b/R/c14_calibrate.R
@@ -17,6 +17,9 @@
 #'   * `"oxcal"`: [oxcAAR::oxcalCalibrate()]
 #'   * `"bchron"`: [Bchron::BchronCalibrate()]
 #'
+#' @details
+#' `c14_age` and `c14_error` are recycled to a common length.
+#'
 #' @return A list of `cal` objects.
 #' @export
 #'
@@ -25,10 +28,12 @@ c14_calibrate <- function(c14_age,
                           c14_error,
                           ...,
                           engine = c("intcal", "rcarbon", "oxcal", "bchron")) {
+  c(c14_age, c14_error) %<-% vec_recycle_common(c14_age, c14_error)
   engine <- rlang::arg_match(engine)
 
+
   if (engine == "intcal") {
-    cals <- IntCal::caldist(c14_age, c14_error)
+    cals <- c14_calibrate_intcal(c14_age, c14_error, ...)
   }
 
   else if (engine == "rcarbon") {
@@ -37,6 +42,7 @@ c14_calibrate <- function(c14_age,
     }
     cals <- rcarbon::calibrate(c14_age, c14_error, calMatrix = FALSE,
                                verbose = FALSE, ...)
+    cals <- as_cal(cals)
   }
 
   else if (engine == "oxcal") {
@@ -45,20 +51,33 @@ c14_calibrate <- function(c14_age,
     }
     oxcAAR::quickSetupOxcal()
     cals <- oxcAAR::oxcalCalibrate(c14_age, c14_error, ...)
+    cals <- as_cal(cals)
   }
 
   else if (engine == "bchron") {
     if(!requireNamespace("Bchron", quietly = TRUE)) {
       stop('`engine` = "Bchron" requires package Bchron')
     }
-
     cals <- Bchron::BchronCalibrate(c14_age, c14_error, ...)
+    cals <- as_cal(cals)
   }
 
-  cals <- as_cal(cals)
   return(cals)
 }
 
+#' Vectorised wrapper for IntCal::caldist
+#'
+#' @return
+#' A cal vector.
+#'
+#' @noRd
+#' @keywords internal
+c14_calibrate_intcal <- function(c14_age, c14_error, ...) {
+  purrr::map2(c14_age, c14_error, IntCal::caldist, ...) |>
+    purrr::map(as.data.frame) |>
+    do.call(what = cal)
+}
+
 #' Generate the normal distribution of a radiocarbon age
 #'
 #' @param age Radiocarbon age(s) in years.
diff --git a/man/c14_calibrate.Rd b/man/c14_calibrate.Rd
index 7faaf40..46d1823 100644
--- a/man/c14_calibrate.Rd
+++ b/man/c14_calibrate.Rd
@@ -35,4 +35,7 @@ A list of \code{cal} objects.
 Transforms 'raw' radiocarbon ages into a calendar probability distribution
 using a calibration curve.
 }
+\details{
+\code{c14_age} and \code{c14_error} are recycled to a common length.
+}
 \concept{tidy radiocarbon functions}