The SML Program: heap.sml

  1 datatype tree = empty | node of tree * int * tree;
  2 
  3 fun inorder empty s = s
  4  |  inorder (node(l,n,r)) s = inorder l (n :: (inorder r s))
  5  ;
  6 
  7 local
  8   fun max (x:int) y = if x > y then x else y
  9  in
 10   fun height empty = 0
 11    |  height (node(l,_,r)) = 1 + max (height l) (height r)
 12 end;
 13 
 14 fun isfull empty = true
 15  |  isfull (node(l,_,r)) = height l = height r  andalso isfull l andalso isfull r
 16  ;
 17 
 18 fun is_complete empty = true
 19  |  is_complete (t as node(l,_,r)) =
 20         isfull t orelse 
 21         ((height l) = (height r) + 1 andalso isfull r andalso is_complete l) orelse
 22         ((height l) = (height r) andalso isfull l andalso is_complete r)
 23  ;
 24 
 25 fun max n empty = true
 26  |  max n (node (l,m,r)) = n>=m andalso (is_prioritized l) andalso (is_prioritized r)
 27 and
 28     is_prioritized (empty) = true
 29  |  is_prioritized (node (l,n,r)) = (max n l) andalso (max n r)
 30  ;
 31 
 32 fun isheap t = is_complete t andalso is_prioritized t
 33 
 34 
 35 fun CBTinsert item empty = node (empty,item,empty)
 36  |  CBTinsert item (t as node(l,n,r)) =
 37        if isfull t orelse 
 38           (height l = height r + 1 andalso isfull r andalso is_complete l andalso not (isfull l))
 39        then node (CBTinsert item l,n,r)
 40        else node (l,n,CBTinsert item r)
 41  ;
 42 
 43 fun LISTtoCBT [] t = t
 44  |   LISTtoCBT (x::xs) t = LISTtoCBT xs (CBTinsert x t)
 45  ;
 46 
 47 
 48 fun heapify empty = empty
 49  |  heapify (t as node(empty,n,r)) = t   (* assumes r=empty! *)
 50  |  heapify (t as node(node(l,m,r),n,empty)) =   (* assumes l,r=empty! *)
 51       if n>=m then t else node (node (empty,n,empty),m,empty)
 52  |  heapify (t as node(l as node(l1,m,r1),n,r as node(l2,q,r2))) = 
 53       if n>=m andalso n>=q then t
 54       else if m>=n andalso m>=q then node (heapify (node(l1,n,r1)),m,r)
 55       else node (l,q,heapify(node(l2,n,r2)))
 56  ;
 57 
 58 fun CBTtoHeap empty = empty
 59  |  CBTtoHeap (node(l,n,r)) = heapify (node (CBTtoHeap l, n, CBTtoHeap r));
 60 
 61 fun HEAPbuild l = CBTtoHeap (LISTtoCBT l empty);
 62 
 63 val h = HEAPbuild [503,087,512,061,908,170,897,275,653,426,154,509,612,677,765,703];
 64 
 65 fun HEAPinsert item t = CBTtoHeap (CBTinsert item t);
 66 
 67 (*
 68 fun HEAPmerge empty empty = empty
 69  |  HEAPmerge empty t = t
 70  |  HEAPmerge t empty = t
 71  |  HEAPmerge (l as node(l1,m,r1)) (r as node(l2,q,r2)) = 
 72       if m>=q then node (heapify (node(l1,q,r1)),m,r)
 73       else node (l,q,heapify(node(l2,m,r2)))
 74  ;
 75 *)
 76 
 77 fun HEAPmerge t s = CBTtoHeap (LISTtoCBT (inorder t []) s);
 78 
 79 fun HEAPsort empty = []
 80  |  HEAPsort (node(l,n,r)) = n :: HEAPsort (HEAPmerge l r);
 81 
 82 HEAPsort h;