higher order functions riddle solving function in haskell

Question

I am trying to recreate a riddle with pyramid:

The last layer of the pyramid is the permutation of the numbers from 1 to n, where n is the number of fields. Then every other field that is not in the lowest layer is the sum of the numbers diagonally under that number.

So I want to make a function that when given the riddle on the left returns solutions on the right. I was planning to do that by enumerating layers like this:

for the layers I made a custom data type:

data Layer = One | Two | Three | Four | Five | Six
deriving (Eq,Ord,Enum,Show)

and other types:

type LayerDepth = Layer
type FieldNumber = Int
type FieldContent = Int
type FieldAssignment = (FieldNumber -> FieldContent)
type PyramidRiddle = FieldAssignment
type PyramidSolution = FieldAssignment
type PyramidSolutions = [PyramidSolution]

and the function:

solveRiddle :: LayerDepth -> PyramidRiddle -> Pyramidsolutions

for the illustrated example I would make anonymous function of type (FieldNumber -> FieldContent):

fieldAssignment1 = \n -> if (n==6) || n==8) then 3 else 0

This function will mark 6th and 8th field with number 3

Then calling: solveRiddle Four fieldAssignment1 ->> [pyramidSolution1, pyramidSolution2]

Four means four layers, and PyramidSolutions is the list of FieldAssignments that has a solutions of the riddle

My problem:

I would somehow need to return a function that will given the field assignment calculate the permutations in the last layer and based on that assign the numbers to the rest of fields.

Somehow like this:

pyramidSolution1 = \n -> case n of 1 -> 18
                                   2 -> 11 
                                   3 -> 7
                                   4 -> 7 
                                   5 -> 4 
                                   6 -> 3 
                                   7 -> 4 
                                   8 -> 3 
                                   9 -> 1 
                                  10 -> 2
                                   _ -> 0 

and

pyramidSolution2 = \n -> case n of 1 -> 20
                                   2 -> 12 
                                   3 -> 8
                                   4 -> 7 
                                   5 -> 5 
                                   6 -> 3 
                                   7 -> 4 
                                   8 -> 3 
                                   9 -> 2 
                                  10 -> 1
                                   _ -> 0 

But what is the best way to approach this?

How do I assign a permutation of the numbers and know how to place them that the number up is the sum of the numbers bellow?

What is the best way to implement the anonymous function pyramidSolution1 and pyramidSolution2 into the code above?

Answer 1

I'd simplify this a little. A layer is a list of numbers:

type Layer = [Int]
-- e.g. [4,3,1,2]

A rule is a list of fixed assignments to some elements.

data Must = Any | Only Int  -- Yes, it's just Maybe with different labels

type Rule = [Must]
-- e.g. [Any,Only 3,Any,Any]

You'll need a function that can generate a layer from the one below it:

nextLayer :: Layer -> Layer
nextLayer = undefined
-- nextLayer [4,3,1,2] == [7,4,3]

and a function to check a layer against a valid rule

isLayerValid :: Rule -> Layer -> Bool
isLayerValid = undefined
-- isLayerValid [Any,Any,Only 3] [1,2,3] == True
-- isLayerValid [Any,Any,Only 3] [1,3,2] == False

A riddle is just a list of rules:

type Riddle = [Rule]
riddle :: Riddle
riddle = [[Any, Only 3, Any, Any], [Any, Any, Only 3], [Any, Any], [Any]]

and a solution is a list of layers starting from some base.

type Pyramid = [Layer]
pyramid :: Layer -> Pyramid
pyramid [] = []
pyramid base = base : pyramid (nextLayer base)
-- pyramid [4,3,1,2] == [[4,3,1,2],[7,4,3],[11,7],[18]]

A correct solution is one that validates against a given riddle:

isValidFor :: Riddle -> Pyramid -> Bool
isValidFor [] [] = True
isValidFor (r:rs) (x:xs) = isLayerValid r x && isValidFor rs xs
-- isValidFor riddle (pyramid [4,3,1,2]) == True
-- isValidFor riddle (pyramid [1,3,4,2]) == False

The trick now is to generate all potential solutions

permutations :: [Int] -> [[Int]]
permutations ns = undefined

-- e.g. allSolutions = map pyramid (permutations [1..n])

and filter them using your solution test:

solutions :: Riddle -> [Pyramid]
solutions r = filter (isValidFor r) (map pyramid (permutations [1..length r]))
-- solutions riddle == [pyramid [4,3,1,2], pyramid [4,3,2,1]]