A bit

src/Sudoku.hs

@@ -1 +1,131 @@
-module Sudoku where
+{-# LANGUAGE OverloadedStrings, LambdaCase, MultiWayIf #-}
+module Sudoku ( isValid
+              , Cell(..)
+              , Grid(..)
+              , updateCell
+              , emptyGrid
+              , parseStringToGrid
+              ) where
+
+import Data.Matrix hiding (getRow, getCol)
+import Data.Matrix qualified as M
+import Data.Vector (Vector)
+import Data.Vector qualified as V
+import Data.Coerce
+import Control.Parallel
+import Control.Parallel.Strategies
+
+data Cell where
+  One :: Cell
+  Two :: Cell
+  Three :: Cell
+  Four :: Cell
+  Five :: Cell
+  Six :: Cell
+  Seven :: Cell
+  Eight :: Cell
+  Nine :: Cell
+  Unknown :: Cell
+  deriving (Eq)
+
+instance Show Cell where
+  show One = "1"
+  show Two = "2"
+  show Three = "3"
+  show Four = "4"
+  show Five = "5"
+  show Six = "6"
+  show Seven = "7"
+  show Eight = "8"
+  show Nine = "9"
+  show Unknown = " "
+
+cellFromChar :: String -> Cell
+cellFromChar "1" = One
+cellFromChar "2" = Two
+cellFromChar "3" = Three
+cellFromChar "4" = Four
+cellFromChar "5" = Five
+cellFromChar "6" = Six
+cellFromChar "7" = Seven
+cellFromChar "8" = Eight
+cellFromChar "9" = Nine
+cellFromChar "X" = Unknown
+cellFromChar  _  = error "Unknown char"
+
+numbers :: Vector Cell
+numbers = V.fromList [One, Two, Three, Four, Five, Six, Seven, Eight, Nine]
+
+newtype Column = Column (Vector Cell)
+newtype Row = Row (Vector Cell)
+-- Square is 3x3 
+newtype Square = Square (Matrix Cell)
+-- Grid is 9x9
+newtype Grid = Grid (Matrix Cell)
+
+instance Show Grid where
+  show (Grid m) = prettyMatrix m
+
+emptyGrid :: Grid
+emptyGrid = coerce $ matrix 9 9 (const Unknown)
+
+parseStringToGrid :: String -> Grid
+parseStringToGrid str =
+  let m = M.fromLists . fmap (fmap cellFromChar) . fmap words . lines $ str
+      rows = nrows m
+      cols = nrows m
+  in if
+    | rows == 9 && cols == 9 && isValid (Grid m) -> Grid m
+    | rows == 9 && cols == 9 -> error "Grid was not valid"
+    | otherwise -> error "String did not fit a sudoku grid"
+
+isValidVector :: Vector Cell -> Bool
+isValidVector = V.all (<= 1) . (numbers >>=) . (((pure . V.length) .) . (. (==)) . flip V.filter)
+
+isValidColumn :: Column -> Bool
+isValidColumn = isValidVector . coerce
+
+isValidRow :: Row -> Bool
+isValidRow = isValidVector . coerce
+
+isValidSquare :: Square -> Bool
+isValidSquare = isValidVector . getMatrixAsVector . coerce
+
+getRow :: Int -> Grid -> Row
+getRow n
+  | n > 0 && n <= 9 = Row . M.getRow n . coerce
+  | otherwise       = error "Indexing row outside of grid"
+
+getColumn :: Int -> Grid -> Column
+getColumn n
+  | n > 0 && n <= 9 = Column . M.getCol n . coerce
+  | otherwise       = error "Indexing column outside of grid"
+
+getSquare :: Int -> Grid -> Square
+getSquare n
+  | n > 0 && n <= 9 = let !sr = (n+2) `div` 3
+                          !er = sr + 2
+                          !sc = (n+2) `mod` 3 + 1
+                          !ec = sc + 2
+                      in Square . submatrix sr er sc ec . coerce
+  | otherwise       = error "Indexing square outside of grid"
+
+isValid :: Grid -> Bool
+isValid g = and $ flip (parMap rpar) [1..9]
+                   (\i ->
+                      let row = isValidRow (getRow i g)
+                          col = isValidColumn (getColumn i g)
+                          square = isValidSquare (getSquare i g)
+                      in col `par` square `par` row && col && square
+                   )
+
+updateCell :: Int -> Int -> Cell -> Grid -> Grid
+updateCell n m 
+  | n > 0 && n <= 9 && m > 0 && m <= 9 = \ c g ->
+      let mx = coerce g in
+      if (mx M.! (n,m) == Unknown) then
+        coerce $ setElem c (n,m) mx else
+        error "Updating non unkown value"
+  | otherwise = error "Updating cell outside of grid"
+  
+