|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 2418 (0x972)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
package body Hpsort is
procedure Heapsort (Heap : in out Heap_Array;
Heapsize : in Pos_Int) is
Savevalue : Small_Int;
Swapptr : Pos_Int;
Nextptr : Pos_Int;
Heapindx : Pos_Int;
begin
-- CREATE A HEAP FROM THE INPUT ARRAY. A HEAP IS
-- AN ARRAY FOR WHICH EACH ELEMENT HEAP(I)
-- HEAP(I) >= HEAP(2I) AND
-- HEAP(I) >= HEAP(2I+1)
for Heapindx in 2 .. Heapsize loop
Swapptr := Heapindx;
Nextptr := Swapptr / 2;
Savevalue := Heap (Swapptr);
while (Nextptr /= 0) and then (Savevalue > Heap (Nextptr)) loop
Heap (Swapptr) := Heap (Nextptr);
Swapptr := Nextptr;
if Nextptr < 2 then
Nextptr := 0;
else
Nextptr := Nextptr / 2;
end if;
end loop; -- WHILE
Heap (Swapptr) := Savevalue;
end loop; --FOR
-- SIFT THE HEAP IN ASCENDING ORDER
-- MOVE THE FIRST ELEMENT TO THE LAST ELEMENT AND SIFT THE
-- REMAINING ELEMENTS SO THAT THE LARGEST REMAINING ELEMENT
-- IS NOW THE FIRST ELEMENT. MOVE THIS ELEMENT TO THE LAST
-- OF THE REMAINING ELEMENTS AND REPEAT UNTIL THERE IS JUST ONE
-- REMAINING ELEMENT.
for Heapindx in reverse 2 .. Heapsize loop
Savevalue := Heap (Heapindx);
Heap (Heapindx) := Heap (1);
Swapptr := 1;
Nextptr := 2;
while Nextptr < Heapindx loop
if Nextptr + 1 < Heapindx and then
Heap (Nextptr + 1) > Heap (Nextptr) then
Nextptr := Nextptr + 1;
end if;
if Heap (Nextptr) > Savevalue then
Heap (Swapptr) := Heap (Nextptr);
Swapptr := Nextptr;
if Nextptr > Heapindx / 2 then
Nextptr := Heapindx;
else
Nextptr := Nextptr + Nextptr;
end if;
else
Nextptr := Heapindx;
end if;
end loop; --WHILE
Heap (Swapptr) := Savevalue;
end loop; --FOR
return;
end Heapsort;
end Hpsort;