From fb0eef925c36b98409df45217f816dcebcb7685c Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Fri, 16 Sep 2016 17:24:04 -0600 Subject: [PATCH 01/19] Add First of Many Puzzle.solve Tests Addresses https://github.com/jehoshua02/elm-sudoku/issues/10 --- src/Sudoku/Puzzle.elm | 2 +- src/Sudoku/PuzzleSolveTests.elm | 45 +++++++++++++++++++++++++++++++++ tests/Main.elm | 2 ++ 3 files changed, 48 insertions(+), 1 deletion(-) create mode 100644 src/Sudoku/PuzzleSolveTests.elm diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 495344c..479c458 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -60,7 +60,7 @@ solve puzzle = |> Possible.eliminateUsed |> Possible.eliminateCrowds |> Possible.eliminateSame - |> Possible.eliminateAligned + --|> Possible.eliminateAligned in if before == after then Err Unsolvable diff --git a/src/Sudoku/PuzzleSolveTests.elm b/src/Sudoku/PuzzleSolveTests.elm new file mode 100644 index 0000000..dcd05c5 --- /dev/null +++ b/src/Sudoku/PuzzleSolveTests.elm @@ -0,0 +1,45 @@ +port module Sudoku.PuzzleSolveTests exposing (tests) + +import Test exposing (..) +import Expect +import Sudoku.Puzzle as Puzzle exposing (Error(..)) +import Util exposing (set) + + +tests : Test +tests = + describe "Puzzle" + [ describe "solve" + ([ + { id = "Sudoku #001 (Easy)" + , puzzle = + [1,3,0,2,0,0,7,4,0 + ,0,2,5,0,1,0,0,0,0 + ,4,8,0,0,6,0,0,5,0 + ,0,0,0,7,8,0,2,1,0 + ,5,0,0,0,9,0,3,7,0 + ,9,0,0,0,3,0,0,0,5 + ,0,4,0,0,0,6,8,9,0 + ,0,5,3,0,0,1,4,0,0 + ,6,0,0,0,0,0,0,0,0 + ] + , solution = + [1,3,6,2,5,9,7,4,8 + ,7,2,5,4,1,8,9,3,6 + ,4,8,9,3,6,7,1,5,2 + ,3,6,4,7,8,5,2,1,9 + ,5,1,8,6,9,2,3,7,4 + ,9,7,2,1,3,4,6,8,5 + ,2,4,1,5,7,6,8,9,3 + ,8,5,3,9,2,1,4,6,7 + ,6,9,7,8,4,3,5,2,1 + ] + } + ] |> List.map + (\puzzle -> + test ("should solve " ++ puzzle.id) <| + \() -> + Expect.equal (Ok puzzle.solution) (Puzzle.solve puzzle.puzzle) + ) + ) + ] diff --git a/tests/Main.elm b/tests/Main.elm index d6e04c8..ccfbe39 100644 --- a/tests/Main.elm +++ b/tests/Main.elm @@ -7,6 +7,7 @@ import Test exposing (..) import Sudoku.PuzzleTests import Sudoku.PossibleTests import Sudoku.GridTests +import Sudoku.PuzzleSolveTests tests : Test @@ -15,6 +16,7 @@ tests = [ Sudoku.GridTests.tests , Sudoku.PuzzleTests.tests , Sudoku.PossibleTests.tests + , Sudoku.PuzzleSolveTests.tests ] From f41936d42423b403bfaec944e6c6b3eb4508fd6d Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Sat, 17 Sep 2016 20:59:05 -0600 Subject: [PATCH 02/19] Add Another Puzzle.solve Test, Improve Possible.eliminateUsed --- src/Sudoku/Possible.elm | 31 +++++++---- src/Sudoku/Puzzle.elm | 2 +- src/Sudoku/PuzzleSolveTests.elm | 98 ++++++++++++++++++++++----------- 3 files changed, 88 insertions(+), 43 deletions(-) diff --git a/src/Sudoku/Possible.elm b/src/Sudoku/Possible.elm index 882e09c..a53dd17 100644 --- a/src/Sudoku/Possible.elm +++ b/src/Sudoku/Possible.elm @@ -78,18 +78,27 @@ eliminateUsed possible = let puzzle = toPuzzle possible - in - possible - |> List.indexedMap - (\i xs -> - ( i, used i puzzle ) - ) - |> flip List.foldl - possible - (\( i, xs ) possible -> + + before = + possible + + after = + before + |> List.indexedMap + (\i xs -> + ( i, used i puzzle ) + ) + |> flip List.foldl possible - |> eliminate xs [ i ] - ) + (\( i, xs ) possible -> + possible + |> eliminate xs [ i ] + ) + in + if before == after then + before + else + eliminateUsed after used : Int -> Puzzle -> List Int diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 479c458..495344c 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -60,7 +60,7 @@ solve puzzle = |> Possible.eliminateUsed |> Possible.eliminateCrowds |> Possible.eliminateSame - --|> Possible.eliminateAligned + |> Possible.eliminateAligned in if before == after then Err Unsolvable diff --git a/src/Sudoku/PuzzleSolveTests.elm b/src/Sudoku/PuzzleSolveTests.elm index dcd05c5..6485e1c 100644 --- a/src/Sudoku/PuzzleSolveTests.elm +++ b/src/Sudoku/PuzzleSolveTests.elm @@ -10,36 +10,72 @@ tests : Test tests = describe "Puzzle" [ describe "solve" - ([ - { id = "Sudoku #001 (Easy)" - , puzzle = - [1,3,0,2,0,0,7,4,0 - ,0,2,5,0,1,0,0,0,0 - ,4,8,0,0,6,0,0,5,0 - ,0,0,0,7,8,0,2,1,0 - ,5,0,0,0,9,0,3,7,0 - ,9,0,0,0,3,0,0,0,5 - ,0,4,0,0,0,6,8,9,0 - ,0,5,3,0,0,1,4,0,0 - ,6,0,0,0,0,0,0,0,0 - ] - , solution = - [1,3,6,2,5,9,7,4,8 - ,7,2,5,4,1,8,9,3,6 - ,4,8,9,3,6,7,1,5,2 - ,3,6,4,7,8,5,2,1,9 - ,5,1,8,6,9,2,3,7,4 - ,9,7,2,1,3,4,6,8,5 - ,2,4,1,5,7,6,8,9,3 - ,8,5,3,9,2,1,4,6,7 - ,6,9,7,8,4,3,5,2,1 - ] - } - ] |> List.map - (\puzzle -> - test ("should solve " ++ puzzle.id) <| - \() -> - Expect.equal (Ok puzzle.solution) (Puzzle.solve puzzle.puzzle) - ) + ([ { id = "Sudoku #001 (Easy)" + , puzzle = + {- + [1,3,0,2,0,0,7,4,0 + ,0,2,5,0,1,0,0,0,0 + ,4,8,0,0,6,0,0,5,0 + ,0,0,0,7,8,0,2,1,0 + ,5,0,0,0,9,0,3,7,0 + ,9,0,0,0,3,0,0,0,5 + ,0,4,0,0,0,6,8,9,0 + ,0,5,3,0,0,1,4,0,0 + ,6,0,0,0,0,0,0,0,0 + ] + -} + [ 1, 3, 0, 2, 0, 0, 7, 4, 0, 0, 2, 5, 0, 1, 0, 0, 0, 0, 4, 8, 0, 0, 6, 0, 0, 5, 0, 0, 0, 0, 7, 8, 0, 2, 1, 0, 5, 0, 0, 0, 9, 0, 3, 7, 0, 9, 0, 0, 0, 3, 0, 0, 0, 5, 0, 4, 0, 0, 0, 6, 8, 9, 0, 0, 5, 3, 0, 0, 1, 4, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0 ] + , solution = + {- + [1,3,6,2,5,9,7,4,8 + ,7,2,5,4,1,8,9,3,6 + ,4,8,9,3,6,7,1,5,2 + ,3,6,4,7,8,5,2,1,9 + ,5,1,8,6,9,2,3,7,4 + ,9,7,2,1,3,4,6,8,5 + ,2,4,1,5,7,6,8,9,3 + ,8,5,3,9,2,1,4,6,7 + ,6,9,7,8,4,3,5,2,1 + ] + -} + [ 1, 3, 6, 2, 5, 9, 7, 4, 8, 7, 2, 5, 4, 1, 8, 9, 3, 6, 4, 8, 9, 3, 6, 7, 1, 5, 2, 3, 6, 4, 7, 8, 5, 2, 1, 9, 5, 1, 8, 6, 9, 2, 3, 7, 4, 9, 7, 2, 1, 3, 4, 6, 8, 5, 2, 4, 1, 5, 7, 6, 8, 9, 3, 8, 5, 3, 9, 2, 1, 4, 6, 7, 6, 9, 7, 8, 4, 3, 5, 2, 1 ] + } + , { id = "Sudoku #002 (Easy)" + , puzzle = + {- + [1,0,0,0,0,0,2,7,6 + ,0,0,9,1,4,0,0,0,0 + ,0,2,0,0,0,6,0,9,1 + ,0,8,0,0,0,9,6,1,0 + ,7,3,0,0,8,4,0,0,0 + ,0,0,2,0,0,5,0,8,0 + ,5,0,6,0,0,3,0,0,0 + ,0,0,7,0,0,0,0,5,0 + ,3,4,0,5,9,0,0,0,0 + ] + -} + [ 1, 0, 0, 0, 0, 0, 2, 7, 6, 0, 0, 9, 1, 4, 0, 0, 0, 0, 0, 2, 0, 0, 0, 6, 0, 9, 1, 0, 8, 0, 0, 0, 9, 6, 1, 0, 7, 3, 0, 0, 8, 4, 0, 0, 0, 0, 0, 2, 0, 0, 5, 0, 8, 0, 5, 0, 6, 0, 0, 3, 0, 0, 0, 0, 0, 7, 0, 0, 0, 0, 5, 0, 3, 4, 0, 5, 9, 0, 0, 0, 0 ] + , solution = + {- + [1,5,4,9,3,8,2,7,6 + ,6,7,9,1,4,2,8,3,5 + ,8,2,3,7,5,6,4,9,1 + ,4,8,5,2,7,9,6,1,3 + ,7,3,1,6,8,4,5,2,9 + ,9,6,2,3,1,5,7,8,4 + ,5,1,6,8,2,3,9,4,7 + ,2,9,7,4,6,1,3,5,8 + ,3,4,8,5,9,7,1,6,2 + ] + -} + [ 1, 5, 4, 9, 3, 8, 2, 7, 6, 6, 7, 9, 1, 4, 2, 8, 3, 5, 8, 2, 3, 7, 5, 6, 4, 9, 1, 4, 8, 5, 2, 7, 9, 6, 1, 3, 7, 3, 1, 6, 8, 4, 5, 2, 9, 9, 6, 2, 3, 1, 5, 7, 8, 4, 5, 1, 6, 8, 2, 3, 9, 4, 7, 2, 9, 7, 4, 6, 1, 3, 5, 8, 3, 4, 8, 5, 9, 7, 1, 6, 2 ] + } + ] + |> List.map + (\puzzle -> + test ("should solve " ++ puzzle.id) <| + \() -> + Expect.equal (Ok puzzle.solution) (Puzzle.solve puzzle.puzzle) + ) ) ] From c64ad2f1a2508a7be1b50d39e11d588ff6717e38 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Sat, 17 Sep 2016 21:30:25 -0600 Subject: [PATCH 03/19] Adds a So-Called Medium and Hard Test --- src/Sudoku/PuzzleSolveTests.elm | 60 +++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/src/Sudoku/PuzzleSolveTests.elm b/src/Sudoku/PuzzleSolveTests.elm index 6485e1c..c71dd48 100644 --- a/src/Sudoku/PuzzleSolveTests.elm +++ b/src/Sudoku/PuzzleSolveTests.elm @@ -70,6 +70,66 @@ tests = -} [ 1, 5, 4, 9, 3, 8, 2, 7, 6, 6, 7, 9, 1, 4, 2, 8, 3, 5, 8, 2, 3, 7, 5, 6, 4, 9, 1, 4, 8, 5, 2, 7, 9, 6, 1, 3, 7, 3, 1, 6, 8, 4, 5, 2, 9, 9, 6, 2, 3, 1, 5, 7, 8, 4, 5, 1, 6, 8, 2, 3, 9, 4, 7, 2, 9, 7, 4, 6, 1, 3, 5, 8, 3, 4, 8, 5, 9, 7, 1, 6, 2 ] } + , { id = "Sudoku #001 (Medium)" + , puzzle = + {- + [8,9,2,0,0,3,0,1,4 + ,0,0,0,0,0,0,0,0,0 + ,0,0,0,0,6,8,0,7,0 + ,4,5,0,0,8,0,0,0,1 + ,0,0,8,0,0,0,2,0,0 + ,1,0,3,7,0,0,5,0,0 + ,0,7,1,0,0,6,0,5,0 + ,5,0,9,2,0,0,0,8,0 + ,6,0,0,0,0,7,0,0,9 + ] + -} + [ 8, 9, 2, 0, 0, 3, 0, 1, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 6, 8, 0, 7, 0, 4, 5, 0, 0, 8, 0, 0, 0, 1, 0, 0, 8, 0, 0, 0, 2, 0, 0, 1, 0, 3, 7, 0, 0, 5, 0, 0, 0, 7, 1, 0, 0, 6, 0, 5, 0, 5, 0, 9, 2, 0, 0, 0, 8, 0, 6, 0, 0, 0, 0, 7, 0, 0, 9 ] + , solution = + {- + [8,9,2,5,7,3,6,1,4 + ,7,4,6,9,2,1,8,3,5 + ,3,1,5,4,6,8,9,7,2 + ,4,5,7,6,8,2,3,9,1 + ,9,6,8,1,3,5,2,4,7 + ,1,2,3,7,4,9,5,6,8 + ,2,7,1,8,9,6,4,5,3 + ,5,3,9,2,1,4,7,8,6 + ,6,8,4,3,5,7,1,2,9 + ] + -} + [ 8, 9, 2, 5, 7, 3, 6, 1, 4, 7, 4, 6, 9, 2, 1, 8, 3, 5, 3, 1, 5, 4, 6, 8, 9, 7, 2, 4, 5, 7, 6, 8, 2, 3, 9, 1, 9, 6, 8, 1, 3, 5, 2, 4, 7, 1, 2, 3, 7, 4, 9, 5, 6, 8, 2, 7, 1, 8, 9, 6, 4, 5, 3, 5, 3, 9, 2, 1, 4, 7, 8, 6, 6, 8, 4, 3, 5, 7, 1, 2, 9 ] + } + , { id = "Sudoku #001 (Hard)" + , puzzle = + {- + [4,3,8,7,6,0,1,0,2 + ,2,0,0,0,9,0,5,3,0 + ,0,0,0,0,0,2,6,0,8 + ,0,0,4,0,2,3,0,5,0 + ,3,0,0,0,0,0,8,0,0 + ,6,0,0,0,0,0,0,0,0 + ,0,0,5,0,1,0,3,0,9 + ,0,1,0,0,0,0,0,8,0 + ,9,0,0,6,0,0,0,7,0 + ] + -} + [ 4, 3, 8, 7, 6, 0, 1, 0, 2, 2, 0, 0, 0, 9, 0, 5, 3, 0, 0, 0, 0, 0, 0, 2, 6, 0, 8, 0, 0, 4, 0, 2, 3, 0, 5, 0, 3, 0, 0, 0, 0, 0, 8, 0, 0, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 0, 1, 0, 3, 0, 9, 0, 1, 0, 0, 0, 0, 0, 8, 0, 9, 0, 0, 6, 0, 0, 0, 7, 0 ] + , solution = + {- + [4,3,8,7,6,5,1,9,2 + ,2,6,1,8,9,4,5,3,7 + ,5,7,9,1,3,2,6,4,8 + ,1,8,4,9,2,3,7,5,6 + ,3,9,2,5,7,6,8,1,4 + ,6,5,7,4,8,1,9,2,3 + ,8,4,5,2,1,7,3,6,9 + ,7,1,6,3,4,9,2,8,5 + ,9,2,3,6,5,8,4,7,1 + ] + -} + [ 4, 3, 8, 7, 6, 5, 1, 9, 2, 2, 6, 1, 8, 9, 4, 5, 3, 7, 5, 7, 9, 1, 3, 2, 6, 4, 8, 1, 8, 4, 9, 2, 3, 7, 5, 6, 3, 9, 2, 5, 7, 6, 8, 1, 4, 6, 5, 7, 4, 8, 1, 9, 2, 3, 8, 4, 5, 2, 1, 7, 3, 6, 9, 7, 1, 6, 3, 4, 9, 2, 8, 5, 9, 2, 3, 6, 5, 8, 4, 7, 1 ] + } ] |> List.map (\puzzle -> From bfe877aad13cec248c35bff4d878d0f1f3a89856 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Sat, 17 Sep 2016 21:40:01 -0600 Subject: [PATCH 04/19] Added Another Hard Test Hmm ... so far none of these puzzles have required the more advanced techniques such as ... + eliminateSame + eliminateAligned + guess --- src/Sudoku/Puzzle.elm | 5 +++-- src/Sudoku/PuzzleSolveTests.elm | 30 ++++++++++++++++++++++++++++++ 2 files changed, 33 insertions(+), 2 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 495344c..bd095e7 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -59,8 +59,9 @@ solve puzzle = before |> Possible.eliminateUsed |> Possible.eliminateCrowds - |> Possible.eliminateSame - |> Possible.eliminateAligned + + --|> Possible.eliminateSame + --|> Possible.eliminateAligned in if before == after then Err Unsolvable diff --git a/src/Sudoku/PuzzleSolveTests.elm b/src/Sudoku/PuzzleSolveTests.elm index c71dd48..a8f5882 100644 --- a/src/Sudoku/PuzzleSolveTests.elm +++ b/src/Sudoku/PuzzleSolveTests.elm @@ -130,6 +130,36 @@ tests = -} [ 4, 3, 8, 7, 6, 5, 1, 9, 2, 2, 6, 1, 8, 9, 4, 5, 3, 7, 5, 7, 9, 1, 3, 2, 6, 4, 8, 1, 8, 4, 9, 2, 3, 7, 5, 6, 3, 9, 2, 5, 7, 6, 8, 1, 4, 6, 5, 7, 4, 8, 1, 9, 2, 3, 8, 4, 5, 2, 1, 7, 3, 6, 9, 7, 1, 6, 3, 4, 9, 2, 8, 5, 9, 2, 3, 6, 5, 8, 4, 7, 1 ] } + , { id = "Sudoku #261 (Hard)" + , puzzle = + {- + [8,0,0,0,6,0,3,9,7 + ,9,1,0,2,0,0,0,0,0 + ,0,0,0,4,0,0,0,0,0 + ,0,0,7,9,0,0,0,0,0 + ,0,0,4,0,0,0,0,2,5 + ,2,0,0,6,7,0,0,0,0 + ,0,0,0,0,9,1,0,0,0 + ,4,0,0,0,0,0,0,3,0 + ,0,0,0,0,0,0,6,1,0 + ] + -} + [ 8, 0, 0, 0, 6, 0, 3, 9, 7, 9, 1, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 0, 7, 9, 0, 0, 0, 0, 0, 0, 0, 4, 0, 0, 0, 0, 2, 5, 2, 0, 0, 6, 7, 0, 0, 0, 0, 0, 0, 0, 0, 9, 1, 0, 0, 0, 4, 0, 0, 0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 0, 0, 6, 1, 0 ] + , solution = + {- + [8,4,2,1,6,5,3,9,7 + ,9,1,5,2,3,7,8,4,6 + ,7,3,6,4,8,9,1,5,2 + ,1,8,7,9,5,2,4,6,3 + ,6,9,4,3,1,8,7,2,5 + ,2,5,3,6,7,4,9,8,1 + ,3,6,8,5,9,1,2,7,4 + ,4,7,1,8,2,6,5,3,9 + ,5,2,9,7,4,3,6,1,8 + ] + -} + [ 8, 4, 2, 1, 6, 5, 3, 9, 7, 9, 1, 5, 2, 3, 7, 8, 4, 6, 7, 3, 6, 4, 8, 9, 1, 5, 2, 1, 8, 7, 9, 5, 2, 4, 6, 3, 6, 9, 4, 3, 1, 8, 7, 2, 5, 2, 5, 3, 6, 7, 4, 9, 8, 1, 3, 6, 8, 5, 9, 1, 2, 7, 4, 4, 7, 1, 8, 2, 6, 5, 3, 9, 5, 2, 9, 7, 4, 3, 6, 1, 8 ] + } ] |> List.map (\puzzle -> From 2c6bcca4f906d19650bcc70a92b78b84c151d677 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 22 Sep 2016 08:15:02 -0600 Subject: [PATCH 05/19] Add Puzzle.valid --- src/Sudoku/Puzzle.elm | 32 +++++++++++++++++++++++++------- src/Sudoku/PuzzleSolveTests.elm | 6 ++++++ src/Sudoku/PuzzleTests.elm | 13 +++++++++++++ 3 files changed, 44 insertions(+), 7 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index bd095e7..ce88cc2 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -5,6 +5,7 @@ module Sudoku.Puzzle , fromList , Error(..) , solved + , valid , solve ) @@ -43,6 +44,26 @@ solved xs = rows xs ++ columns xs ++ groups xs |> List.all (List.sort >> (==) [1..9]) +valid : Puzzle -> Bool +valid xs = + rows xs ++ columns xs ++ groups xs + |> List.all + (\chunk -> + let + filled = + chunk + |> List.filter ((/=) 0) + |> List.sort + + unique = + filled + |> Set.fromList + |> Set.toList + in + filled == unique + ) + + solve : Puzzle -> Result Error Puzzle solve puzzle = if solved puzzle then @@ -53,21 +74,18 @@ solve puzzle = let before = puzzle - |> Possible.initialize after = before + |> Possible.initialize |> Possible.eliminateUsed |> Possible.eliminateCrowds - - --|> Possible.eliminateSame - --|> Possible.eliminateAligned + --|> Possible.eliminateSame + --|> Possible.eliminateAligned + |> Possible.toPuzzle in if before == after then Err Unsolvable - else if after |> List.any ((==) []) then - Err Unsolvable else after - |> Possible.toPuzzle |> solve diff --git a/src/Sudoku/PuzzleSolveTests.elm b/src/Sudoku/PuzzleSolveTests.elm index a8f5882..0bed1ff 100644 --- a/src/Sudoku/PuzzleSolveTests.elm +++ b/src/Sudoku/PuzzleSolveTests.elm @@ -160,6 +160,12 @@ tests = -} [ 8, 4, 2, 1, 6, 5, 3, 9, 7, 9, 1, 5, 2, 3, 7, 8, 4, 6, 7, 3, 6, 4, 8, 9, 1, 5, 2, 1, 8, 7, 9, 5, 2, 4, 6, 3, 6, 9, 4, 3, 1, 8, 7, 2, 5, 2, 5, 3, 6, 7, 4, 9, 8, 1, 3, 6, 8, 5, 9, 1, 2, 7, 4, 4, 7, 1, 8, 2, 6, 5, 3, 9, 5, 2, 9, 7, 4, 3, 6, 1, 8 ] } + --, { id = "http://www.websudoku.com/?level=4&set_id=5147254317" + -- , puzzle = + -- [0,0,0,0,7,0,0,5,1,0,0,2,9,0,0,6,3,0,0,0,0,4,0,0,0,0,7,0,1,5,0,0,6,9,0,0,0,0,0,0,0,0,0,0,0,0,0,4,3,0,0,5,1,0,2,0,0,0,0,7,0,0,0,0,5,3,0,0,2,4,0,0,8,6,0,0,9,0,0,0,0] + -- , solution = + -- [] + -- } ] |> List.map (\puzzle -> diff --git a/src/Sudoku/PuzzleTests.elm b/src/Sudoku/PuzzleTests.elm index ab51fdf..d1f59bd 100644 --- a/src/Sudoku/PuzzleTests.elm +++ b/src/Sudoku/PuzzleTests.elm @@ -39,6 +39,19 @@ tests = \() -> Expect.equal True (Puzzle.solved solvedPuzzle) ] + , describe "valid" + [ test "should say this puzzle is invalid" <| + \() -> + let + puzzle = + solvedPuzzle + |> set 49 4 + in + Expect.equal False (Puzzle.valid puzzle) + , test "should say this puzzle is valid" <| + \() -> + Expect.equal True (Puzzle.valid solvedPuzzle) + ] , describe "solve" [ test "should say this puzzle is already solved" <| \() -> From 39a0eea66b5bd5d5aed6227deb58dc5d0bcea224 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 22 Sep 2016 08:28:24 -0600 Subject: [PATCH 06/19] Slightly More Thorough Test on Puzzle.valid --- src/Sudoku/PuzzleTests.elm | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/Sudoku/PuzzleTests.elm b/src/Sudoku/PuzzleTests.elm index d1f59bd..7f9369a 100644 --- a/src/Sudoku/PuzzleTests.elm +++ b/src/Sudoku/PuzzleTests.elm @@ -51,6 +51,21 @@ tests = , test "should say this puzzle is valid" <| \() -> Expect.equal True (Puzzle.valid solvedPuzzle) + , test "should say all these puzzles are invalid" <| + \() -> + let + puzzles = + [ solvedPuzzle |> set 0 9 + , solvedPuzzle |> set 49 4 + , solvedPuzzle |> set 80 9 + ] + + actual = + puzzles + |> List.map Puzzle.valid + |> List.all ((==) False) + in + Expect.equal True actual ] , describe "solve" [ test "should say this puzzle is already solved" <| From 67b466b21ab8bc9cde06d20c599793130f85a71a Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 22 Sep 2016 08:36:12 -0600 Subject: [PATCH 07/19] Add Puzzle.complete --- src/Sudoku/Puzzle.elm | 10 ++++++++-- src/Sudoku/PuzzleTests.elm | 13 +++++++++++++ 2 files changed, 21 insertions(+), 2 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index ce88cc2..3136147 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -6,6 +6,7 @@ module Sudoku.Puzzle , Error(..) , solved , valid + , complete , solve ) @@ -40,8 +41,8 @@ fromList xs = solved : Puzzle -> Bool -solved xs = - rows xs ++ columns xs ++ groups xs |> List.all (List.sort >> (==) [1..9]) +solved puzzle = + valid puzzle && complete puzzle valid : Puzzle -> Bool @@ -64,6 +65,11 @@ valid xs = ) +complete : Puzzle -> Bool +complete xs = + xs |> List.all ((/=) 0) + + solve : Puzzle -> Result Error Puzzle solve puzzle = if solved puzzle then diff --git a/src/Sudoku/PuzzleTests.elm b/src/Sudoku/PuzzleTests.elm index 7f9369a..14e0b39 100644 --- a/src/Sudoku/PuzzleTests.elm +++ b/src/Sudoku/PuzzleTests.elm @@ -67,6 +67,19 @@ tests = in Expect.equal True actual ] + , describe "complete" + [ test "should say this puzzle is complete" <| + \() -> + Expect.equal True (Puzzle.complete solvedPuzzle) + , test "should say this puzzle is incomplete" <| + \() -> + let + puzzle = + solvedPuzzle + |> set 45 0 + in + Expect.equal False (Puzzle.complete puzzle) + ] , describe "solve" [ test "should say this puzzle is already solved" <| \() -> From 84a07dc74094eadda4d4efea9af4b36b5dc9760c Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 22 Sep 2016 08:37:45 -0600 Subject: [PATCH 08/19] Formatting --- src/Sudoku/Puzzle.elm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 3136147..965654b 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -47,7 +47,9 @@ solved puzzle = valid : Puzzle -> Bool valid xs = - rows xs ++ columns xs ++ groups xs + rows xs + ++ columns xs + ++ groups xs |> List.all (\chunk -> let @@ -88,7 +90,8 @@ solve puzzle = |> Possible.eliminateCrowds --|> Possible.eliminateSame --|> Possible.eliminateAligned - |> Possible.toPuzzle + |> + Possible.toPuzzle in if before == after then Err Unsolvable From 96acc23b0bccf870b66eb383eaf60ed50d75c8f9 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Wed, 28 Sep 2016 20:52:15 -0600 Subject: [PATCH 09/19] Add Evil Test --- src/Sudoku/EvilPuzzleTests.elm | 151 +++++++++++++++++++++++++++++++++ src/Sudoku/Possible.elm | 94 ++++++++++++-------- src/Sudoku/Puzzle.elm | 34 ++++++-- src/Sudoku/PuzzleTests.elm | 27 ++++++ tests/Main.elm | 2 + 5 files changed, 266 insertions(+), 42 deletions(-) create mode 100644 src/Sudoku/EvilPuzzleTests.elm diff --git a/src/Sudoku/EvilPuzzleTests.elm b/src/Sudoku/EvilPuzzleTests.elm new file mode 100644 index 0000000..6becf65 --- /dev/null +++ b/src/Sudoku/EvilPuzzleTests.elm @@ -0,0 +1,151 @@ +port module Sudoku.EvilPuzzleTests exposing (tests) + +import Test exposing (..) +import Expect +import Sudoku.Puzzle as Puzzle exposing (Error(..)) +import Sudoku.Possible as Possible +import Util exposing (set) + + +tests : Test +tests = + describe "EvilPuzzle" + [ describe "Puzzle.valid" <| + [ test "should say this puzzle is valid" <| + \() -> + Expect.equal True (Puzzle.valid evil.puzzle) + ] + , describe "Possible.initialize" + [ test "should initialize correctly" <| + \() -> + let + actual = + evil.puzzle + |> Possible.initialize + + expected = + evil.puzzle + |> List.map + (\n -> + if n == 0 then + [1..9] + else + [ n ] + ) + in + Expect.equal expected actual + ] + , describe "Possible.eliminateUsed" + [ test "should eliminate used" <| + \() -> + let + possible = + evil.puzzle + |> Possible.initialize + + actual = + possible + |> Possible.eliminateUsed + + expected = + [ [ 3, 4, 6, 9 ], [ 3, 4, 8, 9 ], [ 6, 8, 9 ], [ 2, 6, 8 ], [ 7 ], [ 3, 8 ], [ 2, 8 ], [ 5 ], [ 1 ], [ 1, 4, 5, 7 ], [ 4, 7, 8 ], [ 2 ], [ 9 ], [ 1, 5, 8 ], [ 1, 5, 8 ], [ 6 ], [ 3 ], [ 4, 8 ], [ 1, 3, 5, 6, 9 ], [ 3, 8, 9 ], [ 1, 6, 8, 9 ], [ 4 ], [ 1, 2, 3, 5, 6, 8 ], [ 1, 3, 5, 8 ], [ 2, 8 ], [ 2, 8, 9 ], [ 7 ], [ 3, 7 ], [ 1 ], [ 5 ], [ 2, 7, 8 ], [ 2, 4, 8 ], [ 6 ], [ 9 ], [ 2, 4, 7, 8 ], [ 2, 3, 4, 8 ], [ 3, 6, 7, 9 ], [ 2, 3, 7, 8, 9 ], [ 6, 7, 8, 9 ], [ 1, 2, 5, 7, 8 ], [ 1, 2, 4, 5, 8 ], [ 1, 4, 5, 8, 9 ], [ 2, 3, 7, 8 ], [ 2, 4, 6, 7, 8 ], [ 2, 3, 4, 6, 8 ], [ 6, 7, 9 ], [ 2, 7, 8, 9 ], [ 4 ], [ 3 ], [ 2, 8 ], [ 8, 9 ], [ 5 ], [ 1 ], [ 2, 6, 8 ], [ 2 ], [ 4, 9 ], [ 1, 9 ], [ 1, 5, 6, 8 ], [ 1, 3, 4, 5, 6, 8 ], [ 7 ], [ 1, 3, 8 ], [ 6, 8, 9 ], [ 3, 5, 6, 8, 9 ], [ 1, 7, 9 ], [ 5 ], [ 3 ], [ 1, 6, 8 ], [ 1, 6, 8 ], [ 2 ], [ 4 ], [ 6, 7, 8, 9 ], [ 6, 8, 9 ], [ 8 ], [ 6 ], [ 1, 7 ], [ 1, 5 ], [ 9 ], [ 1, 3, 4, 5 ], [ 1, 2, 3, 7 ], [ 2, 7 ], [ 2, 3, 5 ] ] + in + Expect.equal expected actual + ] + , describe "Possible.eliminateCrowds" + [ test "should eliminate crowds" <| + \() -> + let + possible = + evil.puzzle + |> Possible.initialize + |> Possible.eliminateUsed + + actual = + possible + |> Possible.eliminateCrowds + + expected = + [ [ 3, 4, 6, 9 ], [ 3, 4, 8, 9 ], [ 6, 8, 9 ], [ 2, 6, 8 ], [ 7 ], [ 3, 8 ], [ 2, 8 ], [ 5 ], [ 1 ], [ 1, 4, 5, 7 ], [ 4, 7, 8 ], [ 2 ], [ 9 ], [ 1, 5, 8 ], [ 1, 5, 8 ], [ 6 ], [ 3 ], [ 4 ], [ 1, 3, 5, 6, 9 ], [ 3, 8, 9 ], [ 1, 6, 8, 9 ], [ 4 ], [ 1, 2, 3, 5, 6, 8 ], [ 1, 3, 5, 8 ], [ 2, 8 ], [ 9 ], [ 7 ], [ 3, 7 ], [ 1 ], [ 5 ], [ 2, 7, 8 ], [ 2, 4, 8 ], [ 6 ], [ 9 ], [ 2, 4, 7, 8 ], [ 2, 3, 4, 8 ], [ 3, 6, 7, 9 ], [ 2, 3, 7, 8, 9 ], [ 6, 7, 8, 9 ], [ 1, 2, 5, 7, 8 ], [ 1, 2, 4, 5, 8 ], [ 1, 4, 5, 8, 9 ], [ 2, 3, 7, 8 ], [ 2, 4, 6, 7, 8 ], [ 2, 3, 4, 6, 8 ], [ 6, 7, 9 ], [ 2, 7, 8, 9 ], [ 4 ], [ 3 ], [ 2, 8 ], [ 8, 9 ], [ 5 ], [ 1 ], [ 2, 6, 8 ], [ 2 ], [ 4 ], [ 1, 9 ], [ 1, 5, 6, 8 ], [ 3 ], [ 7 ], [ 1, 3, 8 ], [ 6, 8, 9 ], [ 3, 5, 6, 8, 9 ], [ 1, 7, 9 ], [ 5 ], [ 3 ], [ 1, 6, 8 ], [ 1, 6, 8 ], [ 2 ], [ 4 ], [ 6, 7, 8, 9 ], [ 6, 8, 9 ], [ 8 ], [ 6 ], [ 1, 7 ], [ 1, 5 ], [ 9 ], [ 4 ], [ 1, 2, 3, 7 ], [ 2, 7 ], [ 2, 3, 5 ] ] + in + Expect.equal expected actual + ] + , describe "Possible.eliminateSame" + [ test "should eliminate same" <| + \() -> + let + possible = + evil.puzzle + |> Possible.initialize + |> Possible.eliminateUsed + |> Possible.eliminateCrowds + + actual = + possible + |> Possible.eliminateSame + + expected = + [ [ 3, 4, 6, 9 ], [ 3, 4, 8, 9 ], [ 6, 8, 9 ], [ 2, 6, 8 ], [ 7 ], [ 3, 8 ], [ 2, 8 ], [ 5 ], [ 1 ], [ 1, 4, 5, 7 ], [ 4, 7, 8 ], [ 2 ], [ 9 ], [ 1, 5, 8 ], [ 1, 5, 8 ], [ 6 ], [ 3 ], [ 4 ], [ 1, 3, 5, 6, 9 ], [ 3, 8, 9 ], [ 1, 6, 8, 9 ], [ 4 ], [ 1, 2, 3, 5, 6, 8 ], [ 1, 3, 5, 8 ], [ 2, 8 ], [ 9 ], [ 7 ], [ 3, 7 ], [ 1 ], [ 5 ], [ 2, 7, 8 ], [ 2, 4, 8 ], [ 6 ], [ 9 ], [ 2, 4, 7, 8 ], [ 2, 3, 4, 8 ], [ 3, 6, 7, 9 ], [ 2, 3, 7, 8, 9 ], [ 6, 7, 8, 9 ], [ 1, 2, 5, 7, 8 ], [ 1, 2, 4, 5, 8 ], [ 1, 4, 5, 8, 9 ], [ 3, 7 ], [ 2, 4, 6, 7, 8 ], [ 2, 3, 4, 6, 8 ], [ 6, 7, 9 ], [ 2, 7, 8, 9 ], [ 4 ], [ 3 ], [ 2, 8 ], [ 8, 9 ], [ 5 ], [ 1 ], [ 2, 6, 8 ], [ 2 ], [ 4 ], [ 1, 9 ], [ 1, 5, 6, 8 ], [ 3 ], [ 7 ], [ 1, 3 ], [ 6, 8, 9 ], [ 3, 5, 6, 8, 9 ], [ 1, 7, 9 ], [ 5 ], [ 3 ], [ 1, 6, 8 ], [ 1, 6, 8 ], [ 2 ], [ 4 ], [ 6, 7, 8, 9 ], [ 6, 8, 9 ], [ 8 ], [ 6 ], [ 1, 7 ], [ 1, 5 ], [ 9 ], [ 4 ], [ 1, 3, 7 ], [ 2, 7 ], [ 2, 3, 5 ] ] + in + Expect.equal expected actual + ] + , describe "Possible.eliminateAligned" + [ test "should eliminate aligned" <| + \() -> + let + possible = + evil.puzzle + |> Possible.initialize + |> Possible.eliminateUsed + |> Possible.eliminateCrowds + |> Possible.eliminateSame + + actual = + possible + |> Possible.eliminateAligned + + expected = + [ [ 3, 4, 6, 9 ], [ 3, 4, 8, 9 ], [ 6, 8, 9 ], [ 2, 6, 8 ], [ 7 ], [ 3, 8 ], [ 2, 8 ], [ 5 ], [ 1 ], [ 1, 4, 5, 7 ], [ 4, 7, 8 ], [ 2 ], [ 9 ], [ 1, 5, 8 ], [ 1, 5, 8 ], [ 6 ], [ 3 ], [ 4 ], [ 1, 3, 5, 6, 9 ], [ 3, 8, 9 ], [ 1, 6, 8, 9 ], [ 4 ], [ 1, 2, 3, 5, 6, 8 ], [ 1, 3, 5, 8 ], [ 2, 8 ], [ 9 ], [ 7 ], [ 3, 7 ], [ 1 ], [ 5 ], [ 2, 7, 8 ], [ 2, 4, 8 ], [ 6 ], [ 9 ], [ 2, 4, 7, 8 ], [ 2, 3, 4, 8 ], [ 3, 6, 7, 9 ], [ 2, 3, 7, 8, 9 ], [ 6, 7, 8, 9 ], [ 1, 2, 7, 8 ], [ 1, 2, 4, 5, 8 ], [ 1, 4, 5, 8, 9 ], [ 3, 7 ], [ 2, 4, 6, 7, 8 ], [ 2, 3, 4, 6, 8 ], [ 6, 7, 9 ], [ 2, 7, 8, 9 ], [ 4 ], [ 3 ], [ 2, 8 ], [ 8, 9 ], [ 5 ], [ 1 ], [ 2, 6, 8 ], [ 2 ], [ 4 ], [ 1, 9 ], [ 1, 5, 6, 8 ], [ 3 ], [ 7 ], [ 1, 3 ], [ 6, 8, 9 ], [ 3, 5, 6, 8, 9 ], [ 1, 7, 9 ], [ 5 ], [ 3 ], [ 1, 6, 8 ], [ 1, 6, 8 ], [ 2 ], [ 4 ], [ 6, 7, 8, 9 ], [ 6, 8, 9 ], [ 8 ], [ 6 ], [ 1, 7 ], [ 1, 5 ], [ 9 ], [ 4 ], [ 1, 3, 7 ], [ 2, 7 ], [ 2, 3, 5 ] ] + in + Expect.equal expected actual + , test "should still be a valid puzzle" <| + \() -> + let + puzzle = + evil.puzzle + |> Possible.initialize + |> Possible.eliminateUsed + |> Possible.eliminateCrowds + |> Possible.eliminateSame + |> Possible.eliminateAligned + |> Possible.toPuzzle + in + Expect.equal True (Puzzle.valid puzzle) + ] + , describe "Puzzle.solve" + [ test "should solve evil puzzle (http://www.websudoku.com/?level=4&set_id=5147254317)" <| + \() -> + Expect.equal (Ok evil.solution) (Puzzle.solve evil.puzzle) + ] + ] + + +evil : { puzzle : List Int, solution : List Int } +evil = + { puzzle = + {- + [0,0,0,0,7,0,0,5,1 + ,0,0,2,9,0,0,6,3,0 + ,0,0,0,4,0,0,0,0,7 + ,0,1,5,0,0,6,9,0,0 + ,0,0,0,0,0,0,0,0,0 + ,0,0,4,3,0,0,5,1,0 + ,2,0,0,0,0,7,0,0,0 + ,0,5,3,0,0,2,4,0,0 + ,8,6,0,0,9,0,0,0,0 + ] + -} + [ 0, 0, 0, 0, 7, 0, 0, 5, 1, 0, 0, 2, 9, 0, 0, 6, 3, 0, 0, 0, 0, 4, 0, 0, 0, 0, 7, 0, 1, 5, 0, 0, 6, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 3, 0, 0, 5, 1, 0, 2, 0, 0, 0, 0, 7, 0, 0, 0, 0, 5, 3, 0, 0, 2, 4, 0, 0, 8, 6, 0, 0, 9, 0, 0, 0, 0 ] + , solution = + [] + } diff --git a/src/Sudoku/Possible.elm b/src/Sudoku/Possible.elm index a53dd17..f436974 100644 --- a/src/Sudoku/Possible.elm +++ b/src/Sudoku/Possible.elm @@ -95,10 +95,7 @@ eliminateUsed possible = |> eliminate xs [ i ] ) in - if before == after then - before - else - eliminateUsed after + after used : Int -> Puzzle -> List Int @@ -220,47 +217,74 @@ eliminateAligned possible = group |> findIndices (List.member n) + head = + is + |> List.head + |> Maybe.withDefault 0 + same = unique >> List.length >> (==) 1 - row = + rowInGroup = (flip (//) 3) - column = + rowInPuzzle = + (+) ((g // 3) * 3) + + indexInRow = + (\i -> i % 3 + (g % 3) * 3) + + columnInGroup = (flip (%) 3) + + columnInPuzzle = + (+) ((g % 3) * 3) + + indexInColumn = + (\i -> i // 3 + (g // 3) * 3) + + sameRow = + is |> List.map rowInGroup |> same + + sameColumn = + is |> List.map columnInGroup |> same in - if List.length is == 0 then + if List.length is <= 1 then + -- eliminateUsed or eliminateCrowds will handle these [] - else if is |> List.map row |> same then + else let - y = - is - |> List.head - |> Maybe.withDefault 0 - |> row - |> (+) ((g // 3) * 3) + rowEliminations = + if not sameRow then + [] + else + let + y = + head + |> rowInGroup + |> rowInPuzzle + in + is + |> List.map indexInRow + |> diff [0..8] + |> List.map (flip coordToIndex y) + + columnEliminations = + if not sameColumn then + [] + else + let + x = + head + |> columnInGroup + |> columnInPuzzle + in + is + |> List.map indexInColumn + |> diff [0..8] + |> List.map (coordToIndex x) in - is - |> List.map - (\i -> i % 3 + g % 3 * 3) - |> diff [0..8] - |> List.map (flip coordToIndex y) - else if is |> List.map column |> same then - let - x = - is - |> List.head - |> Maybe.withDefault 0 - |> column - |> (+) (g // 3 * 3) - in - is - |> List.map - (\i -> i // 3 + g // 3 * 3) - |> diff [0..8] - |> List.map (coordToIndex x) - else - [] + rowEliminations ++ columnEliminations ) |> flip List.foldl possible diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 965654b..bd3de5f 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -83,18 +83,38 @@ solve puzzle = before = puzzle - after = + possible = before |> Possible.initialize |> Possible.eliminateUsed |> Possible.eliminateCrowds - --|> Possible.eliminateSame - --|> Possible.eliminateAligned - |> - Possible.toPuzzle + |> Possible.eliminateSame + |> Possible.eliminateAligned + + after = + Possible.toPuzzle possible in if before == after then Err Unsolvable else - after - |> solve + solve after + + + +--guess : Possible -> Result Error Puzzle +--guess possible = +-- let +-- is = guesses +-- a = +-- b = +-- in +-- if a /= possible then +-- solve a +-- Err Unsolvable +-- solved +--guesses = Possible -> List Int +--guesses possible = +-- possible +-- |> List.indexedMap (,) +-- |> List.filter +-- (\(_, xs) -> List.length xs /= 2) diff --git a/src/Sudoku/PuzzleTests.elm b/src/Sudoku/PuzzleTests.elm index 14e0b39..3b77481 100644 --- a/src/Sudoku/PuzzleTests.elm +++ b/src/Sudoku/PuzzleTests.elm @@ -108,6 +108,33 @@ tests = in Expect.equal (Ok solvedPuzzle) (Puzzle.solve puzzle) ] + --, describe "make" + -- [ test "should give us valid, incomplete, solvable puzzles" <| + -- \() -> + -- let + -- puzzles = + -- [0..100] + -- |> List.map (toFloat >> (/) 100 >> Puzzle.make) + -- actual = + -- puzzles + -- |> List.map + -- (\puzzle -> + -- let + -- valid = + -- Puzzle.valid puzzle + -- complete = + -- Puzzle.complete puzzle == False + -- solvable = + -- Puzzle.solve puzzle + -- |> Result.toMaybe + -- |> (/=) Nothing + -- in + -- valid && complete && solvable + -- ) + -- |> List.all ((==) True) + -- in + -- Expect.equal True actual + -- ] ] diff --git a/tests/Main.elm b/tests/Main.elm index ccfbe39..c6a9ce1 100644 --- a/tests/Main.elm +++ b/tests/Main.elm @@ -8,6 +8,7 @@ import Sudoku.PuzzleTests import Sudoku.PossibleTests import Sudoku.GridTests import Sudoku.PuzzleSolveTests +import Sudoku.EvilPuzzleTests tests : Test @@ -17,6 +18,7 @@ tests = , Sudoku.PuzzleTests.tests , Sudoku.PossibleTests.tests , Sudoku.PuzzleSolveTests.tests + , Sudoku.EvilPuzzleTests.tests ] From 1d2ced2a010d0628218ef8ab6f895ab081c0177d Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 29 Sep 2016 09:50:19 -0600 Subject: [PATCH 10/19] Implement Guess and Check = Solve Evil Puzzle!!! --- src/Sudoku/EvilPuzzleTests.elm | 2 +- src/Sudoku/Puzzle.elm | 56 +++++++++++++++++++++++----------- 2 files changed, 39 insertions(+), 19 deletions(-) diff --git a/src/Sudoku/EvilPuzzleTests.elm b/src/Sudoku/EvilPuzzleTests.elm index 6becf65..e297a6c 100644 --- a/src/Sudoku/EvilPuzzleTests.elm +++ b/src/Sudoku/EvilPuzzleTests.elm @@ -147,5 +147,5 @@ evil = -} [ 0, 0, 0, 0, 7, 0, 0, 5, 1, 0, 0, 2, 9, 0, 0, 6, 3, 0, 0, 0, 0, 4, 0, 0, 0, 0, 7, 0, 1, 5, 0, 0, 6, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 3, 0, 0, 5, 1, 0, 2, 0, 0, 0, 0, 7, 0, 0, 0, 0, 5, 3, 0, 0, 2, 4, 0, 0, 8, 6, 0, 0, 9, 0, 0, 0, 0 ] , solution = - [] + [ 4, 9, 8, 6, 7, 3, 2, 5, 1, 5, 7, 2, 9, 1, 8, 6, 3, 4, 6, 3, 1, 4, 2, 5, 8, 9, 7, 3, 1, 5, 7, 4, 6, 9, 8, 2, 9, 8, 6, 2, 5, 1, 7, 4, 3, 7, 2, 4, 3, 8, 9, 5, 1, 6, 2, 4, 9, 5, 3, 7, 1, 6, 8, 1, 5, 3, 8, 6, 2, 4, 7, 9, 8, 6, 7, 1, 9, 4, 3, 2, 5 ] } diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index bd3de5f..bd8da6f 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -11,8 +11,10 @@ module Sudoku.Puzzle ) import Set +import List.Extra exposing (findIndex) import Sudoku.Grid exposing (rows, columns, groups) import Sudoku.Possible as Possible +import Util exposing (get, set) type alias Puzzle = @@ -95,26 +97,44 @@ solve puzzle = Possible.toPuzzle possible in if before == after then - Err Unsolvable + guess possible else solve after +guess : Possible.Possible -> Result Error Puzzle +guess possible = + let + m = + possible + |> findIndex (List.length >> (==) 2) + in + case m of + Nothing -> + Err Unsolvable ---guess : Possible -> Result Error Puzzle ---guess possible = --- let --- is = guesses --- a = --- b = --- in --- if a /= possible then --- solve a --- Err Unsolvable --- solved ---guesses = Possible -> List Int ---guesses possible = --- possible --- |> List.indexedMap (,) --- |> List.filter --- (\(_, xs) -> List.length xs /= 2) + Just i -> + let + options = + possible + |> get i [] + |> List.map + (\n -> + possible + |> set i [ n ] + |> Possible.toPuzzle + ) + in + case options of + [ a, b ] -> + let + solveA = + solve a + in + if solveA == Err Unsolvable then + solve b + else + solveA + + _ -> + Err Unsolvable From 939269df3a4b21ce43e5e0156ea6ddee4653c321 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 29 Sep 2016 19:57:01 -0600 Subject: [PATCH 11/19] Stuff --- src/Sudoku/EvilPuzzleTests.elm | 12 ++++++++++++ src/Sudoku/PuzzleSolveTests.elm | 6 ------ 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/Sudoku/EvilPuzzleTests.elm b/src/Sudoku/EvilPuzzleTests.elm index e297a6c..6e7938a 100644 --- a/src/Sudoku/EvilPuzzleTests.elm +++ b/src/Sudoku/EvilPuzzleTests.elm @@ -147,5 +147,17 @@ evil = -} [ 0, 0, 0, 0, 7, 0, 0, 5, 1, 0, 0, 2, 9, 0, 0, 6, 3, 0, 0, 0, 0, 4, 0, 0, 0, 0, 7, 0, 1, 5, 0, 0, 6, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 3, 0, 0, 5, 1, 0, 2, 0, 0, 0, 0, 7, 0, 0, 0, 0, 5, 3, 0, 0, 2, 4, 0, 0, 8, 6, 0, 0, 9, 0, 0, 0, 0 ] , solution = + {- + [4,9,8,6,7,3,2,5,1 + ,5,7,2,9,1,8,6,3,4 + ,6,3,1,4,2,5,8,9,7 + ,3,1,5,7,4,6,9,8,2 + ,9,8,6,2,5,1,7,4,3 + ,7,2,4,3,8,9,5,1,6 + ,2,4,9,5,3,7,1,6,8 + ,1,5,3,8,6,2,4,7,9 + ,8,6,7,1,9,4,3,2,5 + ] + -} [ 4, 9, 8, 6, 7, 3, 2, 5, 1, 5, 7, 2, 9, 1, 8, 6, 3, 4, 6, 3, 1, 4, 2, 5, 8, 9, 7, 3, 1, 5, 7, 4, 6, 9, 8, 2, 9, 8, 6, 2, 5, 1, 7, 4, 3, 7, 2, 4, 3, 8, 9, 5, 1, 6, 2, 4, 9, 5, 3, 7, 1, 6, 8, 1, 5, 3, 8, 6, 2, 4, 7, 9, 8, 6, 7, 1, 9, 4, 3, 2, 5 ] } diff --git a/src/Sudoku/PuzzleSolveTests.elm b/src/Sudoku/PuzzleSolveTests.elm index 0bed1ff..a8f5882 100644 --- a/src/Sudoku/PuzzleSolveTests.elm +++ b/src/Sudoku/PuzzleSolveTests.elm @@ -160,12 +160,6 @@ tests = -} [ 8, 4, 2, 1, 6, 5, 3, 9, 7, 9, 1, 5, 2, 3, 7, 8, 4, 6, 7, 3, 6, 4, 8, 9, 1, 5, 2, 1, 8, 7, 9, 5, 2, 4, 6, 3, 6, 9, 4, 3, 1, 8, 7, 2, 5, 2, 5, 3, 6, 7, 4, 9, 8, 1, 3, 6, 8, 5, 9, 1, 2, 7, 4, 4, 7, 1, 8, 2, 6, 5, 3, 9, 5, 2, 9, 7, 4, 3, 6, 1, 8 ] } - --, { id = "http://www.websudoku.com/?level=4&set_id=5147254317" - -- , puzzle = - -- [0,0,0,0,7,0,0,5,1,0,0,2,9,0,0,6,3,0,0,0,0,4,0,0,0,0,7,0,1,5,0,0,6,9,0,0,0,0,0,0,0,0,0,0,0,0,0,4,3,0,0,5,1,0,2,0,0,0,0,7,0,0,0,0,5,3,0,0,2,4,0,0,8,6,0,0,9,0,0,0,0] - -- , solution = - -- [] - -- } ] |> List.map (\puzzle -> From 73d75fe48f62693718ed3a38fc7e6f72b5e0efd0 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 29 Sep 2016 19:58:43 -0600 Subject: [PATCH 12/19] Formatting --- src/Sudoku/EvilPuzzleTests.elm | 20 ++++++++++---------- src/Sudoku/PuzzleTests.elm | 27 --------------------------- 2 files changed, 10 insertions(+), 37 deletions(-) diff --git a/src/Sudoku/EvilPuzzleTests.elm b/src/Sudoku/EvilPuzzleTests.elm index 6e7938a..289d241 100644 --- a/src/Sudoku/EvilPuzzleTests.elm +++ b/src/Sudoku/EvilPuzzleTests.elm @@ -148,16 +148,16 @@ evil = [ 0, 0, 0, 0, 7, 0, 0, 5, 1, 0, 0, 2, 9, 0, 0, 6, 3, 0, 0, 0, 0, 4, 0, 0, 0, 0, 7, 0, 1, 5, 0, 0, 6, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 4, 3, 0, 0, 5, 1, 0, 2, 0, 0, 0, 0, 7, 0, 0, 0, 0, 5, 3, 0, 0, 2, 4, 0, 0, 8, 6, 0, 0, 9, 0, 0, 0, 0 ] , solution = {- - [4,9,8,6,7,3,2,5,1 - ,5,7,2,9,1,8,6,3,4 - ,6,3,1,4,2,5,8,9,7 - ,3,1,5,7,4,6,9,8,2 - ,9,8,6,2,5,1,7,4,3 - ,7,2,4,3,8,9,5,1,6 - ,2,4,9,5,3,7,1,6,8 - ,1,5,3,8,6,2,4,7,9 - ,8,6,7,1,9,4,3,2,5 - ] + [4,9,8,6,7,3,2,5,1 + ,5,7,2,9,1,8,6,3,4 + ,6,3,1,4,2,5,8,9,7 + ,3,1,5,7,4,6,9,8,2 + ,9,8,6,2,5,1,7,4,3 + ,7,2,4,3,8,9,5,1,6 + ,2,4,9,5,3,7,1,6,8 + ,1,5,3,8,6,2,4,7,9 + ,8,6,7,1,9,4,3,2,5 + ] -} [ 4, 9, 8, 6, 7, 3, 2, 5, 1, 5, 7, 2, 9, 1, 8, 6, 3, 4, 6, 3, 1, 4, 2, 5, 8, 9, 7, 3, 1, 5, 7, 4, 6, 9, 8, 2, 9, 8, 6, 2, 5, 1, 7, 4, 3, 7, 2, 4, 3, 8, 9, 5, 1, 6, 2, 4, 9, 5, 3, 7, 1, 6, 8, 1, 5, 3, 8, 6, 2, 4, 7, 9, 8, 6, 7, 1, 9, 4, 3, 2, 5 ] } diff --git a/src/Sudoku/PuzzleTests.elm b/src/Sudoku/PuzzleTests.elm index 3b77481..14e0b39 100644 --- a/src/Sudoku/PuzzleTests.elm +++ b/src/Sudoku/PuzzleTests.elm @@ -108,33 +108,6 @@ tests = in Expect.equal (Ok solvedPuzzle) (Puzzle.solve puzzle) ] - --, describe "make" - -- [ test "should give us valid, incomplete, solvable puzzles" <| - -- \() -> - -- let - -- puzzles = - -- [0..100] - -- |> List.map (toFloat >> (/) 100 >> Puzzle.make) - -- actual = - -- puzzles - -- |> List.map - -- (\puzzle -> - -- let - -- valid = - -- Puzzle.valid puzzle - -- complete = - -- Puzzle.complete puzzle == False - -- solvable = - -- Puzzle.solve puzzle - -- |> Result.toMaybe - -- |> (/=) Nothing - -- in - -- valid && complete && solvable - -- ) - -- |> List.all ((==) True) - -- in - -- Expect.equal True actual - -- ] ] From 863194c621577459dc269b2199e6bd4d8b8d2a5a Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 29 Sep 2016 23:40:32 -0600 Subject: [PATCH 13/19] Puzzle.make ... Randoms in Elm are Stupid --- src/Sudoku/Possible.elm | 7 ++++++ src/Sudoku/Puzzle.elm | 38 ++++++++++++++++++++++++++-- src/Sudoku/PuzzleMakeTests.elm | 45 ++++++++++++++++++++++++++++++++++ src/Util.elm | 16 ++++++++++++ tests/Main.elm | 2 ++ 5 files changed, 106 insertions(+), 2 deletions(-) create mode 100644 src/Sudoku/PuzzleMakeTests.elm diff --git a/src/Sudoku/Possible.elm b/src/Sudoku/Possible.elm index f436974..0989c34 100644 --- a/src/Sudoku/Possible.elm +++ b/src/Sudoku/Possible.elm @@ -8,6 +8,8 @@ module Sudoku.Possible , eliminateCrowds , eliminateSame , eliminateAligned + , used + , unused ) import Set @@ -125,6 +127,11 @@ used i puzzle = row ++ column ++ group |> List.filter ((/=) 0) |> unique +unused : Int -> Puzzle -> List Int +unused i puzzle = + used i puzzle |> flip diff [1..9] + + eliminateCrowds : Possible -> Possible eliminateCrowds possible = possible diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index bd8da6f..4123c96 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -3,6 +3,7 @@ module Sudoku.Puzzle ( Puzzle , empty , fromList + , make , Error(..) , solved , valid @@ -14,7 +15,7 @@ import Set import List.Extra exposing (findIndex) import Sudoku.Grid exposing (rows, columns, groups) import Sudoku.Possible as Possible -import Util exposing (get, set) +import Util exposing (get, set, diff, randomItem) type alias Puzzle = @@ -42,6 +43,39 @@ fromList xs = Ok xs +make : Float -> { puzzle : Puzzle, solution : Puzzle } +make percent = + -- first, fill in puzzle one cell at a time + -- this is the solution + -- second, remove numbers from solution up to percent + -- this is the puzzle + let + solution = + empty + |> List.indexedMap (,) + |> List.foldl + (\( i, _ ) puzzle -> + let + random = + puzzle + |> Possible.unused i + |> randomItem + in + case random of + Nothing -> + puzzle + + Just x -> + puzzle + |> set i x + ) + + puzzle = + empty + in + { puzzle = puzzle, solution = solution } + + solved : Puzzle -> Bool solved puzzle = valid puzzle && complete puzzle @@ -71,7 +105,7 @@ valid xs = complete : Puzzle -> Bool complete xs = - xs |> List.all ((/=) 0) + List.length xs == 9 * 9 && List.all ((/=) 0) xs solve : Puzzle -> Result Error Puzzle diff --git a/src/Sudoku/PuzzleMakeTests.elm b/src/Sudoku/PuzzleMakeTests.elm new file mode 100644 index 0000000..4972423 --- /dev/null +++ b/src/Sudoku/PuzzleMakeTests.elm @@ -0,0 +1,45 @@ +port module Sudoku.PuzzleMakeTests exposing (tests) + +import Test exposing (..) +import Expect +import Sudoku.Puzzle as Puzzle exposing (Error(..)) + + +limit : Int +limit = + 100 + + +tests : Test +tests = + describe "Puzzle.make" + ([0..limit] + |> List.map + (\n -> + let + { puzzle, solution } = + Puzzle.make ((toFloat n) / (toFloat limit)) + in + describe ("puzzle " ++ toString n) + [ describe "solution" + [ test "should be valid" <| + \() -> + Expect.equal True (Puzzle.valid solution) + , test "should be complete" <| + \() -> + Expect.equal True (Puzzle.complete solution) + ] + , describe "puzzle" + [ test "should be valid" <| + \() -> + Expect.equal True (Puzzle.valid puzzle) + , test "should be incomplete" <| + \() -> + Expect.equal False (Puzzle.complete puzzle) + , test "should be solvable" <| + \() -> + Expect.equal (Ok solution) (Puzzle.solve puzzle) + ] + ] + ) + ) diff --git a/src/Util.elm b/src/Util.elm index 11bf21e..2ef13dd 100644 --- a/src/Util.elm +++ b/src/Util.elm @@ -2,6 +2,8 @@ module Util exposing (..) import Set import List.Extra exposing (getAt, setAt) +import Random +import Platform.Cmd get : Int -> a -> List a -> a @@ -19,3 +21,17 @@ diff a b = Set.diff (Set.fromList a) (Set.fromList b) |> Set.toList +randomItem : List a -> Maybe a +randomItem xs = + case xs of + [] -> + Nothing + _ -> + let + randomInt = + Random.int 0 ((List.length xs) - 1) + + i = + Random.generate identity randomInt + in + getAt i xs diff --git a/tests/Main.elm b/tests/Main.elm index c6a9ce1..a35f9d7 100644 --- a/tests/Main.elm +++ b/tests/Main.elm @@ -9,6 +9,7 @@ import Sudoku.PossibleTests import Sudoku.GridTests import Sudoku.PuzzleSolveTests import Sudoku.EvilPuzzleTests +import Sudoku.PuzzleMakeTests tests : Test @@ -19,6 +20,7 @@ tests = , Sudoku.PossibleTests.tests , Sudoku.PuzzleSolveTests.tests , Sudoku.EvilPuzzleTests.tests + , Sudoku.PuzzleMakeTests.tests ] From 975165348dc4154296800be9f96cb15657cc84f4 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Thu, 29 Sep 2016 23:57:57 -0600 Subject: [PATCH 14/19] ... --- src/Util.elm | 1 - 1 file changed, 1 deletion(-) diff --git a/src/Util.elm b/src/Util.elm index 2ef13dd..b43ee3a 100644 --- a/src/Util.elm +++ b/src/Util.elm @@ -3,7 +3,6 @@ module Util exposing (..) import Set import List.Extra exposing (getAt, setAt) import Random -import Platform.Cmd get : Int -> a -> List a -> a From df54d197eb5927e7a9f78da93540202c3364d7bc Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Fri, 30 Sep 2016 17:50:30 -0600 Subject: [PATCH 15/19] Failed Technique for Puzzle.make --- src/Sudoku/Possible.elm | 3 ++- src/Sudoku/Puzzle.elm | 3 ++- src/Util.elm | 9 ++++++--- 3 files changed, 10 insertions(+), 5 deletions(-) diff --git a/src/Sudoku/Possible.elm b/src/Sudoku/Possible.elm index 0989c34..a9ffb18 100644 --- a/src/Sudoku/Possible.elm +++ b/src/Sudoku/Possible.elm @@ -129,7 +129,8 @@ used i puzzle = unused : Int -> Puzzle -> List Int unused i puzzle = - used i puzzle |> flip diff [1..9] + used i puzzle + |> diff [1..9] eliminateCrowds : Possible -> Possible diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 4123c96..fc3d9d9 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -16,6 +16,7 @@ import List.Extra exposing (findIndex) import Sudoku.Grid exposing (rows, columns, groups) import Sudoku.Possible as Possible import Util exposing (get, set, diff, randomItem) +import Random type alias Puzzle = @@ -53,7 +54,7 @@ make percent = solution = empty |> List.indexedMap (,) - |> List.foldl + |> flip List.foldl empty (\( i, _ ) puzzle -> let random = diff --git a/src/Util.elm b/src/Util.elm index b43ee3a..fafc346 100644 --- a/src/Util.elm +++ b/src/Util.elm @@ -27,10 +27,13 @@ randomItem xs = Nothing _ -> let - randomInt = + seed = + Random.initialSeed 0 + + generator = Random.int 0 ((List.length xs) - 1) - i = - Random.generate identity randomInt + (i, _) = + Random.step generator seed in getAt i xs From 91a3f9ed632467c0f3aebc3a66e3444a66edd0d4 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Sat, 1 Oct 2016 16:23:48 -0600 Subject: [PATCH 16/19] I Don't Know What the Hell it is with Random --- src/Sudoku/Puzzle.elm | 65 ++++++++++++++++++++------------ src/Sudoku/PuzzleMakeTests.elm | 69 +++++++++++++++++++--------------- src/Util.elm | 37 ++++++++++++------ 3 files changed, 106 insertions(+), 65 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index fc3d9d9..5bda56b 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -12,10 +12,10 @@ module Sudoku.Puzzle ) import Set -import List.Extra exposing (findIndex) +import List.Extra exposing (findIndex, updateAt) import Sudoku.Grid exposing (rows, columns, groups) import Sudoku.Possible as Possible -import Util exposing (get, set, diff, randomItem) +import Util exposing (get, set, diff, randomIndex, shuffle) import Random @@ -44,37 +44,54 @@ fromList xs = Ok xs -make : Float -> { puzzle : Puzzle, solution : Puzzle } -make percent = +make : Random.Seed -> Float -> ({ puzzle : Puzzle, solution : Puzzle }, Random.Seed) +make seed percent = -- first, fill in puzzle one cell at a time -- this is the solution -- second, remove numbers from solution up to percent -- this is the puzzle let - solution = - empty - |> List.indexedMap (,) - |> flip List.foldl empty - (\( i, _ ) puzzle -> - let - random = - puzzle - |> Possible.unused i - |> randomItem - in - case random of - Nothing -> - puzzle - - Just x -> - puzzle - |> set i x - ) + (solution, newSeed) = + makeSolution seed puzzle = empty in - { puzzle = puzzle, solution = solution } + ({ puzzle = puzzle, solution = solution }, newSeed) + + +makeSolution : Random.Seed -> (Puzzle, Random.Seed) +makeSolution seed = + List.repeat 9 [1..9] + |> List.concat + |> makeSolution' seed + + +makeSolution' : Random.Seed -> Puzzle -> (Puzzle, Random.Seed) +makeSolution' seed puzzle = + if solved puzzle then + (puzzle, seed) + else + let + rows' = + rows puzzle + + ( i, newSeed ) = + randomIndex seed rows' + + (newRow, newNewSeed) = + get i [] rows' + |> shuffle newSeed + + newPuzzle = + rows' + |> set i newRow + |> List.concat + + (solution, newNewNewSeed) = + makeSolution' newNewSeed newPuzzle + in + (solution, newNewNewSeed) solved : Puzzle -> Bool diff --git a/src/Sudoku/PuzzleMakeTests.elm b/src/Sudoku/PuzzleMakeTests.elm index 4972423..18a225b 100644 --- a/src/Sudoku/PuzzleMakeTests.elm +++ b/src/Sudoku/PuzzleMakeTests.elm @@ -2,7 +2,9 @@ port module Sudoku.PuzzleMakeTests exposing (tests) import Test exposing (..) import Expect +import Fuzz import Sudoku.Puzzle as Puzzle exposing (Error(..)) +import Random limit : Int @@ -13,33 +15,40 @@ limit = tests : Test tests = describe "Puzzle.make" - ([0..limit] - |> List.map - (\n -> - let - { puzzle, solution } = - Puzzle.make ((toFloat n) / (toFloat limit)) - in - describe ("puzzle " ++ toString n) - [ describe "solution" - [ test "should be valid" <| - \() -> - Expect.equal True (Puzzle.valid solution) - , test "should be complete" <| - \() -> - Expect.equal True (Puzzle.complete solution) - ] - , describe "puzzle" - [ test "should be valid" <| - \() -> - Expect.equal True (Puzzle.valid puzzle) - , test "should be incomplete" <| - \() -> - Expect.equal False (Puzzle.complete puzzle) - , test "should be solvable" <| - \() -> - Expect.equal (Ok solution) (Puzzle.solve puzzle) - ] - ] - ) - ) + [ fuzz2 Fuzz.int Fuzz.percentage "should valid, solvable puzzles" <| + (\s p -> + let + ({ puzzle, solution }, _) = + Puzzle.make (Random.initialSeed s) p + + actual = + { solution = + { valid = Puzzle.valid solution + , complete = Puzzle.complete solution + , solved = Puzzle.solved solution + } + , puzzle = + { valid = Puzzle.valid puzzle + , complete = Puzzle.complete puzzle + , solved = Puzzle.solved puzzle + , solve = Puzzle.solve puzzle + } + } + + expected = + { solution = + { valid = True + , complete = True + , solved = True + } + , puzzle = + { valid = True + , complete = False + , solved = False + , solve = Ok solution + } + } + in + Expect.equal expected actual + ) + ] diff --git a/src/Util.elm b/src/Util.elm index fafc346..1fc2695 100644 --- a/src/Util.elm +++ b/src/Util.elm @@ -1,7 +1,7 @@ module Util exposing (..) import Set -import List.Extra exposing (getAt, setAt) +import List.Extra exposing (getAt, setAt, removeAt) import Random @@ -20,20 +20,35 @@ diff a b = Set.diff (Set.fromList a) (Set.fromList b) |> Set.toList -randomItem : List a -> Maybe a -randomItem xs = +randomIndex : Random.Seed -> List a -> (Int, Random.Seed) +randomIndex seed xs = + let + seed = + Random.initialSeed 0 + + generator = + Random.int 0 ((List.length xs) - 1) + in + Random.step generator seed + + +shuffle : Random.Seed -> List a -> (List a, Random.Seed) +shuffle seed xs = case xs of - [] -> - Nothing - _ -> + [] -> ([], seed) + [_] -> (xs, seed) + head :: tail -> let - seed = - Random.initialSeed 0 - generator = Random.int 0 ((List.length xs) - 1) - (i, _) = + (i, newSeed) = Random.step generator seed + + x = + get i head xs + + (tail, newNewSeed) = + shuffle newSeed (removeAt i xs) in - getAt i xs + (x :: tail, newNewSeed) From 57d05a22f75db8e095ae608785b7649ead0fd4fd Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Sun, 2 Oct 2016 12:23:18 -0600 Subject: [PATCH 17/19] Some Debug Code --- src/Sudoku/Puzzle.elm | 3 ++- src/Sudoku/PuzzleMakeTests.elm | 2 +- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 5bda56b..6ea3628 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -81,11 +81,12 @@ makeSolution' seed puzzle = (newRow, newNewSeed) = get i [] rows' + |> Debug.log "before" |> shuffle newSeed newPuzzle = rows' - |> set i newRow + |> set i (Debug.log "after" newRow) |> List.concat (solution, newNewNewSeed) = diff --git a/src/Sudoku/PuzzleMakeTests.elm b/src/Sudoku/PuzzleMakeTests.elm index 18a225b..4ff0ba9 100644 --- a/src/Sudoku/PuzzleMakeTests.elm +++ b/src/Sudoku/PuzzleMakeTests.elm @@ -19,7 +19,7 @@ tests = (\s p -> let ({ puzzle, solution }, _) = - Puzzle.make (Random.initialSeed s) p + Puzzle.make (Random.initialSeed (Debug.log "s" s)) (Debug.log "p" p) actual = { solution = From e9e4bc9268c25f108557272f5c550f3cfa40d02c Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Sun, 2 Oct 2016 12:34:12 -0600 Subject: [PATCH 18/19] Formatting --- src/Sudoku/Puzzle.elm | 18 +++++++++--------- src/Sudoku/PuzzleMakeTests.elm | 2 +- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index 6ea3628..d03c8ca 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -44,33 +44,33 @@ fromList xs = Ok xs -make : Random.Seed -> Float -> ({ puzzle : Puzzle, solution : Puzzle }, Random.Seed) +make : Random.Seed -> Float -> ( { puzzle : Puzzle, solution : Puzzle }, Random.Seed ) make seed percent = -- first, fill in puzzle one cell at a time -- this is the solution -- second, remove numbers from solution up to percent -- this is the puzzle let - (solution, newSeed) = + ( solution, newSeed ) = makeSolution seed puzzle = empty in - ({ puzzle = puzzle, solution = solution }, newSeed) + ( { puzzle = puzzle, solution = solution }, newSeed ) -makeSolution : Random.Seed -> (Puzzle, Random.Seed) +makeSolution : Random.Seed -> ( Puzzle, Random.Seed ) makeSolution seed = List.repeat 9 [1..9] |> List.concat |> makeSolution' seed -makeSolution' : Random.Seed -> Puzzle -> (Puzzle, Random.Seed) +makeSolution' : Random.Seed -> Puzzle -> ( Puzzle, Random.Seed ) makeSolution' seed puzzle = if solved puzzle then - (puzzle, seed) + ( puzzle, seed ) else let rows' = @@ -79,7 +79,7 @@ makeSolution' seed puzzle = ( i, newSeed ) = randomIndex seed rows' - (newRow, newNewSeed) = + ( newRow, newNewSeed ) = get i [] rows' |> Debug.log "before" |> shuffle newSeed @@ -89,10 +89,10 @@ makeSolution' seed puzzle = |> set i (Debug.log "after" newRow) |> List.concat - (solution, newNewNewSeed) = + ( solution, newNewNewSeed ) = makeSolution' newNewSeed newPuzzle in - (solution, newNewNewSeed) + ( solution, newNewNewSeed ) solved : Puzzle -> Bool diff --git a/src/Sudoku/PuzzleMakeTests.elm b/src/Sudoku/PuzzleMakeTests.elm index 4ff0ba9..534fd79 100644 --- a/src/Sudoku/PuzzleMakeTests.elm +++ b/src/Sudoku/PuzzleMakeTests.elm @@ -18,7 +18,7 @@ tests = [ fuzz2 Fuzz.int Fuzz.percentage "should valid, solvable puzzles" <| (\s p -> let - ({ puzzle, solution }, _) = + ( { puzzle, solution }, _ ) = Puzzle.make (Random.initialSeed (Debug.log "s" s)) (Debug.log "p" p) actual = From 9060364d9c8e8b2b7a28e8fe9732357a0f067a41 Mon Sep 17 00:00:00 2001 From: Joshua Stoutenburg Date: Mon, 3 Oct 2016 23:57:51 -0600 Subject: [PATCH 19/19] It Runs! (Forever) Sick and tired of elm's bullshit around random, added random as a native module. But with my current implementation of Puzzle.make quickly ran into a stack overflow. Then I found Trampoline! No more stack overflow. Just a program that never finishes. I think I'll keep Trampoline, but I'm going to need a more sophistocated implementation of Puzzle.make that doesn't keep shuffling things that are valid. --- elm-package.json | 2 + src/Native/Random.js | 20 +++++++++ src/Sudoku/Puzzle.elm | 81 ++++++++++++++++++---------------- src/Sudoku/PuzzleMakeTests.elm | 9 ++-- src/Util.elm | 35 +++++---------- 5 files changed, 79 insertions(+), 68 deletions(-) create mode 100644 src/Native/Random.js diff --git a/elm-package.json b/elm-package.json index 418d974..6e0aa38 100644 --- a/elm-package.json +++ b/elm-package.json @@ -7,10 +7,12 @@ "./src" ], "exposed-modules": [], + "native-modules": true, "dependencies": { "elm-community/elm-test": "2.0.0 <= v < 3.0.0", "elm-community/list-extra": "3.1.0 <= v < 4.0.0", "elm-lang/core": "4.0.0 <= v < 5.0.0", + "elm-lang/trampoline": "1.0.0 <= v < 2.0.0", "rtfeldman/node-test-runner": "2.0.0 <= v < 3.0.0" }, "elm-version": "0.17.0 <= v < 0.18.0" diff --git a/src/Native/Random.js b/src/Native/Random.js new file mode 100644 index 0000000..3210a5e --- /dev/null +++ b/src/Native/Random.js @@ -0,0 +1,20 @@ +var _jehoshua02$elm_sudoku$Native_Random = function() { + +function percentage() +{ + return Math.random(); +} + +function int(min, max) +{ + min = Math.ceil(min); + max = Math.floor(max); + return Math.floor(Math.random() * (max - min + 1)) + min; +} + +return { + percentage: percentage, + int: F2(int), +}; + +}(); diff --git a/src/Sudoku/Puzzle.elm b/src/Sudoku/Puzzle.elm index d03c8ca..84470ad 100644 --- a/src/Sudoku/Puzzle.elm +++ b/src/Sudoku/Puzzle.elm @@ -15,8 +15,9 @@ import Set import List.Extra exposing (findIndex, updateAt) import Sudoku.Grid exposing (rows, columns, groups) import Sudoku.Possible as Possible -import Util exposing (get, set, diff, randomIndex, shuffle) -import Random +import Util exposing (get, set, diff, shuffle) +import Native.Random +import Trampoline type alias Puzzle = @@ -44,55 +45,59 @@ fromList xs = Ok xs -make : Random.Seed -> Float -> ( { puzzle : Puzzle, solution : Puzzle }, Random.Seed ) -make seed percent = - -- first, fill in puzzle one cell at a time - -- this is the solution +make : Float -> { puzzle : Puzzle, solution : Puzzle } +make percent = -- second, remove numbers from solution up to percent -- this is the puzzle let - ( solution, newSeed ) = - makeSolution seed + -- first, fill in puzzle one cell at a time + -- this is the solution + solution = + makeSolution + |> Debug.log "solution" puzzle = empty in - ( { puzzle = puzzle, solution = solution }, newSeed ) + { puzzle = puzzle, solution = solution } -makeSolution : Random.Seed -> ( Puzzle, Random.Seed ) -makeSolution seed = +makeSolution : Puzzle +makeSolution = List.repeat 9 [1..9] |> List.concat - |> makeSolution' seed + |> makeSolution' + |> Trampoline.evaluate -makeSolution' : Random.Seed -> Puzzle -> ( Puzzle, Random.Seed ) -makeSolution' seed puzzle = - if solved puzzle then - ( puzzle, seed ) - else - let - rows' = - rows puzzle - - ( i, newSeed ) = - randomIndex seed rows' - - ( newRow, newNewSeed ) = - get i [] rows' - |> Debug.log "before" - |> shuffle newSeed - - newPuzzle = - rows' - |> set i (Debug.log "after" newRow) - |> List.concat - - ( solution, newNewNewSeed ) = - makeSolution' newNewSeed newPuzzle - in - ( solution, newNewNewSeed ) +makeSolution' : Puzzle -> Trampoline.Trampoline Puzzle +makeSolution' puzzle = + Trampoline.jump + (\() -> + if valid puzzle then + Trampoline.done puzzle + else + let + rows' = + rows puzzle + + i = + Native.Random.int 0 ((List.length rows') - 1) + + newRow = + get i [] rows' + |> shuffle + |> Debug.log "after" + + newPuzzle = + rows' + |> updateAt i shuffle + |> Maybe.withDefault rows' + |> List.concat + in + makeSolution' newPuzzle + |> Debug.log "newPuzzle" + ) solved : Puzzle -> Bool diff --git a/src/Sudoku/PuzzleMakeTests.elm b/src/Sudoku/PuzzleMakeTests.elm index 534fd79..bb62b4d 100644 --- a/src/Sudoku/PuzzleMakeTests.elm +++ b/src/Sudoku/PuzzleMakeTests.elm @@ -4,7 +4,6 @@ import Test exposing (..) import Expect import Fuzz import Sudoku.Puzzle as Puzzle exposing (Error(..)) -import Random limit : Int @@ -15,11 +14,11 @@ limit = tests : Test tests = describe "Puzzle.make" - [ fuzz2 Fuzz.int Fuzz.percentage "should valid, solvable puzzles" <| - (\s p -> + [ fuzz Fuzz.percentage "should valid, solvable puzzles" <| + (\p -> let - ( { puzzle, solution }, _ ) = - Puzzle.make (Random.initialSeed (Debug.log "s" s)) (Debug.log "p" p) + { puzzle, solution } = + Puzzle.make (Debug.log "p" p) actual = { solution = diff --git a/src/Util.elm b/src/Util.elm index 1fc2695..b6a0d3e 100644 --- a/src/Util.elm +++ b/src/Util.elm @@ -2,7 +2,7 @@ module Util exposing (..) import Set import List.Extra exposing (getAt, setAt, removeAt) -import Random +import Native.Random get : Int -> a -> List a -> a @@ -20,35 +20,20 @@ diff a b = Set.diff (Set.fromList a) (Set.fromList b) |> Set.toList -randomIndex : Random.Seed -> List a -> (Int, Random.Seed) -randomIndex seed xs = - let - seed = - Random.initialSeed 0 - - generator = - Random.int 0 ((List.length xs) - 1) - in - Random.step generator seed - - -shuffle : Random.Seed -> List a -> (List a, Random.Seed) -shuffle seed xs = +shuffle : List a -> List a +shuffle xs = case xs of - [] -> ([], seed) - [_] -> (xs, seed) + [] -> [] + [_] -> xs head :: tail -> let - generator = - Random.int 0 ((List.length xs) - 1) - - (i, newSeed) = - Random.step generator seed + i = + Native.Random.int 0 ((List.length xs) - 1) x = get i head xs - (tail, newNewSeed) = - shuffle newSeed (removeAt i xs) + tail = + shuffle (removeAt i xs) in - (x :: tail, newNewSeed) + x :: tail