11 #include "../base/base_uses.f90"
26 INTEGER(KIND=keyt) :: key = -1_keyt
27 INTEGER(KIND=valt) ::
value = -1_valt
31 TYPE(cp_heap_node) :: node = cp_heap_node()
32 END TYPE cp_heap_node_e
36 INTEGER,
DIMENSION(:),
POINTER :: index => null()
37 TYPE(cp_heap_node_e),
DIMENSION(:),
POINTER :: nodes => null()
49 ELEMENTAL FUNCTION get_parent(n)
RESULT(parent)
50 INTEGER,
INTENT(IN) :: n
54 END FUNCTION get_parent
61 ELEMENTAL FUNCTION get_left_child(n)
RESULT(child)
62 INTEGER,
INTENT(IN) :: n
66 END FUNCTION get_left_child
73 ELEMENTAL FUNCTION get_right_child(n)
RESULT(child)
74 INTEGER,
INTENT(IN) :: n
78 END FUNCTION get_right_child
86 ELEMENTAL FUNCTION get_value(heap, n)
RESULT(value)
87 TYPE(cp_heap_type),
INTENT(IN) :: heap
88 INTEGER,
INTENT(IN) :: n
89 INTEGER(KIND=valt) :: value
91 value = heap%nodes(n)%node%value
92 END FUNCTION get_value
100 ELEMENTAL FUNCTION get_value_by_key(heap, key)
RESULT(value)
101 TYPE(cp_heap_type),
INTENT(IN) :: heap
102 INTEGER(KIND=keyt),
INTENT(IN) :: key
103 INTEGER(KIND=valt) :: value
108 value = get_value(heap, n)
109 END FUNCTION get_value_by_key
119 TYPE(cp_heap_type),
INTENT(OUT) :: heap
120 INTEGER,
INTENT(IN) :: n
123 ALLOCATE (heap%index(n))
124 ALLOCATE (heap%nodes(n))
132 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
134 DEALLOCATE (heap%index)
135 DEALLOCATE (heap%nodes)
145 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
146 INTEGER(KIND=valt),
DIMENSION(:),
INTENT(IN) :: values
148 INTEGER :: first, i, n
151 cpassert(heap%n >= n)
155 heap%nodes(i)%node%key = i
156 heap%nodes(i)%node%value = values(i)
159 first = get_parent(n)
161 CALL bubble_down(heap, i)
174 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
175 INTEGER(KIND=keyt),
INTENT(OUT) :: key
176 INTEGER(KIND=valt),
INTENT(OUT) :: value
177 LOGICAL,
INTENT(OUT) :: found
179 IF (heap%n .LT. 1)
THEN
183 key = heap%nodes(1)%node%key
184 value = heap%nodes(1)%node%value
197 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
198 INTEGER(KIND=keyt),
INTENT(OUT) :: key
199 INTEGER(KIND=valt),
INTENT(OUT) :: value
200 LOGICAL,
INTENT(OUT) :: found
206 IF (heap%n .GT. 1)
THEN
207 CALL cp_heap_copy_node(heap, 1, heap%n)
209 CALL bubble_down(heap, 1)
224 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
225 INTEGER(KIND=keyt),
INTENT(IN) :: key
226 INTEGER(KIND=valt),
INTENT(IN) :: value
228 INTEGER :: n, new_pos
233 cpassert(heap%nodes(n)%node%key == key)
234 heap%nodes(n)%node%value =
value
235 CALL bubble_up(heap, n, new_pos)
236 CALL bubble_down(heap, new_pos)
245 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
246 INTEGER(KIND=valt),
INTENT(IN) :: value
249 heap%nodes(1)%node%value =
value
250 CALL bubble_down(heap, 1)
259 PURE SUBROUTINE cp_heap_swap(heap, e1, e2)
260 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
261 INTEGER,
INTENT(IN) :: e1, e2
263 INTEGER(KIND=keyt) :: key1, key2
264 TYPE(cp_heap_node) :: tmp_node
266 key1 = heap%nodes(e1)%node%key
267 key2 = heap%nodes(e2)%node%key
269 tmp_node = heap%nodes(e1)%node
270 heap%nodes(e1)%node = heap%nodes(e2)%node
271 heap%nodes(e2)%node = tmp_node
273 heap%index(key1) = e2
274 heap%index(key2) = e1
275 END SUBROUTINE cp_heap_swap
283 PURE SUBROUTINE cp_heap_copy_node(heap, e1, e2)
284 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
285 INTEGER,
INTENT(IN) :: e1, e2
287 INTEGER(KIND=keyt) :: key1, key2
289 key1 = heap%nodes(e1)%node%key
290 key2 = heap%nodes(e2)%node%key
292 heap%nodes(e1)%node = heap%nodes(e2)%node
295 heap%index(key2) = e1
296 END SUBROUTINE cp_heap_copy_node
303 SUBROUTINE bubble_down(heap, first)
304 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
305 INTEGER,
INTENT(IN) :: first
307 INTEGER :: e, left_child, right_child, smallest
308 INTEGER(kind=valt) :: left_child_value, min_value, &
313 cpassert(0 < first .AND. first <= heap%n)
319 DO WHILE (e .LE. get_parent(heap%n) .AND. .NOT. all_done)
323 min_value = get_value(heap, e)
324 left_child = get_left_child(e)
325 IF (left_child .LE. heap%n)
THEN
326 left_child_value = get_value(heap, left_child)
327 IF (left_child_value .LT. min_value)
THEN
328 min_value = left_child_value
329 smallest = left_child
332 right_child = left_child + 1
333 IF (right_child .LE. heap%n)
THEN
334 right_child_value = get_value(heap, right_child)
335 IF (right_child_value .LT. min_value)
THEN
336 min_value = right_child_value
337 smallest = right_child
341 CALL cp_heap_swap(heap, e, smallest)
342 IF (smallest .EQ. e)
THEN
348 END SUBROUTINE bubble_down
356 SUBROUTINE bubble_up(heap, first, new_pos)
357 TYPE(cp_heap_type),
INTENT(INOUT) :: heap
358 INTEGER,
INTENT(IN) :: first
359 INTEGER,
INTENT(OUT) :: new_pos
362 INTEGER(kind=valt) :: my_value, parent_value
365 cpassert(0 < first .AND. first <= heap%n)
370 my_value = get_value(heap, e)
375 DO WHILE (e .GT. 1 .AND. .NOT. all_done)
378 parent = get_parent(e)
379 parent_value = get_value(heap, parent)
380 IF (my_value .LT. parent_value)
THEN
381 CALL cp_heap_swap(heap, e, parent)
388 END SUBROUTINE bubble_up
subroutine, public cp_heap_pop(heap, key, value, found)
Returns and removes the first heap element and rebalances the heap.
subroutine, public cp_heap_fill(heap, values)
Fill heap with given values.
subroutine, public cp_heap_new(heap, n)
...
subroutine, public cp_heap_get_first(heap, key, value, found)
Returns the first heap element without removing it.
integer, parameter, public valt
subroutine, public cp_heap_release(heap)
...
integer, parameter, public keyt
subroutine, public cp_heap_reset_first(heap, value)
Changes the value of the minimum heap element and rebalances the heap.
subroutine, public cp_heap_reset_node(heap, key, value)
Changes the value of the heap element with given key and rebalances the heap.
Defines the basic variable types.
integer, parameter, public int_8
integer, parameter, public int_4