The
Algorithm
in
ADA
The
Algorithm
in
ADA
The
Algorithm
in
ADA
The
Algorithm
in
ADA
|
The Algorithm in Ada
The following adaptation is intended to work with very different
kinds of data. This generality requires two different procedures
based on the FlashSort algorithm.
The first procedure accept all kinds of a vector, in which the elements
are of a discrete type. Discrete types include integers and all the other
enumerated types, as e.g. the user defined type Day :
TYPE Day IS (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday,
Sunday);
The second procedure works for vectors in which the elements are real
numbers (an example of a type which is considered not to be discrete).
For these two procedures, the indexes of a vector are not necessarily
of type integer : they can belong to any enumerated type (as it is
authorized in Ada).
--********************************************************************
-- The FlashSort package version 3.0 **
--********************************************************************
--********************************************************************
-- This package has been written in ADA by **
-- Jérôme Delcourt
-- from the idea of Karl-Dietrich Neubert. **
-- **
-- This code has been verified with the ada compiler **
-- GNAT 3.12 for DOS. It should work with any Ada 83 **
-- or Ada 95 compiler. **
--*********************************************************************
--***************************
--** PACKAGE SPECIFICATION **
--***************************
PACKAGE FlashSort IS
-----------------------------------------------------------------------------
-- The procedure FlashSort_for_discrete_elements provides an adaptation of
--
-- the FlashSort algorithm for any type of vector in which the type of
--
-- elements is discrete (a variable of a discrete type can only have
--
-- a limited number of possible value, as integers for example, in
--
-- oppposition to float numbers).
--
-- This procedure also works for any other kind of elements in the vector,
--
-- provided that they belong to an enumerated type.
--
-----------------------------------------------------------------------------
GENERIC
TYPE Element IS (<>);
TYPE Index IS (<>);
TYPE Vector IS ARRAY(Index RANGE <>) OF Element;
PROCEDURE FlashSort_for_discrete_elements(V : IN OUT Vector);
-----------------------------------------------------------------------------
-- The procedure FlashSort_for_discrete_elements provides an adaptation of
--
-- the FlashSort algorithm for any type of vector in which the type of
--
-- elements is discrete (a variable of a discrete type can only have
--
-- a limited number of possible value, as integers for example, in
--
-- oppposition to float numbers).
--
-----------------------------------------------------------------------------
GENERIC
TYPE Element IS digits <>;
TYPE Index IS (<>);
TYPE Vector IS ARRAY(Index RANGE <>) OF Element;
PROCEDURE FlashSort_for_float_number_elements(V : IN OUT Vector);
-----------------------------------------------------------------------------
END FlashSort;
--******************
--** PACKAGE BODY **
--******************
PACKAGE BODY FlashSort IS
-- Depending on your compiler, you may have to change the following line.
TYPE Greatest_Integer_Type IS NEW LONG_INTEGER;
GENERIC
TYPE Item IS PRIVATE;
PROCEDURE Generic_Swap(x, y : IN OUT Item);
PROCEDURE Generic_Swap(x, y : IN OUT Item) IS
Temp : CONSTANT Item := x;
BEGIN
x := y;
y := Temp;
END Generic_Swap;
FUNCTION Trunc(x : IN LONG_FLOAT) RETURN Greatest_Integer_Type IS
Temp : CONSTANT Greatest_Integer_Type := Greatest_Integer_Type(x);
BEGIN
IF (x < LONG_FLOAT(Temp)) THEN
RETURN Temp-1;
ELSE
RETURN Temp;
END IF;
END;
Go back to contents
--******************************************************************
--** PROCEDURE FlashSort_for_discrete_elements(V : IN OUT Vector) **
--******************************************************************
PROCEDURE FlashSort_for_discrete_elements(V : IN OUT Vector) IS
PROCEDURE Swap IS NEW Generic_Swap(Element);
NbClass : CONSTANT Greatest_Integer_Type := V'LENGTH / 10 + 1;
-- NbClass represents the number of classes.
K : Greatest_Integer_Type;
NMove : Greatest_Integer_Type := 0;
Hold, Flash : Element;
J : Index := V'FIRST;
IndexVMax : Index; -- Indice of the greatest coefficient in the
vector
IndexVMin : Index; -- Indice of the lowest coefficient in the
vector.
VMin : Element := Element'LAST; -- Lowest element in the vector
VMax : Element := Element'FIRST; -- Greatest element in the vector
L : ARRAY(1..NbClass) OF Greatest_Integer_Type := (OTHERS => 0);
C1 : LONG_FLOAT;
BEGIN
----------------------------------
----------------------------------
-- FIRST STEP : CLASS FORMATION --
----------------------------------
----------------------------------
-- Calculate IndexVMax and VMin
FOR I IN V'RANGE LOOP
IF (VMax < V(I)) THEN
IndexVMax := I;
VMax := V(I);
END IF;
IF (V(I) < VMin) THEN
IndexVMin := I;
VMin := V(I);
END IF;
END LOOP;
------------------------------------------
-- If VMin = VMax, V is already sorted. --
------------------------------------------
IF (VMin = VMax) THEN
RETURN;
END IF;
----------------------------------------------------
-- Calculate the number of elements of the vector --
-- in each class --
----------------------------------------------------
-- Note : VMin /= VMax, so, in the following line,
-- there can't be a division by zero.
C1 := LONG_FLOAT(NbClass - 1) / LONG_FLOAT(Element'POS(VMax) -
Element'POS(VMin));
FOR I IN V'RANGE LOOP
K := 1 + Trunc(C1 * LONG_FLOAT(Element'POS(V(I)) - Element'POS(VMin)));
L(K) := L(K) + 1;
END LOOP;
----------------------------------------------------------
-- Cumulate the number of elements of each class, --
-- so now L(K) := L(K) + L(K-1). --
-- That means that the last class L(NbClass) is equal --
-- to the size of the vector : L(NbClass) = V'LENGTH. --
----------------------------------------------------------
FOR I IN L'FIRST+1..L'LAST LOOP
L(I) := L(I) + L(I-1);
END LOOP;
Swap(V(V'FIRST), V(IndexVMax));
-------------------------------
-------------------------------
-- SECOND STEP : PERMUTATION --
-------------------------------
-------------------------------
K := NbClass;
WHILE (NMove < (V'LENGTH - 1)) LOOP
WHILE (Index'POS(J) - Index'POS(V'FIRST) + 1 > L(K)) LOOP
-- Note : L(L'LAST) = V'LENGTH,
-- so this loop will allways end.
J := Index'SUCC(J);
K := 1 + Trunc(C1 * LONG_FLOAT(Element'POS(V(J)) -
Element'POS(VMin)));
END LOOP;
Flash := V(J);
WHILE (Index'POS(J) - Index'POS(V'FIRST) + 1 /= L(K) + 1) LOOP
K := 1 + Trunc(C1 * LONG_FLOAT(Element'POS(Flash) -
Element'POS(VMin)));
Swap(Flash, V(Index'VAL(L(K) + Index'POS(V'FIRST) - 1)));
L(K) := L(K) - 1;
NMove := NMove + 1;
END LOOP;
END LOOP;
-------------------------------------
-------------------------------------
-- THIRD STEP : STRAIGHT INSERTION --
-------------------------------------
-------------------------------------
FOR I IN REVERSE V'FIRST..Index'PRED(Index'PRED(V'LAST)) LOOP
IF (V(Index'SUCC(I)) < V(I)) THEN
Hold := V(I);
J := I;
WHILE (V(Index'SUCC(J)) < Hold) LOOP
V(J) := V(Index'SUCC(J));
J := Index'SUCC(J);
END LOOP;
V(J) := Hold;
END IF;
END LOOP;
END FlashSort_for_discrete_elements;
Go back to contents
--**********************************************************************
--** PROCEDURE FlashSort_for_float_number_elements(V : IN OUT Vector) **
--**********************************************************************
PROCEDURE FlashSort_for_float_number_elements(V : IN OUT Vector) IS
PROCEDURE Swap IS NEW Generic_Swap(Element);
NbClass : CONSTANT Greatest_Integer_Type := V'LENGTH / 10 + 1;
-- NbClass represents the number of classes.
K : Greatest_Integer_Type;
NMove : Greatest_Integer_Type := 0;
Hold, Flash : Element;
J : Index := V'FIRST;
IndexVMax : Index; -- Indice of the greatest coefficient in the vector
IndexVMin : Index; -- Indice of the lowest coefficient in the vector
VMin : Element := Element'LARGE; -- Lowest element in the vector
VMax : Element := -Element'LARGE; -- Greatest element in the vector
L : ARRAY(1..NbClass) OF Greatest_Integer_Type := (OTHERS => 0);
C1 : LONG_FLOAT;
BEGIN
----------------------------------
----------------------------------
-- FIRST STEP : CLASS FORMATION --
----------------------------------
----------------------------------
-- Calculate IndexVMax and VMin
FOR I IN V'RANGE LOOP
IF (VMax < V(I)) THEN
IndexVMax := I;
VMax := V(I);
END IF;
IF (V(I) < VMin) THEN
IndexVMin := I;
VMin := V(I);
END IF;
END LOOP;
------------------------------------------
-- If VMin = VMax, V is already sorted. --
------------------------------------------
IF (VMin = VMax) THEN
RETURN;
END IF;
----------------------------------------------------
-- Calculate the number of elements of the vector --
-- in each class --
----------------------------------------------------
-- Note : VMin /= VMax, so, in the following line,
-- there can't be a division by zero.
C1 := LONG_FLOAT(NbClass - 1) / LONG_FLOAT(VMax - VMin);
FOR I IN V'RANGE LOOP
K := 1 + Trunc(C1 * LONG_FLOAT(V(I) - VMin));
L(K) := L(K) + 1;
END LOOP;
----------------------------------------------------------
-- Cumulate the number of elements of each class, --
-- so now L(K) := L(K) + L(K-1). --
-- That means that the last class L(NbClass) is equal --
-- to the size of the vector : L(NbClass) = V'LENGTH. --
----------------------------------------------------------
FOR I IN L'FIRST+1..L'LAST LOOP
L(I) := L(I) + L(I-1);
END LOOP;
Swap(V(V'FIRST), V(IndexVMax));
-------------------------------
-------------------------------
-- SECOND STEP : PERMUTATION --
-------------------------------
-------------------------------
K := NbClass;
WHILE (NMove < (V'LENGTH - 1)) LOOP
WHILE (Index'POS(J) - Index'POS(V'FIRST) + 1 > L(K)) LOOP
-- Note : L(L'LAST) = V'LENGTH,
-- so this loop will allways end.
J := Index'SUCC(J);
K := 1 + Trunc(C1 * LONG_FLOAT(V(J) - VMin));
END LOOP;
Flash := V(J);
WHILE (Index'POS(J) - Index'POS(V'FIRST) + 1 /= L(K) + 1) LOOP
K := 1 + Trunc(C1 * LONG_FLOAT(Flash - VMin));
Swap(Flash, V(Index'VAL(L(K) + Index'POS(V'FIRST) - 1)));
L(K) := L(K) - 1;
NMove := NMove + 1;
END LOOP;
END LOOP;
-------------------------------------
-------------------------------------
-- THIRD STEP : STRAIGHT INSERTION --
-------------------------------------
-------------------------------------
FOR I IN REVERSE V'FIRST..Index'PRED(Index'PRED(V'LAST)) LOOP
IF (V(Index'SUCC(I)) < V(I)) THEN
Hold := V(I);
J := I;
WHILE (V(Index'SUCC(J)) < Hold) LOOP
V(J) := V(Index'SUCC(J));
J := Index'SUCC(J);
END LOOP;
V(J) := Hold;
END IF;
END LOOP;
END FlashSort_for_float_number_elements;
END FlashSort;
Go back to contents
--***************************************
--** TEST Nř1 OF THE FLASHSORT PACKAGE **
--***************************************
-- Here, the indexes of the vector and its elements are integers :
-- it is one of the common situation.
WITH TEXT_IO; USE TEXT_IO;
WITH FlashSort; USE FlashSort;
PROCEDURE Test1 IS
TYPE Vector_of_integers IS ARRAY(INTEGER RANGE <>) OF LONG_INTEGER;
PACKAGE Integer_IO IS NEW TEXT_IO.INTEGER_IO(INTEGER);
USE Integer_IO;
PACKAGE Long_Integer_IO IS NEW TEXT_IO.INTEGER_IO(LONG_INTEGER);
USE Long_Integer_IO;
Nb : INTEGER;
------------------------------------------------------------------------------
PROCEDURE My_FlashSort IS NEW
FlashSort_for_discrete_elements(LONG_INTEGER,
INTEGER,
Vector_of_integers);
------------------------------------------------------------------------------
PROCEDURE Init_Nb(Nb : OUT INTEGER) IS
BEGIN
PUT("Number of elements in the vector : ");
GET(Nb);
END Init_Nb;
------------------------------------------------------------------------------
PROCEDURE Init_Vector(Vect : IN OUT Vector) IS
BEGIN
PUT_LINE("Initialisation of the vector : ");
FOR I IN Vect'RANGE LOOP
PUT("Element nř");
PUT(I+1, 0);
PUT(" : ");
GET(Vect(I));
END LOOP;
END Init_Vector;
------------------------------------------------------------------------------
PROCEDURE Write_Vector(Msg : IN STRING; Vect : IN Vector) IS
BEGIN
PUT_LINE(Msg);
FOR I IN Vect'RANGE LOOP
PUT(Vect(I), 0); PUT(' ');
END LOOP;
NEW_LINE;
END Write_Vector;
------------------------------------------------------------------------------
BEGIN
Init_Nb(Nb);
DECLARE
Vecteur1, Vecteur2 : Vector(0..Nb-1);
BEGIN
Init_Vector(Vecteur1);
Vecteur2 := Vecteur1;
My_FlashSort(Vecteur2);
Write_Vector("Your vector :", Vecteur1);
Write_Vector("The sorted vector :", Vecteur2);
END;
END Test1;
--***************************************
--** TEST Nř2 OF THE FLASHSORT PACKAGE **
--***************************************
-- Here, the indexes of the vector are integers,
-- and the elements of the vector (entered in english on the keyboard) are
-- some days of the week.
WITH TEXT_IO; USE TEXT_IO;
WITH FlashSort; USE FlashSort;
PROCEDURE Test2 IS
TYPE Day IS (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday,
Sunday);
TYPE Vector IS ARRAY(LONG_INTEGER RANGE <>) OF Day;
PACKAGE Day_IO IS NEW TEXT_IO.ENUMERATION_IO(Day);
USE Day_IO;
PACKAGE Long_Integer_IO IS NEW TEXT_IO.INTEGER_IO(LONG_INTEGER);
USE Long_Integer_IO;
Nb : LONG_INTEGER;
------------------------------------------------------------------------------
PROCEDURE My_FlashSort IS NEW FlashSort_for_discrete_elements(Day,
LONG_INTEGER,
Vector);
------------------------------------------------------------------------------
PROCEDURE Init_Nb(Nb : OUT LONG_INTEGER) IS
BEGIN
PUT("Number of elements in the vector : ");
GET(Nb);
END Init_Nb;
------------------------------------------------------------------------------
PROCEDURE Init_Vector(Vect : IN OUT Vector) IS
BEGIN
PUT_LINE("Initialisation of the vector : ");
FOR I IN Vect'RANGE LOOP
PUT("Days nř");
PUT(I+1, 0);
PUT(" : ");
GET(Vect(I));
END LOOP;
END Init_Vector;
------------------------------------------------------------------------------
PROCEDURE Write_Vector(Msg : IN STRING; Vect : IN Vector) IS
BEGIN
PUT_LINE(Msg);
FOR I IN Vect'RANGE LOOP
PUT(Vect(I)); PUT(' ');
END LOOP;
NEW_LINE;
END Write_Vector;
------------------------------------------------------------------------------
BEGIN
Init_Nb(Nb);
DECLARE
Vecteur1, Vecteur2 : Vector(0..Nb-1);
BEGIN
Init_Vector(Vecteur1);
Vecteur2 := Vecteur1;
My_FlashSort(Vecteur2);
Write_Vector("Your vector :", Vecteur1);
Write_Vector("The sorted vector :", Vecteur2);
END;
END Test2;
--***************************************
--** TEST Nř3 OF THE FLASHSORT PACKAGE **
--***************************************
-- Here, the indexes of the vector are the days of the week,
-- and the elements of the array are float numbers.
WITH TEXT_IO; USE TEXT_IO;
WITH FlashSort; USE FlashSort;
PROCEDURE Test3 IS
TYPE Day IS (Monday, Tuesday, Wednesday, Thursday, Friday, Saturday,
Sunday);
TYPE Vector IS ARRAY(Day RANGE <>) OF FLOAT;
PACKAGE Day_IO IS NEW TEXT_IO.ENUMERATION_IO(Day);
USE Day_IO;
PACKAGE Float_IO IS NEW TEXT_IO.FLOAT_IO(Num => FLOAT);
USE Float_IO;
Vecteur1, Vecteur2 : Vector(Monday..Sunday);
------------------------------------------------------------------------------
PROCEDURE My_FlashSort IS NEW FlashSort_for_float_number_elements(FLOAT,
Day,
Vector);
------------------------------------------------------------------------------
PROCEDURE Init_Vector(Vect : IN OUT Vector) IS
BEGIN
PUT_LINE("Initialisation of the vector : ");
FOR I IN Vect'RANGE LOOP
PUT(I);
PUT(" : ");
GET(Vect(I));
END LOOP;
END Init_Vector;
------------------------------------------------------------------------------
PROCEDURE Write_Vector(Msg : IN STRING; Vect : IN Vector) IS
BEGIN
PUT_LINE(Msg);
FOR I IN Vect'RANGE LOOP
PUT(Vect(I)); PUT(' ');
END LOOP;
NEW_LINE;
END Write_Vector;
------------------------------------------------------------------------------
BEGIN
Init_Vector(Vecteur1);
Vecteur2 := Vecteur1;
My_FlashSort(Vecteur2);
Write_Vector("Your vector :", Vecteur1);
Write_Vector("The sorted vector :", Vecteur2);
END Test3;
------------------------------------------------------------------------------
Go back to contents
|
The
Algorithm
in
C
|
The Algorithm in C
/***** FLASH.C ,FLOAT-, recursive subroutine version
Translation of Neubert's algorithm into C by Michael Sahota *****/
/* Subroutine Flash(a,n,m,ctr)
- Sorts array a with n elements by use of the index vector l of
dimension m (with m about 0.1 n).
- The routine runs fastest with a uniform distribution of elements.
- The vector l is declare dynamically using the calloc function.
- The variable ctr counts the number of times that flashsort is called.
- THRESHOLD is a very important constant. It is the minimum number
of elements required in a subclass before recursion is used. */
#include < stdio.h > ;
#include < math.h > ;
#include < alloc.h > ;
const int THRESHOLD = 75;
const CLASS_SIZE = 75; /* minimum value for m */
void flashsort(float a[],int n,int m,int *ctr)
{
/* declare variables */
int *l,nmin,nmax,i,j,k,nmove,nx,mx;
float c1,c2,flash,hold;
/* allocate space for the l vector */
l=(int*)calloc(m,sizeof(int));
/***** CLASS FORMATION ****/
nmin=nmax=0;
for (i=0 ; i < n ; i++)
if (a[i] < a[nmin]) nmin = i;
else if (a[i] > a[nmax]) nmax = i;
if ( (a[nmax]==a[nmin]) && (ctr==0) )
{
printf("All the numbers are identical, the list is sorted\n");
return;
}
c1=(m-1.0)/(a[nmax]-a[nmin]) ;
c2=a[nmin];
l[0]=-1; /* since the base of the "a" (data) array is 0 */
for (k=1; k < m ; k++) l[k]=0;
for (i=0; i < n ; i++)
{
k=floor(c1*(a[i]-c2) );
l[k]+=1;
}
for (k=1; k < m ; k++) l[k]+=l[k-1];
hold=a[nmax];
a[nmax]=a[0];
a[0]=hold;
/**** PERMUTATION *****/
nmove=0;
j=0;
k=m-1;
while ( nmove < n )
{
while ( j > l[k] )
{
j++;
k=floor(c1*(a[j]-c2) ) ;
}
flash=a[ j ] ;
while ( j <= l[k] )
{
k=floor(c1*(flash-c2));
hold=a[ l[k] ];
a[ l[k] ] = flash;
l[k]--;
flash=hold;
nmove++;
}
}
/**** Choice of RECURSION or STRAIGHT INSERTION *****/
for (k=0;k<(m-1);k++)
if ( (nx = l[k+1]-l[k]) > THRESHOLD ) /* then use recursion */
{
flashsort(&a[l[k]+1],nx,CLASS_SIZE,ctr);
(*ctr)++;
}
else /* use insertion sort */
for (i=l[k+1]-1; i > l[k] ; i--)
if (a[i] > a[i+1])
{
hold=a[i];
j=i;
while (hold > a[j+1] ) a[j++]=a[j+1] ;
a[j]=hold;
}
free(l); /* need to free the memory we grabbed for the l vector */
}
Go back to contents
|
The
Algorithm
in
Pascal
|
The Algorithm in Pascal
(* FLASH.Pas , Integer Version *)
(* Translation of algorithm into Pascal by Nuala Lawless *)
PROGRAM Flashsort(input,output);
TYPE ARR=array[1..1000]of integer;
VAR A,L:arr;
num,nmin,nmax,cnum,i,HOLD:integer;
c1,c2:integer;
PROCEDURE Readin;
VAR i,x:integer;
BEGIN
Writeln( ' This is the Integer Version of Flashsort ');
Writeln( ' In this Pascal Program, for specific testing ');
Writeln( ' you may input directly the numbers to be sorted. ');
Writeln( ' Type in the number of numbers to be sorted - ');
Readln(num);
for i:= 1 to num do
begin
Writeln( ' Type in number ' ,i,' - ');
Readln( x );
A[i]:=x;
end;
Writeln(' How many classes do you want - ');
Readln(cnum);
END;
(*********************************************************************)
PROCEDURE Class;
VAR i,k:integer;
BEGIN
nmin:=1;
nmax:=1;
for i:= 1 to num do
begin
if A[i] < A[nmin] then nmin:=i;
if A[i] > A[nmax] then nmax:=i;
end;
c1:=( cnum - 1 ) div ( A[nmax] - A[nmin]);
c2:= c1 * A[nmin];
for k:= 1 to cnum do
L[k]:=0;
for i:= 1 to num do
begin
k:=1 + ( c1 * A[i] - c2 );
L[k]:=L[k]+1;
end;
for k:= 2 to cnum do
L[k]:=L[k] + L[k-1];
HOLD := A[nmax];
A[nmax]:=a[1];
A[1]:=HOLD;
END;
(**********************************************************************)
PROCEDURE Perm;
VAR nmove,i,j,k,FLASH:integer;
BEGIN
NMOVE:=0;
j:=1;
k:=cnum;
while nmove < ( num - 1 ) do
begin
while j > L[k] do
begin
j:=j + 1;
k:=1 + ( c1 * A[j] - c2 )
end;
FLASH:=A[j];
while j <> ( L[k] + 1 ) do
begin
k:= 1 + ( c1*FLASH - c2 );
HOLD:=A[L[k]];
A[L[k]]:=FLASH;
L[k]:=L[k]-1;
FLASH:=HOLD;
nmove:=nmove+1;
end;
end;
END;
(*****************************************************************)
PROCEDURE Insert;
VAR i,j:integer;
BEGIN
for i:= num-2 downto 1 do
begin
if A[i+1] < A[i] then
begin
HOLD:=A[i];
j:=i;
while A[j+1] < HOLD do
begin
A[j]:=A[j+1];
j:=j+1;
end;
A[j]:=HOLD
end;
end;
END;
(*****************************************************************)
PROCEDURE Writeout;
VAR i:integer;
BEGIN
for i:= 1 to num do
write('Array A ',a[i],' , ');
END;
(******************************************************************)
BEGIN (**** main program ****)
Readin;
Class;
Perm;
Insert;
Writeout;
END.
Go back to contents
|