Merge pull request #45 from MindTheGap-ERC/dev

Dev

.Rbuildignore

@@ -13,3 +13,4 @@
 
 ^CONTRIBUTING.md$
 ^cran-comments\.md$
+^.covrignore$

.covrignore

@@ -0,0 +1 @@
+R/zzz.R

R/adm_summary.R

@@ -7,7 +7,9 @@ quantile_adm = function(x, h, p){
   #' 
   #' @param x a multiadm object
   #' @param h the heights at which to evaluate the adm
-  #' @param p percentile
+  #' @param p percentile, as number between 0 and 1
+  #' 
+  #' @seealso [median_adm()] to extract the median adm, [mean_adm()] for the mean adm
   #' 
   #' @returns an adm object
 
@@ -31,6 +33,8 @@ median_adm = function(x, h){
   #' @param x a multiadm object
   #' @param h the heights at which to evaluate the adm
   #' 
+  #' @seealso [mean_adm()] for the mean age-depth model, [quantile_adm()] for the more general implementation 
+  #' 
   #' @returns an adm object
 
   h_list = get_time(x, h)
@@ -53,6 +57,8 @@ mean_adm = function(x, h){
   #' @param x a multiadm object
   #' @param h the heights at which to evaluate the adm
   #' 
+  #' @seealso [median_adm()] and [quantile_adm()] for median and quantile adms, respectively
+  #' 
   #' @returns an adm object
 
   h_list = get_time(x, h)

R/anchor.R

@@ -4,7 +4,7 @@ anchor = function(x, index = "last", t_anchor = NULL, n = 1000L){
   #' @title anchor age-depth model
   #' 
   #' @param x age-depth model
-  #' @param index "last" or "first", specifying at which tie point the age-depth model will be anchored
+  #' @param index "last" or "first", or an integer (marked by L, e.g. 2L), specifying at which tie point the age-depth model will be anchored. If i is passed as integer, the i-th tie point is anchored.
   #' @param t_anchor time at which the adm is anchored. must be a function that takes no arguments and returns the timing of the tie point. see example or vignettes for details
   #' @param n integer, number of samples drawn from the tie point
   #' 
@@ -17,12 +17,15 @@ anchor = function(x, index = "last", t_anchor = NULL, n = 1000L){
   #' 
   #' @examples
     #' t_anchor = function() rnorm(1) # normally distributed uncertainty
-    #' x = tp_to_adm(t = c(1,2), h = c(2,3)) # simple age-depth model
+    #' x = tp_to_adm(t = c(1,2, 3), h = c(2,3, 4)) # simple age-depth model
     #' m = anchor(x, index = "last", t_anchor = t_anchor, n = 100) # anchor age-depth model
     #' plot(m)
+    #' m = anchor(x, index = 2L, t_anchor = t_anchor, n = 100)
+    #' plot(m)
+    #' 
     #' 
-  if (! index %in% c("last", "first")){
-    stop("can only anchor at first or last tie point")
+  if (! (index %in% c("last", "first") | is.integer(index))){
+    stop("Invalid input for index. Use `first`, `last`, or an integer.")
   }
 
   if (! (is.function(t_anchor))){
@@ -35,6 +38,14 @@ anchor = function(x, index = "last", t_anchor = NULL, n = 1000L){
   if (index == "first"){
     t_ref = min_time(x)
   }
+  if (is.integer(index)){
+    t = get_T_tp(x)
+    l = length(t)
+    if (index > l | index < 1){
+      stop(paste0("index must be between 1 and ", l, " or character" ))
+    }
+    t_ref = t[index]
+  }
 
   for (i in seq_len(n)){
     t_offset = t_anchor()

tests/testthat/test_anchor.R

@@ -3,7 +3,9 @@ test_that("incorrect input for index paramter is caught", {
   x = tp_to_adm(c(0,1), c(0,1), "Myr", "m")
   expect_no_condition(anchor(x, index = "last", t_anchor, n = 10))
   expect_no_condition(anchor(x, index = "first", t_anchor, n = 10))
-  expect_error(anchor(x, index = 2, t_anchor, n = 10))
+  expect_error(anchor(x, index = "2", t_anchor, n = 10))
+  expect_no_condition(anchor(x, index = 2L, t_anchor , n = 10))
+  expect_error(anchor(x, index = 3, t_anchor, n = 10))
 })
 
 test_that("incorrect input for t_anchor parameter is caught", {

tests/testthat/test_is_sac.R

@@ -0,0 +1,4 @@
+test_that("returns true for correct input", {
+  sac = tp_to_sac(t = c(1,2), h = c(2,3), L_unit = "m", T_unit = "Myr")
+  expect_no_condition(sac)
+})