diff --git a/full.sudoku b/full.sudoku index b61ddae..7930278 100644 --- a/full.sudoku +++ b/full.sudoku @@ -1,9 +1,9 @@ -1 2 3 4 5 X 7 8 9 -4 5 6 7 8 X 1 2 3 -7 X X X X X X X X -2 3 X X X X X X X -5 6 7 8 9 X 2 3 4 -8 X 1 2 3 X 5 6 7 -6 7 8 9 1 X 3 4 5 -9 1 2 3 4 X 6 7 8 -3 4 5 6 7 X 9 1 2 +1 2 3 4 5 6 7 8 9 +4 5 6 7 8 9 1 2 3 +7 8 9 1 2 3 4 5 6 +2 3 4 5 6 7 8 9 1 +5 6 7 8 9 1 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 c800785..76183c8 100644 --- a/src/Sudoku.hs +++ b/src/Sudoku.hs @@ -94,6 +94,9 @@ parseStringToGrid str = isValidVector :: Vector Cell -> Bool isValidVector = V.all (<= 1) . (numbers >>=) . (((pure . V.length) .) . (. (==)) . flip V.filter) +hasNoUnknownVector :: Vector Cell -> Bool +hasNoUnknownVector = V.all (/= Unknown) + isValidColumn :: Column -> Bool isValidColumn = isValidVector . coerce @@ -103,11 +106,23 @@ isValidRow = isValidVector . coerce isValidSquare :: Square -> Bool isValidSquare = isValidVector . getMatrixAsVector . coerce +hasNoUnknownColumn :: Column -> Bool +hasNoUnknownColumn = hasNoUnknownVector . coerce + +hasNoUnknownRow :: Row -> Bool +hasNoUnknownRow = hasNoUnknownVector . coerce + +hasNoUnknownSquare :: Square -> Bool +hasNoUnknownSquare = hasNoUnknownVector . getMatrixAsVector . coerce + getRow :: Int -> Grid -> Row getRow n | n > 0 && n <= 9 = Row . M.getRow n . coerce | otherwise = error "Indexing row outside of grid" +getRows :: Grid -> [Row] +getRows = (getRow <$> [1..9] <*>) . pure + getColumn :: Int -> Grid -> Column getColumn n | n > 0 && n <= 9 = Column . M.getCol n . coerce @@ -123,13 +138,22 @@ getSquare n | otherwise = error "Indexing square outside of grid" isValid :: Grid -> Bool -isValid g = and $ flip (parMap rpar) [1..9] +isValid g = and $ flip map [1..9] (\i -> let row = isValidRow (getRow i g) col = isValidColumn (getColumn i g) square = isValidSquare (getSquare i g) in row && col && square ) + +hasNoUnknown :: Grid -> Bool +hasNoUnknown g = and $ flip map [1..9] + (\i -> + let row = hasNoUnknownRow (getRow i g) + col = hasNoUnknownColumn (getColumn i g) + square = hasNoUnknownSquare (getSquare i g) + in row && col && square + ) updateCell :: Int -> Int -> Cell -> Grid -> Grid updateCell n m @@ -147,6 +171,15 @@ leftToPlace = getMatrixAsVector . coerce +leftToPlaceRow :: Row -> [Cell] +leftToPlaceRow = + ((V.toList numbers) \\ ) . + V.toList . + coerce + +findEmptyRow :: Row -> [(Int)] +findEmptyRow = V.toList . ((+1) <$>) . V.findIndices (== Unknown) . coerce + findEmpty :: Grid -> [(Int,Int)] findEmpty = V.toList . ((\n -> ((n) `div` 9 + 1, n `mod` 9 + 1)) <$>) . V.findIndices (== Unknown) . getMatrixAsVector . coerce @@ -154,14 +187,15 @@ 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 $ runEval (go [g] left) of - [] -> error "No solution D:" - [x] -> x - xs -> error (printf "%d solutions" $ length xs) - where go :: [Grid] -> [Cell] -> Eval [Grid] - go gs [] = filterM (pure . isValid) gs - go gs (x:xs) = filterM (pure . isValid) gs >>= - pure . (>>= \g' -> findEmpty g' >>= pure . (g',)) >>= - parList rdeepseq . ((uncurry $ flip (place x)) <$>) >>= - flip go xs +solve = runEval . go . pure + where go :: [Grid] -> Eval Grid + go gs = + case filter hasNoUnknown gs of + [] -> + parList rpar (gs >>= \g -> zip [(1 :: Int)..9] (getRows g) >>= \(i,v) -> findEmptyRow v >>= \j -> leftToPlaceRow v >>= pure . (i,j,,g)) >>= + parList rdeepseq . (>>= \(i,j,c,g) -> pure $ place c (i,j) g) >>= + filterM (pure . isValid) >>= \case + [] -> error "Uhoh" + xs -> go xs + + (x:_) -> () `pseq` pure x