merge beds in strat column

R/merge_beds.R

@@ -0,0 +1,41 @@
+merge_beds = function(s, mode = "identical facies", ...){
+  #' @export
+  #' @title merge beds in stratigraphic column
+  #'
+  #' @param s stratigraphic column
+  #' @param mode character. criteria for merging. currently onlye "identical facies" is implemented
+  #' @param ... other paratmeters. currently not used
+
+  UseMethod("merge_beds")
+}
+
+merge_beds.stratcol = function(s, mode = "identical facies", ...){
+#' @export
+
+if (mode == "identical facies"){
+  nb = no_beds(s)
+  if (nb == 1){
+    return(s)
+  }
+  if (!facies_repetitions(s)){
+    return(s)
+  }
+  fa = facies_names.stratcol(s)
+  ti = bed_thickness.stratcol(s)
+  fa_new = fa[1]
+  ti_new = ti[1]
+  for (i in 1:(nb -1)){
+    id_facies = fa[i] == fa[i+1]
+    if (!id_facies){ # facies are not identical
+      fa_new = c(fa_new, fa[i+1])
+      ti_new = c(ti_new, ti[i+1])
+    }
+    if (id_facies){ # if facies are identical
+      ti_new[length(ti_new)] = ti_new[length(ti_new)] + ti[i+1] # add up thickness
+    }
+  }
+  s_out = as_stratcol(ti_new, fa_new, get_L_unit.stratcol(s), base = get_base.stratcol(s))
+  return(s_out)
+}
+  stop("unknown mode")
+}

tests/testthat/test_merge_beds.R

@@ -0,0 +1,12 @@
+test_that("trivial cases with repeated facies are recognized", {
+  s = as_stratcol(1,1)
+  expect_equal(s, merge_beds(s))
+
+  s = as_stratcol(runif(10), 1:11)
+  expect_equal(s, merge_beds(s))
+})
+
+test_that("repeated facies are merged", {
+  s = as_stratcol(c(1,1), c(1,1))
+  expect_equal( merge_beds(s), as_stratcol(2, 1))
+})

vignettes/stratcols.Rmd

@@ -59,6 +59,9 @@ no_facies(s)
 
 get_base(s) # lowest bed boundary
 get_L_unit(s) # length unit of beds
+
+facies_repetitions(s) # do successive beds have identical facies?
+merge_beds(s, mode = "identical facies") # merge successive beds with identical facies
 ```