A small haskell script to solve sudoku puzzles
git clone https://github.com/m-col/sudoku-solver
Files | Refs | Readme

Commit bb01110c3e4ada856768e4b50615d50ab46b4d58
Parent: 6ef2bf555a42402f9ae453b3213326f87bcc40e8
Author: mcol <mcol@posteo.net>
Date: 2022-04-03 13:26:27 +0100
Committer: mcol <mcol@posteo.net>
Committed: 2022-04-03 13:26:27 +0100

shuffle some code around

sudoku.hs Modified

@@ -12,47 +12,18 @@
 import Data.Maybe (catMaybes, fromMaybe, isJust, listToMaybe, mapMaybe)
 import System.Environment (getArgs)
 
+{-
+Screw dealing with IO when I can use trace. Sorry not sorry.
+-}
 import Debug.Trace
 
 puz p = trace (showPuzzle p) p
 
--- Puzzle #1
-puzzle :: Puzzle
-puzzle =
-    asArray
-        [ ((One, One), Just Five)
-        , ((One, Two), Just Six)
-        , ((One, Four), Just Eight)
-        , ((One, Nine), Just Nine)
-        , ((Two, Three), Just Three)
-        , ((Two, Five), Just Two)
-        , ((Two, Six), Just Six)
-        , ((Two, Eight), Just One)
-        , ((Three, Nine), Just Three)
-        , ((Four, Six), Just Nine)
-        , ((Four, Seven), Just Five)
-        , ((Five, Three), Just Eight)
-        , ((Five, Four), Just Five)
-        , ((Five, Seven), Just One)
-        , ((Six, Three), Just Four)
-        , ((Six, Four), Just Three)
-        , ((Seven, One), Just Three)
-        , ((Seven, Seven), Just Nine)
-        , ((Eight, One), Just Six)
-        , ((Eight, Four), Just Two)
-        , ((Eight, Five), Just One)
-        , ((Eight, Six), Just Four)
-        , ((Nine, Seven), Just Eight)
-        , ((Nine, Nine), Just Four)
-        ]
-
--- Converts the list of values above into an array of maybe values
-asArray :: [(Index, Maybe Cell)] -> Puzzle
-asArray vals = listArray ((One, One), (Nine, Nine)) (repeat Nothing) // vals
-
 type Puzzle = Array Index (Maybe Cell)
 
--- This is the set of possible values, rows and columns.
+{-
+This is the set of possible values, rows and columns.
+-}
 data Cell = One | Two | Three | Four | Five | Six | Seven | Eight | Nine
     deriving (Eq, Ord, Enum, Ix, Show)
 
@@ -63,44 +34,27 @@
 type Index = (Cell, Cell)
 
 {-
-Test if the indices specified by cartesian product of row and column indices contain the
-values One to Nine, one each, and nothing else.
--}
-goodSet :: Puzzle -> [Index] -> Bool
-goodSet p = noRepeats . catMaybes . map ((!) p)
-  where
-    noRepeats cs = length cs == length (nub cs)
-
-{-
-Is the given puzzle valid, considering only the cells that do have values?
-
-Possible improvement: don't test every single row/column/box when making a change.
+Is the given puzzle valid, considering only the cells that do have values? Possible
+improvement: don't test every single row/column/box when making a change.
 -}
 isValid :: Puzzle -> Bool
 isValid p = all (goodSet p) blocks
-
-blocks :: [[Index]]
-blocks = concat [rows, cols, boxes]
   where
-    rows :: [[Index]]
-    rows = map (\r -> map ((,) r) set) set
+    goodSet :: Puzzle -> [Index] -> Bool
+    goodSet p = noRepeats . catMaybes . map ((!) p)
 
-    cols :: [[Index]]
-    cols = map (\c -> map (flip (,) c) set) set
+    noRepeats cs = length cs == length (nub cs)
 
-    boxes :: [[Index]]
+    blocks :: [[Index]]
+    blocks = concat [rows, cols, boxes]
+    rows = map (\r -> map ((,) r) set) set
+    cols = map (\c -> map (flip (,) c) set) set
     boxes = map makeBox [(r, c) | r <- [One, Four, Seven], c <- [One, Four, Seven]]
 
     makeBox :: Index -> [Index]
     makeBox (r, c) = [(r, c) | r <- [r .. succ . succ $ r], c <- [c .. succ . succ $ c]]
 
 {-
-Is this puzzle completely filled in with values?
--}
-isComplete :: Puzzle -> Bool
-isComplete = (==) 81 . length . catMaybes . elems
-
-{-
 Solve the given puzzle!
 -}
 solve :: Puzzle -> Maybe Puzzle
@@ -163,6 +117,9 @@
     parse ' ' = Nothing
     parse char = Just . toEnum . subtract 1 . digitToInt $ char
 
+    asArray :: [(Index, Maybe Cell)] -> Puzzle
+    asArray vals = listArray ((One, One), (Nine, Nine)) (repeat Nothing) // vals
+
 main :: IO ()
 main = do
     args <- getArgs