sudoku solver now solves complex puzzles
This commit is contained in:
parent
8f2ae33e75
commit
485e005ea6
@ -33,14 +33,20 @@ printGrid = putStrLn . unlines . map (unwords . map showCell)
|
|||||||
where showCell = maybe "." show
|
where showCell = maybe "." show
|
||||||
|
|
||||||
solve :: Grid -> Maybe Grid
|
solve :: Grid -> Maybe Grid
|
||||||
solve g = case nextCell g of
|
solve g
|
||||||
Nothing -> Just g
|
| isComplete g = Just g
|
||||||
|
| otherwise = case nextCell g of
|
||||||
|
Nothing -> Nothing
|
||||||
Just (r, c, opts) ->
|
Just (r, c, opts) ->
|
||||||
listToMaybe
|
listToMaybe
|
||||||
[ result
|
[ result
|
||||||
| n <- opts
|
| n <- opts
|
||||||
, let g' = updateGrid g r c (Just n)
|
, let g' = updateGrid g r c (Just n)
|
||||||
, Just result <- [solve g'] ]
|
, Just result <- [solve g']
|
||||||
|
, isComplete result ]
|
||||||
|
|
||||||
|
isComplete :: Grid -> Bool
|
||||||
|
isComplete = all (notElem Nothing)
|
||||||
|
|
||||||
nextCell :: Grid -> Maybe (Int, Int, [Int])
|
nextCell :: Grid -> Maybe (Int, Int, [Int])
|
||||||
nextCell g =
|
nextCell g =
|
||||||
@ -62,7 +68,7 @@ getRow :: Int -> Grid -> [Cell]
|
|||||||
getRow r g = g !! r
|
getRow r g = g !! r
|
||||||
|
|
||||||
getCol :: Int -> Grid -> [Cell]
|
getCol :: Int -> Grid -> [Cell]
|
||||||
getCol c g = map (!! c) g
|
getCol c = map (!! c)
|
||||||
|
|
||||||
getBox :: Int -> Int -> Grid -> [Cell]
|
getBox :: Int -> Int -> Grid -> [Cell]
|
||||||
getBox r c g =
|
getBox r c g =
|
||||||
@ -85,6 +91,6 @@ main = do
|
|||||||
[filePath] -> do
|
[filePath] -> do
|
||||||
grid <- readCSV filePath
|
grid <- readCSV filePath
|
||||||
case solve grid of
|
case solve grid of
|
||||||
Nothing -> putStrLn "No solution found."
|
Nothing -> putStrLn "No complete solution found."
|
||||||
Just g -> printGrid g
|
Just g -> printGrid g
|
||||||
_ -> putStrLn "Usage: sudoku-solver <sudoku.csv>"
|
_ -> putStrLn "Usage: sudoku-solver <sudoku.csv>"
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user