Renames and cleanup

package.yaml

@@ -15,13 +15,14 @@ dependencies:
 - base >= 4.7 && < 5
 
 executables:
-  hasdoku:
+  sudoku:
     main:                Sudoku.hs
     source-dirs:         src
     ghc-options:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N
+    - -O2
     dependencies:
     - split
 

src/Sudoku.hs

@@ -64,11 +64,11 @@ pruneGrid = fixM pruneGrid'
   where
     fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
 
-isFinishedGrid :: Grid -> Bool
-isFinishedGrid grid = null [ () | Possible _ <- concat grid ]
+isGridFilled :: Grid -> Bool
+isGridFilled grid = null [ () | Possible _ <- concat grid ]
 
-isInvalidGrid :: Grid -> Bool
-isInvalidGrid grid =
+isGridInvalid :: Grid -> Bool
+isGridInvalid grid =
   any isInvalidRow grid
   || any isInvalidRow (Data.List.transpose grid)
   || any isInvalidRow (subGridsToRows grid)
@@ -85,39 +85,47 @@ isInvalidGrid grid =
       | y `elem` xs = True
       | otherwise   = hasDups' ys (y:xs)
 
-solve :: Grid -> Maybe Grid
-solve grid = pruneGrid grid >>= solve'
+nextGrids :: Grid -> (Grid, Grid)
+nextGrids grid =
+  let (i, first@(Fixed _), rest) =
+        fixCell
+        . Data.List.minimumBy (compare `Data.Function.on` (possibilityCount . snd))
+        . filter (isPossible . snd)
+        . zip [0..]
+        . concat
+        $ grid
+  in (replace2D i first grid, replace2D i rest grid)
   where
-    solve' grid
-      | isInvalidGrid grid  = Nothing
-      | isFinishedGrid grid = Just grid
-      | otherwise         =
-          let (grid1, grid2) = nextGrids grid
-          in solve grid1 <|> solve grid2
+    isPossible (Possible _) = True
+    isPossible _            = False
 
-    nextGrids grid =
-      let (i, first@(Fixed _), rest) = splitPossible . smallestPossible $ grid
-      in (replace2D i first grid, replace2D i rest grid)
+    possibilityCount (Possible xs) = length xs
+    possibilityCount (Fixed _)     = 1
 
-    smallestPossible grid =
-      Data.List.minimumBy (compare `Data.Function.on` (length . possibleVals . snd))
-      [(i, c) | (i, c@(Possible _)) <- zip [0..] $ concat grid]
-
-    possibleVals (Fixed x)     = [x]
-    possibleVals (Possible xs) = xs
-
-    splitPossible (i, Possible (x:[y])) = (i, Fixed x, Fixed y)
-    splitPossible (i, Possible (x:xs))  = (i, Fixed x, Possible xs)
-    splitPossible _                    = error "Impossible case"
+    fixCell (i, Possible [x, y]) = (i, Fixed x, Fixed y)
+    fixCell (i, Possible (x:xs)) = (i, Fixed x, Possible xs)
+    fixCell _                    = error "Impossible case"
 
+    replace2D :: Int -> a -> [[a]] -> [[a]]
     replace2D i v = let (x, y) = (i `quot` 9, i `mod` 9) in replace x (replace y (const v))
     replace p f xs = [if i == p then f x else x | (x, i) <- zip xs [0..]]
 
+solve :: Grid -> Maybe Grid
+solve grid = pruneGrid grid >>= solve'
+  where
+    solve' grid'
+      | isGridInvalid grid = Nothing
+      | isGridFilled grid' = Just grid'
+      | otherwise          =
+          let (grid1, grid2) = nextGrids grid'
+          in solve grid1 <|> solve grid2
+
+main :: IO ()
 main = do
-  grids <- lines <$> getContents
-  Control.Monad.forM_ grids $ \grid ->
-    case readGrid grid of
-      Nothing -> putStrLn "Invalid grid"
+  inputs <- lines <$> getContents
+  Control.Monad.forM_ inputs $ \input ->
+    case readGrid input of
+      Nothing   -> putStrLn "Invalid input"
       Just grid -> case solve grid of
-        Nothing -> putStrLn "No solution found"
+        Nothing    -> putStrLn "No solution found"
         Just grid' -> putStrLn $ showGrid grid'