Skip to content

Instantly share code, notes, and snippets.

@gaxiiiiiiiiiiii
Last active February 20, 2019 05:36
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
Save gaxiiiiiiiiiiii/0fab7374d7c3ef8f2a0801972aa0aea5 to your computer and use it in GitHub Desktop.
module NumberPlate where
import Data.List
data Cell = Cell {num :: Int, row :: Int, col :: Int, block :: Int} deriving Eq
data Tree = Node Board [Tree] deriving Show
type Board = [Cell]
type Ploblem = [Int]
instance Show Cell where
show (Cell n _ _ _) = show n
----------- initilize -----------
easy :: Ploblem
easy = [5,1,7, 6,0,0, 0,3,4,
2,8,9, 0,0,4, 0,0,0,
3,4,6, 2,0,5, 0,9,0,
6,0,2, 0,0,0, 0,1,0,
0,3,8, 0,0,6, 0,4,7,
0,0,0, 0,0,0, 0,0,0,
0,9,0, 0,0,0, 0,7,8,
7,0,3, 4,0,0, 5,6,0,
0,0,0, 0,0,0, 0,0,0]
difficult :: Ploblem
difficult = [0,0,5, 3,0,0, 0,0,0,
8,0,0, 0,0,0, 0,2,0,
0,7,0, 0,1,0, 5,0,0,
4,0,0, 0,0,5, 3,0,0,
0,1,0, 0,7,0, 0,0,6,
0,0,3, 2,0,0, 0,8,0,
0,6,0, 5,0,0, 0,0,9,
0,0,4, 0,0,0, 0,3,0,
0,0,0, 0,0,9, 7,0,0]
positions :: [(Int,Int,Int)]
positions = [(r,c,b) | r <- [0..8], c <- [0..8], let b = 3 * (classify r) + (classify c)]
where classify = flip div 3
board :: Ploblem -> Board
board nums = zipWith initialize nums positions
where initialize n (r,c,b) = Cell n r c b
b = board easy
----------- tree -----------
tree :: Board -> Tree
tree b = Node b (map tree $ newBoards b empties)
where empties = filter ((== 0) . num) b
newBoards :: Board -> [Cell] -> [Board]
newBoards b [] = []
newBoards b (e:_) = map (fill b) candidates
where candidates = getCandidates b e
fill b n = [if c /= e then c else c {num = n} | c <- b]
getCandidates :: Board -> Cell -> [Int]
getCandidates b c = [1..9] \\ (inSameRow ++ inSameCol ++ inSameBlock)
where inSameRow = map num $ filter ((== row c) . row) b
inSameCol = map num $ filter ((== col c) . col) b
inSameBlock = map num $ filter ((== block c) . block) b
----------- solve -----------
solve :: Board -> Board
solve = head . flatten . tree
flatten :: Tree -> [Board]
flatten (Node b []) = if isSolved b then [b] else []
flatten (Node b ts) = concat $ map flatten ts
isSolved :: Board -> Bool
isSolved b = null empties
where empties = filter ((== 0) . num) b
----------- display -----------
display :: Board -> IO ()
display [] = return ()
display list = do
let (x,xs) = splitAt 9 list
print x
display xs
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment