diff options
| author | tomsmeding <tom.smeding@gmail.com> | 2018-09-01 21:47:21 +0200 |
|---|---|---|
| committer | tomsmeding <tom.smeding@gmail.com> | 2018-09-01 21:47:21 +0200 |
| commit | 64f0ef7212fca25e02fe4752e9a7dcfc4e4e36e5 (patch) | |
| tree | 18f65088490a476ec7e932abbc9f2b5ee577542e /hsolve | |
| parent | b99c4e415149f1881aecd2613a91fa6dbae0ed6b (diff) | |
hsolve: fix bug
Diffstat (limited to 'hsolve')
| -rw-r--r-- | hsolve/Main.hs | 38 | ||||
| -rw-r--r-- | hsolve/hsolve.cabal | 2 |
2 files changed, 2 insertions, 38 deletions
diff --git a/hsolve/Main.hs b/hsolve/Main.hs index 52a0edd..7d99854 100644 --- a/hsolve/Main.hs +++ b/hsolve/Main.hs @@ -6,7 +6,6 @@ import Control.Monad.Writer import Data.Char import Data.Either import Data.List -import Data.Maybe import System.Exit import qualified FSu @@ -353,7 +352,7 @@ scratchPossIndirectReg mainreg intregs' = intcells = [intersectReg mainreg intreg | intreg <- intregs] alloweds = [foldl possOr emptyPoss (map possOf l) | l <- intcells] valOnlyInWhich = -- [(index, value)] for each value in only one intersection - concat [maybe [] (\i -> [(val, i)]) (possGetIfInOne alloweds val) + concat [maybe [] (\i -> [(i, val)]) (possGetIfInOne alloweds val) | val <- [0..8]] in foldM (\su1 (i,v) -> scratchInRegionExcept @@ -376,41 +375,6 @@ scratchPossIndirect su = foldM (\su' (regc, intregs) -> scratchPossIndirectReg (regc su') intregs) su params --- scratchPossIndirectB :: Sudoku -> (Sudoku, [Action]) --- scratchPossIndirectB su = runWriter $ foldM bfunc su [0..8] --- where --- bfunc :: Sudoku -> Int -> SM Sudoku --- bfunc su' bi = --- let rowAllowed = flip map [0..2] $ --- \i -> [possOf $ cell (3 * i + j) (Block bi su') | j <- [0..2]] --- colAllowed = flip map [0..2] $ --- \i -> [possOf $ cell (3 * j + i) (Block bi su') | j <- [0..2]] --- rowIndices = scratchPairsFromAllowed rowAllowed --- colIndices = scratchPairsFromAllowed colAllowed --- in do --- rowsu <- foldM (\su1 (i,n) -> -- i: row number in block; n: value --- scratchInRegionExcept --- n (rowOf (cell (3 * i) (Block bi su1))) --- (Block bi su1) --- (RCombine (reasonReg (Block bi su1)) RRow)) --- su' rowIndices --- colsu <- foldM (\su1 (i,n) -> -- i: row number in block; n: value --- scratchInRegionExcept --- n (colOf (cell i (Block bi su1))) --- (Block bi su1) --- (RCombine (reasonReg (Block bi su1)) RCol)) --- rowsu colIndices --- return colsu - --- -- return [(index, n)] for all the n that occur in only one blockrow --- scratchPairsFromAllowed :: [[Poss]] -> [(Int, Value)] --- scratchPairsFromAllowed plists = --- let allowed = map (foldl1 possOr) plists --- in catMaybes $ --- map (\(mi,n) -> maybe Nothing (\i -> Just (i,n)) mi) $ --- -- v [(Just index if n exists in only one blockrow and else Nothing, n)] --- zip (map (possGetIfInOne allowed) [0..8]) [0..8] - resolveCells :: Sudoku -> (Sudoku, [Action]) resolveCells su = runWriter $ foldM func su [0..80] where diff --git a/hsolve/hsolve.cabal b/hsolve/hsolve.cabal index 4489d0b..66f2b3d 100644 --- a/hsolve/hsolve.cabal +++ b/hsolve/hsolve.cabal @@ -10,7 +10,7 @@ executable hsolve hs-source-dirs: . main-is: Main.hs default-language: Haskell2010 - ghc-options: -Wall -O3 -Wno-incomplete-patterns + ghc-options: -Wall -Wno-incomplete-patterns other-modules: FSu build-depends: base >= 4 && < 5, mtl, array |