How can I implement an optimal, purely functional, double-ended priority queue? - haskell

Okasaki shows how to write purely functional priority queues with O(1) insert and O(log n) minView (some versions also offer O(log n) or even O(1) merge. Can any of these ideas be extended to double-ended priority queues? Khoong and Leong (in a paper I don't have access to) offer an ephemeral implementation based on binomial heaps, but from what I can see of their paper, that approach doesn't seem easy to make persistent, as it uses parent and sibling pointers.

As leftaroundabout points out, this can be done with a 2–3 finger tree. In particular, one annotated with the semigroup
data MinMax k = MinMax
{ smallest :: !k
, largest :: !k }
instance Ord k => Semigroup (MinMax k) where
MinMax min1 max1 <> MinMax min2 max2 = MinMax (min min1 min2) (max max1 max2)
Such an annotated finger tree can be made a double-ended priority queue in basically the same way that the fingertree package defines priority queues (but adjusted slightly to avoid needing a Monoid). minView and maxView can be improved using the same implementation technique as Data.Sequence.deleteAt.
Why use a Semigroup and not add a neutral element to make it a Monoid? This way, we can unpack MinMax annotations into tree nodes and avoid an extra indirection at every step, along with extra allocation.
Performance bounds
insert: Amortized O(1) (note: this bound will hold up even in the face of persistence, thanks to careful use of laziness). Worst-case O(log n). Note that the fingertree package only claims O(log n) for insertion; this is a documentation bug which I have reported and which will be corrected in the next version.
minView/maxView: Worst-case O(1) to see the minimum/maximum; worst-case O(log n) to remove it.
meld: Worst-case O(log (min (m, n)), where m and n are the sizes of the queues.
Hinze-Paterson style 2–3 finger trees are actually a bit more than necessary. A one-fingered version will do the trick, with fewer digit sizes.
{-# options_ghc -funbox-strict-fields #-}
data Node k a
= Node2 !(MinMax k) !a !a
| Node3 !(MinMax k) !a !a !a
data Tree k a
= Empty
-- the child of a Zero node may
-- not be empty
| Zero !(MinMax k) (Tree k (Node k a))
| One !(MinMax k) !a (Tree k (Node k a))
I've been working on fleshing this out for the last few days. Fortunately, it's mostly quite straightforward. Unfortunately, it requires an awful lot of code. The fundamental challenge is that deletion in 2–3 trees is fairly involved. The version for finger trees adds another layer of complexity. And then the whole thing has to be written twice to deal with both minView and maxView.

Related

Can you implement Binary Search Tree in Haskell with O(log n) insertion?

If I understand correctly, modifying (insertion or deletion) a Binary Search Tree in Haskell requires copying the whole tree, so practically making it being O(n). Is there a way to implement it in O(log n) or maybe compiler would optimize O(n) insertion down to O(log n) "under the hood"?
If I understand correctly, modifying (insertion or deletion) a Binary Search Tree in Haskell requires copying the whole tree, so practically making it being O(n).
You do not need to copy the entire tree. Indeed, let us work with a simple unbalanced binary search tree, like:
data Tree a = Node (Tree a) a (Tree a) | Empty deriving (Eq, Show)
then we can insert a value with:
insertIn :: Ord a => a -> Tree a -> Tree a
insertIn x = go
where go Empty = Node Empty x Empty
go n#(Node l v r)
| x < v = Node (go l) v r
| x > v = Node l v (go r)
| otherwise = n
Here we reuse r in case we construct a Node (go l) v r, and we reuse l in case we construct a Node l v (go r). For each node we visit, we create a new node where one of the two subtrees is used in the new node. This means that the new tree will point to the same subtree objects as the original tree.
In this example, the amount of new nodes thus scales with O(d) with d the depth of the tree. If the tree is fairly balanced, than it will insert in O(log n).
Of course you can improve the algorithm and define an AVL tree or red-black tree by storing more information in the node regarding balancing, in that case you thus can guarantee O(log n) insertion time.
The fact that all data is immutable here helps to reuse parts of the tree: we know that l and r can not change, so the two trees will share a large amount of nodes and thus reduce the amount of memory necessary if you want to use both the original and the new tree.
If there is no reference to the old tree necessary, the garbage collector will eventually collect the "old" nodes that have been replaced by the new tree.

Apply function to all pairs efficiently

I need a second order function pairApply that applies a binary function f to all unique pairs of a list-like structure and then combines them somehow. An example / sketch:
pairApply (+) f [a, b, c] = f a b + f a c + f b c
Some research leads me to believe that Data.Vector.Unboxed probably will have good performance (I will also need fast access to specific elements); also it necessary for Statistics.Sample, which would come in handy further down the line.
With this in mind I have the following, which almost compiles:
import qualified Data.Vector.Unboxed as U      
pairElement :: (U.Unbox a, U.Unbox b)    
=> (U.Vector a)                    
  -> (a -> a -> b)                   
  -> Int                             
-> a                               
 -> (U.Vector b)                    
pairElement v f idx el =
U.map (f el) $ U.drop (idx + 1) v            
pairUp :: (U.Unbox a, U.Unbox b)   
=> (a -> a -> b)                        
 -> (U.Vector a)                         
-> (U.Vector (U.Vector b))
pairUp f v = U.imap (pairElement v f) v 
pairApply :: (U.Unbox a, U.Unbox b)
=> (b -> b -> b)                     
-> b                                 
 -> (a -> a -> b)                     
-> (U.Vector a)                      
 -> b
pairApply combine neutral f v =
folder $ U.map folder (pairUp f v) where
folder = U.foldl combine neutral
The reason this doesn't compile is that there is no Unboxed instance of a U.Vector (U.Vector a)). I have been able to create new unboxed instances in other cases using Data.Vector.Unboxed.Deriving, but I'm not sure it would be so easy in this case (transform it to a tuple pair where the first element is all the inner vectors concatenated and the second is the length of the vectors, to know how to unpack?)
My question can be stated in two parts:
Does the above implementation make sense at all or is there some quick library function magic etc that could do it much easier?
If so, is there a better way to make an unboxed vector of vectors than the one sketched above?
Note that I'm aware that foldl is probably not the best choice; once I've got the implementation sorted I plan to benchmark with a few different folds.
There is no way to define a classical instance for Unbox (U.Vector b), because that would require preallocating a memory area in which each element (i.e. each subvector!) has the same fixed amount of space. But in general, each of them may be arbitrarily big, so that's not feasible at all.
It might in principle be possible to define that instance by storing only a flattened form of the nested vector plus an extra array of indices (where each subvector starts). I once briefly gave this a try; it actually seems somewhat promising as far as immutable vectors are concerned, but a G.Vector instance also requires a mutable implementation, and that's hopeless for such an approach (because any mutation that changes the number of elements in one subvector would require shifting everything behind it).
Usually, it's just not worth it, because if the individual element vectors aren't very small the overhead of boxing them won't matter, i.e. often it makes sense to use B.Vector (U.Vector b).
For your application however, I would not do that at all – there's no need to ever wrap the upper element-choices in a single triangular array. (And it would be really bad for performance to do that, because it make the algorithm take O (n²) memory rather than O (n) which is all that's needed.)
I would just do the following:
pairApply combine neutral f v
= U.ifoldl' (\acc i p -> U.foldl' (\acc' q -> combine acc' $ f p q)
acc
(U.drop (i+1) v) )
neutral v
This corresponds pretty much to the obvious nested-loops imperative implementation
pairApply(combine, b, f, v):
for(i in 0..length(v)-1):
for(j in i+1..length(v)-1):
b = combine(b, f(v[i], v[j]);
return b;
My answer is basically the same as leftaroundabout's nested-loops imperative implementation:
pairApply :: (Int -> Int -> Int) -> Vector Int -> Int
pairApply f v = foldl' (+) 0 [f (v ! i) (v ! j) | i <- [0..(n-1)], j <- [(i+1)..(n-1)]]
where n = length v
As far as I know, I do not see any performance issue with this implementation.
Non-polymorphic for simplicity.

Improve complexity of association list generation

I currently have a list of the form:
[(foo, bar), (foo, baz), (qux, quux)]
I would like to convert this into a list of the form:
[(foo, [bar, baz]), (qux, [quxx])]
In my actual use case, the list contains around 1 million of these tuples.
Currently, I'm solving this in the following way, which, while entirely pure and free of side-effects, also is (as I understand it) O(n^2):
import qualified Data.HashMap.Strict as M
foo xs = M.fromListWith (++) $ xs
Is there a better way to do this?
The fromListWith algorithm has an O(n*log n) time complexity. This is the best you can get with no other constraints. The idea is that you need to traverse the list (O(n)) and foreach element insert (and check for duplicates) the key in the hash (O(log(n))).
With other constraints and with more space complexity you might be able to achieve a linear complexity. For example if the range of the keys is "compact" and the keys are integers, then you can use a vector/array and maybe pay more in terms of space, but get a O(1) lookup and insertion.
No, you're fine, except for a small error in your implementation[1]. As Jeffrey pointed out, fromListWith has O(n log n) complexity, which is quite good.
The potential issue you might face is appending, which could possibly be O(n^2) if all the keys were the same and you appended to the end of each list. However, a little experiment shows
data Tree a = Branch (Tree a) (Tree a) | Leaf a
deriving (Show)
ghci> M.fromListWith Branch [(1, Leaf 1), (1, Leaf 2), (1, Leaf 3)]
fromList [(1,Branch (Leaf 3) (Branch (Leaf 2) (Leaf 1)))]
that fromListWith gives the new element as the first argument to the combining function, so you will be prepending (which is O(1)) rather than appending (which is O(n)), so you're okay there.
[1]: You have forgotten to make singleton lists out of the values before passing to M.fromListWith.

Is there a way to avoid copying the whole search path of a binary tree on insert?

I've just started working my way through Okasaki's Purely Functional Data Structures, but have been doing things in Haskell rather than Standard ML. However, I've come across an early exercise (2.5) that's left me a bit stumped on how to do things in Haskell:
Inserting an existing element into a binary search tree copies the entire search path
even though the copied nodes are indistinguishable from the originals. Rewrite insert using exceptions to avoid this copying. Establish only one handler per insertion rather than one handler per iteration.
Now, my understanding is that ML, being an impure language, gets by with a conventional approach to exception handling not so different to, say, Java's, so you can accomplish it something like this:
type Tree = E | T of Tree * int * Tree
exception ElementPresent
fun insert (x, t) =
let fun go E = T (E, x, E)
fun go T(l, y, r) =
if x < y then T(go (l), x, r)
else if y < x then T(l, x, go (r))
else raise ElementPresent
in go t
end
handle ElementPresent => t
I don't have an ML implementation, so this may not be quite right in terms of the syntax.
My issue is that I have no idea how this can be done in Haskell, outside of doing everything in the IO monad, which seems like cheating and even if it's not cheating, would seriously limit the usefulness of a function which really doesn't do any mutation. I could use the Maybe monad:
data Tree a = Empty | Fork (Tree a) a (Tree a)
deriving (Show)
insert :: (Ord a) => a -> Tree a -> Tree a
insert x t = maybe t id (go t)
where go Empty = return (Fork Empty x Empty)
go (Fork l y r)
| x < y = do l' <- go l; return (Fork l' y r)
| x > y = do r' <- go r; return (Fork l y r')
| otherwise = Nothing
This means everything winds up wrapped in Just on the way back up when the element isn't found, which requires more heap allocation, and sort of defeats the purpose. Is this allocation just the price of purity?
EDIT to add: A lot of why I'm wondering about the suitability of the Maybe solution is that the optimization described only seems to save you all the constructor calls you would need in the case where the element already exists, which means heap allocations proportional to the length of the search path. The Maybe also avoids those constructor calls when the element already exists, but then you get a number of Just constructor calls equal to the length of the search path. I understand that a sufficiently smart compiler could elide all the Just allocations, but I don't know if, say, the current version of GHC is really that smart.
In terms of cost, the ML version is actually very similar to your Haskell version.
Every recursive call in the ML version results in a stack frame. The same is true in the
Haskell version. This is going to be proportional in size to the path that you traverse in
the tree. Also, both versions will of course allocate new nodes for the entire path if an insertion is actually performed.
In your Haskell version, every recursive call might also eventually result in the
allocation of a Just node. This will go on the minor heap, which is just a block of
memory with a bump pointer. For all practical purposes, GHC's minor heap is roughly equivalent in
cost to the stack. Since these are short-lived allocations, they won't normally end up
being moved to the major heap at all.
GHC generally cannot elide path copying in cases like that. However, there is a way to do it manually, without incurring any of the indirection/allocation costs of Maybe. Here it is:
{-# LANGUAGE MagicHash #-}
import GHC.Prim (reallyUnsafePtrEquality#)
data Tree a = Empty | Fork (Tree a) a (Tree a)
deriving (Show)
insert :: (Ord a) => a -> Tree a -> Tree a
insert x Empty = Fork Empty x Empty
insert x node#(Fork l y r)
| x < y = let l' = insert x l in
case reallyUnsafePtrEquality# l l' of
1# -> node
_ -> Fork l' y r
| x > y = let r' = insert x r in
case reallyUnsafePtrEquality# r r' of
1# -> node
_ -> Fork l y r'
| otherwise = node
The pointer equality function does exactly what's in the name. Here it is safe because even if the equality returns a false negative we only do a bit of extra copying, and nothing worse happens.
It's not the most idiomatic or prettiest Haskell, but the performance benefits can be significant. In fact, this trick is used very frequently in unordered-containers.
As fizruk indicates, the Maybe approach is not significantly different from what you'd get in Standard ML. Yes, the whole path is copied, but the new copy is discarded if it turns out not to be needed. The Just constructor itself may not even be allocated on the heap—it can't escape from insert, let alone the module, and you don't do anything weird with it, so the compiler is free to analyze it to death.
Edit
There are efficiency problems, now that I think of it. Your use of Maybe conceals the fact that you're actually making two passes—one down to find the insertion point and one up to build the tree. The solution to this is to drop Maybe Tree in favor of (Tree,Bool) and use strictness annotations, or to switch to continuation-passing style. Also, if you choose to stay with the three-way logic, you may want to use the three-way comparison function. Alternatively, you can go all the way to the bottom each time and check later if you hit a duplicate.
If you have a predicate that checks whether the key is already in the tree, you can look before you leap:
insert x t = if contains t x then t else insert' x t
This traverses the tree twice, of course. Whether that's as bad as it sounds should be determined empirically: it might just load the relevant part of the tree into the cache.

Find the max value of node in a tree

I have a problem.
I have to implement a function maxT in Haskell which returns the maximum value of a node from a binary tree.
data Tree a = Leaf a | Node (Tree a) a (Tree a)
This is given. What should I do next?
maxT :: (Tree Integer) -> Integer
maxT (Leaf a) = a
maxT (Node l a r) = max a (max (maxT l) (maxT r))
Is this right?
Let's see how hard this is to prove correct. Why? Because it's a great way to analyze programs for errors. Especially recursive ones. We'll technically use induction, but it isn't so complex. The key is to realize that maxT t must always be the largest value in the tree t—this declaration, "maxT t must always be the largest value in the tree t" is called an invariant and we'll try to prove it.
First, let's assume t is a Leaf. In this case, you've defined maxT (Leaf a) = a and since there are literally no other values in this tree, a must be the largest. Thus, maxT upholds our invariant when passed a Leaf. This is the "base case".
Now we'll consider what happens when we let t = Node (Leaf a) b (Leaf c) for some Integers a, b, and c. This is a height-1 tree and forms what you might call an "example case" for induction. Let's try out maxT and see if the invariant holds.
maxT t
===
maxT (Node (Leaf a) b (Leaf c))
===
max b (max (maxT (Leaf a)) (maxT (Leaf c)))
at this point we'll use our base-case step and say that since the only applications of maxT in this expression are on Leafs then each one must uphold our invariant. This is kind of dumb, but that's because it's just an example case. We'll see the more general pattern later.
For now, let's evaluate our maxT (Leaf _) bits knowing that the result is the maximal value in each particular left- or right-subtree.
===
max b (max a c)
Now, I don't much want to dive into the definition of max, but based on its name I'm happy to assume that max a b returns value that is maximal between a and b. We could pick our way through the details here, but it's clear that max b (max a c) has been given all the relevant information about our Node for computing the maximum of the entire height-1 tree. I'd call this a successful proof that maxT works for both height-0 and height-1 trees (Leafs and Nodes containing only Leafs).
The next step is to generalize this example case.
So let's apply that same pattern generalizing on the height of the tree. We'll ask what happens if we fix some number, n, and assume that maxT t upholds our invariant for all t of height n or less. This is a little bizarre—we have only shown this works for n = 0 and n = 1. It'll be clear why this works a little later.
So what does that assumption do for us? Well, let's take any two Trees of height n or less (call them l and r), any integer x, and combine them to form a new tree t = Node x l r. What happens when we do maxT t?
maxT t
===
maxT (Node x l r)
===
max x (max (maxT l) (maxT r))
and we know, per our assumption, that maxT l and maxT r uphold our invariant. Then the chain of maxes continues to uphold our invariant now for a tree t that's height-(n+1). Furthermore (and this is really important) our process of assembling new Trees is general—we can make any height-(n+1) tree in this method. This means that maxT works for any height-(n+1) tree.
Induction time! We now know that if we pick an n and believe (for some reason) that maxT works for any height-n tree, then it immediately must work for any height-(n+1) tree. Let's pick n = 0. We know by the "base case" that maxT works for Leafs, so suddenly we know that maxT works for height-1 trees. This was our "example case". Now, given that knowledge, we can immediately see maxT works for height-2 trees. And then height-3 trees. And then height-4. And so on and on and on.
This completes a proof* that maxT is correct.
*I have to leave a few caveats. We didn't really do the fiddly details to show that the max chains work out, though it makes sense. I also didn't really prove that the induction step works—what if there were more ways to make a height-(n+1) tree than just using Node on height-n or lesser trees? The more powerful way is to "break apart" a height-n tree, but that's a little harder to see, I think. Finally, we would want to really think hard about what happens if we send in maxT (Leaf undefined) or other pathological values like that. These arise in Haskell because it's a (turing-complete) computer language instead of pure math. Honestly, these little bits don't change a whole lot for your situation, though.

Resources