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

formatted hs script

Browse Source
This commit is contained in:
Danilo Reyes 2025-04-02 22:12:02 -06:00
parent ed27112dbc
commit 5a081e4ecd
1 changed files with 50 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,15 +2,15 @@
module Main where module Main where
import Data.Char (isSpace)
import Data.List (transpose, minimumBy, delete, dropWhileEnd)
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 Data.Char (isSpace)
import qualified Data.Csv as CSV import qualified Data.Csv as CSV
import Data.List (delete, dropWhileEnd, minimumBy, transpose)
import Data.Maybe (catMaybes, isNothing, listToMaybe)
import Data.Ord (comparing)
import qualified Data.Vector as V
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]]
@ -18,7 +18,8 @@ type Pos = (Int, Int)
parseCell :: String -> Cell parseCell :: String -> Cell
parseCell s = readMaybe (trim s) parseCell s = readMaybe (trim s)
where trim = dropWhileEnd isSpace . dropWhile isSpace where
trim = dropWhileEnd isSpace . dropWhile isSpace
readCSV :: FilePath -> IO Grid readCSV :: FilePath -> IO Grid
readCSV path = do readCSV path = do
@ -26,11 +27,13 @@ readCSV path = do
case CSV.decode CSV.NoHeader csvData of case CSV.decode CSV.NoHeader csvData of
Left err -> error ("CSV parse error: " ++ err) Left err -> error ("CSV parse error: " ++ err)
Right v -> return $ map (map (parseCell . trimQuotes) . V.toList) (V.toList v) Right v -> return $ map (map (parseCell . trimQuotes) . V.toList) (V.toList v)
where trimQuotes = filter (/= '"') where
trimQuotes = filter (/= '"')
printGrid :: Grid -> IO () printGrid :: Grid -> IO ()
printGrid = putStrLn . unlines . map (unwords . map showCell) 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 solve g
@ -43,7 +46,8 @@ solve g
| 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 result
]
isComplete :: Grid -> Bool isComplete :: Grid -> Bool
isComplete = all (notElem Nothing) isComplete = all (notElem Nothing)
@ -58,7 +62,8 @@ nextCell g =
[ (r, c, validOptions g r c) [ (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
]
validOptions :: Grid -> Int -> Int -> [Int] validOptions :: Grid -> Int -> Int -> [Int]
validOptions g r c = validOptions g r c =
@ -73,16 +78,18 @@ getCol c = map (!! c)
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' <- [br..br+2], c' <- [bc..bc+2] ] | r' <- [br .. br + 2]
, c' <- [bc .. bc + 2]
]
where where
br = r - r `mod` 3 br = r - r `mod` 3
bc = c - c `mod` 3 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 =
take r g ++ take r g
[take c (g !! r) ++ [val] ++ drop (c + 1) (g !! r)] ++ ++ [take c (g !! r) ++ [val] ++ drop (c + 1) (g !! r)]
drop (r + 1) g ++ drop (r + 1) g
main :: IO () main :: IO ()
main = do main = do