KenKen in Haskell

KenKen puzzle in Haskell

Page 1 of 1

3 Replies - 1521 Views - Last Post: 30 November 2010 - 05:57 PM

#1 priyan820   User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 2
  • Joined: 28-November 10

KenKen in Haskell

Posted 28 November 2010 - 10:47 PM

I have to implement a version of extendProblemInstance. This version ofextendProblemInstance should be given just a ProblemInstance and not a CellRef. Its job is first to determine which Cell should be expanded, and then to expand itóin the usual way.

If you go through the code, in the end you can see what needs to be implemented. Can anyone help me?
Thanks in advance.


I want to write KenKen program in Haskell language. KenKen is a puzzle.
Imports
import Data.List as List
import Data.Map as Map
import Data.Set as Set
import Debug.Trace

Type declarations
Input types
These types are used to represent the problem in its raw input form.
data Cage      = Cage {target :: CellValue
                      , op :: Op
                      , cageCells :: [CellRef]
                      } deriving (Eq, Ord, Show)

type KenKen    = [Cage]

data Op        = Add | Subtract | Multiply | Divide deriving (Show, Ord, Eq)
                    
-- The direction in which the solver scans the cells.
-- LR: Left to Right
-- RL: Right to Left
-- TB: Top to Bottom
-- BT: Bottom to Top        
data ScanDirection = LR | RL | TB | BT deriving (Show)
To run a test case (e.g., test_case_x), create a KenKen, which is a list of Cages, and include it in the source file. After the file is loaded, select a ScanDirection (e.g. LR for Left to Right) and run it at the prompt as follows. (Note that the ScanDirection is an enumerated type, not a String. Don't use quotation marks.)  For example, donít do it this way
Test data
testCage1 = Cage  0 Divide [(1, 2), (3, 1)]   -- 1 & 8. divide 1 8 produces 0,  but
                                              -- only because of the floor function.
                                              -- (cageSatisfied testGrid testCage1) 
                                              -- should return False.

testCage2 = Cage 10 Subtract [(2, 1), (4, 3)] -- 4 & 14. 4-14 /= 10, but 14-4 == 10.
                                              -- (cageSatisfied testGrid testCage2)
                                              -- should return True.

testGrid  = [  [0,  1,  2,  3]  -- This is not a valid KenKen grid, 
            ,  [4,  5,  6,  7]  -- but it can be used for testing.
            ,  [8,  9, 10, 11]  
            , [12, 13, 14, 15] 
            ]

 
 
kk4
kk4 =       [ Cage  1 Subtract [(1, 1), (2, 1)]
            , Cage  3 Subtract [(1, 2), (1, 3)]
            , Cage  2 Divide   [(1, 4), (2, 4)]
            , Cage 12 Multiply [(2, 2), (2, 3), (3, 3)]
            , Cage  3 Add      [(3, 1), (3, 2)]
            , Cage  4 Add      [(3, 4), (4, 4)]
            , Cage 24 Multiply [(4, 1), (4, 2), (4, 3)]
            ]
            
> solveKenKen kk4 TB
CellRef/Grids: (1,1)/4
CellRef/Grids: (1,2)/6
CellRef/Grids: (1,3)/4
CellRef/Grids: (1,4)/2
CellRef/Grids: (2,1)/4
CellRef/Grids: (2,2)/9
CellRef/Grids: (2,3)/12  -- Max possibilities
CellRef/Grids: (2,4)/8
CellRef/Grids: (3,1)/12  -- Max possibilities
CellRef/Grids: (3,2)/8
CellRef/Grids: (3,3)/1
CellRef/Grids: (3,4)/1
CellRef/Grids: (4,1)/1
CellRef/Grids: (4,2)/1
CellRef/Grids: (4,3)/1
CellRef/Grids: (4,4)/1  

 3 4 1 2
 2 1 3 4
 1 2 4 3
 4 3 2 1


> solveKenKen test_case_x LR

Problem representation types

The solution strategy is to scan the grid of cells in the ScanDirection and try all valid values for each cell. This generates a tree of possible solutions. Most of the branches will terminate, but presumably one will make it down to the end. That will be the solution. At each cell, children are generated for the possible values at that cell. But also at each cell values are checked against the constraints. No value is allowed to repeat in a row or column. No value is allowed that prevents a Cage from being satisfied.
Each combination Cell Values is stored as a ProblemInstance. A ProblemInstance contains four Maps:
 rowCandidateSetMap :: CandidateSetMap. For each row, there is a set of values that are still unused. As values are assigned, these sets shrink.
 colCandidateSetMap :: CandidateSetMap. For each column, there is a set of values that are still unused. As values are assigned, these sets shrink.
 cellsMap :: CellsMap. Initially, the Map is empty. As values are assigned to Cells, those assignments are stored in this Map. The CellsMap contains pairs of the following form: [((1, 2), 4), ((3, 2), 1), ... ]. That is, it's a Map that uses CellRef as the key and Cell as the value type.
 cageCombinationsMap :: CageCombinationsMap. Before the scan begins each Cage is given a list of the possible combinations of values that satisfy the Cage. During he Scan, no Cage computations are done since they are all pre-computed. As cells are assigned values, the possible combinations are pruned away. For example, assume that in a 4x4 game, we have a Cage that refers to cells C1 and C2 and that the Cage requires those two cells to produce a value of 2 using division. Pre-computing the possibilities, we store [(1, 2), (2, 1), (2, 4), (4, 2)] as the possible CageCombinations. When a cell (say C1) gets a value of (say) 2, we change the cageCombinations to be [(2, 1), (2, 4)]. The other possibilities ((1, 2) and (4, 2)) are no longer viable since the first cell (C1) now has a value of 2. The cageCombinationsMap stores for each Cage, the list of still viable combinations for that Cage.
type CageCombinations = [[CellValue]]  

type CageCombinationsMap = Map Cage CageCombinations  

type CandidateSetMap = Map Int ValueSet

data Cell      = Cell { cellRef :: CellRef 
                      , cage:: Cage
                      , position :: Int
                      , value:: CellValue
                      } deriving (Eq, Show)
     
row :: Cell -> Int
row cell = fst (cellRef cell)

col :: Cell -> Int
col cell = snd (cellRef cell)  

type CellsMap  = (Map CellRef Cell) 
         
type CellRef   = (Int, Int) -- Count starting with 1.

type CellValue = Int

data ProblemInstance =    
           None String 
         | ProblemInstance { rowCandidateSetMap  :: CandidateSetMap
                           , colCandidateSetMap  :: CandidateSetMap
                           , cellsMap            :: CellsMap 
                           , cageCombinationsMap :: CageCombinationsMap
                           } 

type ValueSet  = Set CellValue
Show
Code that formats the Cells in the CellsMap of a ProblemInstance as a 2-dimensional array.
instance Show ProblemInstance where
  show (None reason)   = "\r       No solutions: " ++ reason ++ "\n"
  show problemInstance = '\r' : ( formatChars 
                                . unlines 
                                . (Prelude.map show) 
                                . cellsMapTo2DValuesArray 
                                . cellsMap 
                                $ problemInstance
                                )
             


cellsMapTo2DValuesArray :: Map (Int, Int) Cell -> [[CellValue]] 
cellsMapTo2DValuesArray map =
    let mapList = List.sortBy 
                     (\ ((row1, col1), _) ((row2, col2), _) -> 
                           if      row1 <  row2 || row1 == row2 && col1 < col2  then LT
                           else if row1 == row2 && col1 == col2                 then EQ  -- should never happen
                           else                                                      GT )
                     (Map.toList map)
        ((rowMin, colMin), _) = head mapList
        ((rowMax, colMax), _) = last mapList
     in [ [ (\ cell -> value cell) cell | col <- [colMin .. colMax]
                                        , ((r, c), cell) <- mapList
                                        , r == row, c == col
          ] | row <- [rowMin .. rowMax]] 


formatChars :: [Char] -> [Char]
formatChars []             = []
formatChars (c:cs)
    | c == '['  = "  " ++ formatChars cs
    | c == ','  = " "  ++ formatChars cs
    | c == ']'  =         formatChars cs
    | otherwise =     c : formatChars cs
Operation API
applyOp :: Op -> [CellValue] -> CellValue
applyOp op cells = foldr (opFn op) (idElt op) cells


divide :: CellValue -> CellValue -> CellValue
divide a b = floor ((fromIntegral a) / (fromIntegral B)/>)


idElt :: Op -> CellValue
idElt Add = 0
idElt Multiply = 1


opFn :: Op -> CellValue -> CellValue -> CellValue
opFn Add = (+)
opFn Subtract = (-)
opFn Multiply = (*)
opFn Divide =  divide 


opSatisfied :: Op -> [CellValue] -> CellValue -> Bool
opSatisfied op values target
    | length values > 2 || op == Multiply || op == Add = (applyOp op values)       == target
    | length values == 1            = (head values) == target 
    | op == Subtract = (opFn op) (values!!0) (values!!1) == target || (opFn op) (values!!1) (values!!0) == target
    | op == Divide = 
                ((values!!0) `mod` (values!!1)) == 0 && (opFn op) (values!!0) (values!!1) == target 
             || ((values!!1) `mod` (values!!0)) == 0 && (opFn op) (values!!1) (values!!0) == target
  
 

Build initial ProblemInstance
The user call is solveKenKen. Create an initial ProblemInstance and call findSolutions to look for solutions.
{-  This is copied here for reference. 
ProblemInstance { rowCandidateSetMap  :: CandidateSetMap
                , colCandidateSetMap  :: CandidateSetMap
                , cellsMap            :: CellsMap 
                , cageCombinationsMap :: CageCombinationsMap
                }
-}           
 

buildProblemInstance :: KenKen -> ValueSet -> ProblemInstance        
buildProblemInstance kenken valueSet = 
    let size = Set.size valueSet
        cellsMap = makeCellsMap kenken size
        candidateSetsMap = Map.fromList (zip [1 .. size] (replicate size valueSet))
        cageCombinationsMap = makeCageCombinationsMap kenken valueSet
    in ProblemInstance candidateSetsMap candidateSetsMap cellsMap cageCombinationsMap
            

findCage :: CellRef -> KenKen -> Cage
findCage cellRef kenken = head [cage| cage <- kenken, cellRef `elem` (cageCells cage)] 


indexOf :: (Eq a) => a -> [a] -> Int
indexOf y [] = minBound :: Int   
indexOf y (x:xs)   
   | y == x = 0
   | otherwise = 1 + indexOf y xs  

       
makeCageCombinations :: Cage -> ValueSet -> CageCombinations
makeCageCombinations cage valueSet = 
    [ combination | combination <- xProduct (length . cageCells $ cage) (Set.toList valueSet) [[]]
                  , opSatisfied (op cage) combination (target cage)]
                                                  
       
makeCageCombinationsMap :: KenKen -> ValueSet -> CageCombinationsMap
makeCageCombinationsMap kenken valueSet = 
    foldr
         (\ cage map -> Map.insert cage (makeCageCombinations cage valueSet) map)
         Map.empty
         kenken


makeCellsMap :: KenKen -> Int -> CellsMap          
makeCellsMap kenken size =
    foldr 
         (\cell map -> Map.insert (row cell, col cell) cell map )
         Map.empty 
         [ Cell cellRef cage cagePosition nullValue  | row <- [1 .. size]
                                                     , col <- [1 .. size]
                                                     , let cellRef = (row, col)
                                                           cage = (findCage cellRef kenken)
                                                           cagePosition = indexOf cellRef (cageCells cage)
         ]          
         
         
nullValue :: CellValue
nullValue = 0 


-- This is the main function.
solveKenKen:: KenKen -> ScanDirection -> ProblemInstance
solveKenKen kenken scanDirection = 
    let cellRefsInCages = concat . (Prelude.map cageCells) $ kenken
        size = maximum . (Prelude.map fst) $ cellRefsInCages 
        missingCells = [(x, y) | x <- [1 .. size], y <- [1 .. size], not (elem (x, y) cellRefsInCages )]
    in 
       if not . Prelude.null $ missingCells then None ("Missing cells: " ++ show missingCells) else
          let valueSet = (Set.fromList [1 .. size])
              initialProbInst = buildProblemInstance kenken valueSet
              problemInstances = findSolutions initialProbInst scanDirection size 
          in if Prelude.null problemInstances then None "No solutions found" else head problemInstances

     
xProduct :: Int -> [a] -> [[a]] -> [[a]]           
xProduct n values soFar 
       | (length . head $ soFar) == n = soFar
       | otherwise = xProduct n values [ x:xs | x <- values, xs <- soFar ]


Search
The search algorithm. The strategy is to instantiate Cells one by one. Every time a Cell is instantiated each possible value is used to extend the current ProblemInstance. So if a Cell can be instantiated n ways in a given ProblemInstance, that ProblemInstance generates n child ProblemInstances. The danger is explosive growth of possible ProblemInstances.
As an example, consider the 4x4 puzzle, showed in the begiining.
 Initially there are no cells filled in.
 The first round attempts to fill in cell (1, 1). Any of [1 .. 4] can conceivably be put there. So there are now 4 possibilities.
 Then for each of those four possibilities, we try to fill in (1, 2). The cage at [(1, 2), (1, 3)] can contain only these two possibilities: [1, 4], and [4, 1]. So (1, 2) can contain only 1 or 4.
 In the case where (1, 1) contains 1, (1, 2) may contain only 4.
 In the case where (1, 1) contains 2, (1, 2) may contain either 1 or 4.
 In the case where (1, 1) contains 3, (1, 2) may contain either 1 or 4.
 In the case where (1, 1) contains 4, (1, 2) may contains only 1.
That gives us 6 possibilities for filling in the first two cells: [1, 4], [2, 1], [2, 4], [3, 1], [3, 4], and [4, 1].
 For each of these 6 we try to fill in (1, 3). The possibilities are: [2, 1, 4], [2, 4, 1], [3, 1, 4], and [3, 4, 1]. The other extensions would violate the row constraint or the cage constraint.
 For each of these 4 we try all possibilities for (1, 4). They are [3, 1, 4, 2], and [3, 4, 1, 2].
 Then we move on to row 2. Since (1, 1) must contain 3, the cell at (2, 1) must contain either 2 or 4. Either one works with the two possibilities we had after row 1. So now we have 4 possibilities. Etc.

We implement this algorithm as follow. When a Cell is instantiated the only values that are allowed are those (a) that do not already appear in either the Cell's row or column and (B) thatstill do appear in the Cell's position in at least one of the combinations remaining in the Cage that constrains the Cell.
When a Cell is given a value, that value is removed from the list of values kept as still available for the Cell's row and from the list of values kept as still available for the Cell's column. These are the rowCandidatesSet and columnCandidatesSet kept in the rowCandidatesSetMap and the columnCandidatesSetMap whose key is the Cell's row and column numbers.

In addition, the list of combinations stored for the Cell's Cage is pruned to eliminate all those that do not contain the Cell's assigned number at the Cell's position. This generally reduces the size of the list of Cage possibilities significantly. See extendProblemInstance for how this is done.
The order in which Cell's are considered is currently determined by the ScanDirection. It would be significantly more efficient to consider Cells in order of most constrained first. A good way to do that is to keep the Cage possibilities list sorted. To determine which Cell to instantiate next, select a Cage with the smallest number of viable possibilities and instantiate one of its Cell's.
Once a Cell has been instantiated, no other Cell in the same row or column may have the same number. That reduces both the rowCandidatesSet and the columnCandidatesSetassociated with that Cell. It also is likely to reduce the possibilities for Cages for other Cells in the Cell's row and column.
Once all those Sets are updated, the Cage with the smallest number of possibilities is selected for the next instantiation.

Things That needs to be implemented

This will require that you implement your own version of extendProblemInstance. Your version ofextendProblemInstance should be given just a ProblemInstance and not a CellRef.

extendProblemInstance :: ProblemInstance -> [ProblemInstance]

Its job is first to determine which Cell should be expanded, and then to expand itóin the usual way.
extendProblemInstances :: CellRef -> [ProblemInstance] -> [ProblemInstance]
extendProblemInstances cellRef problemInstances = 
   let newProblemInstancesList = 
         [ newProblemInstance | problemInstance <- problemInstances
                              , newProblemInstance <- extendProblemInstance cellRef problemInstance 
                              ]
   in trace ("CellRef/Grids: " ++ show cellRef ++ "/" ++ show (length newProblemInstancesList))
            newProblemInstancesList


extendProblemInstance :: CellRef -> ProblemInstance -> [ProblemInstance]     

extendProblemInstance [email protected](row, col) problemInstance = 
        -- Note that Just is required because of the type of the library function Map.lookup.
        -- Map.lookup :: (Ord k) => k -> Map k a -> Maybe a
        -- In general Map.lookup may or may not succeed. In our case it will always succeed.

   let Just cell = Map.lookup cellRef (cellsMap problemInstance)
       Just rowCandidatesSet = Map.lookup row (rowCandidateSetMap problemInstance)
       Just colCandidatesSet = Map.lookup col (colCandidateSetMap problemInstance)
       candidates = (Set.intersection rowCandidatesSet colCandidatesSet)
       Just cageCombs = Map.lookup (cage cell) (cageCombinationsMap problemInstance)
   in if Prelude.null cageCombs then [] else
     [ updateProblemInstance problemInstance newRowCandidates newColCandidates cellRef newCell newCageCombinations
            | x <- Set.toList candidates
            , let newCageCombinations = 
                     [ cageComb | cageComb <- cageCombs, x == cageComb!!(position cell) ]
            , not . Prelude.null $ newCageCombinations
            , let newCell          = cell {value = x} 
                  newRowCandidates = Set.delete x rowCandidatesSet
                  newColCandidates = Set.delete x colCandidatesSet
            ]
                
               
findSolutions :: ProblemInstance -> ScanDirection -> Int -> [ProblemInstance]
findSolutions problemInstance scanDirection size = 
    tailRecursionEngine
        (\((row, col), problemInstances) -> 
                  row > size || col > size || row < 1 || col < 1 || Prelude.null problemInstances)
        (\(_, problemInstances) -> problemInstances)
        (\(cellRef, problemInstances) ->  
              (nextCellRef cellRef scanDirection size, extendProblemInstances cellRef problemInstances))
        (startingCellRef scanDirection size, [problemInstance])  
        
            
nextCellRef :: CellRef -> ScanDirection -> Int -> CellRef
nextCellRef (row, col) LR size = 
     let needNextCol = row == size
     in (if needNextCol then 1 else row+1, if needNextCol then col + 1 else col)
nextCellRef (row, col) RL size = 
     let needNextCol = row == size
     in (if needNextCol then 1 else row+1, if needNextCol then col - 1 else col)
nextCellRef (row, col) TB size = 
     let needNextRow = col == size
     in (if needNextRow then row + 1 else row, if needNextRow then 1 else col+1)
nextCellRef (row, col) BT size = 
     let needNextRow = col == size
     in (if needNextRow then row - 1 else row, if needNextRow then 1 else col+1)


startingCellRef :: ScanDirection -> Int -> CellRef
startingCellRef LR size = (1, 1)
startingCellRef RL size = (1, size)
startingCellRef TB size = (1, 1)
startingCellRef BT size = (size, 1)

                
tailRecursionEngine
  :: (t1 -> Bool) -> (t1 -> t) -> (t1 -> t1) -> t1 -> t            
tailRecursionEngine termCond termFn wayAheadFn = 
  tailRecursiveFn
  where tailRecursiveFn y
           | termCond y = termFn y
           | otherwise = (tailRecursiveFn (wayAheadFn y))


updateProblemInstance :: 
       ProblemInstance -> ValueSet -> ValueSet -> CellRef -> Cell -> CageCombinations -> ProblemInstance
updateProblemInstance problemInstance newRowCandidates newColCandidates [email protected](row, col) newCell cageCombinations =  
   let newRowCandidateSetMap  = Map.insert row            newRowCandidates (rowCandidateSetMap problemInstance)
       newColCandidateSetMap  = Map.insert col            newColCandidates (colCandidateSetMap problemInstance)
       newCellsMap            = Map.insert cellRef        newCell          (cellsMap problemInstance)
       newCageCombinationsMap = Map.insert (cage newCell) cageCombinations (cageCombinationsMap problemInstance)
   in  ProblemInstance newRowCandidateSetMap newColCandidateSetMap newCellsMap newCagCombinationsMap



Edited by macosxnerd101: Please, :code:.

Is This A Good Question/Topic? 0
  • +

Replies To: KenKen in Haskell

#2 macosxnerd101   User is online

  • Games, Graphs, and Auctions
  • member icon




Reputation: 12316
  • View blog
  • Posts: 45,416
  • Joined: 27-December 08

Re: KenKen in Haskell

Posted 28 November 2010 - 10:55 PM

Moved to Functional Programming.
Was This Post Helpful? 0
  • +
  • -

#3 priyan820   User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 2
  • Joined: 28-November 10

Re: KenKen in Haskell

Posted 29 November 2010 - 11:22 AM

This is the code that looks for solutions. Its strategy is to step cell-by-cell through the grid keeping track of all the possible combinations of cell values. It does this by keeping a list of all of the possibilities. Each possibility is represented by its own ProblemInstance. The central function is findSolutions. It uses tail recursion. At each step it expands each of theProblemInstances in its list of ProblemInstances to get a new list of ProblemInstances. In some cases the new list will be longer. In others it will be shorter. The list will shrink when there is no viable extension for one or more ProblemInstance.
extendProblemInstances extends the list of ProblemInstances. It does so by calling extendProblemInstance on each ProblemInstance in its list and collecting the results together.
extendProblemInstance is the workhorse. It tries all possible values for the CellRef to be extended and updates and returns a list of the ProblemInstances for those that succeed

 extendProblemInstances :: CellRef -> [ProblemInstance] -> [ProblemInstance]
extendProblemInstances cellRef problemInstances = 

   -- For each current ProblemInstance generate a list (possibly empty) of new ones.
   let newProblemInstancesList = concatMap (extendProblemInstance cellRef) problemInstances 

   -- This is where the trace values are printed.
   in trace ("CellRef/Grids: " ++ show cellRef ++ "/" ++ show (length newProblemInstancesList))
            newProblemInstancesList


extendProblemInstance :: CellRef -> ProblemInstance -> [ProblemInstance]     
extendProblemInstance [email protected](row, col) problemInstance = 
   let cell = getCell cellRef problemInstance
   in 
     [ newProblemInstance { cellsMap = Map.insert cellRef newCell newCellsMap }
            | newCellValue <- Set.toList (candidates cell)

              -- The trick here is that we are both updating the CageCombinations while
              -- checking to see that no CageCombination becomes empty. viable is 
              -- True or False depending on whether all CageCombination are still
              -- non-empty, which means that the generated ProblemInstance is viable.
            , let (viable, newProblemInstance) = 
                                updateCageCombinationsMap problemInstance cellRef newCellValue 
            , viable -- If viable is False the current newCellValue is discarded.
            , let newCell     = cell { value = newCellValue, candidates = Set.empty } 
                  newCellsMap = deleteCellValue cellRef newCellValue (cellsMap problemInstance)
            ] 

                
               
findSolutions :: ProblemInstance -> ScanDirection -> Int -> [ProblemInstance]
findSolutions problemInstance scanDirection size = 
    tailRecursionEngine
        (\((row, col), problemInstances) -> 
                  row > size || col > size || row < 1 || col < 1 || Prelude.null problemInstances)
        (\(_, problemInstances) -> problemInstances)
        (\(cellRef, problemInstances) ->  
              (nextCellRef cellRef scanDirection size, extendProblemInstances cellRef problemInstances))
        (startingCellRef scanDirection size, [problemInstance])  
        
            
getCage :: CellRef -> ProblemInstance -> Cage
getCage cellRef problemInstance = cage (getCell cellRef problemInstance)


getCell :: CellRef -> ProblemInstance -> Cell
getCell cellRef problemInstance = 
    let Just cell = Map.lookup cellRef (cellsMap problemInstance)
    in cell    -- Since all Cell lookups will succeed, strip the Just away.
    


nextCellRef :: CellRef -> ScanDirection -> Int -> CellRef
nextCellRef (row, col) LR size = 
     let needNextCol = row == size
     in (if needNextCol then 1 else row+1, if needNextCol then col + 1 else col)
nextCellRef (row, col) RL size = 
     let needNextCol = row == size
     in (if needNextCol then 1 else row+1, if needNextCol then col - 1 else col)
nextCellRef (row, col) TB size = 
     let needNextRow = col == size
     in (if needNextRow then row + 1 else row, if needNextRow then 1 else col+1)
nextCellRef (row, col) BT size = 
     let needNextRow = col == size
     in (if needNextRow then row - 1 else row, if needNextRow then 1 else col+1)


startingCellRef :: ScanDirection -> Int -> CellRef
startingCellRef LR size = (1, 1)
startingCellRef RL size = (1, size)
startingCellRef TB size = (1, 1)
startingCellRef BT size = (size, 1)

                
tailRecursionEngine :: (t1 -> Bool) -> (t1 -> t) -> (t1 -> t1) -> t1 -> t            
tailRecursionEngine termCond termFn wayAheadFn = 
  tailRecursiveFn
  where tailRecursiveFn y
           | termCond y = termFn y
           | otherwise = (tailRecursiveFn (wayAheadFn y))


updateAndReplaceCageCombinations 
     :: CellRef -> CellValue -> CellRef -> (Bool, ProblemInstance) -> (Bool, ProblemInstance) 
updateAndReplaceCageCombinations newCellRef newCellValue cellRef (bool, problemInstance) 
      | not bool = (bool, problemInstance) 
      | otherwise =
           let cell = getCell cellRef problemInstance
               cageCombsMap = cageCombinationsMap problemInstance
               cellCage = getCage cellRef problemInstance
               Just cageCombs = Map.lookup cellCage cageCombsMap
               newCageCombs = updateCageCombs (newCellRef == cellRef) (position cell) newCellValue cageCombs
               newCageCombsMap =  Map.insert cellCage newCageCombs cageCombsMap
               newProblemInstance = problemInstance { cageCombinationsMap = newCageCombsMap }
           in ( not . Prelude.null $ newCageCombs, newProblemInstance )
        

updateCageCombinationsMap :: ProblemInstance -> CellRef -> CellValue -> (Bool, ProblemInstance)
updateCageCombinationsMap problemInstance [email protected](row, col) cellValue =

       -- These are the CellRefs of Cells in the same row or column.
       -- nub removes duplicates and prevents (row, col) from appearing twice.
   let rowColRefs = nub ( concat [ [(row, k), (k, col)] | k <- [1 .. (piSize problemInstance) ] ] ) 
   in  foldr (updateAndReplaceCageCombinations cellRef cellValue) (True, problemInstance) rowColRefs
   
   
updateCageCombs :: Bool -> Int -> CellValue -> CageCombinations -> CageCombinations
updateCageCombs bool cellPos cellValue cageCombs =

    -- The CageCombinations that either do or don't have cellValue at position pos.
    -- bool is True if we want cellValue at position pos; False otherwise. 
   [ cageComb | cageComb <- cageCombs
              , let theSame = cellValue == cageComb!!cellPos
              , if bool then theSame else not theSame
              ]


updateCell :: CellRef -> CellValue -> (CellRef, Cell) -> (CellRef, Cell)

-- (row, col) is the CellRef of the Cell being expanded.               
-- cellValue  is the new value for that Cell.               
-- ((row', col'), cell') is a CellRef and Cell from the CellsMap.               
-- It is the Cell being updated.               
updateCell (row, col) cellValue ((row', col'), cell') 
  | (row, col) == (row', col') = ((row', col'), cell'{value = cellValue, candidates = Set.empty})
  | row == row' || col == col' = ((row', col'), cell'{candidates=Set.delete cellValue (candidates cell')})
  | otherwise                  = ((row', col'), cell')
 

updateCellsMap :: CellRef -> CellValue -> CellsMap -> CellsMap
updateCellsMap cellRef cellValue cellsMap = 

   -- Update every Cell in the CellsMap.               
   Map.fromList [ updateCell cellRef cellValue cellRefCell | cellRefCell <- Map.toList cellsMap ]
 



The order in which Cell's are considered is currently determined by the ScanDirection. I am trying to make it more efficient to consider Cells in order of most constrained first.
I think, a good way to do that is to select as the next Cell to be expanded the one whose candidates list is the smallest. If there are several Cells that have the same number of candidates, use the one with the smallest number of Cage combinations. If there are several that are minimal on each, pick one.

I have to modify findSolutions so that it looks for the most constrained Cell to expand next. Other than eliminating the ScanDirection argument tosolveKenKen. Does anyone have idea of how to modify findSolutions so everything else remains the same?
Was This Post Helpful? 0
  • +
  • -

#4 Raynes   User is offline

  • D.I.C Lover
  • member icon

Reputation: 614
  • View blog
  • Posts: 2,815
  • Joined: 05-January 09

Re: KenKen in Haskell

Posted 30 November 2010 - 05:57 PM

[rules][/rules]
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1