Reusable Laws for a Vector Protocol

The same four laws test ordinary double vectors and an S7 ReadDepth class. For an introduction to interfaces and traits, see Behavioral Contracts on S7.

Vector-like behavior

Many algorithms need only a length, a way to slice, and access to values. Both ordinary double vectors and ReadDepth objects implement those operations. The class validator keeps positions and depths aligned, while the interface describes the behavior consumers need.

vec_length <- new_generic("vec_length", "x")
vec_slice <- new_generic("vec_slice", "x", function(x, i) S7_dispatch())
vec_values <- new_generic("vec_values", "x")

VectorLike <- new_interface(
  "VectorLike",
  generics = list(
    length = interface_requirement(vec_length, returns = class_integer),
    slice = interface_requirement(vec_slice, args = list(i = class_integer)),
    values = interface_requirement(vec_values, returns = class_double)
  )
)

ReadDepth <- new_class(
  "ReadDepth",
  properties = list(position = class_integer, depth = class_double),
  validator = function(self) {
    if (length(self@position) != length(self@depth)) {
      "@position and @depth must have the same length"
    }
  }
)

method(vec_length, ReadDepth) <- function(x) length(x@depth)
method(vec_slice, ReadDepth) <- function(x, i) {
  ReadDepth(position = x@position[i], depth = x@depth[i])
}
method(vec_values, ReadDepth) <- function(x) x@depth

method(vec_length, class_double) <- function(x) length(x)
method(vec_slice, class_double) <- function(x, i) x[i]
method(vec_values, class_double) <- function(x) x

coverage <- ReadDepth(position = 1:5, depth = c(12, 15, 9, 20, 17))
implements(coverage, VectorLike)
#> [1] TRUE
implements(class_double, VectorLike)
#> [1] TRUE

A function can depend on this small protocol without knowing how the object is represented internally.

window_mean <- function(x, i) {
  assert_implements(x, VectorLike)
  with(VectorLike, mean(vec_values(vec_slice(x, i))))
}

window_mean(coverage, 2:4)
#> [1] 14.66667
window_mean(c(12, 15, 9, 20, 17), 2:4)
#> [1] 14.66667

One protocol, several implementations

A protocol author can publish a function returning a named list of laws. Implementation authors supply a constructor; the laws compare each result with the reference values passed to that constructor.

The domain here is unnamed vectors of finite doubles between -10 and 10, with positive, in-range integer indices. gen_double() expands its bounds with size and shrinks toward zero. Empty vectors and selections are included; indices may repeat or appear out of order. The generator mixes ordered subsequences, permutations without replacement, and repeated selections. Missing values, names, and negative indices are outside this example.

gen_bind() constructs the object and an index generator from the reference values. When those values shrink, it rebuilds both, preserving object validity and index bounds. Bounds come from the reference data rather than the method being tested. Inside the contract mask, base::length() keeps the reference calculation separate from the interface’s length alias.

vector_laws <- function(make, element = gen_double(-10, 10)) {
  values <- gen_vector(element, max = 6L)
  cases <- gen_bind(values, function(values) {
    indices <- if (length(values) == 0L) {
      gen_constant(integer())
    } else {
      gen_choice(
        gen_subsequence(seq_along(values)),
        gen_sample(seq_along(values)),
        gen_vector(gen_element(seq_along(values)), max = 6L)
      )
    }
    gen_product(
      x = gen_constant(make(values)),
      values = gen_constant(values),
      i = indices
    )
  })

  list(
    values = new_law("values preserve constructor input", list(input = cases),
      function(input) with(VectorLike, {
        identical(vec_values(input$x), input$values)
      })),
    length = new_law("length agrees with constructor input", list(input = cases),
      function(input) with(VectorLike, {
        identical(vec_length(input$x), base::length(input$values))
      })),
    slice_values = new_law("slicing preserves selected values and order", list(input = cases),
      function(input) with(VectorLike, {
        identical(vec_values(vec_slice(input$x, input$i)), input$values[input$i])
      }),
      classify = function(input) c(
        if (length(input$values) == 0L) "empty" else "nonempty",
        if (anyDuplicated(input$i) > 0L) "repeated",
        if (is.unsorted(input$i)) "reordered",
        if (!is.unsorted(input$i, strictly = TRUE)) "subsequence",
        if (length(input$i) == length(input$values) && !anyDuplicated(input$i)) "permutation",
        if (any(input$values != trunc(input$values))) "fractional"
      ),
      min_coverage = c(empty = 0.05, nonempty = 0.5, repeated = 0.05,
                       reordered = 0.1, subsequence = 0.2, permutation = 0.2,
                       fractional = 0.5)
    ),
    slice_length = new_law("slice length matches the index count", list(input = cases),
      function(input) with(VectorLike, {
        identical(vec_length(vec_slice(input$x, input$i)), base::length(input$i))
      }))
  )
}

lapply() runs the same four laws against both representations.

implementations <- list(
  numeric = identity,
  read_depth = function(values) ReadDepth(position = seq_along(values), depth = values)
)
vector_results <- lapply(implementations, function(make) {
  lapply(vector_laws(make), check_law, tests = 100L, seed = 1L)
})
sapply(vector_results, function(results) {
  vapply(results, function(result) result@status, character(1))
})
#>              numeric  read_depth
#> values       "passed" "passed"  
#> length       "passed" "passed"  
#> slice_values "passed" "passed"  
#> slice_length "passed" "passed"

Which cases were tested?

The slicing law classifies inputs as empty or nonempty, records fractional values, and labels repeated, reordered, subsequence, and permutation selections. Labels describe the indices themselves, so they can overlap: an empty selection is a subsequence, and a full ordered selection is also a permutation. Each label counts once per accepted case. Its min_coverage requirements use proportions: reordered = 0.1 asks for reordered indices in at least 10% of cases.

gen_sample() fixes cardinality and shrinks toward earlier source positions, swapping selected positions to preserve uniqueness. gen_subsequence() grows length with size and keeps source order during shrinking. Both sample positions; equal values at different positions may still appear together. Sampling with replacement uses gen_vector() and gen_element().

vector_results$numeric$slice_values@coverage
#>         label count proportion minimum  met
#> 1       empty    16       0.16    0.05 TRUE
#> 2    nonempty    84       0.84    0.50 TRUE
#> 3    repeated    17       0.17    0.05 TRUE
#> 4   reordered    36       0.36    0.10 TRUE
#> 5 subsequence    57       0.57    0.20 TRUE
#> 6 permutation    57       0.57    0.20 TRUE
#> 7  fractional    84       0.84    0.50 TRUE

Fixing size at zero exercises only empty vectors. The predicate passes, but the coverage requirements prevent the run from passing:

empty_only <- check_law(vector_laws(identity)$slice_values,
                        tests = 10L, seed = 1L, max_size = 0L)
empty_only
#> Law 'slicing preserves selected values and order' passed 10 tests but missed coverage requirements (seed 1).
#> Case coverage (10 accepted cases):
#>   "nonempty": 0/10 (0%; minimum 50% unmet)
#>   "repeated": 0/10 (0%; minimum 5% unmet)
#>   "reordered": 0/10 (0%; minimum 10% unmet)
#>   "fractional": 0/10 (0%; minimum 50% unmet)
#>   "empty": 10/10 (100%; minimum 5%)
#>   "subsequence": 10/10 (100%; minimum 20%)
#>   "permutation": 10/10 (100%; minimum 20%)

This follows the test-data classification discussed by Claessen and Hughes (2000), §2.4. These minima describe observed proportions within the chosen test budget; they carry no statistical confidence guarantee. Discards, errors, and shrink evaluations contribute no counts. A falsifying generated case does count, and a run that ends early reports partial coverage alongside its primary failure. See new_law() for classifier requirements and result fields.

Structural conformance and a behavioral failure

This subclass inherits the correct length and value methods, but its slice method reverses the requested order. All required methods are available, so implements() succeeds. Its slices also have valid representations and the expected value type and length. This run uses integer-valued doubles to keep the counterexample easy to read.

ReversedDepth <- new_class("ReversedDepth", parent = ReadDepth)
method(vec_slice, ReversedDepth) <- function(x, i) {
  ReadDepth(position = x@position[rev(i)], depth = x@depth[rev(i)])
}

implements(ReversedDepth, VectorLike)
#> [1] TRUE
whole_numbers <- gen_map(gen_integer(-10L, 10L), as.double, prototype = double())
broken_results <- lapply(
  vector_laws(function(values) ReversedDepth(position = seq_along(values), depth = values),
              element = whole_numbers),
  check_law, tests = 100L, seed = 1L
)
vapply(broken_results, function(result) result@status, character(1))
#>       values       length slice_values slice_length 
#>     "passed"     "passed"  "falsified"     "passed"

Only the law about selected values and their order fails. The reduced input still produces a valid slice, but its values differ from the reference slice.

failure <- broken_results$slice_values
failure
#> Law 'slicing preserves selected values and order' was falsified after 3 attempts and 1 shrinks (seed 1).
#> The law returned FALSE.
#> Shrinking stopped: no child of this counterexample preserves the failure.
#> Smallest counterexample found:
#> List of 1
#>  $ input:List of 3
#>   ..$ x     : <ReversedDepth>
#>   .. ..@ position: int [1:2] 1 2
#>   .. ..@ depth   : num [1:2] 0 -1
#>   ..$ values: num [1:2] 0 -1
#>   ..$ i     : int [1:2] 1 2
#> Case coverage (3 accepted cases; partial run):
#>   "nonempty": 1/3 (33.3%; minimum 50% unmet)
#>   "repeated": 0/3 (0%; minimum 5% unmet)
#>   "reordered": 0/3 (0%; minimum 10% unmet)
#>   "fractional": 0/3 (0%; minimum 50% unmet)
#>   "empty": 2/3 (66.7%; minimum 5%)
#>   "subsequence": 3/3 (100%; minimum 20%)
#>   "permutation": 3/3 (100%; minimum 20%)
example <- failure@counterexample@minimal$input
example$values
#> [1]  0 -1
example$i
#> [1] 1 2
with(VectorLike, vec_values(vec_slice(example$x, example$i)))
#> [1] -1  0
example$values[example$i]
#> [1]  0 -1

The result records the inputs and run parameters needed to replay the failure:

replayed <- do.call(check_law, c(list(law = failure@law), failure@parameters))
identical(replayed@counterexample@minimal, failure@counterexample@minimal)
#> [1] TRUE

A bug hidden by integer inputs

This value method silently rounds fractional measurements. Integer-only inputs let it pass; the same law with gen_double() detects the loss of precision.

RoundedDepth <- new_class("RoundedDepth", parent = ReadDepth)
method(vec_values, RoundedDepth) <- function(x) round(x@depth)
rounded <- function(values) RoundedDepth(position = seq_along(values), depth = values)

integer_check <- check_law(vector_laws(rounded, whole_numbers)$values, seed = 1L)
fractional_check <- check_law(vector_laws(rounded)$values, seed = 1L)
c(whole_numbers = integer_check@status, fractions = fractional_check@status)
#> whole_numbers     fractions 
#>      "passed"   "falsified"

For generator composition, budgets, and tinytest integration, see Generative Laws with tinytest.