Add remaining verification functions and supporting internal functions.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: wallis
 Title: Room squares in R
-Version: 0.0.0.9004
+Version: 0.0.0.9005
 Authors@R: 
     person("Matthew", "Henderson", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-7949-8208"))

NAMESPACE

@@ -2,6 +2,9 @@
 
 export(empty_cells)
 export(empty_room)
+export(is_maximal_proom)
+export(is_partial_room)
+export(is_room)
 export(n_filled_cells)
 export(plot_room_square)
 export(unused_pairs)

R/avail.R

@@ -0,0 +1,11 @@
+#' Is pair p available in R at cell e?
+#'
+#' @param R A partial Room square.
+#' @param p A pair.
+#' @param e An empty cell of R.
+#'
+#' @return True if and only if the pair p can be placed in cell e in R.
+avail <- function(R, p, e) {
+  available <- R[R$row == e[1] & R$col == e[2], "avail"]$avail[[1]]
+  p[1] %in% available && p[2] %in% available
+}

R/distinct-pairs.R

@@ -0,0 +1,12 @@
+#' Pairs used in R
+#'
+#' @param R A Room square.
+#'
+#' @return A list of the distinct pairs that appear in R.
+distinct_pairs <- function(R) {
+  R |>
+    tidyr::pivot_wider() |>
+    dplyr::filter(!is.na(first)) |>
+    dplyr::filter(!is.na(second)) |>
+    dplyr::distinct(first, second)
+}

R/room.R

@@ -0,0 +1,72 @@
+#' Is R a partial Room square?
+#'
+#' @param R A partial Room square.
+#'
+#' @return True if and only if R is a partial Room square, False otherwise.
+#' @export
+is_partial_room <- function(R) {
+  expected_number_of_distinct_pairs <- choose(max(R$col) + 1, 2)
+  nfc <- n_filled_cells(R)
+  is_row_latin(R) && 
+    is_col_latin(R) && 
+    n_filled_cells(R) <= expected_number_of_distinct_pairs
+}
+
+#' Is R a Room square?
+#'
+#' @param R A Room square.
+#'
+#' @return True if and only if R is a Room square, False otherwise.
+#' @export
+is_room <- function(R) {
+  nfc <- n_filled_cells(R)
+  is_partial_room(R) && nrow(distinct_pairs(R)) == nfc
+}
+
+#' Is R a maximal partial Room square?
+#'
+#' @param R A partial Room square.
+#'
+#' @return True if and only if R is a maximal partial Room square, False otherwise.
+#' @export
+is_maximal_proom <- function(R) {
+
+  result <- is_partial_room(R)
+
+  n <- max(R$col)
+
+  R <- R |>
+    dplyr::mutate(
+      see = purrr::map2(row, col, see2, R = R)
+    ) |>
+    dplyr::mutate(
+      avail = purrr::map(see, setdiff, x = 0:(n - 1))
+    )
+
+  # iterate through the set of unusued pairs trying to place them
+  # return true if and only if no pairs can be placed
+  for(p in unused_pairs(R)) {
+
+    E <- empty_cells(R) 
+    # try to find a hole
+    x <- NULL
+
+    # iterate through empty cells in given order
+    for(cell in E) {
+
+      if(avail(R, p, cell)) {
+        x <- cell
+      }
+
+    }
+
+    # if we were successful then this is not a maximal proom
+    if(!is.null(x))  {
+      result <- FALSE
+      break()
+    }
+
+  }
+
+  return(result)
+}

R/see.R

@@ -0,0 +1,28 @@
+#' Symbols visible from cell e
+#'
+#' @param R A Room square.
+#' @param e A cell in R.
+#'
+#' @return A list of symbols visible in R from cell e.
+see <- function(R, e) {
+  first <- R[R$row == e[1] | R$col == e[2], "first"]$first
+  first_non_na <- first[!is.na(first)]
+  second <- R[R$row == e[1] | R$col == e[2], "second"]$second
+  second_non_na <- second[!is.na(second)]
+  sort(unique(c(first_non_na, second_non_na)))
+}
+
+#' Symbols visible from cell (row, col) in R
+#'
+#' @param R A Room square.
+#' @param row A row index.
+#' @param col A column index.
+#'
+#' @return A list of symbols visible in R from cell (col, rol).
+see2 <- function(R, row, col) {
+  first <- R[R$row == row | R$col == col, "first"]$first
+  first_non_na <- first[!is.na(first)]
+  second <- R[R$row == row | R$col == col, "second"]$second
+  second_non_na <- second[!is.na(second)]
+  sort(unique(c(first_non_na, second_non_na)))
+}