Bug in code for Priority Queue

Bug in code for Priority Queue

[Tucker Taft]

Brian Hanson of Cray (brh@cray.com) kindly pointed out a bug
in the code for a priority queue I posted several weeks ago,
which arose during my effort to create a stand-alone
priority queue package from a version that was embedded
in something else.  So much for reuse by transcription ;-).

In any case, here is a description of the bug and the fix...

In the procedure Remove_Top_Prio, the local variable Parent_Limit
is declared:

    Parent_Limit : Heap_Index;   -- WRONG

and then initialized:

    Parent_Limit := Num_In_Heap / 2;

Since Num_In_Heap might be 1, Parent_Limit might be 0.
Hence, the subtype of Parent_Limit should be Heap_Count instead of
Heap_Index; that is:

    Parent_Limit : Heap_Count;   -- RIGHT


Sorry for any inconvenience.

-Tucker Taft   stt@inmet.com

P.S. Here is the complete, repaired code, if you are interested:
-----------------------------------------------
-- Copyright (C) 1995 Intermetrics, Inc.
-- May be copied if accompanied by this notice.

package Priority_Queue is
  -- Provide a priority queue; greater priority means more urgent.

    Min_Prio : constant := 0;
    Max_Prio : constant := 100;
    type Priority is range Min_Prio .. Max_Prio;

    type Queue_Entry_Record;
    type Queue_Entry is access Queue_Entry_Record;

    type Queue_Entry_Record is
      record
        Prio : Priority;
	Next : Queue_Entry;
        Other_Info : Integer; -- Or whatever
      end record;

    procedure Add_Entry(Ent : Queue_Entry);
      -- Add Ent to priority queue

    procedure Remove_Top_Prio(Ent : out Queue_Entry);
      -- Remove and return an entry with the highest priority
      -- Ent set to null if queue is empty.

    function Top_Prio return Queue_Entry;
      -- Return pointer to entry with highest priority (leave in queue)
      -- Returns null if queue is empty.

    function Is_Empty return Boolean;
      -- Return True if queue is empty
end Priority_Queue;

package body Priority_Queue is
  -- Implement a priority queue; greater priority means more urgent.
  -- Internal representation is a binary heap, 
  -- plus an array of FIFO queues.

    type FIFO_Queue_Header is
      record
        First, Last : Queue_Entry := null;
      end record;
    FIFO_Queues : array(Priority) of FIFO_Queue_Header;
      -- Array of singly-linked FIFO queues

    Num_Prio : constant := Max_Prio - Min_Prio + 1;
    type Heap_Count is range 0 .. Num_Prio + 1;
      -- One extra so remove may assume have either 2 or 0 children
    subtype Heap_Index is Heap_Count range 1 .. Heap_Count'Last;

    Heap : array(Heap_Index) of Priority := (Heap_Index => Min_Prio);
      -- Heap of priority values, indicating highest priority
      -- with non-empty set of entries;
      -- Preinitialized to Min_Prio to simplify removal

    -- Binary heap condition is: Heap(N) > Max(Heap(2*N), Heap(2*N+1))
    Num_In_Heap : Heap_Count := 0;  -- Count of number in heap

    procedure Add_Entry(Ent : Queue_Entry) is
      -- Add Ent to priority queue

      -- Algorithm:
      --   Add new entry to its FIFO queue.  If its FIFO queue was empty,
      --   add its priority to end of heap, and then "sift" it up
      --   until binary heap condition is restored.

	Parent, Child : Heap_Index;
	Prio_To_Add : constant Priority := Ent.Prio;
	FIFO_Queue : FIFO_Queue_Header renames FIFO_Queues(Prio_To_Add);
    begin
	Ent.Next := null;

	if FIFO_Queue.Last /= null then
	    -- There are already elements for this priority;
	    -- Just add to end of its FIFO queue and return.
	    FIFO_Queue.Last.Next := Ent;

	    return;

	end if;

	-- This is a new priority, add to binary heap
	Num_In_Heap := Num_In_Heap + 1;
	    
        -- Start at end of heap
        Child := Num_In_Heap;

	-- Loop until reach top of heap, or parent greater than new prio
	while Child > 1 loop
	    Parent := Child / 2;  -- Find slot which should be greater
	    exit when Heap(Parent) >= Prio_To_Add;
		-- All done if parent now greater

	    -- Parent smaller, move it down to child's slot
	    Heap(Child) := Heap(Parent);

	    -- Advance up to parent slot and iterate
	    Child := Parent;
	end loop;

	-- ASSERT: Prio_To_Add < Heap(Child/2) or reached top-of-heap
	Heap(Child) := Prio_To_Add;
        
	-- Now initialize FIFO queue header to point to new entry
	FIFO_Queue.First := Ent;
	FIFO_Queue.Last := Ent;
      
    end Add_Entry;

    procedure Remove_Top_Prio(Ent : out Queue_Entry) is
      -- Remove and return an entry with the highest priority
      -- Ent set to null if FIFO queue is empty.

      -- Algorithm:
      --   Retrieve highest priority in heap.  Remove first element
      --   from corresponding FIFO queue.  If FIFO queue now empty,
      --   remove corresponding priority from heap, and "sift"
      --   priority at bottom of heap down from top of heap,
      --   until binary heap condition is restored.

	Top_Prio : Priority;
	Prio_To_Sift : Priority;
	Parent, Child : Heap_Index;
	Parent_Limit : Heap_Count;  -- Might be zero
    begin
	if Num_In_Heap = 0 then
	    -- Priority queue is empty
	    Ent := null;
	    return;
	end if;

	Top_Prio := Heap(Heap'First);  -- Get highest priority

	-- Remove first element from appropriate FIFO queue
	Ent := FIFO_Queues(Top_Prio).First;
	FIFO_Queues(Top_Prio).First := Ent.Next;

	if Ent.Next /= null then
	    -- There are more in same FIFO queue, just return now
	    return;
	end if;

	-- This is only entry in this FIFO queue, set Last to null
	-- and remove its priority from binary heap
	FIFO_Queues(Top_Prio).Last := null;

	-- Get priority from bottom of heap to sift down
	Prio_To_Sift := Heap(Num_In_Heap);

	-- Replace it with min-prio to allow us to ignore
	-- special case when parent has exactly one child.
	Heap(Num_In_Heap) := Min_Prio;

	-- Shorten the heap
	Num_In_Heap := Num_In_Heap - 1;
	if Num_In_Heap = 0 then

	    -- All done if heap now empty	
	    return;

	end if;

	-- Start at top of heap
	Parent := 1;

	-- Calculate limit on parent (to avoid overflow on
	-- child calculation).
	Parent_Limit := Num_In_Heap / 2;

	-- Loop until reach bottom of heap, 
	-- or prio-to-sift > both children
	while Parent <= Parent_Limit loop

	    -- Determine larger "child"
	    Child := Parent * 2;
	    if Heap(Child + 1) > Heap(Child) then
		-- 2*N+1 child is larger than 2*N child
		Child := Child + 1;
	    end if;

	    exit when Prio_To_Sift >= Heap(Child);
		-- All done when found slot for prio-to-sift

	    -- Move larger child up, and iterate
	    Heap(Parent) := Heap(Child);
	    Parent := Child;
	end loop;

	-- ASSERT: Prio_To_Sift > both children (2*Parent, 2*Parent+1)
	-- or slot has no children

	-- Put prio in its new slot
	Heap(Parent) := Prio_To_Sift;

    end Remove_Top_Prio;
	
    function Top_Prio return Queue_Entry is
      -- Return pointer to entry with highest priority (leave in queue)
      -- Returns null if queue is empty.
    begin
	if Num_In_Heap = 0 then
	    return null;
	else
	    return FIFO_Queues(Heap(Heap'First)).First;
	end if;
    end Top_Prio;

    function Is_Empty return Boolean is
      -- Return true if queue is empty
    begin
	return Num_In_Heap = 0;
    end Is_Empty;

end Priority_Queue;

Re: Bug in code for Priority Queue

[Jardine Barrington-Cook]

In article <D1us76.Gp@inmet.camb.inmet.com> stt@dsd.camb.inmet.com (Tucker Taft) writes:
>Newsgroups: comp.lang.ada
>Path: logica.co.uk!pipex!howland.reston.ans.net!gatech!bloom-beacon.mit.edu!uhog.mit.edu!news.mathworks.com!noc.near.net!inmet!dsd!stt
>From: stt@dsd.camb.inmet.com (Tucker Taft)
>Subject: Bug in code for Priority Queue
>Message-ID: <D1us76.Gp@inmet.camb.inmet.com>
>Sender: news@inmet.camb.inmet.com
>Organization: Intermetrics, Inc.
>Date: Tue, 3 Jan 1995 23:35:29 GMT
>Lines: 246

>Brian Hanson of Cray (brh@cray.com) kindly pointed out a bug
>in the code for a priority queue I posted several weeks ago,
>which arose during my effort to create a stand-alone
>priority queue package from a version that was embedded
>in something else.  So much for reuse by transcription ;-).

>In any case, here is a description of the bug and the fix...
 [.. real code cut out...]

There is a logical problem with the use of priority queues for warning 
messages, which I would like to publicise. I have seen this problem twice, and 
once was in an aircraft audio alarm system.

When putting an element of priority "n" onto a prioritorised warning queue, it 
is essential to search the lower priority queues for the same warning at a 
lower severity - if you do not do this the resulting warnings to the operator 
can be very misleading.

In a UK Television broadcast of the 1983 election results this caused 
two succesive headline messages to appear in the form:

"4th recount at Molesly North" followed by
"3rd recount at Molesly North".

In the aircraft audio warning case the results were of the form:

"Warning: aircraft below 30 meters"
"Warning: aircraft below 40 meters" 

(the aircraft was still descending, and below 30 meters)

I for one would be very happy never to see this problem again.


Jardine Barrington-Cook    ! "...See worlds on worlds compose one universe
Space Division - Logica    ! observe how system into system runs..."
...personal opinions,      !     
subject to change...       ! A. Pope - from "An Essay on Man", 1773