src/sudoku/Grid.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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
module Grid 
  ( Grid(..), Cell(..)
  , rows, cols, blocks
  , grid, solved
  , deadEnd
  , deadGrid
  , full, fullCell
  , numFilled
  )
where

import Data.List
import qualified Data.Set as S
import Test.QuickCheck

-- A Grid is a 9x9 matrix corresponding to a sudoku puzzle. The origin is
-- the top left corner.
newtype Grid = Grid [[Cell]]

instance Show Grid where
  show (Grid cells) = (intercalate "\n"
                       $ map (intercalate " | " . (map show)) cells) ++ "\n"

instance Arbitrary Grid where
  arbitrary = fmap Grid (nine (nine arbitrary))
     where nine a = sequence $ take 9 $ repeat a
    -- Keeps cells in [1..9] but produces invalid grids.
-- A Cell represents a filled or empty cell in a Grid.
newtype Cell = Cell (Maybe Int) deriving (Eq)

instance Show Cell where
  show (Cell (Just x)) = show x
  show (Cell Nothing) = "-"

instance Arbitrary Cell where
  arbitrary = do
    x <- choose (1, 9)
    return $ Cell $ Just x


-- | Tell if a grid is completely full
full :: Grid -> Bool
full g = all fullRow (rows g)
    where fullRow = all fullCell


-- | Tell if a cell is full
fullCell :: Cell -> Bool
fullCell (Cell (Just _)) = True
fullCell (Cell Nothing)  = False



-- Returns a grid with all cells empty
emptyGrid :: Grid
emptyGrid = Grid $ take 9 $ repeat $ take 9 $ repeat (Cell Nothing)

-- Returns a grid given a list of strings.
-- Characters that are "-" are treated as Nothing values.
-- Characters that are Ints in [1, 9] are treated as Just x values.
grid :: [String] -> Grid
grid cells = Grid $ map (map maybeify . filter (/= ' ')) cells
  where maybeify :: Char -> Cell
        maybeify '-' = Cell Nothing
        maybeify x = Cell (Just $ read [x])

-- solved returns true if and only if the grid is valid and all rows, columns 
-- and blocks sum to 9.
solved :: Grid -> Bool
solved g = valid g && all sum45 bs && all sum45 rs && all sum45 cs
  where bs = blocks g
        rs = rows g
        cs = cols g

-- sum45 returns true when the sum of cells equals 45.
-- If a Nothing value is in cells, sum45 returns false.
sum45 :: [Cell] -> Bool
sum45 cells = sum45' cells 0
  where sum45' [] sum = sum == 45
        sum45' ((Cell Nothing):_) _ = False
        sum45' (Cell (Just c):cs) sum = sum45' cs (sum + c)

-- | @deadGrid@ tells if a grid cannot possibly be completed into a solution

deadGrid :: Grid -> Bool
deadGrid = not . valid

-- | @valid@ returns true if and only if all rows, columns and blocks  contain
-- either a Nothing value or a unique Just x value where x is in [1, 9]
valid :: Grid -> Bool
valid grid = v (blocks grid) && v (rows grid) && v (cols grid)
  where v = all valid'

valid' :: [Cell] -> Bool
valid' cells = valid'' cells S.empty
  where valid'' :: [Cell] -> S.Set Int -> Bool
        valid'' [] _ = True
        valid'' ((Cell Nothing):xs) seen = valid'' xs seen
        valid'' (Cell (Just x):xs) seen =
          case (x `S.member` seen, x < 1 || x > 9) of
            (True, _) -> False
            (_, True) -> False
            (False, False) -> valid'' xs (x `S.insert` seen)

deadEnd :: [Cell] -> Bool
deadEnd = not . valid'


numFilled :: Grid -> Int
numFilled grid = sum (map row (rows grid))
    where row = length . filter fullCell
                 
                 



-- Returns all the rows in the grid
rows :: Grid -> [[Cell]]
rows (Grid cells) = cells

-- Returns the row at i (indexed 1 through 9)
row :: Grid -> Int -> [Cell]
row (Grid cells) i = head $ drop (i - 1) cells

-- Returns all the columns in the grid.
cols :: Grid -> [[Cell]]
cols g = foldr (\index accum -> (col g index):accum) [] [1..9]

-- Returns the column at i (indexed 1 through 9)
col :: Grid -> Int -> [Cell]
col (Grid cells) i = foldr (\r c -> (r !! (i - 1)):c) [] cells

-- Returns all of the blocks in the grid.
blocks :: Grid -> [[Cell]]
blocks g = foldr (\index accum -> (block g index):accum) [] [1..9]

-- Returns the block at i (index 1 through 9, left to right then top to bottom)
block :: Grid -> Int -> [Cell]
block g i =
  -- I am ashamed of myself.
  case i of
    1 -> blockify [0..2] [0..2]
    2 -> blockify [0..2] [3..5]
    3 -> blockify [0..2] [6..8]
    4 -> blockify [3..5] [0..2]
    5 -> blockify [3..5] [3..5]
    6 -> blockify [3..5] [6..8]
    7 -> blockify [6..8] [0..2]
    8 -> blockify [6..8] [3..5]
    9 -> blockify [6..8] [6..8]
  where blockify :: [Int] -> [Int] -> [Cell]
        blockify rs cs = foldr (++) [] (map onlyCols rows)
          where onlyCols :: [Cell] -> [Cell]
                onlyCols row = foldr (\ind accum -> (row !! ind):accum) [] cs

                rows :: [[Cell]]
                rows = map (row g) $ map (+ 1) rs