jawz/scripts
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

solves easy sudokus

Browse Source
This commit is contained in:
Danilo Reyes 2025-04-02 21:55:14 -06:00
parent 0b0a55516f
commit 8f2ae33e75
1 changed files with 28 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
src/sudoku-hs/src/Main.hs
View File

@ -3,16 +3,18 @@
module Main where module Main where
import Data.Char (isSpace) import Data.Char (isSpace)
import Data.List (transpose, dropWhileEnd) import Data.List (transpose, minimumBy, delete, dropWhileEnd)
import Data.Maybe (isNothing, listToMaybe) import Data.Maybe (isNothing, listToMaybe, catMaybes)
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Vector as V import qualified Data.Vector as V
import qualified Data.Csv as CSV import qualified Data.Csv as CSV
import System.Environment (getArgs) import System.Environment (getArgs)
import Text.Read (readMaybe) import Text.Read (readMaybe)
import Data.Ord (comparing)
type Cell = Maybe Int type Cell = Maybe Int
type Grid = [[Cell]] type Grid = [[Cell]]
type Pos = (Int, Int)
parseCell :: String -> Cell parseCell :: String -> Cell
parseCell s = readMaybe (trim s) parseCell s = readMaybe (trim s)
@ -31,30 +33,30 @@ printGrid = putStrLn . unlines . map (unwords . map showCell)
where showCell = maybe "." show where showCell = maybe "." show
solve :: Grid -> Maybe Grid solve :: Grid -> Maybe Grid
solve grid = solve' grid solve g = case nextCell g of
solve' :: Grid -> Maybe Grid
solve' g = case findEmpty g of
Nothing -> Just g Nothing -> Just g
Just (r, c) -> Just (r, c, opts) ->
listToMaybe [ g' listToMaybe
| n <- [1..9] [ result
, isSafe g r c n | n <- opts
, let g' = updateGrid g r c (Just n) , let g' = updateGrid g r c (Just n)
, Just _ <- [solve' g'] ] , Just result <- [solve g'] ]
findEmpty :: Grid -> Maybe (Int, Int) nextCell :: Grid -> Maybe (Int, Int, [Int])
findEmpty g = listToMaybe nextCell g =
[ (r, c) case filter (not . null . (\(_, _, opts) -> opts)) candidates of
[] -> Nothing
cs -> Just $ minimumBy (comparing (\(_, _, opts) -> length opts)) cs
where
candidates =
[ (r, c, validOptions g r c)
| (r, row) <- zip [0..] g | (r, row) <- zip [0..] g
, (c, cell) <- zip [0..] row , (c, cell) <- zip [0..] row
, isNothing cell ] , isNothing cell ]
isSafe :: Grid -> Int -> Int -> Int -> Bool validOptions :: Grid -> Int -> Int -> [Int]
isSafe g r c n = validOptions g r c =
notElem (Just n) (getRow r g) && foldr delete [1..9] (catMaybes (getRow r g ++ getCol c g ++ getBox r c g))
notElem (Just n) (getCol c g) &&
notElem (Just n) (getBox r c g)
getRow :: Int -> Grid -> [Cell] getRow :: Int -> Grid -> [Cell]
getRow r g = g !! r getRow r g = g !! r
@ -65,10 +67,10 @@ getCol c g = map (!! c) g
getBox :: Int -> Int -> Grid -> [Cell] getBox :: Int -> Int -> Grid -> [Cell]
getBox r c g = getBox r c g =
[ g !! r' !! c' [ g !! r' !! c'
| r' <- brange, c' <- crange ] | r' <- [br..br+2], c' <- [bc..bc+2] ]
where where
brange = let b = r - r `mod` 3 in [b..b+2] br = r - r `mod` 3
crange = let b = c - c `mod` 3 in [b..b+2] bc = c - c `mod` 3
updateGrid :: Grid -> Int -> Int -> Cell -> Grid updateGrid :: Grid -> Int -> Int -> Cell -> Grid
updateGrid g r c val = updateGrid g r c val =