R/permutation_solver.R

In hrj21/nonogram: nonogram: Encoding, Solving, and Plotting Nonograms

#' permutation_solver
#'
#' @description Given a row or column pattern and the set of all possible 
#'     permutations of the row/column's length, `permutation_solver` identifies 
#'     the set of permutations that satisfy the pattern 
#'     
#' @param pattern A numeric vector where each element corresponds to the length of a run.
#' @param permutation_patterns A matrix of permutations as generated by `make_full_perm_set()`
#' @param full_patterns A list where each element is a numerical run length encoding corresponding 
#'     to the rows in the `permutation_patterns` matrix. If `NULL` (default), the run length
#'     encodings will be calculated by the function.
#'
#' @return A matrix with the same number of columns as the `permutation_patterns` 
#'     argument, and the same number of rows as there are matches.
#' @export
#'
#' @examples
#' full <- make_full_perm_set(10)
#' permutation_solver(c(2, 4, 1), full)
permutation_solver <- function(pattern, permutation_patterns, full_patterns = NULL, verbose = TRUE) {
  
  if(is.null(full_patterns)) {
    if(verbose) cat(format(Sys.time(), usetz = TRUE), ": Creating run length encoding\n")
    full_patterns <- apply(permutation_patterns, 1, function(x){
      pat <- rle(x)$lengths[rle(x)$values==1]
      if(length(pat) == 0) {
        0
        } else pat
      })
  }
  
  matches <- unlist(lapply(full_patterns, function(x) {
    if (length(x) == length(pattern)) {
      all(x == pattern)
    } else
      FALSE
  }))
  
  permutation_patterns[matches, , drop = FALSE]
}