diff --git a/app/Main.hs b/app/Main.hs index c28d901..b9d51d6 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,5 +7,5 @@ import System.Environment (getArgs) main :: IO () main = getArgs >>= \case - [filename] -> readFile filename >>= print . parseStringToGrid + [filename] -> readFile filename >>= print . solve . parseStringToGrid _ -> error "Usage: Estinen filename" diff --git a/fucky.sudoku b/fucky.sudoku new file mode 100644 index 0000000..5989e06 --- /dev/null +++ b/fucky.sudoku @@ -0,0 +1,9 @@ +1 2 3 4 5 X 7 8 9 +4 5 6 7 X 9 1 2 3 +7 8 9 1 2 X 4 5 6 +2 3 4 5 6 7 X 9 1 +5 6 7 8 9 X 2 3 4 +8 9 1 2 3 4 5 6 7 +6 7 8 9 1 2 3 4 5 +9 1 2 3 4 5 6 7 8 +3 4 5 6 7 8 9 1 2 diff --git a/src/Sudoku.hs b/src/Sudoku.hs index f85bd98..c561bab 100644 --- a/src/Sudoku.hs +++ b/src/Sudoku.hs @@ -5,15 +5,19 @@ module Sudoku ( isValid , updateCell , emptyGrid , parseStringToGrid + , solve + , getSquare ) where -import Data.Matrix hiding (getRow, getCol) +import Data.Matrix hiding (getRow, getCol, trace) 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 +import Text.Printf +import Data.List data Cell where One :: Cell @@ -38,7 +42,7 @@ instance Show Cell where show Seven = "7" show Eight = "8" show Nine = "9" - show Unknown = " " + show Unknown = "_" cellFromChar :: String -> Cell cellFromChar "1" = One @@ -60,8 +64,12 @@ newtype Column = Column (Vector Cell) newtype Row = Row (Vector Cell) -- Square is 3x3 newtype Square = Square (Matrix Cell) +instance Show Square where + show (Square m) = prettyMatrix m + -- Grid is 9x9 newtype Grid = Grid (Matrix Cell) + deriving Eq instance Show Grid where show (Grid m) = prettyMatrix m @@ -103,9 +111,9 @@ getColumn n getSquare :: Int -> Grid -> Square getSquare n - | n > 0 && n <= 9 = let !sr = (n+2) `div` 3 + | n > 0 && n <= 9 = let !sr = ((n-1) `div` 3) * 3 + 1 !er = sr + 2 - !sc = (n+2) `mod` 3 + 1 + !sc = ((n-1) `mod` 3) * 3 + 1 !ec = sc + 2 in Square . submatrix sr er sc ec . coerce | otherwise = error "Indexing square outside of grid" @@ -127,5 +135,33 @@ updateCell n m coerce $ setElem c (n,m) mx else error "Updating non unkown value" | otherwise = error "Updating cell outside of grid" - +leftToPlace :: Grid -> [Cell] +leftToPlace = + V.toList . + (\v -> numbers >>= \i -> flip V.replicate i . (9-) . V.length $ V.elemIndices i v) . + getMatrixAsVector . + coerce + +findEmpty :: Grid -> [(Int,Int)] +findEmpty = V.toList . ((\n -> ((n) `div` 9 + 1, n `mod` 9 + 1)) <$>) . V.findIndices (== Unknown) . getMatrixAsVector . coerce + +place :: Cell -> (Int,Int) -> Grid -> Grid +place c pos g = coerce $ setElem c pos (coerce g) + +solve :: Grid -> Grid +solve g = let left = leftToPlace g in + case nub $ go g left of + [] -> error "No solution D:" + [x] -> x + xs -> error (printf "%d solutions" $ length xs) + where go :: Grid -> [Cell] -> [Grid] + go g [] = if isValid g then pure g else mempty + go g (x:xs) = if not $ isValid g then mempty else + let empties = findEmpty g in + go' xs $ flip (x `place`) g <$> empties + + go' :: [Cell] -> [Grid] -> [Grid] + go' _ [] = [] + go' xs (g:gs) = let sol = go g xs in + sol `par` go' xs gs <> sol diff --git a/valid.sudoku b/valid.sudoku index db932bd..15b7db3 100644 --- a/valid.sudoku +++ b/valid.sudoku @@ -1,9 +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 +1 2 3 4 5 X 7 8 9 +4 5 6 7 X 9 1 2 3 +7 8 X 1 2 X 4 5 6 +2 X 4 5 6 7 X 9 1 +5 6 X 8 9 X 2 3 4 +8 9 X 2 X 4 5 6 7 +6 7 X 9 1 2 X 4 5 +9 X 2 3 4 5 X X 8 +3 4 5 6 7 8 X 1 2