variant of pascal's triangle in haskell - problem with lazy evaluation - algorithm

To solve some problem I need to compute a variant of the pascal's triangle which is defined like this:
f(1,1) = 1,
f(n,k) = f(n-1,k-1) + f(n-1,k) + 1 for 1 <= k < n,
f(n,0) = 0,
f(n,n) = 2*f(n-1,n-1) + 1.
For n given I want to efficiently get the n-th line (f(n,1) .. f(n,n)). One further restriction: f(n,k) should be -1 if it would be >= 2^32.
My implementation:
next :: [Int64] -> [Int64]
next list#(x:_) = x+1 : takeWhile (/= -1) (nextRec list)
nextRec (a:rest#(b:_)) = boundAdd a b : nextRec rest
nextRec [a] = [boundAdd a a]
boundAdd x y
| x < 0 || y < 0 = -1
| x + y + 1 >= limit = -1
| otherwise = (x+y+1)
-- start shoud be [1]
fLine d start = until ((== d) . head) next start
The problem: for very large numbers I get a stack overflow. Is there a way to force haskell to evaluate the whole list? It's clear that each line can't contain more elements than an upper bound, because they eventually become -1 and don't get stored and each line only depends on the previous one. Due to the lazy evaluation only the head of each line is computed until the last line needs it's second element and all the trunks along the way are stored...
I have a very efficient implementation in c++ but I am really wondering if there is a way to get it done in haskell, too.

Works for me: What Haskell implementation are you using? A naive program to calculate this triangle works fine for me in GHC 6.10.4. I can print the 1000th row just fine:
nextRow :: [Integer] -> [Integer]
nextRow row = 0 : [a + b + 1 | (a, b) <- zip row (tail row ++ [last row])]
tri = iterate nextRow [0]
main = putStrLn $ show $ tri !! 1000 -- print 1000th row
I can even print the first 10 numbers in row 100000 without overflowing the stack. I'm not sure what's going wrong for you. The global name tri might be keeping the whole triangle of results alive, but even if it is, that seems relatively harmless.
How to force order of evaluation: You can force thunks to be evaluated in a certain order using the Prelude function seq (which is a magic function that can't be implemented in terms of Haskell's other basic features). If you tell Haskell to print a `seq` b, it first evaluates the thunk for a, then evaluates and prints b.
Note that seq is shallow: it only does enough evaluation to force a to no longer be a thunk. If a is of a tuple type, the result might still be a tuple of thunks. If it's a list, the result might be a cons cell having thunks for both the head and the tail.
It seems like you shouldn't need to do this for such a simple problem; a few thousand thunks shouldn't be too much for any reasonable implementation. But it would go like this:
-- Evaluate a whole list of thunks before calculating `result`.
-- This returns `result`.
seqList :: [b] -> a -> a
seqList lst result = foldr seq result lst
-- Exactly the same as `nextRow`, but compute every element of `row`
-- before calculating any element of the next row.
nextRow' :: [Integer] -> [Integer]
nextRow' row = row `seqList` nextRow row
tri = iterate nextRow' [0]
The fold in seqList basically expands to lst!!0 `seq` lst!!1 `seq` lst!!2 `seq` ... `seq` result.
This is much slower for me when printing just the first 10 elements of row 100,000. I think that's because it requires computing 99,999 complete rows of the triangle.

Related

transferring an imperative for-loop into idiomatic haskell

I have some difficulties to transfer imperative algorithms into a functional style. The main concept that I cannot wrap my head around is how to fill sequences with values according to their position in the sequence. How would an idiomatic solution for the following algorithm look in Haskell?
A = unsigned char[256]
idx <- 1
for(i = 0 to 255)
if (some_condition(i))
A[i] <- idx
idx++
else
A[i] = 0;
The algorithm basically creates a lookup table for the mapping function of a histogram.
Do you know any resources which would help me to understand this kind of problem better?
One of the core ideas in functional programming is to express algorithms as data transformations. In a lazy language like Haskell, we can even go a step further and think of lazy data structures as reified computations. In a very real sense, Haskell's lists are more like loops than normal linked lists: they can be calculated incrementally and don't have to exist in memory all at once. At the same time, we still get many of the advantages of having a data type like that ability to pass it around and inspect it with pattern matching.
With this in mind, the "trick" for expressing a for-loop with an index is to create a list of all the values it can take. Your example is probably the simplest case: i takes all the values from 0 to 255, so we can use Haskell's built-in notation for ranges:
[0..255]
At a high level, this is Haskell's equivalent of for (i = 0 to 255); we can then execute the actual logic in the loop by traversing this list either by a recursive function or a higher-order function from the standard library. (The second option is highly preferred.)
This particular logic is a good fit for a fold. A fold lets us take in a list item by item and build up a result of some sort. At each step, we get a list item and the value of our built-up result so far. In this particular case, we want to process the list from left to right while incrementing an index, so we can use foldl; the one tricky part is that it will produce the list backwards.
Here's the type of foldl:
foldl :: (b -> a -> b) -> b -> [a] -> b
So our function takes in our intermediate value and a list element and produces an updated intermediate value. Since we're constructing a list and keeping track of an index, our intermediate value will be a pair that contains both. Then, once we have the final result, we can ignore the idx value and reverse the final list we get:
a = let (result, _) = foldl step ([], 1) [0..255] in reverse result
where step (a, idx) i
| someCondition i = (idx:a, idx + 1)
| otherwise = (0:a, idx)
In fact, the pattern of transforming a list while keeping track of some intermediate state (idx in this case) is common enough so that it has a function of its own in terms of the State type. The core abstraction is a bit more involved (read through ["You Could Have Invented Monads"][you] for a great introduction), but the resulting code is actually quite pleasant to read (except for the imports, I guess :P):
import Control.Applicative
import Control.Monad
import Control.Monad.State
a = evalState (mapM step [0..255]) 1
where step i
| someCondition i = get <* modify (+ 1)
| otherwise = return 0
The idea is that we map over [0..255] while keeping track of some state (the value of idx) in the background. evalState is how we put all the plumbing together and just get our final result. The step function is applied to each input list element and can also access or modify the state.
The first case of the step function is interesting. The <* operator tells it to do the thing on the left first, the thing on the right second but return the value on the left. This lets us get the current state, increment it but still return the value we got before it was incremented. The fact that our notion of state is a first-class entity and we can have library functions like <* is very powerful—I've found this particular idiom really useful for traversing trees, and other similar idioms have been quite useful for other code.
There are several ways to approach this problem depending on what data structure you want to use. The simplest one would probably be with lists and the basic functions available in Prelude:
a = go 1 [] [0..255]
where
go idx out [] = out
go idx out (i:is) =
if condition i
then go (idx + 1) (out ++ [idx]) is
else go idx (out ++ [0]) is
This uses the worker pattern with two accumulators, idx and out, and it traverses down the last parameter until no more elements are left, then returns out. This could certainly be converted into a fold of some sort, but in any case it won't be very efficient, appending items to a list with ++ is very inefficient. You could make it better by using idx : out and 0 : out, then using reverse on the output of go, but it still isn't an ideal solution.
Another solution might be to use the State monad:
a = flip runState 1 $ forM [0..255] $ \i -> do
idx <- get
if condition i
then do
put $ idx + 1 -- idx++
return idx -- A[i] = idx
else return 0
Which certainly looks a lot more imperative. The 1 in flip runState 1 is indicating that your initial state is idx = 1, then you use forM (which looks like a for loop but really isn't) over [0..255], the loop variable is i, and then it's just a matter of implementing the rest of the logic.
If you want to go a lot more advanced you could use the StateT and ST monads to have an actual mutable array with a state at the same time. The explanation of how this works is far beyond the scope of this answer, though:
import Control.Monad.State
import Control.Monad.ST
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as MV
a :: V.Vector Int
a = runST $ (V.freeze =<<) $ flip evalStateT (1 :: Int) $ do
a' <- lift $ MV.new 256
lift $ MV.set a' 0
forM_ [0..255] $ \i -> do
when (condition i) $ do
idx <- get
lift $ MV.write a' i idx
put $ idx + 1
return a'
I simplified it a bit so that each element is set to 0 from the start, we begin with an initial state of idx = 1, loop over [0..255], if the current index i meets the condition then get the current idx, write it to the current index, then increment idx. Run this as a stateful operation, then freeze the vector, and finally run the ST monad side of things. This allows for an actual mutable vector hidden safely within the ST monad so that the outside world doesn't know that to calculate a you have to do some rather strange things.
Explicit recursion:
a = go 0 1
where go 256 _ = []
go i idx | someCondition i = idx : go (i+1) (idx+1)
| otherwise = 0 : go (i+1) idx
Unfolding: (variant of the explicit recursion above)
a = unfoldr f (0,1)
where f (256,_) = Nothing
f (i,idx) | someCondition i = Just (idx,(i+1,idx+1))
| otherwise = Just (0 ,(i+1,idx ))
Loops can usually be expressed using different fold functions. Here is a solution which uses foldl(you can switch to foldl' if you run into a stackoverflow error):
f :: (Num a) => (b -> Bool) -> a -> [b] -> [a]
f pred startVal = reverse . fst . foldl step ([], startVal)
where
step (xs, curVal) x
| pred x = (curVal:xs, curVal + 1)
| otherwise = (0:xs, curVal)
How to use it? This function takes a predicate (someCondition in your code), the initial value of an index and a list of element to iterate over. That is, you can call f someCondition 1 [0..255] to obtain the result for the example from your question.

Is a list comprehension or a sequential filter more optimized?

Let's say you have to return the sum of all the multiples of 2 and 3 in a set of integers from 1-100. In Haskell, the code I would write would look something like this:
sum ([x*2 | x<-[1..100], x*2 < 100] `union` [x*3 | x<-[1..100], x*3 < 100])
This uses 2 list comprehensions with a union. Another solution would be to step through each item in the list and evaluate it (using a modulus), then add it to a separate list, which you would later add together.
Both of these solutions come out with the same answer, but which one is more optimized if you had to do the same for, say, a list from 1..1000000?
The answer to the original question is 3317 if you want to create your own algorithm.
If you are looking for performance, you can simplify this problem to the point where you don't even need a computer....
Numbers divisible by 2 or 3 fall into a pattern
0 (1) 2 3 4 (5).... 6 (7) 8 9 10 (11).... etc
or
TFTTTF.... TFTTTF....
Assume that the max bound is divisible by 6, (if not, you can just choose the highest value below the real bound and add the remaining few values by hand). Let maxBound=6*N.
For each additional N, you add the following values
6*n, 0, 6*n+2, 6*n+3, 6*n+4, 0
which sums to
24*n+9
so all you need to do is sum up
sum from n=0 to N of (24*n+9)
=24*(sum from n=0 to N of n) + 9*N
=24*N*(N-1)/2 + 9*N
=12*N^2-3*N
so a very fast Haskell program that would solve this problem would look something like this
f maxBound = 12*n^2-3*n + remainingStuff
where n = maxBound `quot` 6
remainingStuff = sum $ filter (<= maxBound) [6*n, 6*n+2, 6*n+3, 6*n+4]
The union function is a "quadratic" algorithm, so using one list comprehension will be faster.
A better way which is useful for generating these kinds of sequences is to take advantage of the fact that they are ordered and merge them together with a function like:
merge :: [Int] -> [Int] -> [Int]
merge as [] = as
merge [] bs = bs
merge as#(a:at) bs#(b:bt) =
case compare a b of
LT -> a : merge at bs
EQ -> a : merge at bt
GT -> b : merge as bt
and then generate your sequence with:
[ x | x <- merge [2,4..100] [3,6..100] ]
One last tip for writing combinatorial loops... replace expressions like x <- [1..100], 2*x < 100 with x <- [1..49], or if you can't compute the upper bound explicitly, use x <- takeWhile (\x -> 2*x < 100) [1..100]. The latter forms only generates as many items as needed.

Haskell Recursion - finding largest difference between numbers in list

Here's the problem at hand: I need to find the largest difference between adjacent numbers in a list using recursion. Take the following list for example: [1,2,5,6,7,9]. The largest difference between two adjacent numbers is 3 (between 2 and 5).
I know that recursion may not be the best solution, but I'm trying to improve my ability to use recursion in Haskell.
Here's the current code I currently have:
largestDiff (x:y:xs) = if (length (y:xs) > 1) then max((x-y), largestDiff (y:xs)) else 0
Basically - the list will keep getting shorter until it reaches 1 (i.e. no more numbers can be compared, then it returns 0). As 0 passes up the call stack, the max function is then used to implement a 'King of the Hill' type algorithm. Finally - at the end of the call stack, the largest number should be returned.
Trouble is, I'm getting an error in my code that I can't work around:
Occurs check: cannot construct the infinite type:
t1 = (t0, t1) -> (t0, t1)
In the return type of a call of `largestDiff'
Probable cause: `largestDiff' is applied to too few arguments
In the expression: largestDiff (y : xs)
In the first argument of `max', namely
`((x - y), largestDiff (y : xs))'
Anyone have some words of wisdom to share?
Thanks for your time!
EDIT: Thanks everyone for your time - I ended up independently discovering a much simpler way after much trial and error.
largestDiff [] = error "List too small"
largestDiff [x] = error "List too small"
largestDiff [x,y] = abs(x-y)
largestDiff (x:y:xs) = max(abs(x-y)) (largestDiff (y:xs))
Thanks again, all!
So the reason why your code is throwing an error is because
max((x-y), largestDiff (y:xs))
In Haskell, you do not use parentheses around parameters and separate them by commas, the correct syntax is
max (x - y) (largestDiff (y:xs))
The syntax you used is getting parsed as
max ((x - y), largestDiff (y:xs))
Which looks like you're passing a tuple to max!
However, this does not solve the problem. I always got 0 back. Instead, I would recommend breaking up the problem into two functions. You want to calculate the maximum of the difference, so first write a function to calculate the differences and then a function to calculate the maximum of those:
diffs :: Num a => [a] -> [a]
diffs [] = [] -- No elements case
diffs [x] = [] -- One element case
diffs (x:y:xs) = y - x : diffs (y:xs) -- Two or more elements case
largestDiff :: (Ord a, Num a) => [a] -> a
largestDiff xs = maximum $ map abs $ diffs xs
Notice how I've pulled the recursion out into the simplest possible case. We didn't need to calculate the maximum as we traversed the list; it's possible, just more complex. Since Haskell has a handy built-in function for calculating the maximum of a list for us, we can also leverage that. Our recursive function is clean and simple, and it is then combined with maximum to implement the desired largestDiff. As an FYI, diffs is really just a function to compute the derivative of a list of numbers, it can be a very useful function for data processing.
EDIT: Needed Ord constraint on largestDiff and added in map abs before calculating maximum.
Here's my take at it.
First some helpers:
diff a b = abs(a-b)
pick a b = if a > b then a else b
Then the solution:
mdiff :: [Int] -> Int
mdiff [] = 0
mdiff [_] = 0
mdiff (a:b:xs) = pick (diff a b) (mdiff (b:xs))
You have to provide two closing clauses, because the sequence might have either even or odd number of elements.
Another solution to this problem, which circumvents your error, can be obtained
by just transforming lists and folding/reducing them.
import Data.List (foldl')
diffs :: (Num a) => [a] -> [a]
diffs x = zipWith (-) x (drop 1 x)
absMax :: (Ord a, Num a) => [a] -> a
absMax x = foldl' max (fromInteger 0) (map abs x)
Now I admit this is a bit dense for a beginner, so I will explain the above.
The function zipWith transforms two given lists by using a binary function,
which is (-) in this case.
The second list we pass to zipWith is drop 1 x, which is just another way of
describing the tail of a list, but where tail [] results in an error,
drop 1 [] just yields the empty list. So drop 1 is the "safer" choice.
So the first function calculates the adjacent differences.
The name of the second function suggests that it calculates the maximum absolute
value of a given list, which is only partly true, it results in "0" if passed an
empty list.
But how does this happen, reading from right to left, we see that map abs
transforms every list element to its absolute value, which is asserted by
the Num a constraint. Then the foldl'-function traverses the list and
accumulates the maximum of the previous accumulator and the current element of
the list traversal. Moreover I'd like to mention that foldl' is the "strict"
sister/brother of the foldl-function, where the latter is rarely of use,
because it tends to build up a bunch of unevaluated expressions called thunks.
So let's quit all this blah blah and see it in action ;-)
> let a = diffs [1..3] :: [Int]
>>> zipWith (-) [1,2,3] (drop 1 [1,2,3])
<=> zipWith (-) [1,2,3] [2,3]
<=> [1-2,2-3] -- zipWith stops at the end of the SHORTER list
<=> [-1,-1]
> b = absMax a
>>> foldl' max (fromInteger 0) (map abs [-1,-1])
-- fromInteger 0 is in this case is just 0 - interesting stuff only happens
-- for other numerical types
<=> foldl' max 0 (map abs [-1,-1])
<=> foldl' max 0 [1,1]
<=> foldl' max (max 0 1) [1]
<=> foldl' max 1 [1]
<=> foldl' max (max 1 1) []
<=> foldl' max 1 [] -- foldl' _ acc [] returns just the accumulator
<=> 1

Recursion confusion in Haskell again - subsets with an inclusion test

I'm testing a simple program to generate subsets with an inclusion test. For example, given
*Main Data.List> factorsets 7
[([2],2),([2,3],1),([3],1),([5],1),([7],1)]
calling chooseP 3 (factorsets 7), I would like to get (read from right to left, a la cons)
[[([5],1),([3],1),([2],2)]
,[([7],1),([3],1),([2],2)]
,[([7],1),([5],1),([2],2)]
,[([7],1),([5],1),([2,3],1)]
,[([7],1),([5],1),([3],1)]]
But my program is returning an extra [([7],1),([5],1),([3],1)] (and missing a [([7],1),([5],1),([2],2)]):
[[([5],1),([3],1),([2],2)]
,[([7],1),([3],1),([2],2)]
,[([7],1),([5],1),([3],1)]
,[([7],1),([5],1),([2,3],1)]
,[([7],1),([5],1),([3],1)]]
The inclusion test is: members' first part of the tuple must have a null intersection.
Once tested as working, the plan is to sum the internal products of each subset's snds, rather than accumulate them.
Since I've asked a similar question before, I imagine that an extra branch is generated since when the recursion splits at [2,3], the second branch runs over the same possibilities once it passes the skipped section. Any pointers on how to resolve that would be appreciated; and if you'd like to share ideas about how to enumerate and sum such product combinations more efficiently, that would be great, too.
Haskell code:
chooseP k xs = chooseP' xs [] 0 where
chooseP' [] product count = if count == k then [product] else []
chooseP' yys product count
| count == k = [product]
| null yys = []
| otherwise = f ++ g
where (y:ys) = yys
(factorsY,numY) = y
f = let zzs = dropWhile (\(fs,ns) -> not . and . map (null . intersect fs . fst) $ product) yys
in if null zzs
then chooseP' [] product count
else let (z:zs) = zzs in chooseP' zs (z:product) (count + 1)
g = if and . map (null . intersect factorsY . fst) $ product
then chooseP' ys product count
else chooseP' ys [] 0
Your code is complicated enough that I might recommend starting over. Here's how I would proceed.
Write a specification. Let it be as stupidly inefficient as necessary -- for example, the spec I choose below will build all combinations of k elements from the list, then filter out the bad ones. Even the filter will be stupidly slow.
sorted xs = sort xs == xs
unique xs = nub xs == xs
disjoint xs = and $ liftM2 go xs xs where
go x1 x2 = x1 == x2 || null (intersect x1 x2)
-- check that x is valid according to all the validation functions in fs
-- (there are other fun ways to spell this, but this is particularly
-- readable and clearly correct -- just what we want from a spec)
allFuns fs x = all ($x) fs
choosePSpec k = filter good . replicateM k where
good pairs = allFuns [unique, disjoint, sorted] (map fst pairs)
Just to make sure it's right, we can test it at the prompt:
*Main> mapM_ print $ choosePSpec 3 [([2],2),([2,3],1),([3],1),([5],1),([7],1)]
[([2],2),([3],1),([5],1)]
[([2],2),([3],1),([7],1)]
[([2],2),([5],1),([7],1)]
[([2,3],1),([5],1),([7],1)]
[([3],1),([5],1),([7],1)]
Looks good.
Now that we have a spec, we can try to improve the speed one refactoring at a time, always checking that it matches the spec. The first thing I'd want to do is notice that we can ensure uniqueness and sortedness just by sorting the input and picking things "in an increasing way". To do this, we can define a function which chooses subsequences of a given length. It piggy-backs on the tails function, which you can think of as nondeterministically choosing a place to split its input list.
subseq 0 xs = [[]]
subseq n xs = do
x':xt <- tails xs
xs' <- subseq (n-1) xt
return (x':xs')
Here's an example of this function in action:
*Main> subseq 3 [1..4]
[[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
Now we can write a slightly faster chooseP by replacing replicateM with subseq. Recall that we're assuming the inputs are already sorted and unique, though.
choosePSlow k = filter good . subseq k where
good pairs = disjoint $ map fst pairs
We can sanity-check that it's working by running it on the particular input we have from above:
*Main> let i = [([2],2),([2,3],1),([3],1),([5],1),([7],1)]
*Main> choosePSlow 3 i == choosePSpec 3 i
True
Or, better yet, we can stress-test it with QuickCheck. We'll need a tiny bit more code. The condition k < 5 is just because the spec is so hopelessly slow that bigger values of k take forever.
propSlowMatchesSpec :: NonNegative Int -> OrderedList ([Int], Int) -> Property
propSlowMatchesSpec (NonNegative k) (Ordered xs)
= k < 5 && unique (map fst xs)
==> choosePSlow k xs == choosePSpec k xs
*Main> quickCheck propSlowMatchesSpec
+++ OK, passed 100 tests.
There are several more opportunities to make things faster. For instance, the disjoint test could be sped up using choose 2 instead of liftM2; or we might be able to ensure disjointness during element selection and prune the search even earlier; etc. How you want to improve it from here I leave to you -- but the basic technique (start with stupid and slow, then make it smarter, testing as you go) should be helpful to you.

Improvement of the Greedy Algorithm

I've been working on an abstract chess algorithm using Haskell (trying to expand my understanding of different paradigms), and I've hit a challenge that I've been pondering about for weeks.
Here's the problem:
Given a board (represented by a list of lists of integers; each
integer represents a subsequent point value), with dimensions n x n,
determine the path that provides the most points. If there is a tie
for best path, return either of them.
Here are the specifics:
A = [[5,4,3,1],[10,2,1,0],[0,1,2,0],[2,3,4,20]]
which renders as:
R1: 5 4 3 1, R2: 10 2 1 0, R3: 0 1 2 0, R4: 2 3 4 20.
The rules are:
You may start anywhere on the top row
You may move one square at a time, either straight down, down-left (diagonal) , or down-right (diagonal).
The output must be a tuple of integers.
First element is a list representing the columns vs. row, and the second element is the total number of points. Eg. for the above board, the best solution is to travel from top-left (5) and go diagonally for the remaining steps (until the 20 point square). This would result in the tuple ([1,2,3,4], 29).
Remember, this is all in Haskell so it is a functional-paradigm recursive problem. At first, I was thinking about using the greedy algorithm, that is, choosing the highest value in r1, and recursing through comparing the next 3 possibilities; choosing the highest of the 3. However, the downfall is that the greedy algorithm doesn't have the ability to see potential ahead of the next row.
How would I go about this? I'm not looking for code per se, since I enjoy solving things on my own. However, pseudocode or some algorithmic guidance would be much appreciated!
I saw your previous question on the same topic, and I start to work on it.
As you doesn't want the direct solution, I can provide you my reflexion about your problem, I guess it could help you.
Some basic property :
1. The number of movement is alway egal to the length of the list m = length A
2. The number of starting point is egal to the length of the head of the list n = length (head A)
3. The current position could never be negative, then :
- if the current position is egal to 0 you can either go down or right
- else you can go to left, down or right
Which lead us to this pseudo code
generate_path :: [[Int]] -> [[Int]]
generate_path [] = [[]]
generate_path A = ... -- You have to put something here
where
m = length A
n = length (head A)
This things should look like something as this
move pos0 count0
| count0 == 0 =
| pos0 == 0 = move (down count) ++ move (right count)
| otherwise = move (left count) ++ move (down count) ++ move (right count)
where
count = count0 - 1
down = position0
left = position0 - 1
right = position0 + 1
In fact keeping all of this in mind and adding the (!!) operator, we shouldn't be so far of the solution. To convince you play with A + list comprehension + !!, as
[A !! x !! y | x <- [1..2], y <- [0..2]] -- I take random range
Or play with another version :
[[A !! x !! y | x <- [1..2]] | y <- [0..2]]] -- I take random range
In fact you have two recursion the main one working on the parameter n = length (head A), you repeat the same action from 0 to (n-1) at (n-1) retrieve the result, this recursion embedded another one which work on m, repeat the same action from 0 to (m-1).
Hope it help.
Good luck.
Keep a list of the paths to each column in the row just reached with the highest score to that cell.
You'd start (in your example), with the list
[([1],5), ([2],4), ([3],3), ([4],1)]
Then, when checking the next row, for each column, you pick the path with the highest score in the previous row that can reach that column, here, for the second row, in column 1 and 2, you'd pick the path ending in column 1 on the row above, and in column 3, you'd pick the path ending in column 2 in the row above, in column 4, the path ending in colum 3 in the previous row, so that would give you
[([1,1],15), ([1,2],7), ([2,3],5), ([3,4],3)]
for the third row, [0,1,2,0], you'd again pick the path ending in column 1 for the first two columns, the path ending in column 2 for the third, and the path ending in column 3 for the fourth,
[([1,1,1],15), ([1,1,2],16), ([1,2,3],9), ([2,3,4],5)]
for the fourth row, [2,3,4,20], you'd pick the path ending in column 2 for the first three columns, and the path ending in column 3 for the last,
[([1,1,2,1],18), ([1,1,2,2],19), ([1,1,2,3],20), ([1,2,3,4],29)]
Then, when you've reached the last row, you pick the path with the highest total.
Why it works:
Let the highest-scoring path end in column c. The part above the last column must be the highest scoring path ending in one of the columns c-1, c, c+1 on the penultimate row, since column c in the last row can only be reached from those.
The best solution is not a greedy algorithm from the top down, but rather an approach that starts with the last row and works up:
import Data.Function
import Data.List
-- All elements of Board are lists of equal lengths
-- valid b = 1 == length (group (map length b))
type Value = Int
type Board = [[Value]]
type Index = Int
type Result = ([Index], Value)
p :: Board
p = [[5,4,3,1],[10,2,1,0],[0,1,2,0],[2,3,4,20]]
best_from :: Board -> Result
best_from [] = undefined
best_from xs | any null xs = undefined
best_from b = best_of . best_list $ b
best_list :: Board -> [Result]
best_list b = foldr1 layer (map label b)
where label = zipWith (\index value -> ([index],value)) [1..]
layer new rest = zipWith (\(i1,v1) (i2,v2) -> (i1++i2, v1+v2)) new best
where temp = head rest : map best_pair (zip rest (tail rest))
best = map best_pair (zip temp (tail rest)) ++ [last temp]
best_pair :: (Result,Result) -> Result
best_pair (a#(_,a1), b#(_,b1)) | a1 >=b1 = a
| otherwise = b
best_of :: [Result] -> Result
best_of = maximumBy (compare `on` snd)
main = do
print (best_from p)
It is easy to solve if there is one row. So this converts each row into a list of Result with a simple [#] solution path.
Given the rest for the puzzel below a new row then adding the new row is a matter of finding the best solution from rest (by checking down, down left, down right) and combining with the new row.
This makes foldr, or here foldr1 the natural structure.
I chose a different path, no pun intended. I listed the allowed index combinations and mapped the board to them. Perhaps someone can find a way to generalize it to a board of any size.
import Data.List
import Data.Ord
import Data.Maybe
a = [[5,4,3,1],[10,2,1,0],[0,1,2,0],[2,3,4,20]]
r1 = a !! 0
r2 = a !! 1
r3 = a !! 2
r4 = a !! 3
i = [0,1,2,3]
index_combinations = [[a,b,c,d] | a <- i, b <- i, c <- i, d <- i,
abs (b-a) < 2, abs (c-b) < 2, abs (d-c) < 2]
mapR xs = [r1 !! (xs !! 0), r2 !! (xs !! 1),
r3 !! (xs !! 2), r4 !! (xs !! 3)]
r_combinations = map mapR index_combinations
r_combinations_summed = zip r_combinations $ map (foldr (+) 0) r_combinations
result = maximumBy (comparing snd) r_combinations_summed
path = index_combinations !! fromJust (elemIndex result r_combinations_summed)

Resources