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