Add is_calendar()

NAMESPACE

@@ -39,6 +39,9 @@ export(fixed_to_BP)
 export(fixed_to_CE)
 export(fixed_to_b2k)
 export(fixed_to_julian)
+export(is_calendar)
+export(is_gregorian)
+export(is_julian)
 export(year_axis)
 exportClasses(RataDie)
 exportClasses(TimeIntervals)
@@ -67,8 +70,6 @@ exportMethods(frequency)
 exportMethods(get_calendar)
 exportMethods(image)
 exportMethods(intervals)
-exportMethods(is_gregorian)
-exportMethods(is_julian)
 exportMethods(overlap)
 exportMethods(plot)
 exportMethods(pretty)

R/AllGenerics.R

@@ -174,33 +174,6 @@ setGeneric(
   valueClass = "TimeScale"
 )
 
-#' Is an Object a Calendar?
-#'
-#' Test inheritance relationships between an object and a calendar class.
-#' @param object Any \R object.
-#' @return
-#'  A [`logical`] vector.
-#' @author N. Frerebeau
-#' @docType methods
-#' @family calendar tools
-#' @name is
-#' @rdname is
-NULL
-
-#' @rdname is
-#' @aliases is_gregorian-method
-setGeneric(
-  name = "is_gregorian",
-  def = function(object) standardGeneric("is_gregorian")
-)
-
-#' @rdname is
-#' @aliases is_julian-method
-setGeneric(
-  name = "is_julian",
-  def = function(object) standardGeneric("is_julian")
-)
-
 #' Calendar Parameters
 #'
 #' @param object A [`TimeScale-class`] object.

R/calendar-gregorian.R

@@ -2,18 +2,6 @@
 #' @include AllGenerics.R
 NULL
 
-# Gregorian calendar ===========================================================
-#' @export
-#' @rdname is
-#' @aliases is_gregorian,ANY-method
-setMethod(
-  f = "is_gregorian",
-  signature = "ANY",
-  definition = function(object) {
-    methods::is(object, "GregorianCalendar")
-  }
-)
-
 # Fixed from Gregorian =========================================================
 #' @export
 #' @rdname fixed

R/calendar-julian.R

@@ -2,18 +2,6 @@
 #' @include AllGenerics.R
 NULL
 
-# Julian calendar ==============================================================
-#' @export
-#' @rdname is
-#' @aliases is_julian,ANY-method
-setMethod(
-  f = "is_julian",
-  signature = "ANY",
-  definition = function(object) {
-    methods::is(object, "JulianCalendar")
-  }
-)
-
 # Fixed from Julian ============================================================
 #' @export
 #' @rdname fixed

R/calendar.R

@@ -132,6 +132,33 @@ setMethod(
   }
 )
 
+# Predicates ===================================================================
+#' Is an Object a Calendar?
+#'
+#' Test inheritance relationships between an object and a calendar class.
+#' @param object Any \R object.
+#' @return
+#'  A [`logical`] scalar.
+#' @author N. Frerebeau
+#' @docType methods
+#' @family calendar tools
+#' @export
+is_calendar <- function(object) {
+  methods::is(object, "TimeScale")
+}
+
+#' @export
+#' @rdname is_calendar
+is_gregorian <- function(object) {
+  methods::is(object, "GregorianCalendar")
+}
+
+#' @export
+#' @rdname is_calendar
+is_julian <- function(object) {
+  methods::is(object, "JulianCalendar")
+}
+
 # Mutators =====================================================================
 ## Getters ---------------------------------------------------------------------
 #' @export

inst/tinytest/test_calendar.R

@@ -16,6 +16,7 @@ expect_error(calendar("XXX"), "Unknown calendar")
 # Gregorian calendar ===========================================================
 G <- calendar("BP")
 
+expect_true(is_calendar(G))
 expect_true(is_gregorian(G))
 expect_false(is_julian(G))
 
@@ -30,6 +31,7 @@ expect_identical(calendar_year(G), 365.2425)
 # Julian calendar ==============================================================
 J <- calendar("julian")
 
+expect_true(is_calendar(J))
 expect_true(is_julian(J))
 expect_false(is_gregorian(J))