1% ---------------------------------------------------------------------- 2% System: ECLiPSe Constraint Logic Programming System 3% Version: $Id: heaps.pl,v 1.2 2009/07/16 09:11:24 jschimpf Exp $ 4% 5% Copyright: This library has been adapted from code from the Edinburgh 6% DEC-10 Prolog Library, whose copyright notice says: 7% 8% These files are all in the "public domain" so you can 9% use them freely, copy them, incorporate them into 10% programs of your own and so forth without payment. 11% The work of producing them in the first place and of 12% organising them as detailed here has been funded over 13% the years at Edinburgh University mainly by the 14% Science and Engineering Research Council. Their 15% dissemination has been encouraged by the Alvey Special 16% Interest Group: Artificial Intelligence. We would 17% appreciate it if you were to acknowledge these bodies 18% when you use or re-distribute any of these files. 19% ---------------------------------------------------------------------- 20 21% File : HEAPS.PL 22% Author : R.A.O'Keefe 23% Updated: 29 November 1983 24% Purpose: Implement heaps in Prolog. 25 26:- module(heaps). % ECLiPSe header 27:- export 28 add_to_heap/4, 29 get_from_heap/4, 30 heap_size/2, 31 heap_to_list/2, 32 list_to_heap/2, 33 min_of_heap/3, 34 min_of_heap/5. 35 36:- comment(categories, ["Data Structures"]). 37:- comment(summary, "Implement heaps in Prolog"). 38:- comment(author, "R.A.O'Keefe"). 39:- comment(copyright, 'This file is in the public domain'). 40:- comment(date, "29 November 1983"). 41:- comment(desc, html("<P> 42 A heap is a labelled binary tree where the key of each node is less 43 than or equal to the keys of its sons. The point of a heap is that 44 we can keep on adding new elements to the heap and we can keep on 45 taking out the minimum element. If there are N elements total, the 46 total time is O(NlgN). If you know all the elements in advance, you 47 are better off doing a merge-sort, but this file is for when you 48 want to do say a best-first search, and have no idea when you start 49 how many elements there will be, let alone what they are. 50</P><P> 51 A heap is represented as a triple t(N, Free, Tree) where N is the 52 number of elements in the tree, Free is a list of integers which 53 specifies unused positions in the tree, and Tree is a tree made of 54<PRE> 55 t terms for empty subtrees and 56 t(Key,Datum,Lson,Rson) terms for the rest 57</PRE> 58 The nodes of the tree are notionally numbered like this: 59<PRE> 60 1 61 2 3 62 4 6 5 7 63 8 12 10 14 9 13 11 15 64 .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. .. 65</PRE> 66 The idea is that if the maximum number of elements that have been in 67 the heap so far is M, and the tree currently has K elements, the tree 68 is some subtreee of the tree of this form having exactly M elements, 69 and the Free list is a list of K-M integers saying which of the 70 positions in the M-element tree are currently unoccupied. This free 71 list is needed to ensure that the cost of passing N elements through 72 the heap is O(NlgM) instead of O(NlgN). For M say 100 and N say 10^4 73 this means a factor of two. The cost of the free list is slight. 74 The storage cost of a heap in a copying Prolog (which Dec-10 Prolog is 75 not) is 2K+3M words. 76</P> 77")). 78 79:- comment(add_to_heap/4, [ 80 summary:"inserts the new Key-Datum pair into the heap", 81 template:"add_to_heap(+OldHeap, +Key, +Datum, -NewHeap)", 82 desc:html(" 83 inserts the new Key-Datum pair into the heap. The insertion is 84 not stable, that is, if you insert several pairs with the same 85 Key it is not defined which of them will come out first, and it 86 is possible for any of them to come out first depending on the 87 history of the heap. If you need a stable heap, you could add 88 a counter to the heap and include the counter at the time of 89 insertion in the key. If the free list is empty, the tree will 90 be grown, otherwise one of the empty slots will be re-used. (I 91 use imperative programming language, but the heap code is as 92 pure as the trees code, you can create any number of variants 93 starting from the same heap, and they will share what common 94 structure they can without interfering with each other.) 95 ")]). 96 97add_to_heap(t(M,[],OldTree), Key, Datum, t(N,[],NewTree)) :- !, 98 N is M+1, 99 add_to_heap(N, Key, Datum, OldTree, NewTree). 100add_to_heap(t(M,[H|T],OldTree), Key, Datum, t(N,T,NewTree)) :- 101 N is M+1, 102 add_to_heap(H, Key, Datum, OldTree, NewTree). 103 104 105add_to_heap(1, Key, Datum, _, t(Key,Datum,t,t)) :- !. 106add_to_heap(N, Key, Datum, t(K1,D1,L1,R1), t(K2,D2,L2,R2)) :- 107 E is N mod 2, 108 M is N // 2, 109 sort2(Key, Datum, K1, D1, K2, D2, K3, D3), 110 add_to_heap(E, M, K3, D3, L1, R1, L2, R2). 111 112 113add_to_heap(0, N, Key, Datum, L1, R, L2, R) :- !, 114 add_to_heap(N, Key, Datum, L1, L2). 115add_to_heap(1, N, Key, Datum, L, R1, L, R2) :- !, 116 add_to_heap(N, Key, Datum, R1, R2). 117 118 119sort2(Key1, Datum1, Key2, Datum2, Key1, Datum1, Key2, Datum2) :- 120 Key1 @< Key2, 121 !. 122sort2(Key1, Datum1, Key2, Datum2, Key2, Datum2, Key1, Datum1). 123 124 125 126:- comment(get_from_heap/4, [ 127 summary:"returns the Key-Datum pair in OldHeap with the smallest Key", 128 template:"get_from_heap(+OldHeap, ?Key, ?Datum, -NewHeap)", 129 desc:html(" 130 returns the Key-Datum pair in OldHeap with the smallest Key, and 131 also a New Heap which is the Old Heap with that pair deleted. 132 The easy part is picking off the smallest element. The hard part 133 is repairing the heap structure. repair_heap/4 takes a pair of 134 heaps and returns a new heap built from their elements, and the 135 position number of the gap in the new tree. Note that repair_heap 136 is *not* tail-recursive. 137 ")]). 138 139get_from_heap(t(N,Free,t(Key,Datum,L,R)), Key, Datum, t(M,[Hole|Free],Tree)) :- 140 M is N-1, 141 repair_heap(L, R, Tree, Hole). 142 143 144repair_heap(t(K1,D1,L1,R1), t(K2,D2,L2,R2), t(K2,D2,t(K1,D1,L1,R1),R3), N) :- 145 K2 @< K1, 146 !, 147 repair_heap(L2, R2, R3, M), 148 N is 2*M+1. 149repair_heap(t(K1,D1,L1,R1), t(K2,D2,L2,R2), t(K1,D1,L3,t(K2,D2,L2,R2)), N) :- !, 150 repair_heap(L1, R1, L3, M), 151 N is 2*M. 152repair_heap(t(K1,D1,L1,R1), t, t(K1,D1,L3,t), N) :- !, 153 repair_heap(L1, R1, L3, M), 154 N is 2*M. 155repair_heap(t, t(K2,D2,L2,R2), t(K2,D2,t,R3), N) :- !, 156 repair_heap(L2, R2, R3, M), 157 N is 2*M+1. 158repair_heap(t, t, t, 1) :- !. 159 160 161 162:- comment(heap_size/2, [ 163 summary:"reports the number of elements currently in the heap", 164 template:"heap_size(+Heap, ?Size)"]). 165 166heap_size(t(Size,_,_), Size). 167 168 169 170:- comment(heap_to_list/2, [ 171 summary:"returns the current set of Key-Datum pairs in the Heap as a List.", 172 template:"heap_to_list(+Heap, -List)", 173 desc:html(" 174 returns the current set of Key-Datum pairs in the Heap as a 175 List, sorted into ascending order of Keys. This is included 176 simply because I think every data structure foo ought to have 177 a foo_to_list and list_to_foo relation (where, of course, it 178 makes sense!) so that conversion between arbitrary data 179 structures is as easy as possible. This predicate is basically 180 just a merge sort, where we can exploit the fact that the tops 181 of the subtrees are smaller than their descendants. 182 ")]). 183 184heap_to_list(t(_,_,Tree), List) :- 185 heap_tree_to_list(Tree, List). 186 187 188heap_tree_to_list(t, []) :- !. 189heap_tree_to_list(t(Key,Datum,Lson,Rson), [Key-Datum|Merged]) :- 190 heap_tree_to_list(Lson, Llist), 191 heap_tree_to_list(Rson, Rlist), 192 heap_tree_to_list(Llist, Rlist, Merged). 193 194 195heap_tree_to_list([H1|T1], [H2|T2], [H2|T3]) :- 196 H2 @< H1, 197 !, 198 heap_tree_to_list([H1|T1], T2, T3). 199heap_tree_to_list([H1|T1], T2, [H1|T3]) :- !, 200 heap_tree_to_list(T1, T2, T3). 201heap_tree_to_list([], T, T) :- !. 202heap_tree_to_list(T, [], T). 203 204 205 206:- comment(list_to_heap/2, [ 207 summary:"takes a list of Key-Datum pairs and forms them into a heap", 208 template:"list_to_heap(+List, -Heap)", 209 desc:html(" 210 takes a list of Key-Datum pairs (such as keysort could be used to 211 sort) and forms them into a heap. We could do that a wee bit 212 faster by keysorting the list and building the tree directly, but 213 this algorithm makes it obvious that the result is a heap, and 214 could be adapted for use when the ordering predicate is not @< 215 and hence keysort is inapplicable. 216 ")]). 217 218list_to_heap(List, Heap) :- 219 list_to_heap(List, 0, t, Heap). 220 221 222list_to_heap([], N, Tree, t(N,[],Tree)) :- !. 223list_to_heap([Key-Datum|Rest], M, OldTree, Heap) :- 224 N is M+1, 225 add_to_heap(N, Key, Datum, OldTree, MidTree), 226 list_to_heap(Rest, N, MidTree, Heap). 227 228 229 230:- comment(min_of_heap/3, [ 231 summary:"returns the Key-Datum pair at the top of the heap", 232 template:"min_of_heap(+Heap, ?Key, ?Datum)", 233 desc:html(" 234 returns the Key-Datum pair at the top of the heap (which is of 235 course the pair with the smallest Key), but does not remove it 236 from the heap. It fails if the heap is empty. 237 ")]). 238 239:- comment(min_of_heap/5, [ 240 summary:"returns the smallest and second smallest pairs in the heap", 241 template:"min_of_heap(+Heap, ?Key1, ?Datum1, ?Key2, ?Datum2)", 242 desc:html(" 243 returns the smallest (Key1) and second smallest (Key2) pairs in 244 the heap, without deleting them. It fails if the heap does not 245 have at least two elements. 246 ")]). 247 248min_of_heap(t(_,_,t(Key,Datum,_,_)), Key, Datum). 249 250 251min_of_heap(t(_,_,t(Key1,Datum1,Lson,Rson)), Key1, Datum1, Key2, Datum2) :- 252 min_of_heap(Lson, Rson, Key2, Datum2). 253 254 255min_of_heap(t(Ka,_Da,_,_), t(Kb,Db,_,_), Kb, Db) :- 256 Kb @< Ka, !. 257min_of_heap(t(Ka,Da,_,_), _, Ka, Da). 258min_of_heap(t, t(Kb,Db,_,_), Kb, Db). 259 260