SPOILER: This is Project Euler problem #18. READ AT YOUR OWN RISK
The problem is to find the "maximal sum" of all the non-deterministic paths from the top of a pascal triangle going strictly downward to the bottom. I am trying to calculate the sums by doing a fold over the rows of the triangle.
Here is the input string, and some basic preparations:
inputLines = ["75",
"95 64",
"17 47 82",
"18 35 87 10",
"20 04 82 47 65",
"19 01 23 75 03 34",
"88 02 77 73 07 63 67",
"99 65 04 28 06 16 70 92",
"41 41 26 56 83 40 80 70 33",
"41 48 72 33 47 32 37 16 94 29",
"53 71 44 65 25 43 91 52 97 51 14",
"70 11 33 28 77 73 17 78 39 68 17 57",
"91 71 52 38 17 14 91 43 58 50 27 29 48",
"63 66 04 68 89 53 67 30 73 16 69 87 40 31",
"04 62 98 27 23 09 70 98 73 93 38 53 60 04 23"]
input = map (map (read ::String ->Integer) . words) inputLines
prepareElems :: [[Integer]] -> [[Elem Integer]]
prepareElems = map mkElemsFromTri
There are two ideas here - having the row of a tree, and having a row of the triangle. I didn't do very much type-level abstraction, but that should not matter as much. The idea is that every row in the triangle is a "parallel enumeration" of binomials across it's length (ie: [(4,0), (3,1), (2,2), ... (0,4)]), and every row of the tree get's "copy-forked" before the labelled triangle row is applied to the tree's row, making sure that the non-determinism's integrity is retained at each opportunity to fork. Here is what my technique looks like:
data BiLabel = BiLabel Integer Integer
deriving (Show, Eq)
leftLabel (BiLabel x _) = x
rightLabel (BiLabel _ y) = y
parEnumBiLabel :: Integer -> [BiLabel]
parEnumBiLabel n = map ( \x ->BiLabel x $ (n-1)-x ) [0..(n-1)]
forkBiLabel :: BiLabel -> (BiLabel, BiLabel)
forkBiLabel (BiLabel x y) = (BiLabel (x+1) y,BiLabel x (y+1))
data Elem a = Elem {label :: BiLabel, element :: a}
deriving (Show, Eq)
forkElem :: Elem a -> [Elem a]
forkElem (Elem l a) = [Elem left a,Elem right a]
where
(left,right) = forkBiLabel l
-- Does a binomial expansion, but cloning the elements and making new labels
cloneNextLevel :: [Elem Integer] -> [Elem Integer]
cloneNextLevel = concatMap forkElem
My issue is that the code works for one row of input, but is failing when folding over multiple rows. My gut is telling me that my "copy-fork" technique is creating new labels before my overElems function can apply via the labels it expects to have access to. Here are my main functions:
-- this applys a 1-ary function to all Elems of a list that match the label
onLabel :: (a -> a) -> BiLabel -> [Elem a] -> [Elem a]
onLabel f (BiLabel la lb) (x:xs) | label x == BiLabel la lb = processHead : processTail
| otherwise = x : processTail
where
processHead = Elem (BiLabel la lb) $ f (element x)
processTail = onLabel f (BiLabel la lb) xs
onLabel _ _ [] = []
-- this _tries_ to do the equivalent of `onLabel`, but over lists and 2-ary functions
overElems :: (a -> a -> a) -> [Elem a] -> [Elem a] -> [Elem a]
overElems f (x:xs) ys = overElems f xs ( onLabel (f $ element x) (label x) ys )
overElems _ [] ys = ys
-- This starts with the first element of `input` as an accumulator, just because
-- then I won't have to copy it over as part of the fold, and can simply
-- `cloneNextLevel` before I process it with `overElems`.
calculate :: [[Elem Integer]] -> [Elem Integer]
calculate = foldr (\z acc -> overElems (+) z (cloneNextLevel acc)) [Elem (BiLabel 0 0) (head $ head input)]
The strange thing is that folding over one row works, but folding over multiple fails to do apply the higher order function, yet still expands the result to the correct size. Here are a couple example inputs:
\> calculate $ prepareElems [[2,3]]
[Elem {label = BiLabel 1 0, element = 78},Elem {label = BiLabel 0 1, element = 77}]
-- that's correct, because the first element of the tree is 75
\> calculate $ prepareElems [[2,3],[10,20,30]]
[Elem {label = BiLabel 2 0, element = 75},Elem {label = BiLabel 1 1, element = 75},
Elem {label = BiLabel 1 1, element = 75},Elem {label = BiLabel 0 2, element = 75}]
-- this is the correct size and labeling, but not the right contents.
Would lazyness in my list processing cause this? My sense is that label enumeration is happening before overWith has a chance to apply the function via labels. Here is a full page of my code, too.
