OpenEuphoria

Re: Optimizing basic operations

• Posted by gimlet Aug 21, 2013
• 4407 views

Derek,

Looking at your code I notice that your implementation of
insert_record is faulty. If you insert data on increasing
key values into a max-heap the code appears to generate a
linked list.

You say that the tree is not balanced: but a heap is
required to be a coplete tree - no gaps except the bottom
row which is filled from left to right.

Code attached: (untested)

(* This is for a max-heap *)

const M = 256;                       (* say *) 
 
type  rec = array[1..26] of integer; (* say *) 
 
var   Heap : array[1..M,0..1] of integer; 
      N : integer := 0; 
	  Data : array[1..M] of rec; 
 
(* Two procedures siftUp and siftDown which move a node *) 
(* into its correct position in the heap. *) 
 
procedure siftUp; 
var i,p,t : integer; 
begin 
	i := N; 
	while i > 1 do 
		p := i div 2; 
		if Heap[i,0] > Heap[p,0] then  (* swap *) 
		begin 
			t := Heap[i]; 
			Heap[i] := Heap[p]; 
			Heap[p] := t; 
			i := c 
		end 
		else                 (* stop *) 
			exit while; 
	end 
end; (* siftUp *) 
 
procedure siftDown; 
var i,c,t : integer; 
begin 
    i := 1; 
	c := 2; 
	while c <= N do 
	begin 
		if c < N and Heap[c,0] < Heap[c+1,0] then c := c+1; 
		if Heap[c,0] > Heap[i,0] then 
			t := Heap[c]; 
			Heap[c] := Heap[i]; 
     		Heap[i] := t; 
		    i := c; 
		    c := 2*c 
	    else (* stop *) 
		    exit while; 
	end; 
end; (* siftDown *) 
 
(* Three procedures to add, remove and replace nodes. 
   Addition is always done at the end - it is the only 
   action that can cause an overflow. Take always takes 
   the root and can cause an underflow. Replace is not 
   required - it was written with respect to James's 
   problem find the top 100 elements in a list. *) 
 
procedure add(r : rec); 
begin 
	N := N+1;            (* add a node *) 
	Heap[N,0] := r[1]; 
    Data[Heap[N,1]] := r; 
    siftUp; 
end; (* add *) 
 
function take : rec; 
var r integer; 
begin 
    r := Heap[1,1]; 
	Heap[1] := Heap[N];  (* copies both node value and pointer *) 
    Heap[N,1] := r;      (* N now points to the record to be dropped *) 
	N := N-1; 
	siftDown; 
	take := Data[r] 
end; (* take *) 
 
procedure replace(r : rec); 
begin 
	Heap[1,0] := r[1]; 
	Data[Heap[1,1]] := r; (* overwrites with new record *) 
	siftDown; 
end; (* replace *)