Generalise standard era definitions. Closes #6

Standard eras are now defined in an internal dataset (era_table) generated in data-raw/era_table.R. The internal function era_dictionary() is replaced by eras(), which is exported, uses partial matching, and can also list all available eras. As a side effect, the era() constructor is now fully vectorised. The "abbrieviation" parameter of eras is now called "label".
joeroe · Nov 11, 2020 · 86a6015 · 86a6015
1 parent 4578088
commit 86a6015
Show file tree

Hide file tree

Showing 15 changed files with 216 additions and 114 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -6,3 +6,4 @@
 ^_pkgdown\.yml$
 ^docs$
 ^pkgdown$
+^data-raw$
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -6,16 +6,21 @@ Authors@R: person("Joe", "Roe", email = "joe@joeroe.io",
   role = c("aut", "cre"), comment = c(ORCID = "0000-0002-1011-1244"))
 Description: Provides a consistent vector representation of years with an 
     associated calendar era or time scale. It includes built-in definitions of 
-    several time scales commonly used in archaeology, geology, and other 
-    paleosciences (e.g. Common Era, Before Present, SI-prefixed *annus*) as well
-    as support for arbitrary user-defined eras. Functions and type-stable 
-    arithmetic with years and conversions between eras are also provided.
+    many contemporary and historic calendars; time scales commonly used in
+    archaeology, astronomy, geology, and other palaeosciences (e.g. Before 
+    Present, SI-prefixed annus); and support for arbitrary user-defined eras. 
+    Functions for converting between eras and for type-stable arithmetic with 
+    years are also provided.
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.1.1
+Depends: 
+    R (>= 2.10)
 Imports: 
     vctrs (>= 0.3.0),
     methods,
     rlang
+Suggests: 
+    tibble
diff --git a/NAMESPACE b/NAMESPACE
@@ -19,13 +19,13 @@ S3method(vec_ptype_abbr,era_yr)
 S3method(vec_ptype_full,era_yr)
 export("yr_era<-")
 export(era)
-export(era_abbr)
-export(era_abbreviation)
 export(era_direction)
 export(era_epoch)
+export(era_label)
 export(era_name)
 export(era_scale)
 export(era_unit)
+export(eras)
 export(is_era)
 export(is_yr)
 export(yr)

diff --git a/R/era.R b/R/era.R
@@ -4,21 +4,21 @@
 
 #' Create an era object
 #'
-#' The `era` class defines the time scale associated with a vector of years
+#' An `era` object defines the time scale associated with a vector of years
 #' (see [yr()]). `era()` returns an `era` object, either by looking up
-#' `abbreviation` in the standard definitions included in the package or, if
-#' more than one argument is given, constructing a new definition with the
-#' given parameters.
+#' `label` in the standard eras defined in [eras()] or, if more than one
+#' argument is given, constructing a new definition with the specified
+#' parameters.
 #'
-#' @param abbreviation  Character. If only one argument is given to `era()`, the
-#'  abbreviation of a standard era defined in the package.
-#'  Otherwise, the abbreviation of a user-specified era defined by the following
+#' @param label  Character. If only one argument is given to `era()`, the
+#'  abbreviated label of a standard era defined in [eras()].
+#'  Otherwise, the label to give to the era constructed using the following
 #'  arguments.
 #' @param epoch  Integer. Epoch year from which years are counted (in the Common
 #'  Era).
 #' @param name  Character. Full name of the era. Defaults to the value of
-#'  `abbreviation`.
-#' @param unit  Character. Default: `"calendar years"`.
+#'  `label`.
+#' @param unit  Character. Type of years used. Default: `"calendar"`.
 #' @param scale  Integer. Number of years represented by one unit, e.g. `1000`
 #'  for ka. Default: 1.
 #' @param direction  Are years counted `"backwards"` (the default) or `"forwards"`
@@ -33,39 +33,45 @@
 #' era("cal BP")
 #'
 #' era("T.A.", epoch = -9021, name = "Third Age", direction = "forwards")
-era <- function(abbreviation,
+era <- function(label,
                 epoch = NULL,
-                name = abbreviation,
-                unit = c("calendar years", "radiocarbon years"),
+                name = label,
+                unit = c("calendar", "radiocarbon"),
                 scale = 1,
                 direction = c("backwards", "forwards")) {
   if (missing(epoch) &&
       missing(name) &&
       missing(unit) &&
       missing(scale) &&
       missing(direction)) {
-    vec_assert(abbreviation, character())
-    return(era_dictionary(abbreviation))
+    label <- vec_cast(label, character())
+    parameters <- as.list(eras(label))
+  }
+  else {
+    # Use data.frame() to get vector recycling
+    parameters <- data.frame(
+      label = vec_cast(label, character()),
+      epoch = vec_cast(epoch, integer()),
+      name = vec_cast(name, character()),
+      unit = rlang::arg_match(unit),
+      scale = vec_cast(scale, integer()),
+      direction = rlang::arg_match(direction),
+      stringsAsFactors = FALSE
+    )
+    parameters <- as.list(parameters)
   }
 
-  vec_cast(abbreviation, character())
-  epoch <- vec_cast(epoch, integer())
-  vec_cast(name, character())
-  unit <- rlang::arg_match(unit)
-  scale <- vec_cast(scale, integer())
-  direction <- rlang::arg_match(direction)
-
-  new_era(abbreviation, epoch, name, unit, scale, direction)
+  do.call(new_era, parameters)
 }
 
-new_era <- function(abbreviation = NA,
+new_era <- function(label = NA,
                     epoch = NA,
                     name = NA,
                     unit = NA,
                     scale = NA,
                     direction = NA) {
   new_rcrd(
-    list(abbreviation = abbreviation,
+    list(label = label,
          epoch = epoch,
          name = name,
          unit = unit,
@@ -75,30 +81,47 @@ new_era <- function(abbreviation = NA,
   )
 }
 
-era_dictionary <- function(x) {
-  switch(x,
-         # Calendar years Before Present
-         `BP` = era("BP", 1950, "Before Present"),
-         `cal BP` = era("cal BP", 1950, "Before Present"),
-         # Common Era
-         `BC` = era("BC", 0, "Before Christ"),
-         `BCE` = era("BCE", 0, "Before Common Era"),
-         `AD` = era("AD", 0, "Anno Domini", direction = "forwards"),
-         `CE` = era("CE", 0, "Common Era", direction = "forwards"),
-         # Uncalibrated radiocarbon years
-         `uncal BP` = era("uncal BP", 1950, "uncalibrated Before Present", "radiocarbon years"),
-         `bp` = era("bp", 1950, "uncalibrate Before Present", "radiocarbon years"),
-         `bc` = era("bc", 1950, "uncalibrated BC"),
-         # SI time scale
-         `ka` = era("ka", 1950, "kiloannum", scale = 1000),
-         `Ma` = era("Ma", 1950, "megaannum", scale = 1e6),
-         `Ga` = era("Ga", 1950, "gigaannum", scale = 1e9),
-         # Pseudo-SI (years ago) time scale
-         `kya` = era("kya", 1950, "thousand years ago", scale = 1000),
-         `mya` = era("mya", 1950, "million years ago", scale = 1e6),
-         `bya` = era("bya", 1950, "billion years ago", scale = 1e9),
-         stop("Unknown era: '", x, "'.")
-  )
+#' Standard eras
+#'
+#' @description
+#' Definitions of common eras and time scales.
+#'
+#' `eras()` lists all available era definitions. `eras(label)` looks up a
+#' specific era by its unique, abbreviated name (e.g. "cal BP").
+#'
+#' @param label (Optional) Abbreviated names(s) of eras to look up.
+#'
+#' @details
+#' Looking up eras by `label` uses partial matching.
+#'
+#' @return
+#' A table of era definitions. This can be passed to [era()] to construct an
+#' `era` object.
+#'
+#' @export
+#'
+#' @examples
+#' # List all available eras
+#' eras()
+#'
+#' # Look up a specific era by label
+#' eras("cal BP")
+#'
+#' #  uses partial matching
+#' eras("cal")
+eras <- function(label = NA) {
+  # era_table is an internal dataset generated in data-raw/era_table.R
+  if (requireNamespace("tibble", quietly = TRUE)) {
+    era_table <- tibble::as_tibble(era_table)
+  }
+
+  # Partial matching
+  if (!all(is.na(label))) {
+    era_table[pmatch(label, era_table[["label"]]),]
+  }
+  else {
+    era_table
+  }
 }
 
 #' Is this an `era` object?
@@ -120,13 +143,14 @@ is_era <- function(x) {
 
 #' @export
 format.era <- function(x, ...) {
-  nameout <- paste0(era_name(x), " (", era_abbr(x), ")")
-  nameout[era_name(x) == era_abbr(x)] <- era_name(x)[era_name(x) == era_abbr(x)]
+  nameout <- paste0(era_name(x), " (", era_label(x), ")")
+  nameout[era_name(x) == era_label(x)] <- era_name(x)[era_name(x) == era_label(x)]
 
   unitout <- paste0(era_unit(x), " (\u00d7", era_scale(x), ")")
   unitout[era_scale(x) == 1] <- era_unit(x)[era_scale(x) == 1]
 
-  out <- paste0(nameout, ": ", unitout, ", counted ", era_direction(x), " from ", era_epoch(x))
+  out <- paste0(nameout, ": ", unitout, " years, counted ", era_direction(x),
+                " from ", era_epoch(x))
 
   return(out)
 }
@@ -147,7 +171,7 @@ format.era <- function(x, ...) {
 #' @details
 #' The available attributes are:
 #'
-#' * **abbreviation** (abbr) – abbreviated name of the era, e.g. "cal BP"
+#' * **label** – unique, abbreviated label of the era, e.g. "cal BP"
 #' * **epoch** – year of origin of the era, e.g. 1950 for years Before Present
 #' * **name** – full name of the era, e.g. "calendar years Before Present"
 #' * **unit** – unit of years used, e.g. "calendar years", "radiocarbon years"
@@ -161,14 +185,8 @@ NULL
 
 #' @rdname era_attributes
 #' @export
-era_abbreviation <- function(x) {
-  return(field(x, "abbreviation"))
-}
-
-#' @rdname era_attributes
-#' @export
-era_abbr <- function(x) {
-  return(era_abbreviation(x))
+era_label <- function(x) {
+  return(field(x, "label"))
 }
 
 #' @rdname era_attributes

diff --git a/R/sysdata.rda b/R/sysdata.rda
diff --git a/R/transform.R b/R/transform.R
@@ -17,7 +17,8 @@
 #' Not supported:
 #'
 #' * Between directions (to be implemented).
-#' * units: `calendar years` ↔ `radiocarbon years`. This requires [calibration](https://en.wikipedia.org/wiki/Radiocarbon_calibration)
+#' * units: `calendar` ↔ `radiocarbon` years. This requires
+#'   [calibration](https://en.wikipedia.org/wiki/Radiocarbon_calibration)
 #'   or un-calibration, which is outside the scope of this package. Functions
 #'   for radiocarbon calibration can be found in [rcarbon::calibrate()] and
 #'   [Bchron::BchronCalibrate()].

diff --git a/R/yr.R b/R/yr.R
@@ -17,8 +17,8 @@ new_yr <- function(x = numeric(), era = new_era()) {
 #'
 #' @param x    A numeric vector of years.
 #' @param era  Object describing time scale. Either:
-#'  * A string matching one of the standard era abbreviations recognised by [era()]
-#'  * An `era` object
+#'  * A string matching one of the standard era labels defined in [eras()]
+#'  * An `era` object constructed with [era()]
 #'
 #' @return
 #' A `yr` (`era_yr`) object.
@@ -110,24 +110,17 @@ vec_cast.double.era_yr <- function(x, to, ...) {
 # Print generics ---------------------------------------------------------
 #' @export
 vec_ptype_full.era_yr <- function(x, ...) {
-  paste0("yr (", era_abbr(yr_era(x)), ")")
+  paste0("yr (", era_label(yr_era(x)), ")")
 }
 
 #' @export
 vec_ptype_abbr.era_yr <- function(x, ...) {
   "yr"
 }
 
-# format.era_yr <- function(x, ...) {
-#   out <- formatC(vec_data(x))
-#   out[is.na(x)] <- NA
-#   out[!is.na(x)] <- paste0(out[!is.na(x)], " ", era_abbreviation(yr_era(x)))
-#   return(out)
-# }
-
 #' @export
 obj_print_header.era_yr <- function(x, ...) {
-  xera <- era_abbr(yr_era(x))
+  xera <- era_label(yr_era(x))
   cat("# ", xera, " years <", vec_ptype_abbr(x), "[", vec_size(x), "]>:", "\n",
       sep = "")
 }

diff --git a/README.Rmd b/README.Rmd
@@ -19,8 +19,10 @@ knitr::opts_chunk$set(
 <!-- badges: end -->
 
 **era** is an R package that provides a consistent vector representation of years with an associated calendar era or time scale.
-It includes built-in definitions of several time scales commonly used in archaeology, geology, and other paleosciences (e.g. Common Era, Before Present, SI-prefixed *annus*) as well as support for arbitrary user-defined eras.
-Functions for type-stable arithmetic with years and conversions between eras are also provided.
+It includes built-in definitions of many contemporary and historic calendars;
+time scales commonly used in archaeology, astronomy, geology, and other palaeosciences (e.g. Before Present, SI-prefixed *annus*);
+and support for arbitrary user-defined eras. 
+Functions for converting between eras and for type-stable arithmetic with years are also provided.
 
 ## Installation
 

diff --git a/README.md b/README.md
@@ -10,11 +10,11 @@ status](https://github.com/joeroe/era/workflows/R-CMD-check/badge.svg)](https://
 
 **era** is an R package that provides a consistent vector representation
 of years with an associated calendar era or time scale. It includes
-built-in definitions of several time scales commonly used in
-archaeology, geology, and other paleosciences (e.g. Common Era, Before
-Present, SI-prefixed *annus*) as well as support for arbitrary
-user-defined eras. Functions for type-stable arithmetic with years and
-conversions between eras are also provided.
+built-in definitions of many contemporary and historic calendars; time
+scales commonly used in archaeology, astronomy, geology, and other
+palaeosciences (e.g. Before Present, SI-prefixed *annus*); and support
+for arbitrary user-defined eras. Functions for converting between eras
+and for type-stable arithmetic with years are also provided.
 
 ## Installation
 
@@ -47,8 +47,8 @@ convert between eras.
 x <- yr(10010:10001, "cal BP")
 yr_transform(x, era("BCE"))
 #> # BCE years <yr[10]>:
-#>  [1] 8061 8060 8059 8058 8057 8056 8055 8054 8053 8052
-#> # Era: Before Common Era (BCE): calendar years, counted backwards from 1
+#>  [1] 8060 8059 8058 8057 8056 8055 8054 8053 8052 8051
+#> # Era: Before Common Era (BCE): calendar years, counted backwards from 0
 ```
 
 Arbitrary user-defined eras are also supported.
@@ -69,11 +69,11 @@ tibble(bp_year = yr(c(15000, 14000, 13000, 12000, 11000), "cal BP"),
 #> # A tibble: 5 x 2
 #>   bp_year bce_year
 #>      <yr>     <yr>
-#> 1   15000    13051
-#> 2   14000    12051
-#> 3   13000    11051
-#> 4   12000    10051
-#> 5   11000     9051
+#> 1   15000    13050
+#> 2   14000    12050
+#> 3   13000    11050
+#> 4   12000    10050
+#> 5   11000     9050
 ```
 
 It also ensures type- and size-stable computations. For example, you can
@@ -85,7 +85,7 @@ b <- yr(2020, "CE")
 b - a
 #> # CE years <yr[1]>:
 #> [1] 520
-#> # Era: Common Era (CE): calendar years, counted forwards from 1
+#> # Era: Common Era (CE): calendar years, counted forwards from 0
 ```
 
 But only when they have the same era: