!
! Module library implementing integer binary heap for sorting 
! and for realising priority queues
!
!  (c) 1992-2010, A. Migdalas @ MSCC
!  version 0.3 @ 1998/09/25 
!

MODULE IntMinHeap

!
! Implements a Priority Queue as a Binary Heap
!
!The Heap is implemented as an integer array of
!pointers (cursors, pseudopointers) to an array of values. 
!That is, we do not move values, we rather permute the 
!pseudopointers.
!
!We also use an integer to keep the size of the heap.
!
!The heap is a complete binary tree represented as
!an array. The root is in position 1. Any element I
!has its left child in position 2I, and its right
!child located immediately after, in position 2I+1.
!Finally, the parent is in position INT(i/2). Of course,
!the root has no parent.
!
! WARNING:
!      Client is responsible for checking array bounds!
!

CONTAINS

  !------------------------------------------!

  SUBROUTINE heap_insert_min(value,index,heap,size)

    !
    ! Inserts VALUE(INDEX) in the HEAP.
    ! The SIZE of HEAP is increased by 1.
    ! An empty HEAP, i.e. one of size 0 is allowed.
    !

    IMPLICIT NONE
    INTEGER, DIMENSION(:) :: value,heap
    INTEGER :: index, size

    INTEGER :: i, position

    size=size+1; i=size

    DO WHILE(i.LE.size.AND.i.GE.1)
       IF(i.EQ.1) THEN
          position=i    ! At root
          EXIT
       ENDIF
       IF(value(index).GE.value(heap(i/2)))THEN
          position=i
          EXIT
       ENDIF
       heap(i)=heap(i/2) ! Move to parent of i
       i = i/2
    ENDDO

    heap(position) = index

  END SUBROUTINE heap_insert_min

  !------------------------------------------!

  INTEGER FUNCTION heap_delete_min(heap,value,size)

    !
    ! Removes the root of the heap, then adjusts
    ! the heap. Returns the root contents, i.e. HEAP(1).
    ! Heap cannot be emty, i.e. SIZE > 0 is expected.
    !

    IMPLICIT NONE

    INTEGER, DIMENSION(:) :: heap, value
    INTEGER :: size

    INTEGER :: k, i, j

    heap_delete_min = heap(1) ! get root contents
    k = heap(size) ! last element must be moved
    size = size - 1 ! reduce heap size by 1

    i = 1; j = 2
    DO WHILE(j.LE.size)
       IF(j.LT.size) THEN
          IF(value(heap(j)).GT.value(heap(j+1)))j=j+1
       ENDIF  ! j points to the smallest child
       IF(value(k).LE.value(heap(j)))EXIT
       heap(i)=heap(j) ! move child up
       i = j; j = 2*j  ! move i and j down
    ENDDO
    heap(i)=k

  END FUNCTION heap_delete_min

  !---------------------------------------------!

  SUBROUTINE heap_adjust_min(heap,value,root,size)  

    !
    ! Adjusts a heap. Operation also known as siftdown.
    ! The assumption is that the sons of ROOT are already
    ! roots of subtrees that are in heap order. Then it adjusts
    ! HEAP so that ROOT also gets in heap order.
    ! Please note that the HEAP array must have values
    ! in it, i.e. pointers to VALUE.
    !

    INTEGER, DIMENSION(:) :: heap, value
    INTEGER :: size, root

    INTEGER :: e, k, j

    e=heap(root); k=value(heap(root))

    j=2*root
    DO WHILE(j.LE.size)
       IF(j.LT.size) THEN
          IF(value(heap(j)).GT.value(heap(j+1)))j=j+1
       ENDIF
       IF(k.LE.value(heap(j)))EXIT
       heap(j/2) = heap(j)
       j=j*2
    ENDDO
    heap(j/2)=e

  END SUBROUTINE heap_adjust_min

  !---------------------------------------------!

  SUBROUTINE heap_init_min(heap,value,size)

    !
    ! Converts an array into a heap, with the
    ! least element at the root.
    !

    IMPLICIT NONE

    INTEGER, DIMENSION(:) :: heap, value
    INTEGER :: size

    INTEGER:: i

    i=size/2
    DO WHILE(i.GE.1)
       CALL heap_adjust_min(heap,value,i,size)
       i=i-1
    ENDDO

  END SUBROUTINE heap_init_min

  !---------------------------------------------!

  SUBROUTINE heap_sort_descend(heap,value,size)

    !
    ! Sorts using a heap. No need to call HEAP_INIT.
    ! Heap should not be empty, of course!
    !

    IMPLICIT NONE

    INTEGER, DIMENSION(:) :: heap, value
    INTEGER :: size

    INTEGER :: i, t

    CALL heap_init_min(heap,value,size)

    DO i = size-1, 1, -1
       t = heap(i+1)
       heap(i+1)=heap(1)
       heap(1)=t
       CALL heap_adjust_min(heap,value,1,i)
    ENDDO

  END SUBROUTINE heap_sort_descend

  !----------------------------------------!

  SUBROUTINE heap_reduce_key(index,heap,value,size)

    ! Adjust heap after an element in it got a reduced value
    ! Assume Min-Heap

    IMPLICIT NONE
    INTEGER, DIMENSION(:) :: heap, value
    INTEGER :: size, index,current

    current = index ! The subtrees rooted at the sons of INDEX are already heaps
    DO WHILE(current.GE.1) ! Follow the path to the root and adjust heap.
       CALL heap_adjust_min(heap,value,current,size)
       current = INT(current/2) ! Subtree rooted at current is heap, move to parent.
    ENDDO

  END SUBROUTINE heap_reduce_key

END MODULE IntMinHeap







