## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)
library(thinr)

## ----edge---------------------------------------------------------------------
# A 3-pixel-thick horizontal bar flush against the top edge.
bar_top <- matrix(0L, nrow = 5, ncol = 9)
bar_top[1:3, ] <- 1L

# The same bar one row in from the edge.
bar_interior <- matrix(0L, nrow = 5, ncol = 9)
bar_interior[2:4, ] <- 1L

# Both thin to a single-pixel line, and to the same number of pixels.
sum(thin(bar_top))
sum(thin(bar_interior))

## ----edge-test----------------------------------------------------------------
methods <- c("zhang_suen", "guo_hall", "lee", "k3m",
             "hilditch", "opta", "holt")
vapply(methods, function(m) {
  out <- thin(bar_top, method = m)
  # No foreground survives more than one pixel thick on the top edge.
  max(colSums(out[1:2, , drop = FALSE])) <= 1L
}, logical(1))

## ----connectivity-------------------------------------------------------------
# 8-connected component count.
n_components <- function(m) {
  m <- m != 0
  lab <- matrix(0L, nrow(m), ncol(m))
  k <- 0L
  for (i in seq_len(nrow(m))) for (j in seq_len(ncol(m))) {
    if (m[i, j] && lab[i, j] == 0L) {
      k <- k + 1L
      stack <- list(c(i, j))
      lab[i, j] <- k
      while (length(stack)) {
        p <- stack[[length(stack)]]
        stack[[length(stack)]] <- NULL
        for (di in -1:1) for (dj in -1:1) {
          r <- p[1] + di
          cc <- p[2] + dj
          if (r >= 1 && r <= nrow(m) && cc >= 1 && cc <= ncol(m) &&
                m[r, cc] && lab[r, cc] == 0L) {
            lab[r, cc] <- k
            stack[[length(stack) + 1]] <- c(r, cc)
          }
        }
      }
    }
  }
  k
}

# A 2-pixel-thick, 9-pixel-long bar: one component in, one component out.
bar2 <- matrix(0L, nrow = 6, ncol = 13)
bar2[3:4, 3:11] <- 1L
vapply(methods, function(m) n_components(thin(bar2, method = m)),
       integer(1))

## ----dt-inf-------------------------------------------------------------------
solid <- matrix(1L, nrow = 4, ncol = 4)
vapply(c("euclidean", "manhattan", "chessboard"),
       function(mt) unique(as.vector(distance_transform(solid, metric = mt))),
       numeric(1))

## ----na, error = TRUE---------------------------------------------------------
try({
m <- matrix(1L, nrow = 3, ncol = 3)
m[2, 2] <- NA
thin(m)
})