Related
I am new to Haskell and have been practicing by doing some simple programming challenges. The last 2 days, I've been trying to implement the unbounded knapsack problem here. The algorithm I'm using is described on the wikipedia page, though for this problem the word 'weight' is replaced with the word 'length'. Anyways, I started by writing the code without memoization:
maxValue :: [(Int,Int)] -> Int -> Int
maxValue [] len = 0
maxValue ((l, val): other) len =
if l > len then
skipValue
else
max skipValue takeValue
where skipValue = maxValue other len
takeValue = (val + maxValue ([(l, val)] ++ other) (len - l)
I had hoped that haskell would be nice and have some nice syntax like #pragma memoize to help me, but looking around for examples, the solution was explained with this fibonacci problem code.
memoized_fib :: Int -> Integer
memoized_fib = (map fib [0 ..] !!)
where fib 0 = 0
fib 1 = 1
fib n = memoized_fib (n-2) + memoized_fib (n-1)
After grasping the concept behind this example, I was very disappointed - the method used is super hacky and only works if 1) the input to the function is a single integer, and 2) the function needs to compute the values recursively in the order f(0), f(1), f(2), ... But what if my parameters are vectors or sets? And if I want to memoize a function like f(n) = f(n/2) + f(n/3), I need to compute the value of f(i) for all i less than n, when I don't need most of those values. (Others have pointed out this claim is false)
I tried implementing what I wanted by passing a memo table that we slowly fill up as an extra parameter:
maxValue :: (Map.Map (Int, Int) Int) -> [(Int,Int)] -> Int -> (Map.Map (Int, Int) Int, Int)
maxValue m [] len = (m, 0)
maxValue m ((l, val) : other) len =
if l > len then
(mapWithSkip, skipValue)
else
(mapUnion, max skipValue (takeValue+val))
where (skipMap, skipValue) = maxValue m other len
mapWithSkip = Map.insertWith' max (1 + length other, len) skipValue skipMap
(takeMap, takeValue) = maxValue m ([(l, val)] ++ other) (len - l)
mapWithTake = Map.insertWith' max (1 + length other, len) (takeValue+val) mapWithSkip
mapUnion = Map.union mapWithSkip mapWithTake
But this is too slow, I believe because Map.union takes too long, it's O(n+m) rather than O(min(n,m)). Furthermore, this code seems a quite messy for something as simple as memoizaton. For this specific problem, you might be able to get away with generalizing the hacky approach to 2 dimensions, and computing a bit extra, but I want to know how to do memoization in a more general sense. How can I implement memoization in this more general form while maintaining the same complexity as the code would have in imperative languages?
And if I want to memoize a function like f(n) = f(n/2) + f(n/3), I need to compute the value of f(i) for all i less than n, when I don't need most of those values.
No, laziness means that values that are not used never get computed. You allocate a thunk for them in case they are ever used, so it's a nonzero amount of CPU and RAM dedicated to this unused value, but e.g. evaluating f 6 never causes f 5 to be evaluated. So presuming that the expense of calculating an item is much higher than the expense of allocating a cons cell, and that you end up looking at a large percentage of the total possible values, the wasted work this method uses is small.
But what if my parameters are vectors or sets?
Use the same technique, but with a different data structure than a list. A map is the most general approach, provided that your keys are Ord and also that you can enumerate all the keys you will ever need to look up.
If you can't enumerate all the keys, or you plan to look up many fewer keys than the total number possible, then you can use State (or ST) to simulate the imperative process of sharing a writable memoization cache between invocations of your function.
I would have liked to show you how this works, but I find your problem statement / links confusing. The exercise you link to does seem to be equivalent to the UKP in the Wikipedia article you link to, but I don't see anything in that article that looks like your implementation. The "Dynamic programming in-advance algorithm" Wikipedia gives is explicitly designed to have the exact same properties as the fib memoization example you gave. The key is a single Int, and the array is built from left to right: starting with len=0 as the base case, and basing all other computations on already-computed values. It also, for some reason I don't understand, seems to assume you will have at least 1 copy of each legal-sized object, rather than at least 0; but that is easily fixed if you have different constraints.
What you've implemented is totally different, starting from the total len, and choosing for each (length, value) step how many pieces of size length to cut up, then recursing with a smaller len and removing the front item from your list of weight-values. It's closer to the traditional "how many ways can you make change for an amount of currency given these denominations" problem. That, too, is amenable to the same left-to-right memoization approach as fib, but in two dimensions (one dimension for amount of currency to make change for, and another for number of denominations remaining to be used).
My go-to way to do memoization in Haskell is usually MemoTrie. It's pretty straightforward, it's pure, and it usually does what I'm looking for.
Without thinking too hard, you could produce:
import Data.MemoTrie (memo2)
maxValue :: [(Int,Int)] -> Int -> Int
maxValue = memo2 go
where
go [] len = 0
go lst#((l, val):other) len =
if l > len then skipValue else max skipValue takeValue
where
skipValue = maxValue other len
takeValue = val + maxValue lst (len - l)
I don't have your inputs, so I don't know how fast this will go — it's a little strange to memoize the [(Int,Int)] input. I think you recognize this too because in your own attempt, you actually memoize over the length of the list, not the list itself. If you want to do that, it makes sense to convert your list to a constant-time-lookup array and then memoize. This is what I came up with:
import qualified GHC.Arr as Arr
maxValue :: [(Int,Int)] -> Int -> Int
maxValue lst = memo2 go 0
where
values = Arr.listArray (0, length lst - 1) lst
go i _ | i >= length lst = 0
go i len = if l > len then skipValue else max skipValue takeValue
where
(l, val) = values Arr.! i
skipValue = go (i+1) len
takeValue = val + go i (len - l)
General, run-of-the-mill memoization in Haskell can be implemented the same way it is in other languages, by closing a memoized version of the function over a mutable map that caches the values. If you want the convenience of running the function as if it was pure, you'll need to maintain the state in IO and use unsafePerformIO.
The following memoizer will probably be sufficient for most code submission websites, as it depends only on System.IO.Unsafe, Data.IORef, and Data.Map.Strict, which should usually be available.
import qualified Data.Map.Strict as Map
import System.IO.Unsafe
import Data.IORef
memo :: (Ord k) => (k -> v) -> (k -> v)
memo f = unsafePerformIO $ do
m <- newIORef Map.empty
return $ \k -> unsafePerformIO $ do
mv <- Map.lookup k <$> readIORef m
case mv of
Just v -> return v
Nothing -> do
let v = f k
v `seq` modifyIORef' m $ Map.insert k v
return v
From your question and comments, you seem to be the sort of person who's perpetually disappointed (!), so perhaps the use of unsafePerformIO will disappoint you, but if GHC actually provided a memoization pragma, this is probably what it would be doing under the hood.
For an example of straightforward use:
fib :: Int -> Int
fib = memo fib'
where fib' 0 = 0
fib' 1 = 1
fib' n = fib (n-1) + fib (n-2)
main = do
print $ fib 100000
or more to the point (SPOILERS?!), a version of your maxValue memoized in the length only:
maxValue :: [(Int,Int)] -> Int -> Int
maxValue values = go
where go = memo (go' values)
go' [] len = 0
go' ((l, val): other) len =
if l > len then
skipValue
else
max skipValue takeValue
where skipValue = go' other len
takeValue = val + go (len - l)
This does a little more work than necessary, since the takeValue case re-evaluates the full set of marketable pieces, but it was fast enough to pass all the test cases on the linked web page. If it wasn't fast enough, then you'd need a memoizer that memoizes a function with results shared across calls with non-identical arguments (same length, but different marketable pieces, where you know the answer is going to be the same anyway because of special aspects of the problem and the order in which you check different marketable pieces and lengths). This would be a non-standard memoization, but it wouldn't be hard to modify the memo function to handle this case, I don't think, simply by splitting the argument up into a "key" argument and a "non-key" argument, or deriving the key from the argument via an arbitrary function supplied at memoization time.
I have the following code:
// volume queue
let volumeQueue = Queue<float>()
let queueSize = 10 * 500 // 10 events per second, 500 seconds max
// add a signed volume to the queue
let addToVolumeQueue x =
volumeQueue.Enqueue(x)
while volumeQueue.Count > queueSize do volumeQueue.TryDequeue() |> ignore
// calculate the direction of the queue, normalized between +1 (buy) and -1 (sell)
let queueDirection length =
let subQueue =
volumeQueue
|> Seq.skip (queueSize - length)
let boughtVolume =
subQueue
|> Seq.filter (fun l -> l > 0.)
|> Seq.sum
let totalVolume =
subQueue
|> Seq.sumBy (fun l -> abs l)
2. * boughtVolume / totalVolume - 1.
What this does is run a fixed length queue to which transaction volumes are added, some positive, some negative.
And then it calculates the cumulative ratio of positive over negative entries and normalizes it between +1 and -1, with 0 meaning the sums are half / half.
There is no optimization right now but this code's performance will matter. So I'd like to make it fast, without compromising readability (it's called roughly every 100ms).
The first thing that comes to mind is to do the two sums at once (the positive numbers and all the numbers) in a single loop. It can easily be done in a for loop, but can it be done with collection functions?
The next option I was thinking about is to get rid of the queue and use a circular buffer, but since the code is run on a part of the buffer (the last 'length' items), I'd have to handle the wrap around part; I guess I could extend the buffer to the size of a power of 2 and get automatic wrap around that way.
Any idea is welcome, but my first original question is: can I do the two sums in a single pass with the collection functions? I can't iterate in the queue with an indexer, so I can't use a for loop (or I guess I'd have to instance an iterator)
First of all, there is nothing inherently wrong with using mutable variables and loops in F#. Especially at a small scale (e.g. inside a function), this can often be quite readable - or at least, easy to understand if there is a suitable comment.
To do this using a single iteration, you could use fold. This basically calculates the two sums in a single iteration at the cost of some readability:
let queueDirectionFold length =
let boughtVolume, totalVolume =
volumeQueue
|> Seq.skip (queueSize - length)
|> Seq.fold (fun (bv, tv) v ->
(if v > 0.0 then bv else bv + v), tv + abs v) (0.0, 0.0)
2. * boughtVolume / totalVolume - 1.
As I mentioned earlier, I would also consider using a loop. The loop itself is quite simple, but some complexity is added by the fact that you need to skip some elements. Still, I think it's quite clear:
let queueDirectionLoop length =
let mutable i = 0
let mutable boughtVolume = 0.
let mutable totalVolume = 0.
for v in volumeQueue do
if i >= queueSize - length then
totalVolume <- totalVolume + abs v
if v > 0. then boughtVolume <- boughtVolume + v
i <- i + 1
2. * boughtVolume / totalVolume - 1.
I tested the performance using 4000 elements and here is what I got:
#time
let rnd = System.Random()
for i in 0 .. 4000 do volumeQueue.Enqueue(rnd.NextDouble())
for i in 0 .. 10000 do ignore(queueDirection 1000) // ~900 ms
for i in 0 .. 10000 do ignore(queueDirectionFold 1000) // ~460 ms
for i in 0 .. 10000 do ignore(queueDirectionLoop 1000) // ~370 ms
Iterating over the queue just once definitely helps with performance. Doing this in an imperative loop helps the performance even more - this may be worth it if you care about performance. The code may be a bit less readable than the original, but I think it's not much worse than fold.
Suppose I have an Int list where elements are known to be bounded and the list is known to be no longer than their range, so that it is entirely possible for it not to contain duplicates. How can I test most quickly whether it is the case?
I know of nubOrd. It is quite fast. We can pass our list through and see if it becomes shorter. But the efficiency of nubOrd is still not linear.
My idea is that we can trade space for time efficiency. Imperatively, we would allocate a bit field as wide as our range, and then traverse the list, marking the entries corresponding to the list elements' values. As soon as we try to flip a bit that is already 1, we return False. It only takes (read + compare + write) * length of the list. No binary search trees, no nothing.
Is it reasonable to attempt a similar construction in Haskell?
The discrimination package has a linear time nub you can use. Or a linear time group that doesn't require the equivalent elements to be adjacent in order to group them, so you could see if any of the groups are not size 1.
The whole package is based on sidestepping the well known bounds on comparison-based sorts (and joins, and etc) by using algorithms based on "discrimination" rather than ones based on comparisons. As I understand it, the technique is somewhat like a radix sort, but generalised to ADTs.
For integers (and other Ix-like types), you could use a mutable array, for example with the array package.
We can here use a STUArray here, like:
import Control.Monad.ST
import Data.Array.ST
updateDups_ :: [Int] -> STArray s Int Bool -> ST s Bool
updateDups_ [] _ = return False
updateDups_ (x:xs) arr = do
contains <- readArray arr x
if contains then return True
else writeArray arr x True >> updateDups_ xs arr
withDups_ :: Int -> [Int] -> ST s Bool
withDups_ mx l = newArray (0, mx) False >>= updateDups_ l
withDups :: Int -> [Int] -> Bool
withDups mx ls = runST (withDups_ mx ls)
For example:
Prelude Control.Monad.ST Data.Array.ST> withDups 17 [1,4,2,5]
False
Prelude Control.Monad.ST Data.Array.ST> withDups 17 [1,4,2,1]
True
Prelude Control.Monad.ST Data.Array.ST> withDups 17 [1,4,2,16,2]
True
So here the first parameter is the maximum value that can be added in the list, and the second parameter the list of values we want to check.
So you have a list of size N, and you know that the elements in the list are within the range min .. min+N-1.
There is a simple linear time algorithm that requires O(1) space.
First, scan the list to find the minimum and maximum elements.
If (max - min + 1) < N then you know there's a duplicate. Otherwise ...
Because the range is N, the minimum item can go at a[0], and the max item at a[n-1]. You can map any item to its position in the array simply by subtracting min. You can do an in-place sort in O(n) because you know exactly where every item should go.
Starting at the beginning of the list, take the first element and subtract min to determine where it should go. Go to that position, and replace the item that's there. With the new item, compute where it should go, and replace the item in that position, etc.
If you ever get to a point where you're you're trying to place an item at a[x], and the value already there is the value that's supposed to be there (i.e. a[x] == x+min), then you've found a duplicate.
The code to do all this is pretty simple:
Corrected code.
min, max = findMinMax()
currentIndex = 0
while currentIndex < N
temp = a[currentIndex]
targetIndex = temp - min;
// Do this until we wrap around to the current index
// If the item is already in place, then targetIndex == currentIndex,
// and we won't enter the loop.
while targetIndex != currentIndex
if (a[targetIndex] == temp)
// the item at a[targetIndex] is the item that's supposed to be there.
// The only way that can happen is if the item we have in temp is a duplicate.
found a duplicate
end if
save = a[targetIndex]
a[targetIndex] = temp
temp = save
targetIndex = temp - min
end while
// At this point, targetIndex == currentIndex.
// We've wrapped around and need to place the last item.
// There's no need to check here if a[targetIndex] == temp, because if it did,
// we would not have entered the loop.
a[targetIndex] = temp
++currentIndex
end while
That's the basic idea.
Consider the finite set {2,3,5,...,n}. I am interested in primes but the question could apply to any set of numbers. I want to find all possible products of these numbers in ascending order, and in particular greater than or equal to some number x. Does anyone know a nice algorithm for this?
EDIT to clarify:
Each factor in the input set may be used any number of times. If the input were {2,3,5,7} the output would be {2,3,4,5,6,7,8,9,10,12,14,15,16,18,...}. The algorithm can stop as soon as it produces a result greater than or equal to some number x.
A Haskell code, as seen in this answer,
hamm :: [Integer] -> [Integer]
hamm [] = []
hamm (p:ps) = xs -- e.g. hamm [2,3,5]
where xs = merge (hamm ps) -- H({p} ∪ ps) = S,
(p : map (p*) xs) -- S ⊇ {p} ∪ H(ps) ∪ { p*x | x ∊ S }
merge a#(x:xs) b#(y:ys) | x < y = x : merge xs b
| otherwise = y : merge a ys
merge [] b = b
merge a [] = a
merge here doesn't try to eliminate multiples, because there won't be any -- but only in case you're using only the primes in the input:
~> take 20 $ hamm [2,3,5,7]
[2,3,4,5,6,7,8,9,10,12,14,15,16,18,20,21,24,25,27,28]
If not, you need to use union instead,
union a#(x:xs) b#(y:ys) | x < y = x : union xs b
| x > y = y : union a ys
| otherwise = x : union xs ys
union [] b = b
union a [] = a
Starting from (above) a given value efficiently might be an interesting challenge. A directly slice-generating code at the bottom of this answer could be taken as a starting point.
In general it is easy to skip along the ordered sequence until a value is passed over. In Haskell, it is done with a built-in dropWhile (< n),
~> take 10 $ dropWhile (< 100) $ hamm [2,3,5,7]
[100,105,108,112,120,125,126,128,135,140]
(Edit: made it produce all products in ascending order; let users filter them as they wish. This is a generalised Hamming numbers problem)
genHamming :: Integral a => [a] -> [a]
genHamming zs = hmng where
hmng = 1 : foldr (||) [] [map (z*) hmng | z <- zs]
[] || ys = ys
xs || [] = xs
(x:xs) || (y:ys) | x==y = x : (xs || ys)
| x<y = x : (xs || (y:ys))
| y<x = y : (ys || (x:xs))
Example usage
Prelude Hamming> take 10 $ dropWhile (< 1000) $ genHamming [2,3,5]
[1000,1024,1080,1125,1152,1200,1215,1250,1280,1296]
Prelude Hamming>
You probably also want to include 2^0 * 3^0 * 5^0 * 7^0 = 1 in your output.
The way to do this is with a priority queue. If k is in the sequence, so are 2k, 3k, 5k and 7k. Start your output with 1, then add 2, 3, 5, and 7 to the priority queue. Pop 2 from the top of the queue and add 2*2=4, 2*3=6, 2*5=10 and 2*7=14 to the queue; the queue at that point will contain 3, 4, 5, 6, 7, 10 and 14. Pop 3 from the top of the queue and add 3*2=6, 3*3=9, 3*5=15 and 3*7=21 to the queue. And so on.
You will discover that many elements are duplicated; for instance, we added 6 to the priority queue twice in the example above. You can either add duplicates, and check each time you pop the queue if the element is the same as the prior member of the sequence, or you can keep a separate list of items in the queue and refrain from adding duplicates in the first place.
I discuss a priority queue that contains only distinct elements at my blog.
Every integer greater than 1 is the product of a 'set of primes' because it is the product of its prime factors. It might be easier to start at your desired minimum number and strike out all numbers that have a prime factor not in your initial set. Continue the process until your result set is large enough. In effect you are doing a modified Sieve of Eratosthenes, removing all multiples of the primes not in your initial set.
Because our application is written in python I came up with the following implementation which I wanted to share:
def powers(x):
y = x
while True:
yield y
y *= x
def products(factors):
y0 = factors[0]
if len(factors) == 1:
yield from powers(y0)
else:
yield y0
g1 = products(factors)
y1 = y0 * next(g1)
g2 = products(factors[1:])
y2 = next(g2)
while True:
if y1 < y2:
yield y1
y1 = y0 * next(g1)
else:
yield y2
y2 = next(g2)
if __name__ == "__main__":
import itertools
for n in itertools.islice(products([2, 3, 5, 7]), 10**6):
print(n)
No doubt the use of recursion with generators could be improved upon, but in practice the performance is good enough for our application. Beyond that, I'm still interested in how to start at a given minimum value efficiently, as mentioned in Will Ness' answer. Thanks to all those who contributed.
There are two algorithms that come to mind for this. First, you could calculate all possible products between the numbers, and then sorts these. Although this seems to be the naive approach, you could speed this up by 'remembering' the last product, dividing out one number, and multiplying a different number in its place. This would greatly reduce the number of operations necessary, if with the correct ordering of your permutations (look into Gray Codes) you could minimize the total multiplications.
On the other hand, what you could do is compute the sets of all the original numbers, the set of the products of pairs (of two) original numbers, the set of products of 3... so on. Then you can sort each individual set (which shouldn't be hard to ensure they are nearly sorted anyways), and the mergesort the sets together into one sorted list of products. This would take more operations, but would result in a nearly sorted list at the end, which may take less time to construct overall.
The other algorithm would be to take the product of all the primes of interest, and call this P. Construct another list of all the original primes squared. Now, loop over all numbers up to P, and test if those are divisible by any of the values in the primes-squared array. If they are, toss them. If not, then add them to the output array. You can optimize this by only testing divisibility up to sqrt(i), where i is the iteration in your for loop. This is still likely slower than the above method though.
As every prime factor is allowed to appear many times, the sequence is infinite. So we can't generate all products and then sort them. We have to generate the sequence iteratively.
If a is a member of the sequence, then {2*a, 3*a, 5*a ... n*a} will also be members of the sequence, coming later.
So, the algorithm that comes to my mind is to have a (sorted, duplicate-free) buffer of the next sequence members. We extract and present the smallest value and insert all of its multiples into the buffer.
As it's difficult to predict the buffer content for your starting number x, this algorithm should start from the beginning and ignore the results until they reach the x threshold.
Several years ago I took an algorithms course where we were giving the following problem (or one like it):
There is a building of n floors with an elevator that can only go up 2 floors at a time and down 3 floors at a time. Using dynamic programming write a function that will compute the number of steps it takes the elevator to get from floor i to floor j.
This is obviously easy using a stateful approach, you create an array n elements long and fill it up with the values. You could even use a technically non-stateful approach that involves accumulating a result as recursively passing it around. My question is how to do this in a non-stateful manner by using lazy evaluation and tying the knot.
I think I've devised the correct mathematical formula:
where i+2 and i-3 are within the allowed values.
Unfortunately I can't get it to terminate. If I put the i+2 case first and then choose an even floor I can get it to evaluate the even floors below the target level but that's it. I suspect that it shoots straight to the highest even floor for everything else, drops 3 levels, then repeats, forever oscillating between the top few floors.
So it's probably exploring the infinite space (or finite but with loops) in a depth first manner. I can't think of how to explore the space in a breadth first fashion without using a whole lot of data structures in between that effectively mimic a stateful approach.
Although this simple problem is disappointingly difficult I suspect that having seen a solution in 1 dimension I might be able to make it work for a 2 dimensional variation of the problem.
EDIT: A lot of the answers tried to solve the problem in a different way. The problem itself isn't interesting to me, the question is about the method used. Chaosmatter's approach of creating a minimal function which can compare potentially infinite numbers is possibly a step in the right direction. Unfortunately if I try to create a list representing a building with 100 floors the result takes too long to compute, since the solutions to sub problems are not reused.
I made an attempt to use a self-referencing data structure but it doesn't terminate, there is some kind of infinite loop going on. I'll post my code so you can understand what it is I'm going for. I'll change the accepted answer if someone can actually solve the problem using dynamic programming on a self-referential data structure using laziness to avoid computing things more than once.
levels = go [0..10]
where
go [] = []
go (x:xs) = minimum
[ if i == 7
then 0
else 1 + levels !! i
| i <- filter (\n -> n >= 0 && n <= 10) [x+2,x-3] ]
: go xs
You can see how 1 + levels !! i tries to reference the previously calculated result and how filter (\n -> n >= 0 && n <= 10) [x+2,x-3] tries to limit the values of i to valid ones. As I said, this doesn't actually work, it simply demonstrates the method by which I want to see this problem solved. Other ways of solving it are not interesting to me.
Since you're trying to solve this in two dimensions, and for other problems than the one described, let's explore some more general solutions. We are trying to solve the shortest path problem on directed graphs.
Our representation of a graph is currently something like a -> [a], where the function returns the vertices reachable from the input. Any implementation will additionally require that we can compare to see if two vertices are the same, so we'll need Eq a.
The following graph is problematic, and introduces almost all of the difficulty in solving the problem in general:
problematic 1 = [2]
problematic 2 = [3]
problematic 3 = [2]
problematic 4 = []
When trying to reach 4 from 1, there are is a cycle involving 2 and 3 that must be detected to determine that there is no path from 1 to 4.
Breadth-first search
The algorithm Will presented has, if applied to the general problem for finite graphs, worst case performance that is unbounded in both time and space. We can modify his solution to attack the general problem for graphs containing only finite paths and finite cycles by adding cycle detection. Both his original solution and this modification will find finite paths even in infinite graphs, but neither is able to reliably determine that there is no path between two vertices in an infinite graph.
acyclicPaths :: (Eq a) => (a->[a]) -> a -> a -> [[a]]
acyclicPaths steps i j = map (tail . reverse) . filter ((== j).head) $ queue
where
queue = [[i]] ++ gen 1 queue
gen d _ | d <= 0 = []
gen d (visited:t) = let r = filter ((flip notElem) visited) . steps . head $ visited
in map (:visited) r ++ gen (d+length r-1) t
shortestPath :: (Eq a) => (a->[a]) -> a -> a -> Maybe [a]
shortestPath succs i j = listToMaybe (acyclicPaths succs i j)
Reusing the step function from Will's answer as the definition of your example problem, we could get the length of the shortest path from floor 4 to 5 of an 11 story building by fmap length $ shortestPath (step 11) 4 5. This returns Just 3.
Let's consider a finite graph with v vertices and e edges. A graph with v vertices and e edges can be described by an input of size n ~ O(v+e). The worst case graph for this algorithm is to have one unreachable vertex, j, and the remaining vertexes and edges devoted to creating the largest number of acyclic paths starting at i. This is probably something like a clique containing all the vertices that aren't i or j, with edges from i to every other vertex that isn't j. The number of vertices in a clique with e edges is O(e^(1/2)), so this graph has e ~ O(n), v ~ O(n^(1/2)). This graph would have O((n^(1/2))!) paths to explore before determining that j is unreachable.
The memory required by this function for this case is O((n^(1/2))!), since it only requires a constant increase in the queue for each path.
The time required by this function for this case is O((n^(1/2))! * n^(1/2)). Each time it expands a path, it must check that the new node isn't already in the path, which takes O(v) ~ O(n^(1/2)) time. This could be improved to O(log (n^(1/2))) if we had Ord a and used a Set a or similar structure to store the visited vertices.
For non-finite graphs, this function should only fail to terminate exactly when there doesn't exists a finite path from i to j but there does exist a non-finite path from i to j.
Dynamic Programming
A dynamic programming solution doesn't generalize in the same way; let's explore why.
To start with, we'll adapt chaosmasttter's solution to have the same interface as our breadth-first search solution:
instance Show Natural where
show = show . toNum
infinity = Next infinity
shortestPath' :: (Eq a) => (a->[a]) -> a -> a -> Natural
shortestPath' steps i j = go i
where
go i | i == j = Zero
| otherwise = Next . foldr minimal infinity . map go . steps $ i
This works nicely for the elevator problem, shortestPath' (step 11) 4 5 is 3. Unfortunately, for our problematic problem, shortestPath' problematic 1 4 overflows the stack. If we add a bit more code for Natural numbers:
fromInt :: Int -> Natural
fromInt x = (iterate Next Zero) !! x
instance Eq Natural where
Zero == Zero = True
(Next a) == (Next b) = a == b
_ == _ = False
instance Ord Natural where
compare Zero Zero = EQ
compare Zero _ = LT
compare _ Zero = GT
compare (Next a) (Next b) = compare a b
we can ask if the shortest path is shorter than some upper bound. In my opinion, this really shows off what's happening with lazy evaluation. problematic 1 4 < fromInt 100 is False and problematic 1 4 > fromInt 100 is True.
Next, to explore dynamic programming, we'll need to introduce some dynamic programming. Since we will build a table of the solutions to all of the sub-problems, we will need to know the possible values that the vertices can take. This gives us a slightly different interface:
shortestPath'' :: (Ix a) => (a->[a]) -> (a, a) -> a -> a -> Natural
shortestPath'' steps bounds i j = go i
where
go i = lookupTable ! i
lookupTable = buildTable bounds go2
go2 i | i == j = Zero
| otherwise = Next . foldr minimal infinity . map go . steps $ i
-- A utility function that makes memoizing things easier
buildTable :: (Ix i) => (i, i) -> (i -> e) -> Array i e
buildTable bounds f = array bounds . map (\x -> (x, f x)) $ range bounds
We can use this like shortestPath'' (step 11) (1,11) 4 5 or shortestPath'' problematic (1,4) 1 4 < fromInt 100. This still can't detect cycles...
Dynamic programming and cycle detection
The cycle detection is problematic for dynamic programming, because the sub-problems aren't the same when they are approached from different paths. Consider a variant of our problematic problem.
problematic' 1 = [2, 3]
problematic' 2 = [3]
problematic' 3 = [2]
problematic' 4 = []
If we are trying to get from 1 to 4, we have two options:
go to 2 and take the shortest path from 2 to 4
go to 3 and take the shortest path from 3 to 4
If we choose to explore 2, we will be faced with the following option:
go to 3 and take the shortest path from 3 to 4
We want to combine the two explorations of the shortest path from 3 to 4 into the same entry in the table. If we want to avoid cycles, this is really something slightly more subtle. The problems we faced were really:
go to 2 and take the shortest path from 2 to 4 that doesn't visit 1
go to 3 and take the shortest path from 3 to 4 that doesn't visit 1
After choosing 2
go to 3 and take the shortest path from 3 to 4 that doesn't visit 1 or 2
These two questions about how to get from 3 to 4 have two slightly different answers. They are two different sub-problems which can't fit in the same spot in a table. Answering the first question eventually requires determining that you can't get to 4 from 2. Answering the second question is straightforward.
We could make a bunch of tables for each possible set of previously visited vertices, but that doesn't sound very efficient. I've almost convinced myself that we can't do reach-ability as a dynamic programming problem using only laziness.
Breadth-first search redux
While working on a dynamic programming solution with reach-ability or cycle detection, I realized that once we have seen a node in the options, no later path visiting that node can ever be optimal, whether or not we follow that node. If we reconsider problematic':
If we are trying to get from 1 to 4, we have two options:
go to 2 and take the shortest path from 2 to 4 without visiting 1, 2, or 3
go to 3 and take the shortest path from 3 to 4 without visiting 1, 2, or 3
This gives us an algorithm to find the length of the shortest path quite easily:
-- Vertices first reachable in each generation
generations :: (Ord a) => (a->[a]) -> a -> [Set.Set a]
generations steps i = takeWhile (not . Set.null) $ Set.singleton i: go (Set.singleton i) (Set.singleton i)
where go seen previouslyNovel = let reachable = Set.fromList (Set.toList previouslyNovel >>= steps)
novel = reachable `Set.difference` seen
nowSeen = reachable `Set.union` seen
in novel:go nowSeen novel
lengthShortestPath :: (Ord a) => (a->[a]) -> a -> a -> Maybe Int
lengthShortestPath steps i j = findIndex (Set.member j) $ generations steps i
As expected, lengthShortestPath (step 11) 4 5 is Just 3 and lengthShortestPath problematic 1 4 is Nothing.
In the worst case, generations requires space that is O(v*log v), and time that is O(v*e*log v).
The problem is that min needs to fully evaluate both calls to f,
so if one of them loops infinitly min will never return.
So you have to create a new type, encoding that the number returned by f is Zero or a Successor of Zero.
data Natural = Next Natural
| Zero
toNum :: Num n => Natural -> n
toNum Zero = 0
toNum (Next n) = 1 + (toNum n)
minimal :: Natural -> Natural -> Natural
minimal Zero _ = Zero
minimal _ Zero = Zero
minimal (Next a) (Next b) = Next $ minimal a b
f i j | i == j = Zero
| otherwise = Next $ minimal (f l j) (f r j)
where l = i + 2
r = i - 3
This code actually works.
standing on the floor i of n-story building, find minimal number of steps it takes to get to the floor j, where
step n i = [i-3 | i-3 > 0] ++ [i+2 | i+2 <= n]
thus we have a tree. we need to search it in breadth-first fashion until we get a node holding the value j. its depth is the number of steps. we build a queue, carrying the depth levels,
solution n i j = case dropWhile ((/= j).snd) queue
of [] -> Nothing
((k,_):_) -> Just k
where
queue = [(0,i)] ++ gen 1 queue
The function gen d p takes its input p from d notches back from its production point along the output queue:
gen d _ | d <= 0 = []
gen d ((k,i1):t) = let r = step n i1
in map (k+1 ,) r ++ gen (d+length r-1) t
Uses TupleSections. There's no knot tying here, just corecursion, i.e. (optimistic) forward production and frugal exploration. Works fine without knot tying because we only look for the first solution. If we were searching for several of them, then we'd need to eliminate the cycles somehow.
see also: https://en.wikipedia.org/wiki/Corecursion#Discussion
With the cycle detection:
solutionCD1 n i j = case dropWhile ((/= j).snd) queue
of [] -> Nothing
((k,_):_) -> Just k
where
step n i visited = [i2 | let i2=i-3, not $ elem i2 visited, i2 > 0]
++ [i2 | let i2=i+2, not $ elem i2 visited, i2 <=n]
queue = [(0,i)] ++ gen 1 queue [i]
gen d _ _ | d <= 0 = []
gen d ((k,i1):t) visited = let r = step n i1 visited
in map (k+1 ,) r ++
gen (d+length r-1) t (r++visited)
e.g. solution CD1 100 100 7 runs instantly, producing Just 31. The visited list is pretty much a copy of the instantiated prefix of the queue itself. It could be maintained as a Map, to improve time complexity (as it is, sol 10000 10000 7 => Just 3331 takes 1.27 secs on Ideone).
Some explanations seem to be in order.
First, there's nothing 2D about your problem, because the target floor j is fixed.
What you seem to want is memoization, as your latest edit indicates. Memoization is useful for recursive solutions; your function is indeed recursive - analyzing its argument into sub-cases, synthetizing its result from results of calling itself on sub-cases (here, i+2 and i-3) which are closer to the base case (here, i==j).
Because arithmetics is strict, your formula is divergent in the presence of any infinite path in the tree of steps (going from floor to floor). The answer by chaosmasttter, by using lazy arithmetics instead, turns it automagically into a breadth-first search algorithm which is divergent only if there's no finite paths in the tree, exactly like my first solution above (save for the fact that it's not checking for out-of-bounds indices). But it is still recursive, so indeed memoization is called for.
The usual way to approach it first, is to introduce sharing by "going through a list" (inefficient, because of sequential access; for efficient memoization solutions see hackage):
f n i j = g i
where
gs = map g [0..n] -- floors 1,...,n (0 is unused)
g i | i == j = Zero
| r > n = Next (gs !! l) -- assuming there's enough floors in the building
| l < 1 = Next (gs !! r)
| otherwise = Next $ minimal (gs !! l) (gs !! r)
where r = i + 2
l = i - 3
not tested.
My solution is corecursive. It needs no memoization (just needs to be careful with the duplicates), because it is generative, like the dynamic programming is too. It proceeds away from its starting case, i.e. the starting floor. An external accessor chooses the appropriate generated result.
It does tie a knot - it defines queue by using it - queue is on both sides of the equation. I consider it the simpler case of knot tying, because it is just about accessing the previously generated values, in disguise.
The knot tying of the 2nd kind, the more complicated one, is usually about putting some yet-undefined value in some data structure and returning it to be defined by some later portion of the code (like e.g. a back-link pointer in doubly-linked circular list); this is indeed not what my1 code is doing. What it does do is generating a queue, adding at its end and "removing" from its front; in the end it's just a difference list technique of Prolog, the open-ended list with its end pointer maintained and updated, the top-down list building of tail recursion modulo cons - all the same things conceptually. First described (though not named) in 1974, AFAIK.
1 based entirely on the code from Wikipedia.
Others have answered your direct question about dynamic programming. However, for this kind of problem I think the greedy approach works the best. It's implementation is very straightforward.
f i j :: Int -> Int -> Int
f i j = snd $ until (\(i,_) -> i == j)
(\(i,x) -> (i + if i < j then 2 else (-3),x+1))
(i,0)