## Sort Array

VANYA
Posts: 1362
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

### Sort Array

I found the code in JustBasic. Works like a quick. On my computer, sorted 1000000 for 0.22 .... second. Someone can offer a faster version?

Code: Select all

`Dim As UInteger MaxSize = 20Dim Shared NumArray(MaxSize) As UIntegerRandomize TimerSub Qsort(start As Integer,Finish As UInteger)   Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A   While  I <= J      While NumArray(I) < X         I+=1      Wend      While NumArray(J) > X         J-=1      Wend            If I<=J Then         A = NumArray(I)         NumArray(I) = NumArray(J)         NumArray(J) = A         I+=1         J-=1      EndIf   Wend   If J > Start Then Qsort(start,J)   If I < Finish Then Qsort(I,Finish)End SubPrint "Unsorted Array"For I As Integer=1 To MaxSize   NumArray(I) = Int(Rnd*100)   Print NumArray(I);" ";NextQsort(1,MaxSize)PrintPrint "Sorted Array"For I As Integer=1 To MaxSize   Print NumArray(I);" ";NextSleep`
I3I2UI/I0
Posts: 90
Joined: Jun 03, 2005 10:39
Location: Germany

### Re: Sort Array

Someone can offer a faster version?

Yes!

Code: Select all

`Dim As UInteger MaxSize = 2000000Dim Shared NumArray(MaxSize) As UIntegerRandomize TimerSub Qsort(start As Integer,Finish As UInteger)  Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A  While  I <= J    While NumArray(I) < X      I+=1    Wend    While NumArray(J) > X      J-=1    Wend    If I<=J Then      A = NumArray(I)      NumArray(I) = NumArray(J)      NumArray(J) = A      I+=1      J-=1    EndIf  Wend  If J > Start Then Qsort(start,J)  If I < Finish Then Qsort(I,Finish)End SubSub ASM_QSort(a() As Integer, l As Integer, r As Integer)  Dim As Integer i=l, j=r, x=a((l+r)\2)Asm QS_L0:              'Do  mov ecx, [a]  mov ecx, [ecx] QS_L1:  mov ebx, [i]  lea edi, [ecx+ebx*4]  mov ebx, [x]  cmp [edi], ebx     'While a(i)<x  jge QS_L2  inc dword ptr [i]  'i+=1  jmp QS_L1 QS_L2:  mov ebx, [j]  lea esi, [ecx+ebx*4]  mov eax, [esi]  cmp [x], eax       'While x<a(j)  jge QS_L3  dec dword ptr [j]  'j-=1  jmp QS_L2 QS_L3:  cmp [i], ebx       'If i<=j Then  jg QS_L4  mov eax, [edi]     'Swap a(i), a(j)  xchg eax, [esi]  mov [edi], eax   inc dword ptr [i]  'i+=1  dec dword ptr [j]  'j-=1 QS_L4:  cmp [i], ebx       'Loop Until i>j  jle QS_L0End Asm   If l<j Then ASM_QSort(a(), l, j)  If i<r Then ASM_QSort(a(), i, r)End SubSub RapidSort (Item()As Integer, LoElement As Integer, HiElement As Integer)  Dim As Integer n, wert, nptr, arr, rep, LoVal, HiVal  LoVal=Item(LoElement)  HiVal=Item(HiElement)  For n=LoElement To HiElement    If LoVal> Item(n) Then LoVal=Item(n)    If HiVal< Item(n) Then HiVal=Item(n)  Next  ReDim SortArray(LoVal To HiVal) As Integer  For n=LoElement To HiElement    wert=Item(n)    SortArray(wert)=SortArray(wert)+1  Next  nptr=LoElement-1  For arr=LoVal To HiVal    rep=SortArray(arr)    For n=1 To rep      nptr=nptr+1      Item(nptr)=arr    Next  Next  Erase SortArrayEnd SubDim t As DoublePrint "Qsort ";For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt=TimerQsort(1,MaxSize)?Timer-tPrint "ASM_QSort ";For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt=TimerASM_QSort(NumArray(),1,MaxSize)?Timer-tPrint "RapidSort ";For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt=TimerRapidSort(NumArray(),1,MaxSize)?Timer-tSleep`
VANYA
Posts: 1362
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

### Re: Sort Array

I3I2UI/I0 wrote:
Someone can offer a faster version?

Yes!

Code: Select all

`Dim As UInteger MaxSize = 2000000Dim Shared NumArray(MaxSize) As UIntegerRandomize TimerSub Qsort(start As Integer,Finish As UInteger)  Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A  While  I <= J    While NumArray(I) < X      I+=1    Wend    While NumArray(J) > X      J-=1    Wend    If I<=J Then      A = NumArray(I)      NumArray(I) = NumArray(J)      NumArray(J) = A      I+=1      J-=1    EndIf  Wend  If J > Start Then Qsort(start,J)  If I < Finish Then Qsort(I,Finish)End SubSub ASM_QSort(a() As Integer, l As Integer, r As Integer)  Dim As Integer i=l, j=r, x=a((l+r)\2)Asm QS_L0:              'Do  mov ecx, [a]  mov ecx, [ecx] QS_L1:  mov ebx, [i]  lea edi, [ecx+ebx*4]  mov ebx, [x]  cmp [edi], ebx     'While a(i)<x  jge QS_L2  inc dword ptr [i]  'i+=1  jmp QS_L1 QS_L2:  mov ebx, [j]  lea esi, [ecx+ebx*4]  mov eax, [esi]  cmp [x], eax       'While x<a(j)  jge QS_L3  dec dword ptr [j]  'j-=1  jmp QS_L2 QS_L3:  cmp [i], ebx       'If i<=j Then  jg QS_L4  mov eax, [edi]     'Swap a(i), a(j)  xchg eax, [esi]  mov [edi], eax   inc dword ptr [i]  'i+=1  dec dword ptr [j]  'j-=1 QS_L4:  cmp [i], ebx       'Loop Until i>j  jle QS_L0End Asm   If l<j Then ASM_QSort(a(), l, j)  If i<r Then ASM_QSort(a(), i, r)End SubSub RapidSort (Item()As Integer, LoElement As Integer, HiElement As Integer)  Dim As Integer n, wert, nptr, arr, rep, LoVal, HiVal  LoVal=Item(LoElement)  HiVal=Item(HiElement)  For n=LoElement To HiElement    If LoVal> Item(n) Then LoVal=Item(n)    If HiVal< Item(n) Then HiVal=Item(n)  Next  ReDim SortArray(LoVal To HiVal) As Integer  For n=LoElement To HiElement    wert=Item(n)    SortArray(wert)=SortArray(wert)+1  Next  nptr=LoElement-1  For arr=LoVal To HiVal    rep=SortArray(arr)    For n=1 To rep      nptr=nptr+1      Item(nptr)=arr    Next  Next  Erase SortArrayEnd SubDim t As DoublePrint "Qsort ";For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt=TimerQsort(1,MaxSize)?Timer-tPrint "ASM_QSort ";For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt=TimerASM_QSort(NumArray(),1,MaxSize)?Timer-tPrint "RapidSort ";For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt=TimerRapidSort(NumArray(),1,MaxSize)?Timer-tSleep`

RapidSort is good! Thanks.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: Sort Array

VANYA wrote:RapidSort is good! Thanks.

Yes because 'RapidSort' algorithm is optimized for the particular case where the variables are integers.
The principle is to compute the distribution 'SortArray()' of the variables to order.
Mihail_B
Posts: 271
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

### Re: Sort Array

randomized quick sort runs in no better than : N*LOG(N)
and this is the limit of comparisions algorithms ...

But a linear sorting algorithm like "radix sort" runs in N*M (where M is the length in bytes of one item and N the number of items)
radix sort is based upon counting sort ...

this is just one example of a faster algorithm ... There are algorithms even better than the linear time N*M !

I wont write down the algorithm since you can google for it ... (

my answer is too stupid ? then :P :)
VANYA
Posts: 1362
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

### Re: Sort Array

Mihail_B wrote:my answer is too stupid ? then :P :)

I do not think so.
I'm glad,that you all for taking the time to this top, thanks.
Mihail_B
Posts: 271
Joined: Jan 29, 2008 11:20
Location: Romania
Contact:

### Re: Sort Array

:D :)
MichaelW
Posts: 3500
Joined: May 16, 2006 22:34
Location: USA

### Re: Sort Array

@VANYA

The CRT qsort function implements a compiler-optimized, non-recursive quick sort-insertion sort hybrid, that despite having to call a separate function for each comparison is much faster than your simple recursive version.

Code: Select all

`''=============================================================================#include "crt.bi"''=============================================================================Dim As UInteger MaxSize = 1000000Dim Shared NumArray(MaxSize) As UIntegerRandomize Timer''=============================================================================function compare naked cdecl( byval elem1 as any ptr, _                              byval elem2 as any ptr ) as integer  asm      mov ecx, [esp+4]      mov edx, [esp+8]      mov eax, [ecx]      sub eax, [edx]      ret  end asmend function''=============================================================================Sub _Qsort(start As Integer,Finish As UInteger)   Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A   While  I <= J      While NumArray(I) < X         I+=1      Wend      While NumArray(J) > X         J-=1      Wend      If I<=J Then         A = NumArray(I)         NumArray(I) = NumArray(J)         NumArray(J) = A         I+=1         J-=1      EndIf   Wend   If J > Start Then _Qsort(start,J)   If I < Finish Then _Qsort(I,Finish)End Sub''=============================================================================/'Print "Unsorted Array"For I As Integer=1 To MaxSize   NumArray(I) = Int(Rnd*100)   Print NumArray(I);" ";Nextprint_Qsort(1,MaxSize)Print "Sorted Array"For I As Integer=1 To MaxSize   Print NumArray(I);" ";NextprintPrint "Unsorted Array"For I As Integer=1 To MaxSize   NumArray(I) = Int(Rnd*100)   Print NumArray(I);" ";Nextprintqsort( @NumArray(1), MaxSize, 4, @compare )Print "Sorted Array"For I As Integer=1 To MaxSize   Print NumArray(I);" ";Nextprint'/sleep 3000dim as double tt = timer_Qsort(1,MaxSize)print using "##.###";timer-tt = timerqsort( @NumArray(1), MaxSize, 4, @compare )print using "##.###";timer-tsleep`

Typical results running on a 500MHz P3:

Code: Select all

` 0.940 0.092`

Typical results running on a 3.0GHz P4:

Code: Select all

`0.1770.011`
dafhi
Posts: 1329
Joined: Jun 04, 2005 9:51

### Re: Sort Array

My sort is about 6% faster than this crt qsort, but only up to about 70k elements.

Code: Select all

`Dim As Integer NumElements = 65000Dim Shared As double mTimeQ,mTimeG,MinLoopTimeDim Shared As String strNum,strDen#include "crt.bi"function compare naked cdecl( byval elem1 as any ptr, _                              byval elem2 as any ptr ) as integer  asm      mov ecx, [esp+4]      mov edx, [esp+8]      mov eax, [ecx]      sub eax, [edx]      ret  end asmend function'' LerpSort by cRex'' also included: cRex-modified quicksort'' Both:'' 1. index reference array, swapping those vals (for langs w/o pointers)'' 2. post-sort cycle swap for minimum user-data movementDim Shared As Integer Q, UB,LBDim Shared As Integer Sorted,mDelta,SwapI_Dim Shared As Single SwapVar,mDelt#Macro zSort3C(pLo,pMid,pHi,A) ''CycleSort version    If A(pLo) <= A(pMid) Then        If A(pMid) <= A(pHi) Then '123        Else            If A(pLo) <= A(pHi) Then '132                SwapI_ = pMid                pMid = pHi: pHi = SwapI_            Else '231                SwapI_ = pHi                pHi = pMid                pMid = pLo: pLo = SwapI_            End If        End If    Else 'plo > pMid        If A(pMid) <= A(pHi) Then            If A(pLo) <= A(pHi) Then   '213                SwapI_ = pMid                pMid = pLo: pLo = SwapI_            Else '312                SwapI_ = pLo                pLo = pMid                pMid = pHi: pHi = SwapI_            End If        Else '321            SwapI_ = pLo            pLo = pHi: pHi = SwapI_        End If    End If#EndMacro#Macro zIfSwapC(I_,J_,A) ''CycleSort version   If A(I_) > A(J_) Then      Swap I_, J_   EndIf#EndMacro#Macro zInsertionSortC(A,lSt,lEnd,pBtr) ''CycleSort version   I_ = lSt   For J_ = I_ + 1 To lEnd      If A(pBtr(I_)) > A(pBtr(J_)) Then         Swap_=pBtr(J_)         SwapVar = A(Swap_)         Copy_ = I_         pBtr(J_) = pBtr(Copy_)         For I_ = J_ - 2 To lSt Step -1            If A(pBtr(I_)) <= SwapVar Then Exit For            pBtr(Copy_) = pBtr(I_)            Copy_ = I_         Next         pBtr(Copy_) = Swap_      End If      I_ = J_   Next#EndMacroPrivate Sub zCycleSort(pSt As Integer, pEnd As Integer, pBtr() As Integer, A() As Single)Dim J As Integer, K As Integer   For pSt = pSt To pEnd      K = pBtr(pSt)      If K <> pSt Then         J = pSt         SwapVar = A(J)         Do            A(J) = A(K)            J = K            K = pBtr(K)            pBtr(J) = J ' "Null"            If K = pSt Then Exit Do         Loop         A(J) = SwapVar         pBtr(K) = K      End If   NextEnd Sub#Macro zInitIndices(IndxAry)   ReDim IndxAry(UBound(A))   For I_ = 0 To UBound(A)      IndxAry(I_) = I_   Next#EndMacroPrivate sub zLerpSortC(pSt As Integer,pEnd As Integer,A() As Single,pBtr() As Integer,Final() As Integer,Lerp_() As Integer)   Dim As Integer I_,J_,K_'' : : About LerpSort (cyclesort version) : :'' 1. LBound must be zero'' 2. LerpSort creates at least 4 Integer arrays'' 3. (2011 July 1) - discovered that LerpSort is identical''    to FlashSort by Karl Dietrich Neubert   I_ = pSt   J_ = pSt       Sorted = -1   For K_ = pSt + 1 To pEnd      ''pBtr = "pointers"         If A(pBtr(J_)) <= A(pBtr(K_)) Then         J_ = K_      Else         Sorted = 0         If A(pBtr(I_)) > A(pBtr(K_)) Then         I_ = K_         End If      End If   Next   If Sorted Then Exit Sub      mDelta = pEnd - pSt       Dim lStack(mDelta) As Integer '' created here in case recursive LerpSort      I_ = pBtr(I_)   mDelt = A(pBtr(J_)) - A(I_)       mDelt = mDelta / mDelt      For K_ = pSt To pEnd   J_ = (A(pBtr(K_)) - A(I_)) * mDelt   Lerp_(K_) = J_   lStack(J_) += 1   Next      I_ = pSt + lStack(0)   lStack(0) = pSt   For J_ = 1 To mDelta      If lStack(J_) > 0 Then         K_ = lStack(J_)         lStack(J_) = I_         I_ = I_ + K_      End If   Next      For I_ = pSt To pEnd   J_ = Lerp_(I_)   Final(lStack(J_)) = pBtr(I_)   lStack(J_) = lStack(J_) + 1   Next      For I_ = pSt To pEnd        pBtr(I_) = Final(I_) ''CycleSwap after LerpSort   Next   Dim As Integer   Swap_, Copy_ '' InsertionSort Macro   Dim As Integer L_   For L_ = 0 To mDelta      pEnd = lStack(L_)      I_ = pEnd - pSt      If I_ < 1 Then      ElseIf I_ = 1 Then         pSt = pEnd      ElseIf I_ = 2 Then         zIfSwapC(pBtr(pSt), pBtr(pEnd - 1), A)         pSt = pEnd      ElseIf I_ = 3 Then         zSort3C(pBtr(pSt), pBtr(pSt + 1), pBtr(pEnd - 1), A)         pSt = pEnd      ElseIf I_ < 10 Then         zInsertionSortC(A,pSt,pEnd - 1,pBtr)         pSt = pEnd      Else         zLerpSortC pSt,pEnd - 1,A(),pBtr(),Final(),Lerp_()         pSt = pEnd      End If   NextEnd SubSub LerpSort(A() As Single)   mDelta = UBound(A)   If mDelta = 0 Then Exit Sub      Dim As Integer I_,J_,pBtr()   zInitIndices(pBtr)      If mDelta = 1 Then      zIfSwapC(pBtr(0), pBtr(1), A)   ElseIf mDelta = 2 Then      zSort3C(pBtr(0), pBtr(1), pBtr(2), A)   Else      Dim As Integer lSt         Dim Final() As Integer      Dim Lerp_() As Integer            ReDim Final(mDelta)      ReDim Lerp_(mDelta)            zLerpSortC lSt,mDelta,A(),pBtr(),Final(),Lerp_()         End If               zCycleSort 0, UBound(A), pBtr(), A()End SubPrivate Sub zTimerCompare(A() As Single,ByRef RetTotal_ As Double)    mTimeQ = Timer - mTimeQ    RetTotal_ = RetTotal_ + mTimeQDim As Integer J, I    For J = 1 To UB        If A(I) > A(J) Then            Q = Q + 1            ? "Sort Problem!"            Exit For        End If        I = J    Next    mDelta = UB - LB    For J = 0 To UB        A(J) = Rnd * UB'-J    Next    Sleep 1End SubPrivate Sub Test(A() As Single,U_ As Integer)Dim TQ_    As Double, TG_  As DoubleDim Q2 As IntegerDim lTimer  As Double   UB = U_   ReDim A(U_)   For Q = 0 To U_      A(Q) = Rnd * U_   Next      Q = 1   Q2 = Q      lTimer = Timer         Do      Q2 = Q      strDen = "Quick"      mTimeQ = Timer      qsort( @A(0), UB+1, 4, @compare )      zTimerCompare A(), TQ_      If Q > Q2 Then      ? "Quick " & Q2      GoTo OHNO      End If            strNum = "Lerp"            mTimeQ = Timer      LerpSort A()      zTimerCompare A(),TG_      If Q > Q2 Then      ? "Lerp " & Q2      GoTo OHNO      End If            If MinLoopTime <= (timer - lTimer) Then Exit Do      Q += 1   Loop      mTimeQ = TQ_   mTimeG = TG_      OHNO:   Q = 0End SubRandomize TimerMinLoopTime = 1.5Dim MyData() As SingleTest MyData(), NumElementsIf mTimeQ <> 0 Then Print strNum & " / " & strDen & " = " & mTimeG / mTimeQSleep`
VANYA
Posts: 1362
Joined: Oct 24, 2010 15:16
Location: Ярославль
Contact:

### Re: Sort Array

MichaelW!

Richard
Posts: 2984
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Sort Array

@ michaelW.
I ran your above hybrid sort code without any changes but with -exx and got the following...

0.527
Aborting due to runtime error 12 ("segmentation violation" signal)
I3I2UI/I0
Posts: 90
Joined: Jun 03, 2005 10:39
Location: Germany

### Re: Sort Array

@MichaelW
'qsort' is not faster (is a fake :))

Code: Select all

`''=============================================================================#Include "crt.bi"''=============================================================================Dim As UInteger MaxSize = 1000000Dim Shared NumArray(MaxSize) As UInteger''=============================================================================Function compare naked Cdecl( ByVal elem1 As Any Ptr, _  ByVal elem2 As Any Ptr ) As Integer  Asm    mov ecx, [esp+4]    mov edx, [esp+8]    mov eax, [ecx]    Sub eax, [edx]    ret  End AsmEnd Function''=============================================================================Sub _Qsort(start As Integer,Finish As UInteger)  Dim As UInteger I=start,J=Finish,X=NumArray(Int((I+J)/2)),A  While  I <= J    While NumArray(I) < X      I+=1    Wend    While NumArray(J) > X      J-=1    Wend    If I<=J Then      A = NumArray(I)      NumArray(I) = NumArray(J)      NumArray(J) = A      I+=1      J-=1    EndIf  Wend  If J > Start Then _Qsort(start,J)  If I < Finish Then _Qsort(I,Finish)End Sub''=============================================================================Dim As Double tRandomize 4711Print "Unsorted Array _Qsort",For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt = Timer_Qsort(1,MaxSize)Print Using "##.###";Timer-tPrint "Sorted Array _Qsort",t = Timer_Qsort(1,MaxSize)Print Using "##.###";Timer-tRandomize 4711Print "Unsorted Array qsort",For I As Integer=1 To MaxSize  NumArray(I) = Int(Rnd*MaxSize)Nextt = Timerqsort( @NumArray(1), MaxSize, 4, @compare )Print Using "##.###";Timer-tPrint "Sorted Array qsort",t = Timerqsort( @NumArray(1), MaxSize, 4, @compare )Print Using "##.###";Timer-tSleep`
Richard
Posts: 2984
Joined: Jan 15, 2007 20:44
Location: Australia

### Re: Sort Array

It appears to be slower but I still get a segmentation error for maxsize over about 12200.
Aborting due to runtime error 12 ("segmentation violation" signal), in the routine COMPARE()
So it may be that it is not actually sorting the array, which might be slowing it down.
I3I2UI/I0
Posts: 90
Joined: Jun 03, 2005 10:39
Location: Germany

### Re: Sort Array

yes @Richard

Function compare naked Cdecl(..) is incompatible with the option -exx
why? I do'nt knows.
fxm
Posts: 9529
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

### Re: Sort Array

Yes, option '-exx' works only with:

Code: Select all

`function compare cdecl ( byval elem1 as integer ptr, _                         byval elem2 as integer ptr) as integer  asm      mov ecx, [elem1]      mov edx, [elem2]      mov eax, [ecx]      sub eax, [edx]      mov [function], eax  end asmend function`