1 | :- module(fibonacci_heap, [init/0, | |
2 | reset/0, | |
3 | push/2, | |
4 | push_bt/2, | |
5 | delete_elm/1, | |
6 | delete_elm_bt/1, | |
7 | is_empty/0, | |
8 | get_max_value/1, | |
9 | get_max_priority/1, | |
10 | get_priority_of/2, | |
11 | get_priority_of_silent_fail/2, | |
12 | get_and_remove_max_value/1, | |
13 | get_and_remove_max_value_bt/1, | |
14 | update/2, | |
15 | update_bt/2, | |
16 | inc_priority_of/2, | |
17 | inc_priority_of_bt/2, | |
18 | dec_priority_of/2, | |
19 | dec_priority_of_bt/2, | |
20 | mult_priority_of/2, | |
21 | mult_priority_of_bt/2, | |
22 | mult_priority_of_all/1, | |
23 | set_maintain_update_order/1, | |
24 | fib_test/0]). | |
25 | ||
26 | :- use_module(probsrc(pathes_lib),[safe_load_foreign_resource/2]). | |
27 | :- use_module(probsrc(error_manager), [add_error_and_fail/2]). | |
28 | :- use_module(probsrc(module_information)). | |
29 | ||
30 | :- module_info(group, extension). | |
31 | :- module_info(description, 'Fibonacci heap to store atoms with a priority.'). | |
32 | ||
33 | % Note: By default, the heap maintains the insertion/update order if several elements have the same priority. | |
34 | % Can be set to false using set_maintain_update_order(false). | |
35 | ||
36 | foreign_resource(fibonacci_heap, [reset, | |
37 | push, | |
38 | push_with_fixed_update_count, | |
39 | is_empty, | |
40 | delete_elm, | |
41 | get_max_value_, | |
42 | get_max_priority_, | |
43 | get_priority_of_, | |
44 | get_update_count_of_, | |
45 | get_and_remove_max_value_, | |
46 | elm_exists, | |
47 | update, | |
48 | inc_priority_of, | |
49 | dec_priority_of, | |
50 | mult_priority_of, | |
51 | mult_priority_of_all, | |
52 | set_maintain_update_order_]). | |
53 | ||
54 | foreign(reset, c, reset). | |
55 | foreign(push, c, push(+float,+atom)). | |
56 | foreign(push_with_fixed_update_count, c, push_with_fixed_update_count(+float,+atom,+integer)). | |
57 | foreign(delete_elm, c, delete_elm(+atom,[-integer])). | |
58 | foreign(is_empty, c, is_empty([-integer])). | |
59 | foreign(get_max_value_, c, get_max_value_([-atom])). | |
60 | foreign(get_max_priority_, c, get_max_priority_([-float])). | |
61 | foreign(get_priority_of_, c, get_priority_of_(+atom,[-float])). | |
62 | foreign(get_update_count_of_, c, get_update_count_of_(+atom,[-integer])). | |
63 | foreign(get_and_remove_max_value_, c, get_and_remove_max_value_([-atom])). | |
64 | foreign(elm_exists, c, elm_exists(+atom,[-integer])). | |
65 | foreign(update, c, update(+atom,+float,[-integer])). | |
66 | foreign(inc_priority_of, c, inc_priority_of(+atom,+float,[-integer])). | |
67 | foreign(dec_priority_of, c, dec_priority_of(+atom,+float,[-integer])). | |
68 | foreign(mult_priority_of, c, mult_priority_of(+atom,+float,[-integer])). | |
69 | foreign(mult_priority_of_all, c, mult_priority_of_all(+float)). | |
70 | foreign(set_maintain_update_order_, c, set_maintain_update_order_(+integer)). | |
71 | ||
72 | is_empty :- | |
73 | is_empty(Empty), | |
74 | Empty == 1. | |
75 | ||
76 | delete_elm(Value) :- | |
77 | delete_elm(Value, Success), | |
78 | Success == 1. | |
79 | ||
80 | update(Value, Priority) :- | |
81 | update(Value, Priority, Success), | |
82 | Success == 1. | |
83 | ||
84 | get_max_value(MaxValue) :- | |
85 | catch(get_max_value_(MaxValue), | |
86 | Exception, | |
87 | add_error_and_fail(get_max_value, Exception)). | |
88 | ||
89 | get_max_priority(MaxPrio) :- | |
90 | catch(get_max_priority_(MaxPrio), | |
91 | Exception, | |
92 | add_error_and_fail(get_max_priority, Exception)). | |
93 | ||
94 | get_priority_of(Value, Priority) :- | |
95 | catch(get_priority_of_(Value, Priority), | |
96 | Exception, | |
97 | add_error_and_fail(get_priority_of, Exception)). | |
98 | ||
99 | get_priority_of_silent_fail(Value, Priority) :- | |
100 | catch(get_priority_of_(Value, Priority), | |
101 | _, | |
102 | fail). | |
103 | ||
104 | get_and_remove_max_value(MaxValue) :- | |
105 | catch(get_and_remove_max_value_(MaxValue), | |
106 | Exception, | |
107 | add_error_and_fail(get_and_remove_max_value, Exception)). | |
108 | ||
109 | get_update_count_of(Value, UpdateCount) :- | |
110 | catch(get_update_count_of_(Value, UpdateCount), | |
111 | Exception, | |
112 | add_error_and_fail(get_update_count_of, Exception)). | |
113 | ||
114 | elm_exists(Value) :- | |
115 | elm_exists(Value, Exists), | |
116 | Exists == 1. | |
117 | ||
118 | inc_priority_of(Value, IncBy) :- | |
119 | inc_priority_of(Value, IncBy, Success), | |
120 | Success == 1. | |
121 | ||
122 | dec_priority_of(Value, IncBy) :- | |
123 | dec_priority_of(Value, IncBy, Success), | |
124 | Success == 1. | |
125 | ||
126 | mult_priority_of(Value, MultBy) :- | |
127 | mult_priority_of(Value, MultBy, Success), | |
128 | Success == 1. | |
129 | ||
130 | push_bt(Priority, Value) :- | |
131 | push(Priority, Value), | |
132 | ( true | |
133 | ; delete_elm(Value), | |
134 | fail | |
135 | ). | |
136 | ||
137 | update_bt(Value, Priority) :- | |
138 | get_priority_of(Value, OldPriority), | |
139 | update(Value, Priority), | |
140 | ( true | |
141 | ; update(Value, OldPriority), | |
142 | fail | |
143 | ). | |
144 | ||
145 | delete_elm_bt(Value) :- | |
146 | get_priority_of(Value, Priority), | |
147 | get_update_count_of(Value, UpdateCount), | |
148 | delete_elm(Value), | |
149 | ( true | |
150 | ; push_with_fixed_update_count(Priority, Value, UpdateCount), | |
151 | fail | |
152 | ). | |
153 | ||
154 | get_and_remove_max_value_bt(MaxValue) :- | |
155 | get_max_value(MaxValue), | |
156 | ? | delete_elm_bt(MaxValue). |
157 | ||
158 | inc_priority_of_bt(Value, IncBy) :- | |
159 | ( inc_priority_of(Value, IncBy) | |
160 | ; dec_priority_of(Value, IncBy), | |
161 | fail | |
162 | ). | |
163 | ||
164 | dec_priority_of_bt(Value, DecBy) :- | |
165 | ( dec_priority_of(Value, DecBy) | |
166 | ; inc_priority_of(Value, DecBy), | |
167 | fail | |
168 | ). | |
169 | ||
170 | mult_priority_of_bt(Value, IncBy) :- | |
171 | get_priority_of(Value, OldPriority), | |
172 | ( mult_priority_of(Value, IncBy) | |
173 | ; update(Value, OldPriority), | |
174 | fail | |
175 | ). | |
176 | ||
177 | set_maintain_update_order(MaintainOrder) :- | |
178 | ( MaintainOrder == true | |
179 | -> set_maintain_update_order_(1) | |
180 | ; set_maintain_update_order_(0) | |
181 | ). | |
182 | ||
183 | :- dynamic loaded/0. | |
184 | ||
185 | init :- | |
186 | load, | |
187 | reset. | |
188 | ||
189 | load :- | |
190 | ( loaded | |
191 | -> true | |
192 | ; asserta(loaded), | |
193 | safe_load_foreign_resource(fibonacci_heap, fibonacci_heap) | |
194 | ). | |
195 | ||
196 | fib_test :- | |
197 | simple_fib_test, | |
198 | bt_fib_test. | |
199 | ||
200 | simple_fib_test :- | |
201 | init, | |
202 | is_empty, | |
203 | push(-1.2, a), | |
204 | elm_exists(a), | |
205 | get_max_value(MaxVal1), | |
206 | get_max_priority(MaxPrio), | |
207 | MaxPrio == -1.2, | |
208 | MaxVal1 == a, | |
209 | push(2, b), | |
210 | elm_exists(b), | |
211 | get_max_value(MaxVal2), | |
212 | MaxVal2 == b, | |
213 | get_and_remove_max_value(MaxVal3), | |
214 | MaxVal3 == b, | |
215 | get_max_value(MaxVal4), | |
216 | MaxVal4 == a, | |
217 | push(3.3, b), | |
218 | get_max_priority(MaxPrio1), | |
219 | MaxPrio1 == 3.3, | |
220 | update(a, 10), | |
221 | get_priority_of(a, PrioA), | |
222 | PrioA == 10.0, | |
223 | get_max_value(MaxVal5), | |
224 | MaxVal5 == a, | |
225 | get_max_priority(MaxPrio2), | |
226 | MaxPrio2 == 10.0, | |
227 | inc_priority_of(b, 10), | |
228 | get_max_value(MaxVal6), | |
229 | MaxVal6 == b, | |
230 | get_max_priority(MaxPrio3), | |
231 | MaxPrio3 == 13.3, | |
232 | delete_elm(b), | |
233 | get_max_value(MaxVal7), | |
234 | MaxVal7 == a, | |
235 | get_max_priority(MaxPrio4), | |
236 | MaxPrio4 == 10.0, | |
237 | mult_priority_of(a, 0.5), | |
238 | get_max_priority(MaxPrio5), | |
239 | MaxPrio5 == 5.0, | |
240 | elm_exists(a), | |
241 | push(5.0, c), | |
242 | get_max_priority(MaxPrio6), | |
243 | MaxPrio6 == 5.0, | |
244 | get_max_value(MaxVal8), | |
245 | MaxVal8 == c, | |
246 | set_maintain_update_order(false), | |
247 | push(5.0, d), | |
248 | get_max_priority(MaxPrio7), | |
249 | MaxPrio7 == 5.0, | |
250 | get_max_value(MaxVal9), | |
251 | MaxVal9 == c, | |
252 | set_maintain_update_order(true), | |
253 | push(5.0, e), | |
254 | get_max_priority(MaxPrio8), | |
255 | MaxPrio8 == 5.0, | |
256 | get_max_value(MaxVal10), | |
257 | MaxVal10 == e, | |
258 | push(4.0, f), | |
259 | update(f, 5.0), | |
260 | get_max_priority(MaxPrio9), | |
261 | MaxPrio9 == 5.0, | |
262 | get_max_value(MaxVal11), | |
263 | MaxVal11 == f, | |
264 | dec_priority_of(f, 2.0), | |
265 | get_priority_of(f, PrioF), | |
266 | PrioF == 3.0. | |
267 | ||
268 | bt_fib_test :- | |
269 | init, | |
270 | push(1, a), | |
271 | push(0, b), | |
272 | ( push_bt(3, c), | |
273 | get_max_value(MaxVal1), | |
274 | elm_exists(c), | |
275 | MaxVal1 == c, | |
276 | fail | |
277 | ; get_max_value(MaxVal2), | |
278 | \+ elm_exists(c), | |
279 | MaxVal2 == a | |
280 | ), | |
281 | ( delete_elm_bt(a), | |
282 | get_max_value(MaxVal3), | |
283 | MaxVal3 == b, | |
284 | fail | |
285 | ; get_max_value(MaxVal4), | |
286 | MaxVal4 == a | |
287 | ), | |
288 | ( update_bt(b, 10), | |
289 | get_max_priority(MaxPrio1), | |
290 | MaxPrio1 == 10.0, | |
291 | get_max_value(MaxVal5), | |
292 | MaxVal5 == b, | |
293 | fail | |
294 | ; get_max_priority(MaxPrio2), | |
295 | MaxPrio2 == 1.0, | |
296 | get_max_value(MaxVal6), | |
297 | MaxVal6 == a | |
298 | ), | |
299 | push(10, c), | |
300 | push(10, d), | |
301 | get_max_value(MaxVal7), | |
302 | MaxVal7 == d, | |
303 | ( delete_elm_bt(c), | |
304 | delete_elm_bt(d), | |
305 | fail | |
306 | ; get_max_value(MaxVal8), | |
307 | MaxVal8 == d | |
308 | ), | |
309 | ( delete_elm_bt(a), | |
310 | delete_elm_bt(b), | |
311 | delete_elm_bt(c), | |
312 | delete_elm_bt(d), | |
313 | fail | |
314 | ; get_and_remove_max_value(MaxVal9), | |
315 | MaxVal9 == d, | |
316 | get_and_remove_max_value(MaxVal10), | |
317 | MaxVal10 == c, | |
318 | get_and_remove_max_value(MaxVal11), | |
319 | MaxVal11 == a, | |
320 | get_and_remove_max_value(MaxVal12), | |
321 | MaxVal12 == b | |
322 | ). |