tests/testthat/test-invariants.R

In Immutables: Fast and Functional Data Structures

#SO

validate_fingertree_invariants <- function(t) {
  is_homogeneous <- function(xs) {
    if(length(xs) <= 1) {
      return(TRUE)
    }
    kinds <- vapply(xs, is_structural_node, logical(1))
    all(kinds == kinds[[1]])
  }

  walk <- function(x) {
    if(x %isa% Empty) {
      testthat::expect_true(!is.null(attr(x, "monoids")))
      testthat::expect_true(!is.null(attr(x, "measures")))
      return(invisible(TRUE))
    }

    if(x %isa% Single) {
      testthat::expect_identical(length(x), 1L)
      testthat::expect_true(!is.null(attr(x, "monoids")))
      testthat::expect_true(!is.null(attr(x, "measures")))
      return(invisible(TRUE))
    }

    if(x %isa% Deep) {
      testthat::expect_true(length(x$prefix) >= 1 && length(x$prefix) <= 4)
      testthat::expect_true(length(x$suffix) >= 1 && length(x$suffix) <= 4)
      testthat::expect_true(is_homogeneous(x$prefix))
      testthat::expect_true(is_homogeneous(x$suffix))
      testthat::expect_true(!is.null(attr(x, "monoids")))
      testthat::expect_true(!is.null(attr(x, "measures")))
      walk(x$middle)
      return(invisible(TRUE))
    }

    if(x %isa% Node) {
      testthat::expect_true(length(x) %in% c(2L, 3L))
      testthat::expect_true(is_homogeneous(x))
      testthat::expect_true(!is.null(attr(x, "monoids")))
      testthat::expect_true(!is.null(attr(x, "measures")))
      for(el in x) {
        if(is_structural_node(el)) {
          walk(el)
        }
      }
      return(invisible(TRUE))
    }

    if(x %isa% Digit) {
      testthat::expect_true(length(x) >= 1 && length(x) <= 4)
      testthat::expect_true(is_homogeneous(x))
      testthat::expect_true(!is.null(attr(x, "monoids")))
      testthat::expect_true(!is.null(attr(x, "measures")))
      for(el in x) {
        if(is_structural_node(el)) {
          walk(el)
        }
      }
      return(invisible(TRUE))
    }
  }

  walk(t)
  invisible(TRUE)
}

testthat::test_that("structural invariants hold after mixed updates", {
  mr <- measure_monoid(function(a, b) a + b, 0, function(el) 1)
  t <- add_monoids(flexseq(), list(count = mr))
  for(i in 1:30) {
    if(i %% 2 == 0) {
      t <- push_back(t, letters[i %% 26 + 1])
    } else {
      t <- push_front(t, letters[i %% 26 + 1])
    }
  }
  validate_fingertree_invariants(t)
})

testthat::test_that("structural invariants hold after concat and split", {
  mr <- measure_monoid(function(a, b) a + b, 0, function(el) 1)
  t1 <- add_monoids(as_flexseq(letters[1:12]), list(count = mr))
  t2 <- add_monoids(as_flexseq(letters[13:20]), list(count = mr))
  t <- c(t1, t2)
  validate_fingertree_invariants(t)

  s <- split_by_predicate(t, function(v) v >= 10, ".size")
  validate_fingertree_invariants(s$left)
  validate_fingertree_invariants(s$right)
})

testthat::test_that("measured deep trees retain root measure through updates", {
  mr <- measure_monoid(function(a, b) a + b, 0, function(el) 1)
  t <- add_monoids(as_flexseq(letters[1:10]), list(count = mr))
  t <- push_front(t, "z")
  t <- push_back(t, "y")
  testthat::expect_identical(attr(t, "measures")$.size, 12)
  validate_fingertree_invariants(t)
})