I'm working on Okasaki's Purely Functional Data Structures and trying to build F# implementations of things. I'm also going through the exercises listed in the book (some are pretty challenging). Well I'm stuck on exercise 3.4 which calls for modifying the merge function of the WeightBiasedLeftistHeap such that it executes in a single pass as opposed to the original 2 pass implementation.
I haven't been able to figure out how to do this yet and was hoping for some suggestions. There was another post here on SO where a guy does it in SML by pretty much inlining the makeT function. I started out going this route (in the commented section 3.4 First Try. But abandoned that approach because I thought that this really wasn't executing in a single pass (it still goes 'till reaching a leaf then unwinds and rebuilds the tree). Am I wrong in interpreting that as still being a two pass merge?
Here is a link to my complete implementation of WeightBiasedLeftistHeap.
Here are my failed attempts to do this in F#:
type Heap<'a> =
| E
| T of int * 'a * Heap<'a> * Heap<'a>
module WeightBiasedLeftistHeap =
exception EmptyException
let weight h =
match h with
| E -> 0
| T(w, _,_,_) -> w
let makeT x a b =
let weightA = weight a
let weightB = weight b
if weightA >= weightB then
T(weightA + weightB + 1, x, a, b)
else
T(weightA + weightB + 1, x, b, a)
// excercise 3.4 first try
// let rec merge3_4 l r =
// match l,r with
// | l,E -> l
// | E,r -> r
// | T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
// if lx <= rx then
// let right = merge3_4 lb rh
// let weightA = weight la
// let weightB = weight right
//
// if weightA >= weightB then
// T(weightA + weightB + 1, lx, la, right)
// else
// T(weightA + weightB + 1, lx, right, la)
// else
// let right = merge3_4 lh rb
// let weightA = weight ra
// let weightB = weight right
//
// if weightA >= weightB then
// T(weightA + weightB + 1, rx, ra, right)
// else
// T(weightA + weightB + 1, rx, right, ra)
// excercise 3.4 second try (fail!)
// this doesn't work, I couldn't figure out how to do this in a single pass
let merge3_4 l r =
let rec merge' l r value leftChild =
match l,r with
| l,E -> makeT value leftChild l
| E,r -> makeT value leftChild r
| T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
if lx <= rx then
merge' lb rh lx la //(fun h -> makeT(lx, la, h))
else
merge' lh rb rx ra //(fun h -> makeT(rx, ra, h))
match l, r with
| l, E -> l
| E, r -> r
| T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
let lf = fun h -> makeT(lx, la, h)
if lx <= rx then
merge' lb rh lx la // (fun h -> makeT(lx, la, h))
else
merge' lh rb rx ra // (fun h -> makeT(rx, ra, h))
let rec merge l r =
match l,r with
| l,E -> l
| E,r -> r
| T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
if lx <= rx then
makeT lx la (merge lb rh)
else
makeT rx ra (merge lh rb)
let insert3_4 x h =
merge3_4 (T(1,x,E,E)) h
The first question is: what constitutes a "one-pass" algorithm? Something that could naturally be implemented as a single top-down loop would qualify. In contrast, recursion--compiled naively--normally has two passes, one on the way down and one on the way back up. Tail recursion can easily be compiled into a loop, and usually is in functional languages. Tail recursion modulo cons is a similar, albeit less common, optimization. But, even if your compiler doesn't support tail recursion modulo cons, you can easily convert such an implementation into a loop by hand.
Tail recursion modulo cons is similar to ordinary tail recursion, except that the tail call is wrapped in a constructor, which can be allocated and partially filled in before the recursive call. In this case, you would want the return expressions to be something like T (1+size(a)+size(b)+size(c),x,a,merge(b,c)). The key insight required here (as mentioned in the edit on the other SO thread) is that you don't need to perform the merge to know how big the result it is going to be, and therefore which side of the new tree it should go on. This is because the size of merge(b,c) will always be size(b)+size(c), which can be calculated outside the merge.
Notice that the original rank function for ordinary leftist heaps does not share this property, and so cannot be optimized in this fashion.
Essentially, then, you inline the two calls to makeT and also convert the calls of the form size(merge(b,c)) to size(b)+size(c).
Once you make this change, the resulting function is significantly lazier than the original, because it can return the root of the result before evaluating the recursive merge.
Similarly, in a concurrent environment involving locks and mutation, the new implementation could support significantly more concurrency by acquiring and releasing locks for each node along the way, rather than locking the entire tree. (Of course, this would only make sense for very lightweight locks.)
I'm not exactly sure if I understood the question correctly, but here is my attempt - currently, the merge operation performs a recursive call to merge (that's the first pass) and when it reaches the end of the heap (first two cases in match), it returns the newly constructed heap back to the caller and calls makeT a couple of times (that's the second pass).
I don't think that simply inlining mMakeT is what we're asked to do (if yes, just add inline to makeT and that's done without making code less readable :-)).
What can be done, though, is to modify the merge function to use continuation-passing-style where the "rest of the work" is passed as a function to the recursive call (so there is not pending work on the stack to be done after the first pass completes). This can be done like this:
let rec merge' l r cont =
match l,r with
| l,E -> cont l // Return result by calling the continuation
| E,r -> cont r // (same here)
| T(_, lx, la, lb) as lh, (T(_, rx, ra, rb) as rh) ->
if lx <= rx then
// Perform recursive call and give it 'makeT' as a continuation
merge' lb rh (makeT lx la)
else
// (same here)
merge' lh rb (makeT rx ra)
// Using 'id' as a continuation, we just return the
// resulting heap after it is constructed
let merge l r = merge' l r id
I'm not fully convinced this is the right answer - it performs just a single pass, but the aggregated work (in the continuation) means that the pass is two-times longer. However, I don't see a way to making this simpler, so it may be the right answer...
Related
Recently, I am reading the book Purely-functional-data-structures
when I came to “Exercise 3.2 Define insert directly rather than via a call to merge” for Leftist_tree。I implement a my version insert.
let rec insert x t =
try
match t with
| E -> T (1, x, E, E)
| T (_, y, left, right ) ->
match (Elem.compare x y) with
| n when n < 0 -> makeT x left (insert y right)
| 0 -> raise Same_elem
| _ -> makeT y left (insert x right)
with
Same_elem -> t
And for verifying if it works, I test it and the merge function offered by the book.
let rec merge m n = match (m, n) with
| (h, E) -> h
| (E, h) -> h
| (T (_, x, a1, b1) as h1, (T (_, y, a2, b2) as h2)) ->
if (Elem.compare x y) < 0
then makeT x a1 (merge b1 h2)
else makeT y a2 (merge b2 h1)
Then I found an interesting thing.
I used a list ["a";"b";"d";"g";"z";"e";"c"] as input to create this tree. And the two results are different.
For merge method I got a tree like this:
and insert method I implemented give me a tree like this :
I think there's some details between the two methods even though I follow the implementation of 'merge' to design the 'insert' version. But then I tried a list inverse ["c";"e";"z";"g";"d";"b";"a"] which gave me two leftist-tree-by-insert tree. That really confused me so much that I don't know if my insert method is wrong or right. So now I have two questions:
if my insert method is wrong?
are leftist-tree-by-merge and leftist-tree-by-insert the same structure? I mean this result give me an illusion like they are equal in one sense.
the whole code
module type Comparable = sig
type t
val compare : t -> t -> int
end
module LeftistHeap(Elem:Comparable) = struct
exception Empty
exception Same_elem
type heap = E | T of int * Elem.t * heap * heap
let rank = function
| E -> 0
| T (r ,_ ,_ ,_ ) -> r
let makeT x a b =
if rank a >= rank b
then T(rank b + 1, x, a, b)
else T(rank a + 1, x, b, a)
let rec merge m n = match (m, n) with
| (h, E) -> h
| (E, h) -> h
| (T (_, x, a1, b1) as h1, (T (_, y, a2, b2) as h2)) ->
if (Elem.compare x y) < 0
then makeT x a1 (merge b1 h2)
else makeT y a2 (merge b2 h1)
let insert_merge x h = merge (T (1, x, E, E)) h
let rec insert x t =
try
match t with
| E -> T (1, x, E, E)
| T (_, y, left, right ) ->
match (Elem.compare x y) with
| n when n < 0 -> makeT x left (insert y right)
| 0 -> raise Same_elem
| _ -> makeT y left (insert x right)
with
Same_elem -> t
let rec creat_l_heap f = function
| [] -> E
| h::t -> (f h (creat_l_heap f t))
let create_merge l = creat_l_heap insert_merge l
let create_insert l = creat_l_heap insert l
end;;
module IntLeftTree = LeftistHeap(String);;
open IntLeftTree;;
let l = ["a";"b";"d";"g";"z";"e";"c"];;
let lh = create_merge `enter code here`l;;
let li = create_insert l;;
let h = ["c";"e";"z";"g";"d";"b";"a"];;
let hh = create_merge h;;
let hi = create_insert h;;
16. Oct. 2015 update
by observing the two implementation more precisely, it is easy to find that the difference consisted in merge a base tree T (1, x, E, E) or insert an element x I used graph which can express more clearly.
So i found that my insert version will always use more complexity to finish his work and doesn't utilize the leftist tree's advantage or it always works in the worse situation, even though this tree structure is exactly “leftist”.
and if I changed a little part , the two code will obtain the same result.
let rec insert x t =
try
match t with
| E -> T (1, x, E, E)
| T (_, y, left, right ) ->
match (Elem.compare x y) with
| n when n < 0 -> makeT x E t
| 0 -> raise Same_elem
| _ -> makeT y left (insert x right)
with
Same_elem -> t
So for my first question: I think the answer is not exact. it can truly construct a leftist tree but always work in the bad situation.
and the second question is a little meaningless (I'm not sure). But it is still interesting for this condition. for instance, even though the merge version works more efficiently but for construct a tree from a list without the need for insert order like I mentioned (["a";"b";"d";"g";"z";"e";"c"], ["c";"e";"z";"g";"d";"b";"a"] , if the order isn't important, for me I think they are the same set.) The merge function can't choose the better solution. (I think the the tree's structure of ["a";"b";"d";"g";"z";"e";"c"] is better than ["c";"e";"z";"g";"d";"b";"a"]'s )
so now my question is :
is the tree structure that each sub-right spine is Empty is a good structure?
if yes, can we always construct it in any input order?
A tree with each sub-right spine empty is just a list. As such a simple list is a better structure for a list. The runtime properties will be the same as a list, meaning inserting for example will take O(n) time instead of the desired O(log n) time.
For a tree you usually want a balanced tree, one where all children of a node are ideally the same size. In your code each node has a rank and the goal would be to have the same rank for the left and right side of each node. If you don't have exactly 2^n - 1 entries in the tree this isn't possible and you have to allow some imbalance in the tree. Usually a difference in rank of 1 or 2 is allowed. Insertion should insert the element on the side with smaller rank and removal has to rebalance any node that exceeds the allowed rank difference. This keeps the tree reasonably balanced, ensuring the desired runtime properties are preserved.
Check your text book what difference in rank is allowed in your case.
I've made a type which is supposed to emulate a "stream". This is basically a list without memory.
data Stream a = forall s. Stream (s -> Maybe (a, s)) s
Basically a stream has two elements. A state s, and a function that takes the state, and returns an element of type a and the new state.
I want to be able to perform operations on streams, so I've imported Data.Foldable and defined streams on it as such:
import Data.Foldable
instance Foldable Stream where
foldr k z (Stream sf s) = go (sf s)
where
go Nothing = z
go (Just (e, ns)) = e `k` go (sf ns)
To test the speed of my stream, I've defined the following function:
mysum = foldl' (+) 0
And now we can compare the speed of ordinary lists and my stream type:
x1 = [1..n]
x2 = Stream (\s -> if (s == n + 1) then Nothing else Just (s, s + 1)) 1
--main = print $ mysum x1
--main = print $ mysum x2
My streams are about half the speed of lists (full code here).
Furthermore, here's a best case situation, without a list or a stream:
bestcase :: Int
bestcase = go 1 0 where
go i c = if i == n then c + i else go (i+1) (c+i)
This is a lot faster than both the list and stream versions.
So I've got two questions:
How to I get my stream version to be at least as fast as a list.
How to I get my stream version to be close to the speed of bestcase.
As it stands the foldl' you are getting from Foldable is defined in terms of the foldr you gave it. The default implementation is the brilliant and surprisingly good
foldl' :: (b -> a -> b) -> b -> t a -> b
foldl' f z0 xs = foldr f' id xs z0
where f' x k z = k $! f z x
But foldl' is the specialty of your type; fortunately the Foldable class includes foldl' as a method, so you can just add this to your instance.
foldl' op acc0 (Stream sf s0) = loop s0 acc0
where
loop !s !acc = case sf s of
Nothing -> acc
Just (a,s') -> loop s' (op acc a)
For me this seems to give about the same time as bestcase
Note that this is a standard case where we need a strictness annotation on the accumulator. You might look in the vector package's treatment of a similar type https://hackage.haskell.org/package/vector-0.10.12.2/docs/src/Data-Vector-Fusion-Stream.html for some ideas; or in the hidden 'fusion' modules of the text library https://github.com/bos/text/blob/master/Data/Text/Internal/Fusion .
I am interrested in different ways of implementing a constant grid in a functional language. A perfect solution should provide traversal in pesimistic constant time per step and not use imperative constructs (laziness is ok). Solutions not quite fulfilling those requirements are still welcome.
My proposal is based on four-way linked nodes like so
A fundamental operation would be to construct a grid of given size. It seems that this operation will determine the type, i.e. which directions will be lazy (obviously this data structure cannot be achieved without laziness). So I propose (in OCaml)
type 'a grid =
| GNil
| GNode of 'a * 'a grid Lazy.t * 'a grid Lazy.t * 'a grid * 'a grid
With references ordered: left, up, right, down. Left and up are suspended. I then build the grid diagonal-wise
Here is a make_grid function that constructs a grid of given size with the coordinate tuples as node values. Please note that gl, gu, gr, gd functions allow walking on a grid in all directions and if given GNil, will return GNil.
let make_grid w h =
let lgnil = Lazy.from_val GNil in
let rec build_ur x y ls dls = match ls with
| l :: ((u :: _) as ls') ->
if x = w && y = h then
GNode ((x, y), l, u, GNil, GNil)
else if x < w && 1 < y then
let rec n = lazy (
let ur = build_ur (x + 1) (y - 1) ls' (n :: dls) in
let r = gd ur in
let d = gl (gd r)
in GNode ((x, y), l, u, r, d)
)
in force n
else if x = w then
let rec n = lazy (
let d = build_dl x (y + 1) (n :: dls) [lgnil]
in GNode ((x, y), l, u, GNil, d)
)
in force n
else
let rec n = lazy (
let r = build_dl (x + 1) y (lgnil :: n :: dls) [lgnil] in
let d = gl (gd r)
in GNode ((x, y), l, u, r, d)
)
in force n
| _ -> failwith "make_grid: Internal error"
and build_dl x y us urs = match us with
| u :: ((l :: _) as us') ->
if x = w && y = h then
GNode ((x, y), l, u, GNil, GNil)
else if 1 < x && y < h then
let rec n = lazy (
let dl = build_dl (x - 1) (y + 1) us' (n :: urs) in
let d = gr dl in
let r = gu (gr d)
in GNode ((x, y), l, u, r, d)
)
in force n
else if y = h then
let rec n = lazy (
let r = build_ur (x + 1) y (n :: urs) [lgnil]
in GNode ((x, y), l, u, r, GNil)
)
in force n
else (* x = 1 *)
let rec n = lazy (
let d = build_ur x (y + 1) (lgnil :: n :: urs) [lgnil] in
let r = gu (gr d)
in GNode ((x, y), l, u, r, d)
)
in force n
| _ -> failwith "make_grid: Internal error"
in build_ur 1 1 [lgnil; lgnil] [lgnil]
It looks pretty complicated as it has to separately handle case when we're going up and when we're going down – build_ur and build_dl auxiliary functions respectively. The build_ur function is of type
build_ur :
int -> int ->
(int * int) grid Lazy.t list ->
(int * int) grid Lazy.t list -> (int * int) grid
It construct a node, given the current position x and y, the list of suspended elements of previous diagonal ls, the list of suspended previous elements of current diagonal urs. The name ls comes from the fact that the first element on ls is the left neighbour of current node. The urs list is needed for construction of the next diagonal.
The build_urs function proceeds with building the next node on the up-right diagonal, passing the current node in a suspension. The left and up neighbour are taken from ls and the right and down neighbours can be accessed through the next node on the diagonal.
Note that I put a bunch of GNils on the urs and ls lists. This is made to always ensure that build_ur and build_dl can consume at least two elements from those lists.
The build_dl function works analogously.
This implementation seems overly complicated for such a simple data structure. In fact I'm suprised it works cause I was driven by faith when writing it and am unable to comprehend completely why it works. Therefore I would like to know a simpler solution.
I was considering building the grid row-wise. This approach has less border cases but I can't eliminate the need of building subsequent rows in different directions. It's because when I go to the end with a row and would like to start building another from the beginning, I would have to somehow know the down node of the first node in current row, which I seemingly can't know until I return from the current function call. And if I can't eliminate bi-directionality, I would need two inner node constructiors: one with suspended left and top and the other with suspended right and top.
Also, here is a gist of this implementation along with omitted functions: https://gist.github.com/mkacz91/0e63aaa2a67f8e67e56f
The datastructure you are looking for if you want a functional solution is a zipper. I've written the rest of the code in Haskell because I find it more to my taste but it's easily ported to OCaml. Here's a gist without the interleaved comments.
{-# LANGUAGE RecordWildCards #-}
module Grid where
import Data.Maybe
We can start by understanding the datastructure for just lists: you can think of a zipper as a pointer deep inside a list. You have wathever is on the left of the element you point at, then the element you point at and finally whatever is on the right.
type ListZipper a = ([a], a, [a])
Given a list and an integer n, you can focus on the element which is at position n. Of course, if n is greater than the lenght of the list, then you just fail. One important thing to notice is that the left part of the list is stored backwards: moving the focus to the left will therefore be possible in constant time. As will moving to the right.
focusListAt :: Int -> [a] -> Maybe (ListZipper a)
focusListAt = go []
where
go _ _ [] = Nothing
go acc 0 (hd : tl) = Just (acc, hd, tl)
go acc n (hd : tl) = go (hd : acc) (n - 1) tl
Let's move on to Grids now. A Grid will just be a list of rows (lists).
newtype Grid a = Grid { unGrid :: [[a]] }
A zipper for a Grid is now given by a grid representing everything above the current focus, another representing everything below it, and a list zipper (advanced level: notice that this looks a bit like nested list zippers & could be reformulated in more generic terms).
data GridZipper a =
GridZipper { above :: Grid a
, below :: Grid a
, left :: [a]
, right :: [a]
, focus :: a }
By focusing on the right row first, and then the right element we may focus a Grid at some coordinates x and y.
focusGridAt :: Int -> Int -> Grid a -> Maybe (GridZipper a)
focusGridAt x y g = do
(before, line , after) <- focusListAt x $ unGrid g
(left , focus, right) <- focusListAt y line
let above = Grid before
let below = Grid after
return GridZipper{..}
Once we have a zipper, we can move around easily. The code for going either left or right is not suprisingly rather similar:
goLeft :: GridZipper a -> Maybe (GridZipper a)
goLeft g#GridZipper{..} =
case left of
[] -> Nothing
(hd:tl) -> Just $ g { focus = hd, left = tl, right = focus : right }
goRight :: GridZipper a -> Maybe (GridZipper a)
goRight g#GridZipper{..} =
case right of
[] -> Nothing
(hd:tl) -> Just $ g { focus = hd, left = focus : left, right = tl }
When going up or down, we have to be a bit careful because we need to focus on the spot right above (or below) the one we left in the new row. We also have to reassemble the previous row we were focused onto into a good old list (by appending the reversed left to focus : right).
goUp :: GridZipper a -> Maybe (GridZipper a)
goUp GridZipper{..} = do
let (line : above') = unGrid above
let below' = (reverse left ++ focus : right) : unGrid below
(left', focus', right') <- focusListAt (length left) line
return $ GridZipper { above = Grid above'
, below = Grid below'
, left = left'
, right = right'
, focus = focus' }
goDown :: GridZipper a -> Maybe (GridZipper a)
goDown GridZipper{..} = do
let (line : below') = unGrid below
let above' = (reverse left ++ focus : right) : unGrid above
(left', focus', right') <- focusListAt (length left) line
return $ GridZipper { above = Grid above'
, below = Grid below'
, left = left'
, right = right'
, focus = focus' }
Finally, I've also added a couple of helper functions to generate grids (with every cell containing a pair of its coordinates) and instances to be able to display grids and zippers in a terminal.
mkGrid :: Int -> Int -> Grid (Int, Int)
mkGrid m n = Grid $ [ zip (repeat i) [0..n-1] | i <- [0..m-1] ]
instance Show a => Show (Grid a) where
show = concatMap (('\n' :) . concatMap show) . unGrid
instance Show a => Show (GridZipper a) where
show GridZipper{..} =
concat [ show above, "\n"
, concatMap show (reverse left)
, "\x1B[33m[\x1B[0m", show focus, "\x1B[33m]\x1B[0m"
, concatMap show right
, show below ]
main creates a small grid of size 5*10, focuses on the element at coordinates (2,3) and moves around a bit.
main :: IO ()
main = do
let grid1 = mkGrid 5 10
print grid1
let grid2 = fromJust $ focusGridAt 2 3 grid1
print grid2
print $ goLeft =<< goLeft =<< goDown =<< goDown grid2
A simple solution for implementing infinite grids consists in using a hash table indexed by the coordinate pairs.
The following is a sample implementation that doesn't check for integer overflow:
type 'a cell = {
x: int; (* position on the horizontal axis *)
y: int; (* position on the vertical axis *)
value: 'a;
}
type 'a grid = {
cells: (int * int, 'a cell) Hashtbl.t;
init_cell: int -> int -> 'a;
}
let create_grid init_cell = {
cells = Hashtbl.create 10;
init_cell;
}
let hashtbl_get tbl k =
try Some (Hashtbl.find tbl k)
with Not_found -> None
(* Check if we have a cell at the given relative position *)
let peek grid cell x_offset y_offset =
hashtbl_get grid.cells (cell.x + x_offset, cell.y + y_offset)
(* Get the cell at the given relative position *)
let get grid cell x_offset y_offset =
let x = cell.x + x_offset in
let y = cell.y + y_offset in
let k = (x, y) in
match hashtbl_get grid.cells k with
| Some c -> c
| None ->
let new_cell = {
x; y;
value = grid.init_cell x y
} in
Hashtbl.add grid.cells k new_cell;
new_cell
let left grid cell = get grid cell (-1) 0
let right grid cell = get grid cell 1 0
let down grid cell = get grid cell 0 (-1)
(* etc. *)
If we have
Ei = mean [abs (Hi - p) for p in Pi]
H = mean [H0, H1, ... Hi, ... Hn]
P = concat [P0, P1, ... Pi, ... Pn]
then does there exist a more efficient way to compute
E = mean [abs (H - p) for p in P]
in terms of H, P, and the Eis and His, given that H, E, and P go on to be used as Hi, Ei, and Pi for some i, at a higher recursive level?
If we store the length of Pi as Li at each stage, then we can let
L = sum [L0, L1, ... Li, ... Ln]
allowing us to perform the somewhat easier calculation
E = sum ([abs (H - p) for p in P] / L)
but the use of the abs function seems to severely restrict the kinds of algebraic manipulations we can use to simplify the numerator.
No. Imagine you have just two groups, and one group has H1 = 1 and the other group has H2 = 2. Imagine that every p in P1 is either 0 or 2, and every p in P2 in is either 1 or 3. Now you will always have E1 = 1 and E2 = 1, regardless of the actual values in P1 and P2. However, you can see that if all p in P1 are 2, and all p in P2 are 1, then E will be minimized (specifically 0.5) because H = 1.5. Or all p in P1 could be 0 and all p in P2 could be 3, in which case E would be maximized. (specifically 1.5). And you could get any answer for E in between 0.5 and 1.5 depending on the distribution of the p. If you don't actually go and look at all the individual p, there's no way to tell what exact value of E you will get between 0.5 and 1.5. So you can't do any better than O(n) time to compute E, where n is the total size of P, which is the same running time if you just compute your desired quantity E directly from it's definition formula.
I am self-studying Okasaki's Purely Functional Data Structures, now on exercise 3.4, which asks to reason about and implement a weight-biased leftist heap. This is my basic implementation:
(* 3.4 (b) *)
functor WeightBiasedLeftistHeap (Element : Ordered) : Heap =
struct
structure Elem = Element
datatype Heap = E | T of int * Elem.T * Heap * Heap
fun size E = 0
| size (T (s, _, _, _)) = s
fun makeT (x, a, b) =
let
val sizet = size a + size b + 1
in
if size a >= size b then T (sizet, x, a, b)
else T (sizet, x, b, a)
end
val empty = E
fun isEmpty E = true | isEmpty _ = false
fun merge (h, E) = h
| merge (E, h) = h
| merge (h1 as T (_, x, a1, b1), h2 as T (_, y, a2, b2)) =
if Elem.leq (x, y) then makeT (x, a1, merge (b1, h2))
else makeT (y, a2, merge (h1, b2))
fun insert (x, h) = merge (T (1, x, E, E), h)
fun findMin E = raise Empty
| findMin (T (_, x, a, b)) = x
fun deleteMin E = raise Empty
| deleteMin (T (_, x, a, b)) = merge (a, b)
end
Now, in 3.4 (c) & (d), it asks:
Currently, merge operates in two
passes: a top-down pass consisting of
calls to merge, and a bottom-up pass
consisting of calls to the helper
function, makeT. Modify merge to
operate in a single, top-down pass.
What advantages would the top-down
version of merge have in a lazy
environment? In a concurrent
environment?
I changed the merge function by simply inlining makeT, but I fail to see any advantages, so I think I haven't grasped the spirit of these parts of the exercise. What am I missing?
fun merge (h, E) = h
| merge (E, h) = h
| merge (h1 as T (s1, x, a1, b1), h2 as T (s2, y, a2, b2)) =
let
val st = s1 + s2
val (v, a, b) =
if Elem.leq (x, y) then (x, a1, merge (b1, h2))
else (y, a2, merge (h1, b2))
in
if size a >= size b then T (st, v, a, b)
else T (st, v, b, a)
end
I think I've figured out one point with regards to lazy evaluation. If I don't use the recursive merge to calculate the size, then the recursive call won't need to be evaluated until the child is needed:
fun merge (h, E) = h
| merge (E, h) = h
| merge (h1 as T (s1, x, a1, b1), h2 as T (s2, y, a2, b2)) =
let
val st = s1 + s2
val (v, ma, mb1, mb2) =
if Elem.leq (x, y) then (x, a1, b1, h2)
else (y, a2, h1, b2)
in
if size ma >= size mb1 + size mb2
then T (st, v, ma, merge (mb1, mb2))
else T (st, v, merge (mb1, mb2), ma)
end
Is that all? I am not sure about concurrency though.
I think you've essentially got it as far as the lazy evaluation goes -- it's not very helpful to use lazy evaluation if you are going to have to end up traversing the whole data structure to find out anything every time you do a merge...
As to the concurrency, I expect the issue is that if, while one thread is evaluating the merge, another comes along and wants to look something up, it will not be able to get anything useful done at least until the first thread completes the merge. (And it might even take longer than that.)
It doesn’t any benefit to WMERGE-3-4C function in a lazy environment. It still does all the work that the original down-up merge did. It pretty sure it would not be any easier for the language system to memorize..
No benefit to WMERGE-3-4C functions in a concurrent environment. Each call to WMERGE-3-4C does all its work before passing the buck to another instance of WMERGE-3-4C. In fact, if we eliminated the recursion by hand, WMERGE-3-4C could be implemented as a single loop that does all the work while accumulating a stack, then a second loop that does the REDUCE work on the stack. The first loop would not be naturally parallizable, though maybe the REDUCE could operate by calling the function on pairs, in parallel, until only one element remained in the list.