Added getTimePoints convenience function (#41)

NAMESPACE

@@ -14,6 +14,7 @@ export(getCorrected)
 export(getEffDims)
 export(getGenoPred)
 export(getHerit)
+export(getTimePoints)
 export(getVar)
 import(ggplot2)
 import(stats)

R/utils.R

@@ -467,3 +467,22 @@ checkAsreml <- function() {
   invisible(TRUE)
 }
 
+#' Extract time points
+#'
+#' Function for extracting a data.frame with timeNumbers and timePoints from
+#' an object of class TP or fitMod.
+#'
+#' @param x An object of class TP or fitMod
+#'
+#' @return A data.frame with columns timeNumber and timePoint listing the
+#' time points in x
+#'
+#' @export
+getTimePoints <- function(x) {
+  ## Check input.
+  if (!inherits(x, "TP") && !inherits(x, "fitMod")) {
+    stop("x should be an object of class TP or fitMod")
+  }
+  return(attr(x = x, which = "timePoints"))
+}
+

inst/tinytest/test_utils.R

@@ -134,5 +134,11 @@ expect_true(inherits(statgenHTP:::chkTimePoints(testTP, 1), "character"))
 expect_equal(statgenHTP:::chkTimePoints(testTP, 1),
              statgenHTP:::chkTimePoints(testTP, "2018-06-01 16:37:00"))
 
+### Test getTimePoints
 
+expect_error(getTimePoints(x = 1:3),
+             "x should be an object of class TP or fitMod")
+## Create TP object.
+expect_true(inherits(getTimePoints(testTP), "data.frame"))
+expect_equal(getTimePoints(testTP), attr(x = testTP, which = "timePoints"))