From 146e50dc00e877b56f0bd74875526e8649c81646 Mon Sep 17 00:00:00 2001
From: tomsmeding <tom.smeding@gmail.com>
Date: Sat, 1 Sep 2018 21:51:17 +0200
Subject: hsolve: Renaming, reordering
---
hsolve/Main.hs | 43 ++++++++++++++++++++++---------------------
1 file changed, 22 insertions(+), 21 deletions(-)
(limited to 'hsolve')
diff --git a/hsolve/Main.hs b/hsolve/Main.hs
index 7d99854..6a9424d 100644
--- a/hsolve/Main.hs
+++ b/hsolve/Main.hs
@@ -316,6 +316,16 @@ writeReason (RBlockI i) = "situation in block " ++ show i
writeReason (RCombine a b) = writeReason a ++ "; " ++ writeReason b
+scratchPossBasicRegion :: Region -> Sudoku
+scratchPossBasicRegion reg = maskPoss reg (listPoss $ [0..8] \\ values reg)
+
+scratchAroundCell :: Region -> Sudoku
+scratchAroundCell cl@(Cell _ _) =
+ let su1 = scratchPossBasicRegion (rowOf cl)
+ su2 = scratchPossBasicRegion (colOf (adaptRegion cl su1))
+ su3 = scratchPossBasicRegion (blockOf (adaptRegion cl su2))
+ in su3
+
scratchInRegionExcept :: Value -> Region -> Region -> Reason -> SM Sudoku
scratchInRegionExcept val reg except reason =
foldM (\su i ->
@@ -329,22 +339,12 @@ scratchInRegionExcept val reg except reason =
(sudokuOf reg) (indexRange reg)
-scratchPossBasic :: Sudoku -> (Sudoku, [Action])
-scratchPossBasic su =
+tacticPossBasic :: Sudoku -> (Sudoku, [Action])
+tacticPossBasic su =
let su1 = foldl (\su' regc -> scratchPossBasicRegion (regc su'))
su (concat [[Row i, Col i, Block i] | i <- [0..8]])
in (su1, [])
-scratchPossBasicRegion :: Region -> Sudoku
-scratchPossBasicRegion reg = maskPoss reg (listPoss $ [0..8] \\ values reg)
-
-scratchAroundCell :: Region -> Sudoku
-scratchAroundCell cl@(Cell _ _) =
- let su1 = scratchPossBasicRegion (rowOf cl)
- su2 = scratchPossBasicRegion (colOf (adaptRegion cl su1))
- su3 = scratchPossBasicRegion (blockOf (adaptRegion cl su2))
- in su3
-
scratchPossIndirectReg :: Region -> [Region] -> SM Sudoku
scratchPossIndirectReg mainreg intregs' =
let intregs = filter (\intreg -> not $ null $ intersectReg mainreg intreg) intregs'
@@ -362,8 +362,8 @@ scratchPossIndirectReg mainreg intregs' =
(RCombine (reasonReg mainreg) (reasonReg (intregs !! i))))
su valOnlyInWhich
-scratchPossIndirect :: Sudoku -> (Sudoku, [Action])
-scratchPossIndirect su =
+tacticPossIndirect :: Sudoku -> (Sudoku, [Action])
+tacticPossIndirect su =
let blocks = [Block i su | i <- [0..8]]
rows = [Row i su | i <- [0..8]]
cols = [Col i su | i <- [0..8]]
@@ -375,8 +375,8 @@ scratchPossIndirect su =
foldM (\su' (regc, intregs) -> scratchPossIndirectReg (regc su') intregs)
su params
-resolveCells :: Sudoku -> (Sudoku, [Action])
-resolveCells su = runWriter $ foldM func su [0..80]
+tacticResolveCells :: Sudoku -> (Sudoku, [Action])
+tacticResolveCells su = runWriter $ foldM func su [0..80]
where
func :: Sudoku -> Int -> SM Sudoku
func su' i = case possList (su' `atp` i) of
@@ -386,8 +386,9 @@ resolveCells su = runWriter $ foldM func su [0..80]
return $ scratchAroundCell (cell i su1)
_ -> return su'
-resolveRegions :: Sudoku -> (Sudoku, [Action])
-resolveRegions su = runWriter $ foldM func su [f i | f <- [Row, Col, Block], i <- [0..8]]
+tacticResolveRegions :: Sudoku -> (Sudoku, [Action])
+tacticResolveRegions su =
+ runWriter $ foldM func su [f i | f <- [Row, Col, Block], i <- [0..8]]
where
func :: Sudoku -> (Sudoku -> Region) -> SM Sudoku
func su' regc =
@@ -406,9 +407,9 @@ resolveRegions su = runWriter $ foldM func su [f i | f <- [Row, Col, Block], i <
operations :: [Sudoku -> (Sudoku, [Action])]
operations = [
- scratchPossBasic, scratchPossIndirect,
- resolveCells,
- resolveRegions]
+ tacticPossBasic, tacticPossIndirect,
+ tacticResolveCells,
+ tacticResolveRegions]
solve :: Sudoku -> [(Sudoku, [Action])]
solve su =
--
cgit v1.2.3-70-g09d2