Skip to content

Commit

Permalink
Make validate_era() more robust and add to era(). Closes #7
Browse files Browse the repository at this point in the history
  • Loading branch information
@joeroe
joeroe committed Nov 20, 2020
1 parent cf959e1 commit e6160ba
Show file tree
Hide file tree
Showing 3 changed files with 58 additions and 44 deletions.
46 changes: 30 additions & 16 deletions R/era.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ era <- function(label,
# Use data.frame() to get vector recycling
parameters <- data.frame(
label = vec_cast(label, character()),
epoch = vec_cast(epoch, integer()),
epoch = vec_cast(epoch, numeric()),
name = vec_cast(name, character()),
unit = arg_match(unit),
scale = vec_cast(scale, integer()),
Expand All @@ -79,7 +79,9 @@ era <- function(label,
parameters <- as.list(parameters)
}

do.call(new_era, parameters)
era <- do.call(new_era, parameters)
validate_era(era)
return(era)
}

new_era <- function(label = NA,
Expand Down Expand Up @@ -148,22 +150,34 @@ eras <- function(label = NA) {
# Validators --------------------------------------------------------------

validate_era <- function(x) {
# label
vec_assert(era_label(x), character())

# epoch
vec_assert(era_epoch(x), numeric())

# name
vec_assert(era_name(x), character())
problems <- c(
"era attributes must not be NA" =
apply(vec_proxy(x), 1, function(x) any(is.na(x))),
"`label` must be a character" =
!vec_is(era_label(x), character()),
"`epoch` must be a numeric" =
!vec_is(era_epoch(x), numeric()),
"`name` must be a character" =
!vec_is(era_name(x), character()),
"`unit` must be one of 'calendar', 'Islamic lunar', 'radiocarbon'" =
!all(era_unit(x) %in% c("calendar", "Islamic lunar", "radiocarbon")),
"`scale` must be an integer" =
!vec_is(era_scale(x), integer()),
"`scale` must be positive" =
!all(era_scale(x) > 0),
"`direction` must be -1 (backwards) or 1 (forwards)" =
!all(era_direction(x) %in% c(-1, 1))
)

# unit
# scale
# direction
if (!era_direction(x) %in% c(-1, 1)) {
abort("`direction` must be -1 (backwards) or 1 (forwards)",
class = "era_invalid_era")
if (any(problems)) {
problems <- names(problems[problems])
names(problems) <- rep("x", length(problems))
abort("Invalid era:",
class = "era_invalid_era",
body = format_error_bullets(problems))
}

return(invisible(x))
}

#' Is this an `era` object?
Expand Down
Binary file modified R/sysdata.rda
View file
Binary file not shown.
56 changes: 28 additions & 28 deletions data-raw/era_table.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,47 +7,47 @@ era_table <- tribble(
# label must be unique
~label, ~epoch, ~name, ~unit, ~scale, ~direction,
# Before Present
"BP", 1950, "Before Present", "calendar", 1, -1,
"cal BP", 1950, "Before Present", "calendar", 1, -1,
"BP", 1950, "Before Present", "calendar", 1L, -1,
"cal BP", 1950, "Before Present", "calendar", 1L, -1,
# Common Era (English)
"BC", 0, "Before Christ", "calendar", 1, -1,
"BCE", 0, "Before Common Era", "calendar", 1, -1,
"AD", 0, "Anno Domini", "calendar", 1, 1,
"CE", 0, "Common Era", "calendar", 1, 1,
"BC", 0, "Before Christ", "calendar", 1L, -1,
"BCE", 0, "Before Common Era", "calendar", 1L, -1,
"AD", 0, "Anno Domini", "calendar", 1L, 1,
"CE", 0, "Common Era", "calendar", 1L, 1,
# SI annus
"ka", 1950, "kiloannum", "calendar", 1000, -1,
"Ma", 1950, "megaannum", "calendar", 1e6, -1,
"Ga", 1950, "gigaannum", "calendar", 1e9, -1,
"ka", 1950, "kiloannum", "calendar", 1000L, -1,
"Ma", 1950, "megaannum", "calendar", 1e6L, -1,
"Ga", 1950, "gigaannum", "calendar", 1e9L, -1,
# Pseudo-SI annus
"kya", 1950, "thousand years ago", "calendar", 1000, -1,
"mya", 1950, "million years ago", "calendar", 1e6, -1,
"bya", 1950, "billion years ago", "calendar", 1e9, -1,
"kya", 1950, "thousand years ago", "calendar", 1000L, -1,
"mya", 1950, "million years ago", "calendar", 1e6L, -1,
"bya", 1950, "billion years ago", "calendar", 1e9L, -1,
# GICC05 (b2k)
# https://www.iceandclimate.nbi.ku.dk/research/strat_dating/annual_layer_count/gicc05_time_scale/
"b2k", 2000, "years before 2000", "calendar", 1, -1,
"b2k", 2000, "years before 2000", "calendar", 1L, -1,
# ISO 80000
# Uncalibrated radiocarbon years
"uncal BP", 1950, "uncalibrated Before Present", "radiocarbon", 1, -1,
"RCYBP", 1950, "Radiocarbon Years Before Present", "radiocarbon", 1, -1,
"bp", 1950, "Before Present (uncalibrated)", "radiocarbon", 1, -1,
"bc", 1950, "Before Christ (uncalibrated)", "radiocarbon", 1, -1,
"bce", 1950, "Before Common Era (uncalibrated)", "radiocarbon", 1, -1,
"ad", 1950, "Anno Domini (uncalibrated)", "radiocarbon", 1, 1,
"ce", 1950, "Common Era (uncalibrated)", "radiocarbon", 1, 1,
"uncal BP", 1950, "uncalibrated Before Present", "radiocarbon", 1L, -1,
"RCYBP", 1950, "Radiocarbon Years Before Present", "radiocarbon", 1L, -1,
"bp", 1950, "Before Present (uncalibrated)", "radiocarbon", 1L, -1,
"bc", 1950, "Before Christ (uncalibrated)", "radiocarbon", 1L, -1,
"bce", 1950, "Before Common Era (uncalibrated)", "radiocarbon", 1L, -1,
"ad", 1950, "Anno Domini (uncalibrated)", "radiocarbon", 1L, 1,
"ce", 1950, "Common Era (uncalibrated)", "radiocarbon", 1L, 1,
# Common Era aliases and translations
# Contemporary calendars
# Islamic calendars
"AH", 622, "Anno Hegirae", "Islamic lunar", 1, 1,
"BH", 622, "Before the Hijra", "Islamic lunar", 1, -1,
"SH", 622, "Solar Hijri", "calendar", 1, 1,
"BSH", 622, "Before Solar Hijri", "calendar", 1, 1,
"AH", 622, "Anno Hegirae", "Islamic lunar", 1L, 1,
"BH", 622, "Before the Hijra", "Islamic lunar", 1L, -1,
"SH", 622, "Solar Hijri", "calendar", 1L, 1,
"BSH", 622, "Before Solar Hijri", "calendar", 1L, 1,
# Historic calendars
# Ancient calendars
# Quirky calendars
"HE", -10000, "Holocene Era", "calendar", 1, 1,
"BHE", -10000, "Before Holocene Era", "calendar", 1, -1,
"AL", -4000, "Anno Lucis", "calendar", 1, 1,
"ADA", -8000, "After the Development of Agriculture", "calendar", 1, 1,
"HE", -10000, "Holocene Era", "calendar", 1L, 1,
"BHE", -10000, "Before Holocene Era", "calendar", 1L, -1,
"AL", -4000, "Anno Lucis", "calendar", 1L, 1,
"ADA", -8000, "After the Development of Agriculture", "calendar", 1L, 1,
)

era_table <- as.data.frame(era_table)
Expand Down

0 comments on commit e6160ba

Please sign in to comment.