Raise test coverage to 100% (mark unreachable defensive branches)

R/thin.R

@@ -74,7 +74,17 @@ as_binary_matrix <- function(image) {
          storage.mode(image), "'.")
   }
   if (is.array(image) && length(dim(image)) == 2L) {
-    return(as_binary_matrix(matrix(image, nrow = dim(image)[1], ncol = dim(image)[2])))
+    # nocov start
+    # Fail-fast assertion (unreachable): the package requires R (>= 4.2),
+    # where every object carrying a length-2 `dim` attribute also satisfies
+    # is.matrix() -- so any 2-D array is already handled by the is.matrix()
+    # branch above and control cannot arrive here. If it ever does, base R's
+    # array/matrix invariant has changed underneath us; raise loudly rather
+    # than silently recursing so the broken assumption is caught, not masked.
+    stop("thinr internal invariant violated: a length-2 `dim` object ",
+         "reached the array branch without satisfying is.matrix(). ",
+         "This contradicts base R (>= 4.2) array/matrix semantics.")
+    # nocov end
   }
   stop("thinr::thin() expects a 2-D matrix. ",
        "Higher-dimensional arrays are not yet supported.")

src/distance_transform.cpp

@@ -232,7 +232,10 @@ NumericMatrix distance_transform_cpp(IntegerMatrix img, int metric) {
     case 0:  return dt_euclidean(img);
     case 1:  return dt_manhattan(img);
     case 2:  return dt_chessboard(img);
-    default: Rcpp::stop("Unknown metric code passed to distance_transform_cpp.");
+    // Defensive default: the R wrapper distance_transform() validates
+    // `metric` with match.arg() and maps it to codes 0/1/2 only, so an
+    // out-of-range code never reaches here. Not exercisable from R.
+    default: Rcpp::stop("Unknown metric code passed to distance_transform_cpp.");  // # nocov
   }
   return NumericMatrix(0, 0);  // unreachable
 }

src/lee.cpp

@@ -39,7 +39,12 @@ static inline int lee_can_delete(int p2, int p3, int p4, int p5,
     case 1:  on_boundary = (p4 == 0); break;  // east
     case 2:  on_boundary = (p6 == 0); break;  // south
     case 3:  on_boundary = (p8 == 0); break;  // west
-    default: on_boundary = 0;
+    // Fail-fast assertion (unreachable): `sub` is driven only by the
+    // internal `for (int sub = 0; sub < 4; sub++)` loop below, so values
+    // outside 0-3 cannot reach here. If one ever does, the caller's loop
+    // bound has been corrupted; abort loudly rather than silently treating
+    // the pixel as interior so the broken invariant is caught, not masked.
+    default: Rcpp::stop("thinr internal invariant: lee sub-iteration index out of range (expected 0-3) in lee_can_delete().");  // # nocov
   }
   if (!on_boundary) return 0;
 

tests/testthat/test-coercion-helpers.R

@@ -0,0 +1,123 @@
+# Strict exact-value tests for the internal coercion helpers
+# (as_binary_matrix / restore_storage) and the array-input path of
+# thin(). These pin the precise dispatch behaviour rather than just
+# the output shape.
+
+describe("as_binary_matrix: collapses foreground to exactly 1", {
+  it("integer input keeps zeros and maps every non-zero to 1L", {
+    img <- matrix(c(0L, 2L, 0L,
+                    5L, 0L, 255L,
+                    0L, 9L, 0L),
+                  nrow = 3, byrow = TRUE)
+    out <- thinr:::as_binary_matrix(img)
+    expect_identical(
+      out,
+      matrix(c(0L, 1L, 0L,
+               1L, 0L, 1L,
+               0L, 1L, 0L),
+             nrow = 3, byrow = TRUE)
+    )
+    expect_type(out, "integer")
+  })
+
+  it("logical input becomes a 0/1 integer matrix", {
+    img <- matrix(c(TRUE, FALSE, FALSE, TRUE), nrow = 2)
+    out <- thinr:::as_binary_matrix(img)
+    expect_identical(out, matrix(c(1L, 0L, 0L, 1L), nrow = 2))
+    expect_type(out, "integer")
+  })
+
+  it("numeric input maps any non-zero (incl. negatives/fractions) to 1", {
+    img <- matrix(c(0, -3.5, 0.2, 0), nrow = 2)
+    out <- thinr:::as_binary_matrix(img)
+    expect_identical(out, matrix(c(0L, 1L, 1L, 0L), nrow = 2))
+    expect_type(out, "integer")
+  })
+
+  it("preserves matrix dimensions", {
+    img <- matrix(1L, nrow = 3, ncol = 7)
+    out <- thinr:::as_binary_matrix(img)
+    expect_identical(dim(out), c(3L, 7L))
+  })
+})
+
+describe("as_binary_matrix: array input dispatches through the matrix path", {
+  # A 2-D object built with array() is, in R (>= 4.2), already a matrix,
+  # so it is handled identically to the equivalent matrix() input. This
+  # pins that equivalence with exact values.
+  it("a 2-D integer array yields the same result as the matrix form", {
+    arr <- array(0L, dim = c(5L, 5L))
+    arr[2:4, 2:4] <- 1L
+    mat <- matrix(0L, nrow = 5, ncol = 5)
+    mat[2:4, 2:4] <- 1L
+    expect_identical(
+      thinr:::as_binary_matrix(arr),
+      thinr:::as_binary_matrix(mat)
+    )
+  })
+
+  it("thin() accepts a 2-D array and matches the matrix result exactly", {
+    arr <- array(0L, dim = c(5L, 5L))
+    arr[2:4, 2:4] <- 1L
+    mat <- matrix(0L, nrow = 5, ncol = 5)
+    mat[2:4, 2:4] <- 1L
+    expect_identical(
+      thin(arr, method = "zhang_suen"),
+      thin(mat, method = "zhang_suen")
+    )
+  })
+})
+
+describe("as_binary_matrix: unsupported inputs error with the documented message", {
+  it("character matrix names the storage mode in the message", {
+    expect_error(
+      thinr:::as_binary_matrix(matrix("a", 2, 2)),
+      "does not know how to interpret a matrix of mode 'character'",
+      fixed = TRUE
+    )
+  })
+
+  it("a 3-D array reports the 2-D requirement", {
+    expect_error(
+      thinr:::as_binary_matrix(array(0L, dim = c(2L, 2L, 2L))),
+      "expects a 2-D matrix"
+    )
+  })
+
+  it("a 1-D array reports the 2-D requirement", {
+    expect_error(
+      thinr:::as_binary_matrix(array(0L, dim = 4L)),
+      "expects a 2-D matrix"
+    )
+  })
+})
+
+describe("restore_storage: returns the storage mode of the original input", {
+  skel <- matrix(c(0L, 1L, 0L, 1L), nrow = 2)
+
+  it("logical original -> logical skeleton with identical values", {
+    out <- thinr:::restore_storage(skel, matrix(TRUE, 2, 2))
+    expect_identical(out, matrix(c(FALSE, TRUE, FALSE, TRUE), nrow = 2))
+    expect_type(out, "logical")
+  })
+
+  it("double original -> double skeleton with identical values", {
+    out <- thinr:::restore_storage(skel, matrix(1.0, 2, 2))
+    expect_identical(out, matrix(c(0, 1, 0, 1), nrow = 2))
+    expect_type(out, "double")
+  })
+
+  it("integer original -> the integer skeleton is returned unchanged", {
+    out <- thinr:::restore_storage(skel, matrix(1L, 2, 2))
+    expect_identical(out, skel)
+    expect_type(out, "integer")
+  })
+
+  it("preserves the skeleton dimensions for every storage mode", {
+    sk <- matrix(0L, nrow = 4, ncol = 6)
+    expect_identical(dim(thinr:::restore_storage(sk, matrix(TRUE, 4, 6))),
+                     c(4L, 6L))
+    expect_identical(dim(thinr:::restore_storage(sk, matrix(1.0, 4, 6))),
+                     c(4L, 6L))
+  })
+})

tests/testthat/test-distance-transform.R

@@ -62,6 +62,28 @@ describe("distance_transform: euclidean distance", {
   })
 })
 
+describe("distance_transform: exact full-matrix values from a corner", {
+  # A 4x4 all-foreground image with a single background pixel at (1, 1).
+  # Pin every cell of every metric, not just a handful.
+  img <- matrix(1L, nrow = 4, ncol = 4)
+  img[1, 1] <- 0L
+
+  it("manhattan: every cell equals (r-1) + (c-1)", {
+    expected <- outer(0:3, 0:3, `+`)
+    expect_equal(distance_transform(img, metric = "manhattan"), expected)
+  })
+
+  it("chessboard: every cell equals max(r-1, c-1)", {
+    expected <- outer(0:3, 0:3, pmax)
+    expect_equal(distance_transform(img, metric = "chessboard"), expected)
+  })
+
+  it("euclidean: every cell equals sqrt((r-1)^2 + (c-1)^2)", {
+    expected <- outer(0:3, 0:3, function(a, b) sqrt(a^2 + b^2))
+    expect_equal(distance_transform(img, metric = "euclidean"), expected)
+  })
+})
+
 describe("distance_transform: all-background image returns zeros", {
   for (metric in c("euclidean", "manhattan", "chessboard")) {
     local({

tests/testthat/test-medial-axis.R

@@ -50,6 +50,31 @@ describe("medial_axis: return_distance returns skeleton + distance", {
   })
 })
 
+describe("medial_axis: exact skeleton and distance on a known rectangle", {
+  # The 7x9 solid 3x5 rectangle from the roxygen example. Pins the exact
+  # ridge pattern and the per-pixel distance values, not just a subset.
+  img <- matrix(0L, nrow = 7, ncol = 9)
+  img[3:5, 3:7] <- 1L
+
+  it("returns the documented skeleton pattern", {
+    expected <- matrix(0L, nrow = 7, ncol = 9)
+    expected[3, 3:4] <- 1L
+    expected[3, 6:7] <- 1L
+    expected[4, 3:7] <- 1L
+    expected[5, 3:4] <- 1L
+    expected[5, 6:7] <- 1L
+    expect_identical(medial_axis(img), expected)
+  })
+
+  it("returns the exact Euclidean distance map", {
+    expected <- matrix(0, nrow = 7, ncol = 9)
+    expected[3, 3:7] <- 1
+    expected[4, 3:7] <- c(1, 2, 2, 2, 1)
+    expected[5, 3:7] <- 1
+    expect_equal(medial_axis(img, return_distance = TRUE)$distance, expected)
+  })
+})
+
 describe("medial_axis: storage mode of output skeleton matches input", {
   it("logical in, logical out", {
     img <- matrix(FALSE, nrow = 5, ncol = 5)

tests/testthat/test-thin.R

@@ -369,6 +369,38 @@ describe("complex shapes do not crash and yield smaller skeletons", {
   }
 })
 
+describe("exact skeletons on small known shapes", {
+  # The property tests above bound the skeleton size; these pin the
+  # exact pixel pattern so a change in any algorithm's output is caught.
+  it("zhang_suen collapses a 3x3 solid block to its single centre pixel", {
+    img <- matrix(0L, nrow = 5, ncol = 5)
+    img[2:4, 2:4] <- 1L
+    expected <- matrix(0L, nrow = 5, ncol = 5)
+    expected[3, 3] <- 1L
+    expect_identical(thin(img, method = "zhang_suen"), expected)
+  })
+
+  it("guo_hall collapses a 3x3 solid block to its single centre pixel", {
+    img <- matrix(0L, nrow = 5, ncol = 5)
+    img[2:4, 2:4] <- 1L
+    expected <- matrix(0L, nrow = 5, ncol = 5)
+    expected[3, 3] <- 1L
+    expect_identical(thin(img, method = "guo_hall"), expected)
+  })
+
+  it("thinImage matches its documented 3x5 example output exactly", {
+    img <- matrix(c(0, 1, 1, 1, 0,
+                    0, 1, 1, 1, 0,
+                    0, 1, 1, 1, 0),
+                  nrow = 3, byrow = TRUE)
+    expected <- matrix(c(0, 1, 1, 1, 0,
+                         0, 0, 1, 0, 0,
+                         0, 1, 1, 1, 0),
+                       nrow = 3, byrow = TRUE)
+    expect_identical(thinImage(img), expected)
+  })
+})
+
 describe("thinImage drop-in", {
   it("accepts a logical matrix", {
     img <- matrix(FALSE, nrow = 5, ncol = 5)