PureBasic Forums - English

Posted: **Sat Nov 18, 2006 8:16 pm**

Hello everyone

Yes another Sort Array topic. This time it's for nested Static array inside structure.
You are free to re-use this template in your project if needed.

By the way, the ShellSort, the CombSort and the Quick are the most efficient.

Regards
Guimauve

Code: Select all

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Project name : Sorting Algorythm Collection
; File : Sorting Algorythm Collection.pb
; File Version : 1.0.0
; Programmation : OK
; Programmed by : Guimauve
; Date : 18-11-2006
; Last Update : 18-11-2006
; Coded for PureBasic V4.01
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; Notes :
;
; Because it's impossible to re-use the standard sorting 
; command with nested Static Array, I have created this 
; template. You are free To re-use any of these procedures 
; in your project if needed. 

; The Gnome, the Bubble, the Stone, the BubbleStone and 
; the Selection algorythm are not very efficient with big 
; Array. (n > 30 elements)
;
; The Shell, the Comb and the Quick are the most efficient
; algorythm To sort Array in place.
; (No need of additionnal array to do the job)
;
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Size Array Constant <<<<<

#SCORE_POINTS_MAX = 150

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Structure definition <<<<<

Structure Score
   
   Points.l[#SCORE_POINTS_MAX]
   
EndStructure

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The mutator <<<<<

Macro SetScorePoints(ObjetA, Index, P_Points)
   
   ObjetA\Points[Index] = P_Points
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The observator <<<<<

Macro GetScorePoints(ObjetA, Index)
   
   ObjetA\Points[Index]
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< GnomeSort Ascendant <<<<<

Procedure GnomeSortAscendantScorePoints(*ScoreA.Score)
   
   While Index < #SCORE_POINTS_MAX
      
      If Index = 0 Or GetScorePoints(*ScoreA, Index - 1) <= GetScorePoints(*ScoreA, Index)
         
         Index + 1   
         
      Else 
         
         Swap GetScorePoints(*ScoreA, Index - 1), GetScorePoints(*ScoreA, Index)
         Index - 1
         
      EndIf
      
   Wend
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< GnomeSort Descendant <<<<<

Procedure GnomeSortDescendantScorePoints(*ScoreA.Score)
   
   While Index < #SCORE_POINTS_MAX
      
      If Index = 0 Or GetScorePoints(*ScoreA, Index - 1) >= GetScorePoints(*ScoreA, Index)

         Index + 1   
         
      Else 
         
         Swap GetScorePoints(*ScoreA, Index - 1), GetScorePoints(*ScoreA, Index)
         Index - 1
         
      EndIf
      
   Wend
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< BubbleSort Ascendant operator <<<<<

Procedure BubbleSortAscendantScorePoints(*ScoreA.Score)
   
   BubbleSortSwapped.b = #True
   
   While BubbleSortSwapped = #True
      
      BubbleSortSwapped = #False
      
      For BubbleIndex = #SCORE_POINTS_MAX - 1 To 1 Step - 1
         
         If GetScorePoints(*ScoreA, BubbleIndex) < GetScorePoints(*ScoreA, BubbleIndex - 1)
            Swap GetScorePoints(*ScoreA, BubbleIndex), GetScorePoints(*ScoreA, BubbleIndex - 1)
            BubbleSortSwapped = #True
         EndIf
         
      Next
      
   Wend
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< StoneSort Ascendant operator <<<<<

Procedure StoneSortAscendantScorePoints(*ScoreA.Score)
   
   StoneSortSwapped.b = #True
   
   While StoneSortSwapped = #True
      
      StoneSortSwapped = #False
      
      For StoneIndex = 0 To #SCORE_POINTS_MAX - 2
         
         If GetScorePoints(*ScoreA, StoneIndex) > GetScorePoints(*ScoreA, StoneIndex + 1)
            Swap GetScorePoints(*ScoreA, StoneIndex), GetScorePoints(*ScoreA, StoneIndex + 1)
            StoneSortSwapped = #True
         EndIf
         
      Next
      
   Wend
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< BubbleStoneSort Ascendant operator <<<<<

Procedure BubbleStoneSortAscendantScorePoints(*ScoreA.Score)
   
   BubbleStoneSortSwapped.b = #True
   
   While BubbleStoneSortSwapped = #True
      
      BubbleStoneSortSwapped = #False
      BubbleIndex = #SCORE_POINTS_MAX - 1
      StoneIndex = 0
      
      For Index = 0 To #SCORE_POINTS_MAX - 2
         
         If GetScorePoints(*ScoreA, StoneIndex) > GetScorePoints(*ScoreA, StoneIndex + 1)
            Swap GetScorePoints(*ScoreA, StoneIndex), GetScorePoints(*ScoreA, StoneIndex + 1)
            BubbleStoneSortSwapped = #True
         EndIf
         
         If GetScorePoints(*ScoreA, BubbleIndex) < GetScorePoints(*ScoreA, BubbleIndex - 1)
            Swap GetScorePoints(*ScoreA, BubbleIndex), GetScorePoints(*ScoreA, BubbleIndex - 1)
            BubbleStoneSortSwapped = #True
         EndIf
         
         BubbleIndex - 1
         StoneIndex + 1
         
      Next
      
   Wend
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< BubbleStoneSort Descendant operator <<<<<

Procedure BubbleStoneSortDescendantGetScorePoints(*ScoreA.Score)
   
   BubbleStoneSortSwapped.b = #True
   
   While BubbleStoneSortSwapped = #True
      
      BubbleStoneSortSwapped = #False
      BubbleIndex = #SCORE_POINTS_MAX - 1
      StoneIndex = 0
      
      For Index = 0 To #SCORE_POINTS_MAX - 2
         
         If GetScorePoints(*ScoreA, StoneIndex) < GetScorePoints(*ScoreA, StoneIndex + 1)
            Swap GetScorePoints(*ScoreA, StoneIndex), GetScorePoints(*ScoreA, StoneIndex + 1)
            BubbleStoneSortSwapped = #True
         EndIf
         
         If GetScorePoints(*ScoreA, BubbleIndex) > GetScorePoints(*ScoreA, BubbleIndex - 1)
            Swap GetScorePoints(*ScoreA, BubbleIndex), GetScorePoints(*ScoreA, BubbleIndex - 1)
            BubbleStoneSortSwapped = #True
         EndIf
         
         BubbleIndex - 1
         StoneIndex + 1
         
      Next
      
   Wend
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< SelectionSort Ascendant operator <<<<<

Procedure SelectionSortAscendantScorePoints(*ScoreA.Score)
   
   For IndexA = 0 To #SCORE_POINTS_MAX - 2
      
      IndexC = IndexA
      
      For IndexB = IndexA + 1 To #SCORE_POINTS_MAX - 1
         If GetScorePoints(*ScoreA, IndexB) < GetScorePoints(*ScoreA, IndexC)
            IndexC = IndexB
         EndIf
      Next
      
      If IndexC > IndexA
         Swap GetScorePoints(*ScoreA, IndexA), GetScorePoints(*ScoreA, IndexC)
      EndIf
      
   Next 
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< SelectionSort Descendant operator <<<<<

Procedure SelectionSortDescendantScorePoints(*ScoreA.Score)
   
   For IndexA = 0 To #SCORE_POINTS_MAX - 2
      
      IndexC = IndexA
      
      For IndexB = IndexA + 1 To #SCORE_POINTS_MAX - 1
         If GetScorePoints(*ScoreA, IndexB) > GetScorePoints(*ScoreA, IndexC)
            IndexC = IndexB
         EndIf
      Next
      
      If IndexC > IndexA
         Swap GetScorePoints(*ScoreA, IndexA), GetScorePoints(*ScoreA, IndexC)
      EndIf
      
   Next 
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ShellSort Ascendant operator <<<<<

Procedure ShellSortAscendantScorePoints(*ScoreA.Score)
   
   ShellSortGap.l = #SCORE_POINTS_MAX - 1
   
   Repeat
      
      ShellSortGap >> 1
      
      Repeat
         
         ShellSortSwapped.b = #False
         
         For Index = 0 To (#SCORE_POINTS_MAX - 1 - ShellSortGap)
            
            If GetScorePoints(*ScoreA, Index) > GetScorePoints(*ScoreA, Index + ShellSortGap)
               Swap GetScorePoints(*ScoreA, Index), GetScorePoints(*ScoreA, Index + ShellSortGap)
               ShellSortSwapped = #True
            EndIf
            
         Next
         
      Until ShellSortSwapped = #False
      
   Until ShellSortGap = 1
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< ShellSort Descendant operator <<<<<

Procedure ShellSortDescendantScorePoints(*ScoreA.Score)
   
   ShellSortGap.l = #SCORE_POINTS_MAX - 1
   
   Repeat
      
      ShellSortGap >> 1
      
      Repeat
         
         ShellSortSwapped.b = #False
         
         For Index = 0 To (#SCORE_POINTS_MAX - 1 - ShellSortGap)
            
            If GetScorePoints(*ScoreA, Index) < GetScorePoints(*ScoreA, Index + ShellSortGap)
               Swap GetScorePoints(*ScoreA, Index), GetScorePoints(*ScoreA, Index + ShellSortGap)
               ShellSortSwapped = #True
            EndIf
            
         Next
         
      Until ShellSortSwapped = #False
      
   Until ShellSortGap = 1
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< CombSort Ascendant operator <<<<<

Procedure CombSortAscendantScorePoints(*ScoreA.Score)
   
   CombSortGap.l = #SCORE_POINTS_MAX - 1
   
   Repeat
      
      CombSortGap = Int(CombSortGap/1.3)
      
      If CombSortGap < 1
         CombSortGap = 1
      EndIf
      
      Repeat
         
         CombSortSwapped.b = #False
         
         For Index = 0 To (#SCORE_POINTS_MAX - 1 - CombSortGap)
            
            If GetScorePoints(*ScoreA, Index) > GetScorePoints(*ScoreA, Index + CombSortGap)
               Swap GetScorePoints(*ScoreA, Index), GetScorePoints(*ScoreA, Index + CombSortGap)
               CombSortSwapped = #True
            EndIf
            
         Next
         
      Until CombSortSwapped = #False
      
   Until CombSortGap = 1
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< CombSort Descendant operator <<<<<

Procedure CombSortDescendantScorePoints(*ScoreA.Score)
   
   CombSortGap.l = #SCORE_POINTS_MAX - 1
   
   Repeat
      
      CombSortGap = Int(CombSortGap/1.3)
      
      If CombSortGap < 1
         CombSortGap = 1
      EndIf
      
      Repeat
         
         CombSortSwapped.b = #False
         
         For Index = 0 To (#SCORE_POINTS_MAX - 1 - CombSortGap)
            
            If GetScorePoints(*ScoreA, Index) < GetScorePoints(*ScoreA, Index + CombSortGap)
               Swap GetScorePoints(*ScoreA, Index), GetScorePoints(*ScoreA, Index + CombSortGap)
               CombSortSwapped = #True
            EndIf
            
         Next
         
      Until CombSortSwapped = #False
      
   Until CombSortGap = 1
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< QuickSort Ascendant operator <<<<<

Procedure QuickSortAscendantScorePoints(*ScoreA.Score, FirstIndex = 0, LastIndex = #SCORE_POINTS_MAX - 1)
   
   MinIndex = FirstIndex
   MaxIndex = LastIndex
   SplitValue.l = GetScorePoints(*ScoreA, (FirstIndex + LastIndex) >> 1)
   
   Repeat
      
      While GetScorePoints(*ScoreA, MinIndex) < SplitValue
         MinIndex + 1
      Wend
      
      While GetScorePoints(*ScoreA, MaxIndex) > SplitValue
         MaxIndex - 1
      Wend
      
      If MinIndex <= MaxIndex
         
         Swap GetScorePoints(*ScoreA, MinIndex), GetScorePoints(*ScoreA, MaxIndex)
         MinIndex + 1
         MaxIndex - 1
         
      EndIf
      
   Until MinIndex > MaxIndex
   
   If FirstIndex < MaxIndex
      QuickSortAscendantScorePoints(*ScoreA, FirstIndex, MaxIndex)
   EndIf
   
   If MinIndex < LastIndex
      QuickSortAscendantScorePoints(*ScoreA, MinIndex, LastIndex)
   EndIf
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< QuickSort Descendant operator <<<<<

Procedure QuickSortDescendantScorePoints(*ScoreA.Score, FirstIndex = 0, LastIndex = #SCORE_POINTS_MAX - 1)
   
   MinIndex = FirstIndex
   MaxIndex = LastIndex
   SplitValue.l = GetScorePoints(*ScoreA, (FirstIndex + LastIndex) >> 1)
   
   Repeat
      
      While GetScorePoints(*ScoreA, MinIndex) > SplitValue
         MinIndex + 1
      Wend
      
      While GetScorePoints(*ScoreA, MaxIndex) < SplitValue
         MaxIndex - 1
      Wend
      
      If MinIndex <= MaxIndex
         
         Swap GetScorePoints(*ScoreA, MinIndex), GetScorePoints(*ScoreA, MaxIndex)
         MinIndex + 1
         MaxIndex - 1
         
      EndIf
      
   Until MinIndex > MaxIndex
   
   If FirstIndex < MaxIndex
      QuickSortDescendantScorePoints(*ScoreA, FirstIndex, MaxIndex)
   EndIf
   
   If MinIndex < LastIndex
      QuickSortDescendantScorePoints(*ScoreA, MinIndex, LastIndex)
   EndIf
   
EndProcedure

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< Copy operator : A = Source : B = Destination <<<<<

Macro CopyScore(ObjetA, ObjetB)
   
   CopyMemory(ObjetA, ObjetB, SizeOf(Score))
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< The Debug Macro <<<<<

Macro DebugScore(Original, Gnome, Bubble, Stone, BubStone, Selection, Shell, Comb, Quick)
   
   Debug "Original : Gnome : Bubble : Stone : BubbleStone : Select :   Shell  :  Comb  : Quick"
   
   For Index = 0 To #SCORE_POINTS_MAX - 1
      
      Line.s = RSet(Str(GetScorePoints(Original, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Gnome, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Bubble, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Stone, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(BubStone, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Selection, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Shell, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Comb, Index)),6,"0") + " : "
      Line + RSet(Str(GetScorePoints(Quick, Index)),6,"0")
      
      Debug Line
   Next
   
EndMacro

; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
; <<<<< !!! WARNING - YOU ARE NOW IN A TESTING ZONE - WARNING !!! <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

For Index = 0 To #SCORE_POINTS_MAX - 1
  SetScorePoints(Original.Score, Index, Random(152550))
Next

CopyScore(Original, Gnome.Score)
CopyScore(Original, Bubble.Score)
CopyScore(Original, Stone.Score)
CopyScore(Original, BubbleStone.Score)
CopyScore(Original, Selection.Score)
CopyScore(Original, Shell.Score)
CopyScore(Original, Comb.Score)
CopyScore(Original, Quick.Score)

GnomeSortAscendantScorePoints(Gnome)
BubbleSortAscendantScorePoints(Bubble)
StoneSortAscendantScorePoints(Stone)
BubbleStoneSortAscendantScorePoints(BubbleStone)
SelectionSortAscendantScorePoints(Selection)
ShellSortAscendantScorePoints(Shell)
CombSortAscendantScorePoints(Comb)
QuickSortAscendantScorePoints(Quick)

DebugScore(Original, Gnome, Bubble, Stone, BubbleStone, Selection, Shell, Comb, Quick)

; <<<<<<<<<<<<<<<<<<<<<<<
; <<<<< END OF FILE <<<<<
; <<<<<<<<<<<<<<<<<<<<<<<

Posted: **Sun Nov 19, 2006 5:03 pm**

What are the licenses on each sorting method?
I know we can probably look this up ourself (on wikipedia or similar) but...
Are they public domain, BSD, zLib, MIT, LGPL or GPL licensed?

Posted: **Sun Nov 19, 2006 8:26 pm**

The BubbleSort and the StoneSort come from my old Introduction to C language pack of loose leaf from college (purchased 10 year ago) and no information about the main author, no copyright, no copyleft, nothing.

The BubbleStoneSort it's a personnal optimisation from my self from the previous Bubble and Stone Sort. I control both algorythm at the same time with 2 loops only. With this optimisation BubbleStone sort is 2 times faster than the standard BubbleSort. For small array it's very efficient

All similar algorythm use 3 loops to do the job. BTW this sort technics is also called Bi-DirectionnalBubble Sort, Cocktail Sort, ShakerSort, ...

For the CombSort, the SelectionSort and the QuickSort they come directly from the PureBasic Codes Archives. But can be seen in many source.

The Shell Sort has created by Donald Shell many year ago. If you check carefully the difference between the CombSort and the ShellSort, it's pratically the same, the only difference is in the SortGap calculation.

The Gnome sort is just for fun. O(ln n³) or O(ln n²) performance

Seriously, do you use a sorting algorythm with O(ln n³) or O(ln n²) performance when O(n ln n) performance are available for a serious project ? I think no.

The liscence for the BubbleStoneSort() : Completelly free, you can re-use it as many time as you want. As long as you assume all risk when you re-use it.

The liscence for the GnomeSort, the ShellSort, the CombSort, the SelectionSort and the QuickSort, the original code are available from so many sources. I don't thing it's a problem to re-use them.

Regards
Guimauve

Posted: **Mon Nov 20, 2006 12:13 am**

Thanks, Guimauve.