tests/testthat/test-solve.R

context("solve")

test_that("multiplication works", {

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # My example puzzle strings
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  puzzle_string_examples <- list(
    R    = "7:13:17:11,7:3,3,3:3,2,10,2:2,2,11,2:3,2,12,1:3,1,4,5,1:3,1,4,4,1:3,1,4,4,1:2,2,11,1:3,2,10,2:6,9,2:11,6:10,5:15:6,5:4,5:4,5-4:8:10:3,3:3,5,3:2,2,5:3,2,5:5,4:4,3:5,4:4,15:4,15:4,15:4,15:3,3,3,2:4,3,3,1:3,3,6:3,4,7:3,15:2,8,6:3,6,6:2,4,1,3:2,1,2:2,2:7",
    duck = "3:2,1:3,2:2,2:6:1,5:6:1:2-1,2:3,1:1,5:7,1:5:3:4:3",
    swan = "2,10:1,1,9:3,9:3,9:1,2,2:3,2,1:3,1,2:2,5:2,3:2,4-2,6:1,5:5:4:2:1,2:6:5:4:4:4,1:4,1,1:4,3:4,4:4,5",
    squirrel = "6:3,2:2,1:1,2:3,1:3,3,1:7,3,1:7,5,1:2,4,2,1,1,1,1:2,3,2,1,1,1,1,1:3,2,1,3,1,1:2,2,1,3,3:2,2,1,1,5:2,2,1,3,1:2,1,1,1:2,2,2:2,7:3,7:3,2,2,1:10:8,1:4,4:3,3:2,2:3,3-3:5:3:6:13,5:19:4,6,1:3,3:2,6,6:3,7,7:2,2,2,4:1,9,9:2,2,5,4:1,6,3,2,1:1,2,4:1,7:1,2:2,6:3,2:11",
    gchq = "7,3,1,1,7:1,1,2,2,1,1:1,3,1,3,1,1,3,1:1,3,1,1,6,1,3,1:1,3,1,5,2,1,3,1:1,1,2,1,1:7,1,1,1,1,1,7:3,3:1,2,3,1,1,3,1,1,2:1,1,3,2,1,1:4,1,4,2,1,2:1,1,1,1,1,4,1,3:2,1,1,1,2,5:3,2,2,6,3,1:1,9,1,1,2,1:2,1,2,2,3,1:3,1,1,1,1,5,1:1,2,2,5:7,1,2,1,1,1,3:1,1,2,1,2,2,1:1,3,1,4,5,1:1,3,1,3,10,2:1,3,1,1,6,6:1,1,2,1,1,2:7,2,1,2,5-7,2,1,1,7:1,1,2,2,1,1:1,3,1,3,1,3,1,3,1:1,3,1,1,5,1,3,1:1,3,1,1,4,1,3,1:1,1,1,2,1,1:7,1,1,1,1,1,7:1,1,3:2,1,2,1,8,2,1:2,2,1,2,1,1,1,2:1,7,3,2,1:1,2,3,1,1,1,1,1:4,1,1,2,6:3,3,1,1,1,3,1:1,2,5,2,2:2,2,1,1,1,1,1,2,1:1,3,3,2,1,8,1:6,2,1:7,1,4,1,1,3:1,1,1,1,4:1,3,1,3,7,1:1,3,1,1,1,2,1,1,4:1,3,1,4,3,3:1,1,2,2,2,6,1:7,1,3,2,1,1")

  # devtools::use_data(puzzle_string_examples, overwrite = TRUE)

  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Known solution to the squirrel puzzle
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  squirrel_matrix <- structure(c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L,
                                 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                                 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 1L,
                                 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L,
                                 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L,
                                 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 1L, 1L, 1L, 1L, 1L,
                                 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 1L, 1L,
                                 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L,
                                 1L, 1L, 1L, 1L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L,
                                 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
                                 1L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L,
                                 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 1L,
                                 1L, 1L, 1L, 1L, 1L, 0L, 0L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 0L, 0L,
                                 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L,
                                 0L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L,
                                 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
                                 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L, 0L,
                                 0L, 0L, 0L, 0L, 0L, 0L, 0L), .Dim = c(25L, 20L))


  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  # Solve the puzzle string and check that it works
  #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  puzzle          <- puzzle_string_examples[['squirrel']]
  solution_matrix <- solve_puzzle(puzzle, verbose=TRUE)

  expect_identical(solution_matrix, squirrel_matrix)
})




test_that("complex puzzle solve", {
  a <- solve_puzzle(puzzle_string_library[1006], verbose = FALSE)

  # create_matrix_plot(a)
  res <- structure(c(0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L,
0L, 0L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 0L, 0L, 0L,
1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L,
0L, 0L, 0L, 0L, 0L), .Dim = 14:15)

  expect_identical(dim(a), c(14L, 15L))
  expect_identical(a, res)
})
coolbutuseless/nonogram documentation built on May 5, 2019, 3:45 a.m.