Tree heap Haskell code

I'd like a review of Haskell tree heap code in Turning a tree into a heap in Haskell.

module Heapify where

data Tree a = Leaf a | Node (Tree a) a (Tree a) 
   deriving Show

ourTree = Node (Node (Leaf 8) 2 (Leaf 4))  3  (Node (Leaf 1) 7 (Leaf 9))

atTop :: Tree a -> a
atTop (Leaf a) = a
atTop (Node _ a _) = a

replaceTop :: Ord a => Tree a -> a -> Tree a
replaceTop (Leaf _) a = Leaf a
replaceTop (Node l _ r) a = heapify (Node l a r)

adjustLeft :: Ord a => Tree a -> Tree a
adjustLeft (Leaf a) = Leaf a   -- But we shouldn't ask to do this. 
adjustLeft  node@(Node l a r) 
     | topL  Tree a -> Tree a
adjustRight (Leaf a) = Leaf a   -- But we shouldn't ask to do this. 
adjustRight  node@(Node l a r) 
     | topR  Tree a -> Tree a
doTop (Leaf a) = Leaf a
doTop node@(Node l a r) 
    | atTop l > atTop r = adjustLeft node
    | otherwise         = adjustRight node

heapify :: Ord a => Tree a -> Tree a
heapify (Leaf a) = Leaf a
heapify (Node l a r) = doTop (Node (heapify l) a (heapify r))

Correctness? Unanticipated cases?

module Heapify where

data Tree a = Leaf a | Node (Tree a) a (Tree a) 
   deriving Show

I think this can't host an even number of elements. fromList [1,2] seems impossible.

ourTree = Node (Node (Leaf 8) 2 (Leaf 4))  3  (Node (Leaf 1) 7 (Leaf 9))

an example data.

atTop :: Tree a -> a
atTop (Leaf a) = a
atTop (Node _ a _) = a

ok.

replaceTop :: Ord a => Tree a -> a -> Tree a
replaceTop (Leaf _) a = Leaf a
replaceTop (Node l _ r) a = heapify (Node l a r)

produces a heap. doesn't know what data was put on top, must re-heapify. Does not use the knowledge whether l/r are in fact heaps already or not. If was called on a heap, both must have been heaps already. The usual flow would be for heapify to be called on arbitrary trees, but replaceAtTop to be called on heaps only. This might have an impact on performance.

adjustLeft :: Ord a => Tree a -> Tree a
adjustLeft (Leaf a) = Leaf a   -- But we shouldn't ask to do this. 
adjustLeft  node@(Node l a r) 
     | topL <= a = node
     | otherwise = Node (replaceTop l a) topL r
         where topL = atTop l

assumes l was already a heap. If not, l might harbor some number yet bigger than topL and the otherwise clause could produce a non-heap (replaceTop fully heapifies its argument so its biggest number will get floated to its top).

adjustRight :: Ord a => Tree a -> Tree a
adjustRight (Leaf a) = Leaf a   -- But we shouldn't ask to do this. 
adjustRight  node@(Node l a r) 
     | topR <= a = node
     | otherwise = Node l topR (replaceTop r a) 
         where topR = atTop r

similarly to the above, assumes r was a heap. Both functions assume both l and r were heaps actually, because r (corr., l) is kept unchanged. So both assume that only the top element can be out of place before the call, and produce a heap under that assumption. If the assumption does not hold, the produced value will not be a heap.

doTop :: Ord a => Tree a -> Tree a
doTop (Leaf a) = Leaf a
doTop node@(Node l a r) 
    | atTop l > atTop r = adjustLeft node
    | otherwise         = adjustRight node

assuming both l and r were heaps before call, produce a heap.

heapify :: Ord a => Tree a -> Tree a
heapify (Leaf a) = Leaf a
heapify (Node l a r) = doTop (Node (heapify l) a (heapify r))

assuming heapify fulfills its promise, OK. Base case (Leaf a): OK.

So, OK (except for the data definition deficiency).

Call graph

heapify                             (does not assume l/r were heaps)
    |
    |_____  heapify
    |
    |_____  doTop
            |
            |____ adjustLeft / adjustRight    (assume l/r were heaps)
                  |
                  |____ replaceTop   (does not assume l/r were heaps)
                        |
                        |_____ heapify

Performance?

So, heapify essentially is

heapify (Leaf a) = Leaf a
heapify (Node l a r) 
   | a >= top    = Node lh a rh
   | ltop > rtop = Node (replaceTop lh a) ltop rh                 -- lh is a heap!
   | otherwise   = Node lh                rtop (replaceTop rh a)  -- rh is a heap!
  where
    lh   = heapify l    ----- superfluous, == id when called from (1)    -- (2)
    rh   = heapify r    ----- superfluous, == id when called from (1)    -- (2)
    ltop = atTop lh
    rtop = atTop rh
    top  = max ltop rtop
    replaceTop (Leaf _)     a = Leaf a
    replaceTop (Node l _ r) a = heapify (Node l a r)   ------- (1)

Looks a very heavy recursion.

One way to fix this is to assume that heapify will be called only on heaps, not on arbitrary trees. Then the fix is simply to eliminate the two (2) calls. Then it becomes logarithmic.

-
Heaps would need to be created from lists. The usual way is fold/insertElem.

-
The data type definition needs to be adjusted to allow insertion of one element into a heap tree. The definitions will have to be readjusted. Probably easier done with small snippets, like in OP code. atTop would have to produce a Maybe value, as now empty heaps become a possibility (say, one of the children of a fromList [1,2] heap tree - now both subtrees are heaps, and one is empty).

-
The whole balance/depth issue is untouched here.

It's probably simpler to re-write replaceTop to essentially duplicate the above code, without the calls to heapify. It will now assume it's operating on heaps only, not on arbitrary trees. This will make replaceTop logarithmic. Leaves all the other problems unaddressed.

replaceTop (Leaf _)       a = Leaf a      -- operates on heaps!
replaceTop (Node lh _ rh) a               -- lh, rh are heaps!
   | a >= top       = Node lh a rh
   | ltop > rtop    = Node (replaceTop lh a) ltop rh               
   | otherwise      = Node lh                rtop (replaceTop rh a)
  where
    ltop = atTop lh
    rtop = atTop rh
    top  = max ltop rtop

According to master theorem for 2T(n/2) + O(log(n)) case, `heapif

StackExchange Code Review Q#26564, answer score: 4