www.neubert.net - Dr. Neubert's Website
The Entropy Reduction Laboratory

A Collection of FlashSort Implementations


Classification
Accumulation

run the loops:
- find cycle leader
- in situ permutation

short range sorting

The FlashSort Algorithm

FlashSort sorts n elements in O(n) time. Flash-Sort uses a vector L(k) of length m in a first step for the classification of the elements of array A. Then, in a second step, the resulting counts are accumulated and the L(k) point to the class boundaries. Then the elements are sorted by in situ permutation. During the permutation, the L(k) are decremented by a unit step at each new placement of an element of class k in the array A. A crucial aspect of FlashSort is that for identifying new cycle leaders. A cycle ends, if the the vector L(k) points to the position of an element below the classboundary of class k. The new cycle leader is the element situated in the lowest position complying to the complimentary condition, i.e. for which L(k) points to a position with L(k(A(i))) >= i. In addition to the array A of length n which holds the n elements to be sorted, the only auxiliary vector is the L(k)-vector. The size of this vector is equal to the number m of classes which is small compared to n, e.g. m typically may be set to m=0.1 n in case of floating point numbers or m=256 in a byte version.
Finally,a small number of partially distinguishable elements are sorted locally within their classes either by recursion or by a simple conventional sort algorithm.
Collection
of
FlashSort
codes

Contents

Collection of FlashSort Codes

  • ADA
  • BASIC
  • C
  • FORTH
  • FORTRAN
  • JAVA
  • PASCAL
  • The extended recursive Version
  • Download codes in txt-format
  • Back to FlashSort introduction
  • Back to Welcome page

    • 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
    BASIC

    The Algorithm in BASIC

    
flashsrt.bas - FlashSort embedded

               in full functional demo inclusive runtime measurement.


CLS

DEFINT A-Z



INPUT " How many numbers to be sorted? N = ", N

REM INPUT " How many numbers classes? M = ", M
REM =================================================

DIM A(N)

REM =================================================

PRINT " Generate vector of N random integer numbers "

PRINT " ------------------------------------------- "

GOSUB RANDOMS

GOSUB DISPLAY

PRINT

PRINT

PRINT " -------------- START FlashSort ------------ "

PRINT " ******************************************* "

			 T0# = TIMER

		       GOSUB FLASHSORT

			 T1# = TIMER

PRINT " -------------- FlashSort READY ------------ "

PRINT

PRINT USING " N = ##### Integers sorted"; N;

PRINT USING " in ##.### seconds "; T1# - T0#

PRINT USING " Number of classes M was ####"; M

PRINT " ------------------------------------------- "

GOSUB DISPLAY

END



REM =================================================

RANDOMS:

RANDOMIZE TIMER

FOR I = 1 TO N

    A(I) = INT(RND(1) * 10000)

NEXT I

RETURN



REM =================================================

DISPLAY:

PRINT " Display first 20 numbers: "

FOR I = 1 TO 20

PRINT USING "##### "; A(I);

NEXT I

PRINT

PRINT " Display last 20 numbers: "

FOR I = N - 20 TO N

  PRINT USING "##### "; A(I);

NEXT I

RETURN



REM =================================================

FLASHSORT:

REM sorts array A with N elements by use of

REM index vector L with M elements, with M ca. 0.1 N.

REM Translation of Karl-Dietrich Neubert's FlashSort

REM algorithm into BASIC by Erdmann Hess.

REM Integer Version.

REM The program was tested with MS-QBasic 1.1.

REM =============== CLASS FORMATION =================

M = .125 * N

DIM L(M)

ANMIN = A(1)

NMAX = 1

FOR I = 1 TO N

	IF (A(I) < ANMIN) THEN ANMIN = A(I)

	IF (A(I) > A(NMAX)) THEN NMAX = I

NEXT I

IF (ANMIN = A(NMAX)) THEN RETURN

C1# = (M - 1) / (A(NMAX) - ANMIN)

FOR K = 1 TO M

	L(K) = 0

NEXT K

FOR I = 1 TO N

	K = 1 + INT(C1# * (A(I) - ANMIN))

	L(K) = L(K) + 1

NEXT I

FOR K = 2 TO M

	L(K) = L(K) + L(K - 1)

NEXT K

HOLD = A(NMAX)

A(NMAX) = A(1)

A(1) = HOLD

REM ==================== PERMUTATION ================

NMOVE = 0

J = 1

K = M

WHILE (NMOVE < (N - 1))

	WHILE (J > L(K))

	J = J + 1

	K = 1 + INT(C1# * (A(J) - ANMIN))

	WEND

	FLASH = A(J)

	WHILE (NOT (J = (L(K) + 1)))

	    K = 1 + INT(C1# * (FLASH - ANMIN))

	    HOLD = A(L(K))

	    A(L(K)) = FLASH

	    FLASH = HOLD

	    L(K) = L(K) - 1

	    NMOVE = NMOVE + 1

	WEND

WEND

REM ================= STRAIGHT INSERTION ============

FOR I = N - 2 TO 1 STEP -1

	IF (A(I + 1) < A(I)) THEN

		HOLD = A(I)

		J = I

		WHILE (A(J + 1) < HOLD)

			A(J) = A(J + 1)

			J = J + 1

		WEND

		A(J) = HOLD

	END IF

NEXT I

REM ============== RETURN, END FLASHSORT ============

RETURN
    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
    FORTH     
    

                       
    


    


     The Algorithm in FORTH
    

 

\    ************** This is the Byte Version of Flashsort *************

\    Karl-Dietrich Neubert

\    The FlashSort Algorithm - a demo of the principal mechanism - 

\    This is an MS 6.0 Word document as published in the Proceedings of the 

\    euroFORTH'97

\    -Conference, Oxford, England,Sept.26-28 1997

 

\ ----------------------------------------------------------------------



: ARRAY

     CREATE WSIZE * ALLOT

     DOES> 

       SWAP WSIZE * + ;



\ ----------------------------------- Flash-Sort -----------------------



  VARIABLE     M                  256 M !

               M @ ARRAY L

  VARIABLE    NA              100000 NA !

              NA @ ARRAY A

  VARIABLE     K 

  VARIABLE     N 

  VARIABLE    JJ

  VARIABLE NMOVE



: KEY-VALUE ( addr --- KEY-VALUE)

  ( COLUMN @ + COLLATION-TABLE )         \ generalized version   

  @ ; 



: CLASSIFY  ( --- )                      \ count elements of classes

    0 L M @ WSIZE * 0 FILL

    N @ 0 DO               

      1 I A KEY-VALUE L +!

    LOOP ;



: L-VECTOR  ( --- )                      \ accumulate counts

    -1 M @ 0 DO

          I L DUP >R @ + DUP R> !

       LOOP DROP ;



: FLASH-EXCHANGE ( @ KEY-VALUE ---  @ KEY-VALUE )

                              \ save the value at position L(K)

                              \ put the L(K) value in place  

    K !

    K @ L @ A

    DUP KEY-VALUE >R DUP @ >R !

    R> R> ; 

 

: PERMUTE ( --- )             \ permute a cycle  

     JJ @ A   DUP @

     SWAP KEY-VALUE DUP K !  

     BEGIN                                   

        K @ L @ JJ @ >= WHILE  

        FLASH-EXCHANGE

        -1 K @ L +!

        -1 NMOVE +!

     REPEAT

     DROP DROP ;



: LEADER ( --- )             \ find a cycle leader at position JJ 

     BEGIN 

        1 JJ +!

        JJ @ DUP A KEY-VALUE L @ <=    \  >( a html dummy remark )

     UNTIL ;



: FLASH-SORT ( --- )

     CLASSIFY                     

     L-VECTOR 

     N @ NMOVE !                    

     0 JJ !                             \ first leader

     PERMUTE                               

     BEGIN

        NMOVE @ WHILE

        LEADER                          \ next leader

        PERMUTE                     

     REPEAT ;
    Go back to contents
    The
    Algorithm
    in
    FORTRAN     
    

                       
    


    


     The Algorithm in FORTRAN
    

 

      SUBROUTINE FLASH1 (A. N. L. M)

C     SORTS ARRY A WITH N ELEMENTS BY USE OF INDEX VECTOR L 

C     OF DIMENSION M WITH M ABOUT 0.1 N. 

C     Karl-Dietrich Neubert, FlashSort1 Algorithm 

C     in  Dr. Dobb's Journal Feb.1998,p.123

                          



      DIMENSION A(1),L(1)

C     ============================ CLASS FORMATION ===== 

      ANMIN=A(1)

      NMAX=1 

      DO I=1,N

         IF( A(I).LT.ANMIN) ANMIN=A(I)

         IF( A(I).GT.A(NMAX)) NMAX=I

      END DO

      IF (ANMIN.EQ.A(NMAX)) RETURN

      C1=(M - 1) / (A(NMAX) - ANMIN)

      DO K=1,M  

         L(K)=0

      END DO 

      DO I=1,N

         K=1 + INT(C1 * (A(I) - ANMIN))

         L(K)=L(K) + 1

      END DO

      DO K=2,M

         L(K)=L(K) + L(K - 1)

      END DO

      HOLD=A(NMAX)

      A(NMAX)=A(1) 

      A(1)=HOLD

C     =============================== PERMUTATION ===== 

      NMOVE=0 

      J=1

      K=M

      DO WHILE (NMOVE.LT.N - 1)

         DO WHILE (J.GT.L(K)) 

            J=J + 1 

            K=1 + INT(C1 * (A(J) - ANMIN)) 

         END DO  

         FLASH=A(J)

         DO WHILE (.NOT.(J.EQ.L(K) + 1)) 

            K=1 + INT(C1 * (FLASH - ANMIN))

            HOLD=A(L(K)) 

            A(L(K))=FLASH

            FLASH=HOLD

            L(K)=L(K) - 1

            NMOVE=NMOVE + 1 

         END DO

      END DO

C     ========================= STRAIGHT INSERTION =====

      DO I=N-2,1,-1

         IF  (A(I + 1).LT.A(I)) THEN

            HOLD=A(I)

            J=I

            DO WHILE  (A(J + 1).LT.HOLD)

               A(J)=A(J + 1) 

               J=J + 1 

            END DO

            A(J)=HOLD 

         ENDIF

      END DO

C     =========================== RETURN,END FLASH1 =====

      RETURN

      END
    Go back to contents
    The
    Algorithm
    in
    JAVA

    The Algorithm in JAVA

    

/**


 * FlashSort.java - integer version 


 * Translation of Karl-Dietrich Neubert's algorithm into Java by   


 * Rosanne Zhang



 * at www.webappcabaret.com/javachina


 * Timing measurement included


 * Full functional application


 */
   
class FlashSort 


{
    static int   n;
    static int   m;
    static int[] a;
    static int[] l;
    
    /**
     * constructor 
     * @param size of the array to be sorted
     */


    public static void flashSort(int size)


    {
        n = size;


        generateRandomArray();


        long start = System.currentTimeMillis();
        partialFlashSort();
        long mid = System.currentTimeMillis();
        insertionSort();
        long end = System.currentTimeMillis();


        // print the time result


        System.out.println("Partial flash sort time     : " + (mid - start) );
        System.out.println("Straight insertion sort time: " + (end - mid) );
    }


    /**
     * Entry point
     */


    public static void main(String[] args) 


    {
        int size = 0;


        if (args.length == 0)


        {
            usage();
            System.exit(1);
        }


        try 


        {
            size = Integer.parseInt(args[0]); 
        }


        catch (NumberFormatException nfe)

       

        {
            usage();
            System.exit(1);
        }


        FlashSort.flashSort(size);
    }




    /**
     * Print usage
     */


    private static void usage() 


    {
        System.out.println();
        System.out.println("Usage: java FlashSort n ");
        System.out.println("       n is size of array to sort");
    }




    /**
     * Generate the random array
     */


    private static void generateRandomArray() 


    {
        a = new int[n];
        for (int i=0; i < n; i++)


        {
            a[i] = (int)(Math.random() * 5 * n);
        }


        //printArray(a);
        


        m = n/20;
    

    /**

     *  if (m < 30) m = 30;

     */


        l = new int[m];   
    }


    /**
     * Partial flash sort
     */


    private static void partialFlashSort() 


    {
        int i = 0, j = 0, k = 0;
        int anmin = a[0];
        int nmax  = 0;


        for (i=1; i < n; i++)


        {
            if (a[i] < anmin) anmin=a[i];
            if (a[i] > a[nmax]) nmax=i;            
        }


        if (anmin == a[nmax]) return;


        double c1 = ((double)m - 1)/(a[nmax] - anmin);


        for (i=0; i < n; i++)


        {
            k=(int)(c1*(a[i] - anmin));
            l[k]++;
        }


        //printArray(l);


        for (k=1; k < m; k++)


        {
          l[k] += l[k-1];
        }


        int hold = a[nmax];
        a[nmax]=a[0];
        a[0]=hold;


        int nmove = 0;
        int flash;
        j=0;
        k=m-1;


        while (nmove < n-1)


        {
            while (j > (l[k]-1))


            {
                j++;
                k = (int)(c1 * (a[j] - anmin));
            }


            flash = a[j];


            while (!(j == l[k]))


            {
                k = (int) (c1 * (flash - anmin));


                hold = a[l[k]-1];
                a[l[k]-1]=flash;
                flash = hold;


                l[k]--;
                nmove++;
            }
        }


        //printArray(a);
    }


    /**
     * Straight insertion sort
     */


    private static void insertionSort()


    {
        int i, j, hold;


        for (i=a.length-3; i>=0; i--)


        {
            if (a[i+1] < a[i]) 


            {
                hold = a[i];
                j=i;


                while (a[j+1] < hold) 


                {
                    a[j] = a[j+1];
                    j++;
                }


                a[j] = hold;
            }
        }


        //printArray(a);
    }


    /**
     * For checking sorting result and the distribution
     */


    private static void printArray(int[] ary)


    {
        for (int i=0; i < ary.length; i++) {


            if ((i+1)%10 ==0) 


                System.out.println(ary[i]);


            else


                System.out.print(ary[i] + " ");
        }


        System.out.println();
    }
}
    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
    Extended
    Recursive
    Version
    -----------------------------------------------------------------------------
    -----------------------------------------------------------------------------

    The Extended Recursive Version of FlashSort

    For real life applications, an extended recursive version of FLASH-SORT is available. With that version, within the limits of available memory, any number of strings of any length and any number of keys with independent selectable collation sequences for any sort order of columns may be sorted in optimal run time. As an example, sorting on a 133 MHz PC 100 000 strings of 50 bytes length with a 50 byte key takes about 4.6 sec, sorting 1000 000 strings of the same length and same number of keys requires 46 sec. The source code for this general version is written in Forth.

    Go back to contents
    Download Download codes in txt-format.
    FlashSort
    introduction         		To go back to FlashSort introduction click here.
    Back to
    Welcome     		To go back to the Welcome page click here.

    This page and each part of it Copyright © 1998-2002 Karl-Dietrich Neubert.
    All Rights Reserved
    Design by Vladimir Marek.
    Last update of the page: April 20, 2003