Flashsort

Share your advanced PureBasic knowledge/code with the community.
Post Reply
akj
Enthusiast
Enthusiast
Posts: 668
Joined: Mon Jun 09, 2003 10:08 pm
Location: Nottingham

Flashsort

Post by akj »

Code updated for 5.20+

I found this incredibly quick sorting algorithm called FlashSort on a website recently and I thought I would let you know about it.

It's sort speed is linear i.e. O(n) where n is the number of items being sorted.
Classical high-speed sort methods like QuickSort and HeapSort have a typical speed of O(n*log(n)) which is far slower for large n.

The following PureBasic implementation will sort a million integers in about one second.

It was adapted from code on the website - which explains the strange choice of variable names. I have corrected a couple of bugs which caused incorrect sorting, especially when the number of items to be sorted was very small.

Code: Select all

; Flashsort  AKJ  01-May-05

; Downloaded:   www.neubert.net/Flacodes/FLACodes.html#Sprung2
; Introduction: www.neubert.net/FSOIntro.html

; FlashSort sorts the n elements of array A() in O(n) [i.e. linear] time.
; It uses an additional array L() of size n/8 as a first step in the
; classification of the elements of array A().

Declare RANDOMS()
Declare DISPLAY()
Declare FLASHSORT()

Global N

OpenConsole()
Print("How many numbers to be sorted? ")
N=Val(Input())
PrintN("")
Global Dim A(N) ; The integer array to be sorted

PrintN("Generating "+Str(N)+" random integers ...")
PrintN("")
RANDOMS()
DISPLAY()
PrintN("")

PrintN("Sorting ...")
t0=ElapsedMilliseconds()
M=FLASHSORT() ; Returns the number of classes

; Format the elapsed time
msecs$=Str(ElapsedMilliseconds()-t0)
secs$=Left(msecs$,Len(msecs$)-3)+"."+Right("00"+msecs$,3)
; Display summary
Print(Str(N)+" Integers sorted")
Print(" in "+secs$+" seconds")
Print(" using "+Str(M)+" class")
If M>1: PrintN("es"): Else: PrintN(""): EndIf
PrintN("")
DISPLAY()
PrintN("")
Print("Press ENTER ... ")
Input()
CloseConsole()
End

Procedure RANDOMS()
  RandomSeed(ElapsedMilliseconds())
  For I=1 To N
    A(I) = Random(10000)
  Next I
EndProcedure

Procedure DISPLAY()
  count=16
  If count>N
    PrintN("All "+Str(N)+" numbers:")
    For I = 1 To N
      Print(Str(A(I))+" ")
    Next I
  Else
    PrintN("First "+Str(count)+" numbers:")
    For I = 1 To count
      Print(Str(A(I))+" ")
    Next I
    PrintN("")
    PrintN("Last "+Str(count)+" numbers:")
    For I = N - count+1 To N
      Print(Str(A(I))+" ")
    Next I
  EndIf
  PrintN("")
EndProcedure

Procedure FLASHSORT() ; Integer version
  ; Sorts an integer array A(), using a much smaller index array L()
  ; This is a translation of Karl-Dietrich Neubert's FlashSort algorithm
  ; It was first published in Dr. Dobb's Journal, February 1998
  
  ; CLASS FORMATION
  M = N/8
  If M<1: M=1: EndIf ; Bug fix by AKJ
  Dim L(M)
  ANMIN = A(1)
  NMAX = 1
  For I=1 To N
    If A(I)<ANMIN: ANMIN = A(I): EndIf
    If A(I)>A(NMAX): NMAX = I: EndIf
  Next I
  If ANMIN=A(NMAX): ProcedureReturn M: EndIf
  C1.f = (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) + 1
  Next I
  For K=2 To M
    L(K) + L(K-1)
  Next K
  HOLD = A(NMAX)
  A(NMAX) = A(1)
  A(1) = HOLD
  
  ; PERMUTATION
  NMOVE = 0
  J = 1
  K = M
  While NMOVE<N-1
    While J>L(K)
      J + 1
      K = 1 + Int(C1*(A(J)-ANMIN))
    Wend
    FLASH = A(J)
    While J<>L(K) + 1
      K = 1 + Int(C1*(FLASH-ANMIN))
      HOLD = A(L(K))
      A(L(K)) = FLASH
      FLASH = HOLD
      L(K) - 1
      NMOVE + 1
    Wend
  Wend
  Dim L(0) ; Free memory
  
  ; STRAIGHT INSERTION
  For I = N-2 To 1 Step -1
    If A(I)>A(I + 1)
      HOLD = A(I)
      J = I
      While A(J+1)<HOLD
        A(J) = A(J+1)
        J + 1
        If J=N: Break: EndIf ; Bug fix by AKJ
      Wend
      A(J) = HOLD
    EndIf
  Next I
  ProcedureReturn M
EndProcedure
Anthony Jordan
Top
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

seems to work ok for low numbers.. But:

okay tried to sort nearly a million :)
999999

result:

Image
Top
User avatar
Rescator
Addict
Addict
Posts: 1769
Joined: Sat Feb 19, 2005 5:05 pm
Location: Norway

Post by Rescator »

*laughs*

Just change line 52 from

A(I) = Random(10000)

to

A(I) = Random(n)
Top
thefool
Always Here
Always Here
Posts: 5875
Joined: Sat Aug 30, 2003 5:58 pm
Location: Denmark

Post by thefool »

heh but at least its not my fault :) didnt have time to look it through

edit: This sort is pretty fast! good one.
Last edited by thefool on Sun May 01, 2005 9:34 pm, edited 1 time in total.
Top
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Re: Flashsort

Post by NoahPhense »

Very nice akj ..

- np
Top
Fred
Administrator
Administrator
Posts: 18253
Joined: Fri May 17, 2002 4:39 pm
Location: France
Contact:
Contact Fred

Post by Fred »

Don't tell me we will have to change the PB sort routines once more ! :twisted:
Top
Num3
PureBasic Expert
PureBasic Expert
Posts: 2812
Joined: Fri Apr 25, 2003 4:51 pm
Location: Portugal, Lisbon
Contact:
Contact Num3

Post by Num3 »

Fred wrote:Don't tell me we will have to change the PB sort routines once more ! :twisted:
Ok... No one will tell you ....
Top
freedimension
Enthusiast
Enthusiast
Posts: 613
Joined: Tue May 06, 2003 2:50 pm
Location: Germany
Contact:
Contact freedimension

Post by freedimension »

Fred wrote:Don't tell me we will have to change the PB sort routines once more ! :twisted:
Is this sort algorithm stable like the current one?
<°)))o><²³
Top
User avatar
NoahPhense
Addict
Addict
Posts: 1999
Joined: Thu Oct 16, 2003 8:30 pm
Location: North Florida

Post by NoahPhense »

freedimension wrote:
Fred wrote:Don't tell me we will have to change the PB sort routines once more ! :twisted:
Is this sort algorithm stable like the current one?
I don't know but it's pretty damn fast ..

- np
Top
horst
Enthusiast
Enthusiast
Posts: 197
Joined: Wed May 28, 2003 6:57 am
Location: Munich
Contact:
Contact horst

Post by horst »

NoahPhense wrote:
freedimension wrote:
Fred wrote:Don't tell me we will have to change the PB sort routines once more ! :twisted:
Is this sort algorithm stable like the current one?
I don't know but it's pretty damn fast ..

- np
I dunno, but on my old 533Mhz Win98 the PB sort is amost twice as fast:
1.3 sec (PB) vs. 2.2 sec (Flash).

Anything wrong with the PB sort (PB3.93) ???
Horst.
Top
zikitrake
Addict
Addict
Posts: 876
Joined: Thu Mar 25, 2004 2:15 pm
Location: Spain

Post by zikitrake »

horst wrote: I dunno, but on my old 533Mhz Win98 the PB sort is amost twice as fast:
1.3 sec (PB) vs. 2.2 sec (Flash).

Anything wrong with the PB sort (PB3.93) ???
Using 9999999 numbers (PIII 2.0 Ghz, WinXP pro, 512 RAM):

- With FLASHSORT() ---> 11.343 seconds

- With PB SortArray(A(), 0) -> 3.922 seconds


:shock:
PB 6.21 beta, PureVision User
Top
User avatar
Comtois
Addict
Addict
Posts: 1431
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Post by Comtois »

Yes
Using 9999999 numbers (P IV 2,6 GHz)
With FlashSort --> 4,469
With SortArray --> 1,891

Code: Select all

; Flashsort  AKJ  01-May-05

; Downloaded:   www.neubert.net/Flacodes/FLACodes.html#Sprung2
; Introduction: www.neubert.net/FSOIntro.html

; FlashSort sorts the n elements of array A() in O(n) [i.e. linear] time.
; It uses an additional array L() of size n/8 as a first step in the
; classification of the elements of array A().

Declare RANDOMS()
Declare DISPLAY()
Declare DISPLAYCopy()
Declare FLASHSORT()

Global n

OpenConsole()
Print("How many numbers to be sorted? ")
n=Val(Input())
PrintN("")
Dim A(n) ; The integer array to be sorted by FlashSort
Dim CopyA(n) ; The integer array to be sorted by SortArray

PrintN("Generating "+Str(n)+" random integers ...")
PrintN("")
RANDOMS()
DISPLAY()
PrintN("")

PrintN("Sorting With FLASHSORT...")
t0=ElapsedMilliseconds()
M=FLASHSORT() ; Returns the number of classes
; Format the elapsed time
msecs$=Str(ElapsedMilliseconds()-t0)
secs$=Left(msecs$,Len(msecs$)-3)+"."+Right("00"+msecs$,3)

PrintN("Sorting With ARRAYSORT...")
t1=ElapsedMilliseconds() ; <
SortArray(CopyA(),0)     ; <
msecs1$=Str(ElapsedMilliseconds()-t1)                       ; <
secs1$=Left(msecs1$,Len(msecs1$)-3)+"."+Right("00"+msecs1$,3) ; <

; Display summary
Print(Str(n)+" Integers sorted with FlashSort")
Print(" in "+secs$+" seconds")
Print(" using "+Str(M)+" class")
If M>1: PrintN("es"): Else: PrintN(""): EndIf
PrintN("")
DISPLAY()
PrintN("")
PrintN("")

;SortArray
Print(Str(n)+" Integers sorted with SortArray")
Print(" in "+secs1$+" seconds")
PrintN("")
DISPLAYCopy()
PrintN("")
Print("Press ENTER ... ")
Input()
CloseConsole()
End


Procedure RANDOMS()
  RandomSeed(ElapsedMilliseconds())
  For i=1 To n
    A(i) = Random(10000)
  CopyA(i) = A(i) ;<
Next i
EndProcedure


Procedure DISPLAY()
  count=16
  If count>n
    PrintN("All "+Str(n)+" numbers:")
    For i = 1 To n
      Print(Str(A(i))+" ")
    Next i
  Else
    PrintN("First "+Str(count)+" numbers:")
    For i = 1 To count
      Print(Str(A(i))+" ")
    Next i
    PrintN("")
    PrintN("Last "+Str(count)+" numbers:")
    For i = n - count+1 To n
      Print(Str(A(i))+" ")
    Next i
  EndIf
  PrintN("")
EndProcedure

Procedure DISPLAYCopy()
  count=16
  If count>n
    PrintN("All "+Str(n)+" numbers:")
    For i = 1 To n
      Print(Str(CopyA(i))+" ")
    Next i
  Else
    PrintN("First "+Str(count)+" numbers:")
    For i = 1 To count
      Print(Str(CopyA(i))+" ")
    Next i
    PrintN("")
    PrintN("Last "+Str(count)+" numbers:")
    For i = n - count+1 To n
      Print(Str(CopyA(i))+" ")
    Next i
  EndIf
  PrintN("")
EndProcedure

Procedure.l FLASHSORT() ; Integer version
  ; Sorts an integer array A(), using a much smaller index array L()
  ; This is a translation of Karl-Dietrich Neubert's FlashSort algorithm
  ; It was first published in Dr. Dobb's Journal, February 1998
  
  ; CLASS FORMATION
  M = n/8
  If M<1: M=1: EndIf ; Bug fix by AKJ
  Dim L(M)
  ANMIN = A(1)
  NMAX = 1
  For i=1 To n
    If A(i)<ANMIN: ANMIN = A(i): EndIf
    If A(i)>A(NMAX): NMAX = i: EndIf
  Next i
  If ANMIN=A(NMAX): ProcedureReturn M: EndIf
  C1.f = (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) + 1
  Next i
  For K=2 To M
    L(K) + L(K-1)
  Next K
  HOLD = A(NMAX)
  A(NMAX) = A(1)
  A(1) = HOLD
  
  ; PERMUTATION
  NMOVE = 0
  J = 1
  K = M
  While NMOVE<n-1
    While J>L(K)
      J + 1
      K = 1 + Int(C1*(A(J)-ANMIN))
    Wend
    FLASH = A(J)
    While J<>L(K) + 1
      K = 1 + Int(C1*(FLASH-ANMIN))
      HOLD = A(L(K))
      A(L(K)) = FLASH
      FLASH = HOLD
      L(K) - 1
      NMOVE + 1
    Wend
  Wend
  Dim L(0) ; Free memory
  
  ; STRAIGHT INSERTION
  For i = n-2 To 1 Step -1
    If A(i)>A(i + 1)
      HOLD = A(i)
      J = i
      While A(J+1)<HOLD
        A(J) = A(J+1)
        J + 1
        If J=n: Break: EndIf ; Bug fix by AKJ
      Wend
      A(J) = HOLD
    EndIf
  Next i
  ProcedureReturn M
EndProcedure
Last edited by Comtois on Thu May 05, 2005 3:29 pm, edited 1 time in total.
Please correct my english
http://purebasic.developpez.com/
Top
MrMat
Enthusiast
Enthusiast
Posts: 762
Joined: Sun Sep 05, 2004 6:27 am
Location: England

Post by MrMat »

@Comtois: Shouldn't the line

Code: Select all

msecs$=Str(ElapsedMilliseconds()-t0)
be

Code: Select all

msecs$=Str(t1-t0)
?
I still get SortArray to be faster but maybe if FlashSort was optimised in asm it might do better.
Mat
Top
User avatar
Comtois
Addict
Addict
Posts: 1431
Joined: Tue Aug 19, 2003 11:36 am
Location: Doubs - France

Post by Comtois »

:oops:

Yes , you're right :)

Edit previous post, i hope everything is correct now ? :?
Please correct my english
http://purebasic.developpez.com/
Top
Post Reply

Return to “Tricks 'n' Tips”