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 ( 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, .