Add is_calendar()

NAMESPACE

@@ -67,6 +67,7 @@ exportMethods(frequency)
 exportMethods(get_calendar)
 exportMethods(image)
 exportMethods(intervals)
+exportMethods(is_calendar)
 exportMethods(is_gregorian)
 exportMethods(is_julian)
 exportMethods(overlap)

R/AllGenerics.R

@@ -179,22 +179,24 @@ setGeneric(
 #' Test inheritance relationships between an object and a calendar class.
 #' @param object Any \R object.
 #' @return
-#'  A [`logical`] vector.
+#'  A [`logical`] scalar.
 #' @author N. Frerebeau
 #' @docType methods
 #' @family calendar tools
-#' @name is
-#' @rdname is
-NULL
+#' @aliases is_calendar-method
+setGeneric(
+  name = "is_calendar",
+  def = function(object) standardGeneric("is_calendar")
+)
 
-#' @rdname is
+#' @rdname is_calendar
 #' @aliases is_gregorian-method
 setGeneric(
   name = "is_gregorian",
   def = function(object) standardGeneric("is_gregorian")
 )
 
-#' @rdname is
+#' @rdname is_calendar
 #' @aliases is_julian-method
 setGeneric(
   name = "is_julian",

R/calendar-gregorian.R

@@ -4,7 +4,7 @@ NULL
 
 # Gregorian calendar ===========================================================
 #' @export
-#' @rdname is
+#' @rdname is_calendar
 #' @aliases is_gregorian,ANY-method
 setMethod(
   f = "is_gregorian",

R/calendar-julian.R

@@ -4,7 +4,7 @@ NULL
 
 # Julian calendar ==============================================================
 #' @export
-#' @rdname is
+#' @rdname is_calendar
 #' @aliases is_julian,ANY-method
 setMethod(
   f = "is_julian",

R/calendar.R

@@ -132,6 +132,18 @@ setMethod(
   }
 )
 
+# Predicates ===================================================================
+#' @export
+#' @rdname is_calendar
+#' @aliases is_calendar,ANY-method
+setMethod(
+  f = "is_calendar",
+  signature = "ANY",
+  definition = function(object) {
+    methods::is(object, "TimeScale")
+  }
+)
+
 # 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))