summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2018-09-01 21:47:21 +0200
committertomsmeding <tom.smeding@gmail.com>2018-09-01 21:47:21 +0200
commit64f0ef7212fca25e02fe4752e9a7dcfc4e4e36e5 (patch)
tree18f65088490a476ec7e932abbc9f2b5ee577542e
parentb99c4e415149f1881aecd2613a91fa6dbae0ed6b (diff)
hsolve: fix bug
-rw-r--r--hsolve/Main.hs38
-rw-r--r--hsolve/hsolve.cabal2
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