diff --git a/Estinen.cabal b/Estinen.cabal index 2de1f84..eb6075b 100644 --- a/Estinen.cabal +++ b/Estinen.cabal @@ -68,6 +68,9 @@ library -- Other library packages from which modules are imported. build-depends: base >=4.19.2.0 + , matrix + , vector + , parallel -- Directories containing source files. hs-source-dirs: src diff --git a/README.md b/README.md index da1b723..8567ba5 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,30 @@ # Estinen -Sudo solver written in haskell \ No newline at end of file +Sudoku solver written in haskell + + +## Format for input files + +``` +1 2 3 4 5 6 7 8 9 +2 3 4 5 6 7 8 9 1 +3 4 5 6 7 8 9 1 2 +4 5 6 7 8 9 1 2 3 +5 6 7 8 9 1 2 3 4 +6 7 8 9 1 2 3 4 5 +7 8 9 1 2 3 4 5 6 +8 9 1 2 3 4 5 6 7 +9 1 2 3 4 5 6 7 8 +``` + +``` +1 2 3 4 5 6 X 8 9 +2 X 4 5 6 X 8 X 1 +3 4 5 X 7 8 9 1 2 +4 5 6 7 8 X 1 2 3 +5 X X 8 9 1 2 3 4 +6 7 8 9 X 2 3 X X +7 X 9 1 2 3 X X X +8 9 1 X 3 4 5 6 X +9 1 2 3 4 5 6 7 8 +``` diff --git a/app/Main.hs b/app/Main.hs index 76e4cc6..c28d901 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,5 +1,11 @@ +{-# LANGUAGE LambdaCase #-} module Main where +import Sudoku +import System.Environment (getArgs) + + main :: IO () -main = do - putStrLn "Hello, Haskell!" +main = getArgs >>= \case + [filename] -> readFile filename >>= print . parseStringToGrid + _ -> error "Usage: Estinen filename" diff --git a/invalid.sudoku b/invalid.sudoku new file mode 100644 index 0000000..578628e --- /dev/null +++ b/invalid.sudoku @@ -0,0 +1,9 @@ +1 2 3 4 5 6 X 9 9 +2 X 4 5 6 X 8 X 1 +3 4 5 X 7 8 9 1 2 +4 5 6 7 8 X 1 2 3 +5 X X 8 9 1 2 3 4 +6 7 8 9 X 2 3 X X +7 X 9 1 2 3 X X X +8 9 1 X 3 4 5 6 X +9 1 2 3 4 5 6 7 8 diff --git a/src/Sudoku.hs b/src/Sudoku.hs index 6cfc70e..dffd151 100644 --- a/src/Sudoku.hs +++ b/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 + +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" + +emptyGrid :: Grid +emptyGrid = coerce $ matrix 9 9 (const Unknown) + + diff --git a/valid.sudoku b/valid.sudoku new file mode 100644 index 0000000..db932bd --- /dev/null +++ b/valid.sudoku @@ -0,0 +1,9 @@ +1 2 3 4 5 6 X 8 9 +2 X 4 5 6 X 8 X 1 +3 4 5 X 7 8 9 1 2 +4 5 6 7 8 X 1 2 3 +5 X X 8 9 1 2 3 4 +6 7 8 9 X 2 3 X X +7 X 9 1 2 3 X X X +8 9 1 X 3 4 5 6 X +9 1 2 3 4 5 6 7 8