abhin4v
/
hasdoku
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Uses traverse instead of sequence . map

This commit is contained in:
Abhinav Sarkar 2018-06-21 10:53:05 +05:30
parent 97da7c92f9
commit 0f6c8f99bf
1 changed files with 17 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
src/Sudoku.hs
View File

@ -13,8 +13,7 @@ type Grid = [Row]
readGrid :: String -> Maybe Grid readGrid :: String -> Maybe Grid
readGrid s readGrid s
| length s == 81 = | length s == 81 = traverse (traverse readCell) . Data.List.Split.chunksOf 9 $ s
sequence . map (sequence . map readCell) . Data.List.Split.chunksOf 9 $ s
| otherwise = Nothing | otherwise = Nothing
where where
readCell '.' = Just $ Possible [1..9] readCell '.' = Just $ Possible [1..9]
@ -38,36 +37,38 @@ showGridWithPossibilities = unlines . map (unwords . map showCell)
$ [1..9] $ [1..9]
pruneCells :: [Cell] -> Maybe [Cell] pruneCells :: [Cell] -> Maybe [Cell]
pruneCells cells = sequence . map pruneCell $ cells pruneCells cells = traverse pruneCell cells
where where
fixeds = [x | Fixed x <- cells] fixeds = [x | Fixed x <- cells]
pruneCell (Possible xs) = case xs Data.List.\\ fixeds of pruneCell (Possible xs) = case xs Data.List.\\ fixeds of
[] -> Nothing [] -> Nothing
[y] -> Just $ Fixed y [y] -> Just $ Fixed y
ys -> Just $ Possible ys ys -> Just $ Possible ys
pruneCell x = Just x pruneCell x = Just x
blocksToRows :: Grid -> Grid subGridsToRows :: Grid -> Grid
blocksToRows = subGridsToRows =
concatMap (\rows -> let (r1:r2:r3:_) = map (Data.List.Split.chunksOf 3) rows concatMap (\rows -> let [r1, r2, r3] = map (Data.List.Split.chunksOf 3) rows
in zipWith3 (\a b c -> a ++ b ++ c) r1 r2 r3) in zipWith3 (\a b c -> a ++ b ++ c) r1 r2 r3)
. Data.List.Split.chunksOf 3 . Data.List.Split.chunksOf 3
pruneGrid' :: Grid -> Maybe Grid
pruneGrid' grid =
traverse pruneCells grid
>>= fmap Data.List.transpose . traverse pruneCells . Data.List.transpose
>>= fmap subGridsToRows . traverse pruneCells . subGridsToRows
pruneGrid :: Grid -> Maybe Grid pruneGrid :: Grid -> Maybe Grid
pruneGrid = fixM pruneGrid' pruneGrid = fixM pruneGrid'
where
pruneGrid' grid = fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
sequence (map pruneCells grid)
>>= fmap Data.List.transpose . sequence . map pruneCells . Data.List.transpose
>>= fmap blocksToRows . sequence . map pruneCells . blocksToRows
fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
isInvalidGrid :: Grid -> Bool isInvalidGrid :: Grid -> Bool
isInvalidGrid grid = isInvalidGrid grid =
any isInvalidRow grid any isInvalidRow grid
|| any isInvalidRow (Data.List.transpose grid) || any isInvalidRow (Data.List.transpose grid)
|| any isInvalidRow (blocksToRows grid) || any isInvalidRow (subGridsToRows grid)
where where
isInvalidRow = not . isValidRow isInvalidRow = not . isValidRow
isValidRow row = isValidRow row =
@ -92,9 +93,8 @@ solve grid
possibleVals (Possible xs) = xs possibleVals (Possible xs) = xs
smallestPossible = smallestPossible =
head Data.List.minimumBy (compare `Data.Function.on` (length . possibleVals . snd))
. Data.List.sortBy (compare `Data.Function.on` (length . possibleVals . snd)) [(i, c) | (i, c@(Possible _)) <- zip [0..] $ concat grid]
$ [(i, c) | (i, c@(Possible _)) <- zip [0..] $ concat grid]
splitPossible (i, Possible (x:[y])) = (i, Fixed x, Fixed y) splitPossible (i, Possible (x:[y])) = (i, Fixed x, Fixed y)
splitPossible (i, Possible (x:xs)) = (i, Fixed x, Possible xs) splitPossible (i, Possible (x:xs)) = (i, Fixed x, Possible xs)