src/sudoku/Main.hs

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
module Main where

import Grid
import Solve

exInvalid :: Grid
exInvalid = grid $ [ "5 3 3 - 7 - - - -"
                   , "6 - - 1 9 5 - - -"
                   , "- 9 8 - - - - 6 -"

                   , "8 - - - 6 - - - 3"
                   , "4 - - 8 - 3 - - 1"
                   , "7 - - - 2 - - - 6"

                   , "- 6 - - - - 2 8 -"
                   , "- - - 4 1 9 - - 5"
                   , "- - - - 8 - - 7 9"
                   ]

wikiGapped :: Grid
wikiGapped = grid $ [ "5 3 - - 7 - - - -"
                    , "6 - - 1 9 5 - - -"
                    , "- 9 8 - - - - 6 -"

                    , "8 - - - 6 - - - 3"
                    , "4 - - 8 - 3 - - 1"
                    , "7 - - - 2 - - - 6"

                    , "- 6 - - - - 2 8 -"
                    , "- - - 4 1 9 - - 5"
                    , "- - - - 8 - - 7 9"
                    ]

wikiGapped2 :: Grid
wikiGapped2 = grid $ [ "- - - - - - - 1 -"
                     , "- - - - - 2 - - 3"
                     , "- - - 4 - - - - -"

                     , "- - - - - - 5 - -"
                     , "4 - 1 6 - - - - -"
                     , "- - 7 1 - - - - -"

                     , "- 5 - - - - 2 - -"
                     , "- - - - 8 - - 4 -"
                     , "- 3 - 9 1 - - - -"
                     ]

wikiAnswered :: Grid
wikiAnswered = grid $ [ "5 3 4 6 7 8 9 1 2"
                      , "6 7 2 1 9 5 3 4 8"
                      , "1 9 8 3 4 2 5 6 7"

                      , "8 5 9 7 6 1 4 2 3"
                      , "4 2 6 8 5 3 7 9 1"
                      , "7 1 3 9 2 4 8 5 6"

                      , "9 6 1 5 3 7 2 8 4"
                      , "2 8 7 4 1 9 6 3 5"
                      , "3 4 5 2 8 6 1 7 9"
                      ]

main = putStr $
       "Here's our puzzle. Has it been solved?\n"
       ++ show wikiGapped
       ++ solvedStr wikiGapped
       ++ "\n\n"
       ++ "Is the answer from Wikipedia correct?\n"
       ++ show wikiAnswered
       ++ solvedStr wikiAnswered
       ++ "\n\n"
       ++ "Our solver\n"
       ++ show (head (improve [wikiGapped]))
       ++ "\n"
       ++ "Our solver on a harder problem?  I think not.\n"
--       ++ concatMap (\ g -> show g ++ "\n\n") (improve [wikiGapped2])
       ++ "\n"
  where solvedStr g = if solved g then "Yes" else "No"