File : asgc-ordered-sortable-quicksort.adb
-- The Ada Structured Library - A set of container classes and general
-- tools for use with Ada95.
-- Copyright (C) 1998-1999 Corey Minyard (minyard@acm.org)
--
-- This library is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by the
-- Free Software Foundation; either version 2 of the License, or (at your
-- option) any later version.
--
-- This library is distributed in the hope that it will be useful, but
-- WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- General Public License for more details.
--
-- You should have received a copy of the GNU General Public License along
-- with this library; if not, write to the Free Software Foundation, Inc.,
-- 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
--
-- As a special exception, if other files instantiate generics from this
-- unit, or you link this unit with other files to produce an executable,
-- this unit does not by itself cause the resulting executable to be
-- covered by the GNU General Public License. This exception does not
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
--
with Ada.Numerics.Discrete_Random;
package body Asgc.Ordered.Sortable.Quicksort is
package Random_Natural is new Ada.Numerics.Discrete_Random (Natural);
Random_Generator : Random_Natural.Generator;
function Random (Min, Max : in Positive)
return Positive is
begin
return ((Random_Natural.Random(Random_Generator) mod (Max - Min + 1))
+ Min);
end Random;
procedure Bubble (Left : in out Iterator'Class;
Right : in out Iterator'Class) is
Left_Pos : Positive := Get_Loc(Left);
Right_Pos : Positive := Get_Loc(Right);
Value_Moved : Boolean := True;
Is_End : End_Marker;
begin
while (Value_Moved) loop
Value_Moved := False;
Set_Loc(Left, Left_Pos);
Set_Loc(Right, Left_Pos + 1);
for I in Left_Pos .. Right_Pos - 1 loop
if (Left > Right) then
Value_Moved := True;
Swap(Left, Right);
end if;
Next(Left, Is_End);
Next(Right, Is_End);
end loop;
end loop;
end Bubble;
procedure Recurse (O : access Object'Class;
Left : in out Iterator'Class;
Right : in out Iterator'Class) is
Left_Idx : Natural := Get_Loc(Left);
Right_Idx : Natural := Get_Loc(Right);
Left_Pos : Positive := Get_Loc(Left);
Right_Pos : Positive := Get_Loc(Right);
Is_End : End_Marker;
begin
if (Left_Idx < Right_Idx) then
-- Get the key from the random position and swap it with the first
-- value.
Swap_At(O.all, Left_Idx, Random(Left_Pos, Right_Pos));
-- From here on down, the key swaps between the left and right
-- location, starting with the left location.
Main_Loop: loop
-- Move the right index to the left while the right value >
-- key.
while (Right >= Left) loop
Right_Idx := Right_Idx - 1;
Prev(Right, Is_End);
exit Main_Loop when (Left_Idx = Right_Idx);
end loop;
-- Put the key into the right position and advance the left
-- position (since it is < the key now).
Swap(Left, Right);
Next(Left, Is_End);
Left_Idx := Left_Idx + 1;
exit Main_Loop when (Left_Idx = Right_Idx);
-- Move the left index to the right while the left value < key.
while (Left <= Right) loop
Left_Idx := Left_Idx + 1;
Next(Left, Is_End);
exit Main_Loop when (Left_Idx = Right_Idx);
end loop;
-- The right value has been pulled out, so replace it with the
-- left value.
Swap(Right, Left);
Prev(Right, Is_End);
Right_Idx := Right_Idx - 1;
exit Main_Loop when (Left_Idx = Right_Idx);
end loop Main_Loop;
if ((Left_Pos + 11) < Left_Idx) then
-- We have 10 or more values, do another quick sort.
Set_Loc(Left, Left_Pos);
Set_Loc(Right, Left_Idx - 1);
Recurse(O, Left, Right);
elsif ((Left_Pos + 1) < Left_Idx) then
-- Less than 10 values to do, but at least two, do a bubble
-- sort.
Set_Loc(Left, Left_Pos);
Set_Loc(Right, Left_Idx - 1);
Bubble(Left, Right);
end if;
if (Right_Pos > (Right_Idx + 11)) then
-- We have 10 or more values, do another quick sort.
Set_Loc(Left, Right_Idx + 1);
Set_Loc(Right, Right_Pos);
Recurse(O, Left, Right);
elsif (Right_Pos > (Right_Idx + 1)) then
-- Less than 20 values to do, but at least two, do a bubble
-- sort.
Set_Loc(Left, Right_Idx + 1);
Set_Loc(Right, Right_Pos);
Bubble(Left, Right);
end if;
end if;
end Recurse;
procedure Sort (O : access Object'Class;
Pos1 : in out Iterator'Class;
Pos2 : in out Iterator'Class) is
Is_End : End_Marker;
Done : Boolean := False;
begin
First(Pos1, Is_End);
if (Is_End = Not_Past_End) then
Last(Pos2, Is_End);
Recurse(O, Pos1, Pos2);
end if;
end Sort;
procedure Sort (O : access Object'Class) is
Pos1 : Iterator_Class
:= Iterator_Class(New_Iterator(Asgc.Object_Class(O)));
Pos2 : Iterator_Class
:= Iterator_Class(New_Iterator(Asgc.Object_Class(O)));
begin
Sort(O, Pos1.all, Pos2.all);
Free(Pos1);
Free(Pos2);
end Sort;
begin
Random_Natural.Reset(Random_Generator);
end Asgc.Ordered.Sortable.Quicksort;