sorting...sort of

[doctornash]

So what we have here is litte app which draws a 'waveform' with points generated from a choice of 3 probability distributions. Then, one can kick off a sort of the points and the 'waveforms' change accordingly over a few seconds. Now, the 'stooge-sort' option appears to work fine. Problem is with the 'slow-sort' - it stops JUST short of a complete sort. Hoping y'all might be able to assist with why. (The recall button enables you to apply the different sorts to the same 'source waveform' - after sorting one way, press recall, then sort the other way).
The slow-sort procedure is based on:
http://c2.com/cgi/wiki?SlowSort
http://programmingpraxis.com/2013/10/25 ... -analysis/

Code: Select all

Enumeration
  #GADGET_Canvas
  #BUTTON_Raw
  #BUTTON_RecallRaw
  #BUTTON_Sort
  #Option_Uniform
  #Option_Skew1
  #Option_Skew2
  #Option_StoogeSort
  #Option_SlowSort
EndEnumeration

#PictureSize = 380

Declare DoTheGraph()

Global Dim XYZ.i(50)
Global Dim GraphArr.i(50)
Global Dim Recall.i(50)
Global g.l = 0


Procedure DistributionUniform()
For i = 0 To 50
  xyz(i) = Random(380,0)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i  
EndProcedure


Procedure DistributionSkew1()
For i = 0 To 50
  r.f=Random(1000,1)/1000
  x.f= 1/Pow(r, (1/2))
  If x> 5
    x = 5
  EndIf  
  xyz(i) = (x-1)*(380/4)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i  
EndProcedure

Procedure DistributionSkew2()
For i = 0 To 50
  r.f=Random(1000,0)/1000
  x.f= Tan(3.141592653589*(r-0.5))
  If x>15
    x = 15
  ElseIf x< -15
    x = -15
  EndIf  
  xyz(i) = 190 - ((190/15)*x)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i    
EndProcedure  


Procedure Stooge_Sort(Array L.i(1), i=0 , j=0)
  If j=0
    j=ArraySize(L())
  EndIf
  If L(i)>L(j)
    Swap L(i), L(j)
  EndIf
  If j-i>1
    Protected t=(j-i+1)/3
    Stooge_Sort(L(), i,   j-t)
    Stooge_Sort(L(), i+t, j )
    Stooge_Sort(L(), i,   j-t)


    For s = 0 To ArraySize(L())
      GraphArr(s) = L(s)
    Next s 
    DoTheGraph()
  EndIf
EndProcedure


Procedure Slow_Sort(Array L.i(1), i=0 , j=0)

  If j=0
    j=ArraySize(L())
  EndIf

  If j-i>1
    m=(i+j)/2
    Slow_Sort(L(), i, m)
    Slow_Sort(L(), m+1, j)
 If L(m)>=L(j)
   Swap L(m), L(j)
    EndIf
    Slow_Sort(L(), i, j-1 )
    
    For s = 0 To ArraySize(L())
      GraphArr(s) = L(s)
      Next s 
      DoTheGraph()
  EndIf
  
EndProcedure


If OpenWindow(0, 0, 0, 640, 400, "lazy sorter", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  
    
  CanvasGadget(#GADGET_Canvas, 10, 10, #PictureSize, #PictureSize, #PB_Canvas_ClipMouse)
  StartDrawing(CanvasOutput(#GADGET_Canvas))
  Box(0, 0, #PictureSize, #PictureSize, $000000)
  LineXY(0, 190, 380, 190, $F10000)
  StopDrawing()
  
  OptionGadget(#Option_StoogeSort, 450, 200, 60, 20, "Stooge")
  OptionGadget(#Option_SlowSort, 450, 220, 60, 20, "Slow")
  SetGadgetState(#Option_StoogeSort, 1)
  
  ButtonGadget(#BUTTON_Raw, 520, 55, 100, 20, "New")
  ButtonGadget(#BUTTON_RecallRaw, 520, 80, 100, 20, "Recall")
  
  ButtonGadget(#BUTTON_Sort, 520, 210, 100, 20, "Sort")

  
  OptionGadget(#Option_Uniform, 450, 50, 60, 20, "Uniform")
  OptionGadget(#Option_Skew1, 450, 70, 60, 20, "Skew1")
  OptionGadget(#Option_Skew2, 450, 90, 60, 20, "Skew2")
  SetGadgetState(#Option_Uniform, 1)
  
  DistributionUniform()
  DoTheGraph()

  Exit = #False
  Repeat
       Event = WaitWindowEvent()
       
       Select Event
       
         Case #PB_Event_Gadget
           Select EventGadget()
             Case #BUTTON_Raw 
                If GetGadgetState(#Option_Uniform) = 1
                  DistributionUniform()
                ElseIf GetGadgetState(#Option_Skew1) = 1  
                  DistributionSkew1()
                ElseIf GetGadgetState(#Option_Skew2) = 1  
                  DistributionSkew2()  
                EndIf  
                DoTheGraph()
              Case #BUTTON_RecallRaw
                  For i = 0 To 50
                    xyz(i) = Recall(i)
                    GraphArr(i) = Recall(i)
                  Next i
                  DoTheGraph()
              Case #BUTTON_Sort
                If GetGadgetState(#Option_StoogeSort) = 1
                  Stooge_Sort(Xyz())
                Else  
                  Slow_Sort(Xyz())
                EndIf  
           EndSelect
       
       EndSelect
     Until Event = #PB_Event_CloseWindow
 
EndIf

Procedure DoTheGraph()
StartDrawing(CanvasOutput(#GADGET_Canvas))
  Box(0, 0, #PictureSize, #PictureSize, $000000)
  LineXY(0, 190, 380, 190, $F10000)
  OLDY = 380-GraphArr(0)
  For t = 0 To ArraySize(GraphArr())
    StartX.f = (380/ArraySize(GraphArr()))*t
    StartY = 380-GraphArr(t)
    LineXY(StartX, StartY,OldX, OldY, $ffffff)
    OldX = StartX
    OldY = StartY
  Next t
  StopDrawing()  
  
EndProcedure  

[infratec]

Hi,

corrected and optimized some things

The result is now the same, but ...
slow is slow

Code: Select all

Enumeration
  #GADGET_Canvas
  #BUTTON_Raw
  #BUTTON_RecallRaw
  #BUTTON_Sort
  #Option_Uniform
  #Option_Skew1
  #Option_Skew2
  #Option_StoogeSort
  #Option_SlowSort
EndEnumeration

#PictureSize = 380

Declare DoTheGraph()

Global Dim XYZ.i(50)
Global Dim GraphArr.i(50)
Global Dim Recall.i(50)
Global g.l = 0


Procedure DistributionUniform()
For i = 0 To 50
  xyz(i) = Random(380,0)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i 
EndProcedure


Procedure DistributionSkew1()
For i = 0 To 50
  r.f=Random(1000,1)/1000
  x.f= 1/Pow(r, (1/2))
  If x> 5
    x = 5
  EndIf 
  xyz(i) = (x-1)*(380/4)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i 
EndProcedure

Procedure DistributionSkew2()
For i = 0 To 50
  r.f=Random(1000,0)/1000
  x.f= Tan(3.141592653589*(r-0.5))
  If x>15
    x = 15
  ElseIf x< -15
    x = -15
  EndIf 
  xyz(i) = 190 - ((190/15)*x)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i   
EndProcedure 


Procedure Stooge_Sort(Array L.i(1), i=0 , j=-1)
  
  If j=-1
    j=ArraySize(L())
  EndIf
  
  If L(i)>L(j)
    Swap L(i), L(j)
  EndIf
  
  If j-i>1
    Protected t=(j-i+1)/3
    Stooge_Sort(L(), i,   j-t)
    Stooge_Sort(L(), i+t, j )
    Stooge_Sort(L(), i,   j-t)
    
    CopyArray(L(), GraphArr())
    DoTheGraph()
  EndIf
EndProcedure


Procedure Slow_Sort(Array L.i(1), i=0 , j=-1)
  
  Protected.i m
  
  
  If j = -1
    j = ArraySize(L())
  EndIf
  
  
  If i >= j
    ProcedureReturn
  EndIf
  
  m = (i + j) / 2
  Slow_Sort(L(), i, m)
  Slow_Sort(L(), m + 1, j)
  If L(m) > L(j)
    Swap L(m), L(j)
  EndIf
  Slow_Sort(L(), i, j - 1)
  
  CopyArray(L(), GraphArr())
  DoTheGraph()
  
EndProcedure


Procedure Stooge_Sort_Thread(*Dummy)
  
  Stooge_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure



Procedure Slow_Sort_Thread(*Dummy)
  
  Slow_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure



If OpenWindow(0, 0, 0, 640, 400, "lazy sorter", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 
   
  CanvasGadget(#GADGET_Canvas, 10, 10, #PictureSize, #PictureSize, #PB_Canvas_ClipMouse)
  StartDrawing(CanvasOutput(#GADGET_Canvas))
  Box(0, 0, #PictureSize, #PictureSize, $000000)
  LineXY(0, 190, 380, 190, $F10000)
  StopDrawing()
 
  OptionGadget(#Option_StoogeSort, 450, 200, 60, 20, "Stooge")
  OptionGadget(#Option_SlowSort, 450, 220, 60, 20, "Slow")
  SetGadgetState(#Option_StoogeSort, 1)
 
  ButtonGadget(#BUTTON_Raw, 520, 55, 100, 20, "New")
  ButtonGadget(#BUTTON_RecallRaw, 520, 80, 100, 20, "Recall")
 
  ButtonGadget(#BUTTON_Sort, 520, 210, 100, 20, "Sort")

 
  OptionGadget(#Option_Uniform, 450, 50, 60, 20, "Uniform")
  OptionGadget(#Option_Skew1, 450, 70, 60, 20, "Skew1")
  OptionGadget(#Option_Skew2, 450, 90, 60, 20, "Skew2")
  SetGadgetState(#Option_Uniform, 1)
 
  DistributionUniform()
  DoTheGraph()

  Exit = #False
  Repeat
       Event = WaitWindowEvent()
       
       Select Event
       
         Case #PB_Event_Gadget
           Select EventGadget()
             Case #BUTTON_Raw
                If GetGadgetState(#Option_Uniform) = 1
                  DistributionUniform()
                ElseIf GetGadgetState(#Option_Skew1) = 1 
                  DistributionSkew1()
                ElseIf GetGadgetState(#Option_Skew2) = 1 
                  DistributionSkew2() 
                EndIf 
                DoTheGraph()
              Case #BUTTON_RecallRaw
                CopyArray(Recall(), Xyz())
                CopyArray(Recall(), GraphArr())
                DoTheGraph()
              Case #BUTTON_Sort
                
                DisableGadget(#BUTTON_Sort, #True)
                DisableGadget(#BUTTON_RecallRaw, #True)
                DisableGadget(#BUTTON_Raw, #True)                
                If GetGadgetState(#Option_StoogeSort) = 1
                  CreateThread(@Stooge_Sort_Thread(), 0)
                Else 
                  CreateThread(@Slow_Sort_Thread(), 0)
                EndIf 
           EndSelect
       
       EndSelect
     Until Event = #PB_Event_CloseWindow
 
EndIf

Procedure DoTheGraph()
  If StartDrawing(CanvasOutput(#GADGET_Canvas))
    Box(0, 0, #PictureSize, #PictureSize, $000000)
    LineXY(0, 190, 380, 190, $F10000)
    OLDY = 380-GraphArr(0)
    For t = 0 To ArraySize(GraphArr())
      StartX.f = (380/ArraySize(GraphArr()))*t
      StartY = 380-GraphArr(t)
      LineXY(StartX, StartY,OldX, OldY, $ffffff)
      OldX = StartX
      OldY = StartY
    Next t
    StopDrawing()
  EndIf
 
EndProcedure  

Main fault: you set j back to full value when 0,
but 0 is a valid value to process.

Bernd

[doctornash]

Thanks Bernd - now does as expected (it certainly felt like an index issue). Thanks also for optimizing copying of the arrays, and demonstrating Thread usage. Yes the slow-sort is around 5x slower to play out on my system than stooge-sort (which in turn is around 15x slower than say insertion sort). But that's good - for the app I'm working on, am looking for a very wide range of sorting profiles and speeds (without the imposition of 'artificial' delay devices either in the sort algorithms themselves, or the procedure calls)

[infratec]

http://www.sortieralgorithmen.de/

It's in german, but when you click on the sortingalgorythms,
and then on the 'Variante' you will see the code.

But better algorythm means also more code to make it work.

Bernd

[doctornash]

included 4 more sort choices - each of these makes the 'waveform' transform differently until the end state is reached (these ones are relatively quick and so that the transformations can be easily seen and compared, have inserted delays into the sort algorithms - just remove to witness the relative 'native' speeds)

Code: Select all

Enumeration
  #GADGET_Canvas
  #BUTTON_Raw
  #BUTTON_RecallRaw
  #BUTTON_Sort
  #Option_Uniform
  #Option_Skew1
  #Option_Skew2
  #Option_StoogeSort
  #Option_SlowSort
  #Option_ShellSort
  #Option_InsertSort
  #Option_CocktailSort
  #Option_BubbleSort
EndEnumeration

#PictureSize = 380

Declare DoTheGraph()

Global Dim XYZ.i(50)
Global Dim GraphArr.i(50)
Global Dim Recall.i(50)
Global g.l = 0


Procedure DistributionUniform()
For i = 0 To 50
  xyz(i) = Random(380,0)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i 
EndProcedure


Procedure DistributionSkew1()
For i = 0 To 50
  r.f=Random(1000,1)/1000
  x.f= 1/Pow(r, (1/2))
  If x> 5
    x = 5
  EndIf 
  xyz(i) = (x-1)*(380/4)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i 
EndProcedure

Procedure DistributionSkew2()
For i = 0 To 50
  r.f=Random(1000,0)/1000
  x.f= Tan(3.141592653589*(r-0.5))
  If x>15
    x = 15
  ElseIf x< -15
    x = -15
  EndIf 
  xyz(i) = 190 - ((190/15)*x)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i   
EndProcedure 

Procedure Insert_Sort(Array a(1))
  Protected low, high
  Protected firstIndex, lastIndex = ArraySize(a())
 
  If lastIndex > firstIndex + 1
    low = firstIndex + 1
    While low <= lastIndex
      high = low
      While high > firstIndex
        If a(high) < a(high - 1)
          Swap a(high), a(high - 1)
        Else
          Break
        EndIf
        high - 1
        Delay(20)
      CopyArray(a(), GraphArr())
      DoTheGraph()
      Wend
      low + 1
    Wend
  EndIf
EndProcedure

Procedure Bubble_Sort(Array a(1))
  Protected i, itemCount, hasChanged
 
  itemCount = ArraySize(a())
  Repeat
    hasChanged = #False
    itemCount - 1
    For i = 0 To itemCount
      If a(i) > a(i + 1)
        Swap a(i), a(i + 1)
        hasChanged = #True
      EndIf 
      Delay(10)
      CopyArray(a(), GraphArr())
      DoTheGraph()
    Next  
  Until hasChanged = #False
EndProcedure

Procedure Cocktail_Sort(Array a(1))
  Protected index, hasChanged, low, high
 
  low = 0
  high = ArraySize(a()) - 1
  Repeat
    hasChanged = #False
    For index = low To high
      If a(index) > a(index + 1)
        Swap a(index), a(index + 1) 
        hasChanged = #True
      EndIf 
      CopyArray(a(), GraphArr())
      DoTheGraph()
      Delay(20)
    Next 
    high - 1
 
    If hasChanged = #False
      Break ;exit the outer loop here if no changes were made
    EndIf 
 
    hasChanged = #False
    For index = high To low Step -1
      If a(index) > a(index + 1)
        Swap a(index), a(index + 1)
        hasChanged = #True
      EndIf
    Next
    low + 1
    CopyArray(a(), GraphArr())
    DoTheGraph()
  Until hasChanged = #False ;if no elements have been changed, then the array is sorted
EndProcedure

Procedure Shell_Sort(Array A(1))
  Protected l=ArraySize(A()), increment=Int(l/2.2)
  Protected i, j, temp
  While increment
    For i= increment To l
      j=i
      temp=A(i)
      While j>=increment And A(j-increment)>temp
        A(j)=A(j-increment)
        j-increment
        CopyArray(a(), GraphArr())
        DoTheGraph()
        Delay(50)
      Wend
      A(j)=temp
    Next i
    If increment=2
      increment=1
    Else
      increment*(5.0/11)
    EndIf
  Wend
EndProcedure


Procedure Stooge_Sort(Array L.i(1), i=0 , j=-1)
  
  If j=-1
    j=ArraySize(L())
  EndIf
  
  If L(i)>L(j)
    Swap L(i), L(j)
  EndIf
  
  If j-i>1
    Protected t=(j-i+1)/3
    Stooge_Sort(L(), i,   j-t)
    Stooge_Sort(L(), i+t, j )
    Stooge_Sort(L(), i,   j-t)
    
    CopyArray(L(), GraphArr())
    DoTheGraph()
  EndIf
  
EndProcedure


Procedure Slow_Sort(Array L.i(1), i=0 , j=-1)
  
  Protected.i m
   
  If j = -1
    j = ArraySize(L())
  EndIf
  
  If i >= j
    ProcedureReturn
  EndIf
  
  m = (i + j) / 2
  Slow_Sort(L(), i, m)
  Slow_Sort(L(), m + 1, j)
  If L(m) > L(j)
    Swap L(m), L(j)
  EndIf
  Slow_Sort(L(), i, j - 1)
  
  CopyArray(L(), GraphArr())
  DoTheGraph()
  
EndProcedure


Procedure Stooge_Sort_Thread(*Dummy)
  
  Stooge_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


Procedure Slow_Sort_Thread(*Dummy)
  
  Slow_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure

Procedure Shell_Sort_Thread(*Dummy)
  
  Shell_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


Procedure Insert_Sort_Thread(*Dummy)
  
  Insert_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure

Procedure Cocktail_Sort_Thread(*Dummy)
  
  Cocktail_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


Procedure Bubble_Sort_Thread(*Dummy)
  
  Bubble_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure



If OpenWindow(0, 0, 0, 640, 400, "wave-o-sort", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 
   
  CanvasGadget(#GADGET_Canvas, 10, 10, #PictureSize, #PictureSize, #PB_Canvas_ClipMouse)
  StartDrawing(CanvasOutput(#GADGET_Canvas))
  Box(0, 0, #PictureSize, #PictureSize, $000000)
  LineXY(0, 190, 380, 190, $F10000)
  StopDrawing()
  
  OptionGadget(#Option_ShellSort, 450, 160, 60, 20, "Shell")
  OptionGadget(#Option_InsertSort, 450, 180, 60, 20, "Insert")
  OptionGadget(#Option_CocktailSort, 450, 200, 60, 20, "Cocktail")
  OptionGadget(#Option_BubbleSort, 450, 220, 60, 20, "Bubble")
  OptionGadget(#Option_StoogeSort, 450, 240, 60, 20, "Stooge")
  OptionGadget(#Option_SlowSort, 450, 260, 60, 20, "Slow")
  SetGadgetState(#Option_StoogeSort, 1)
 
  ButtonGadget(#BUTTON_Raw, 520, 55, 100, 20, "New")
  ButtonGadget(#BUTTON_RecallRaw, 520, 80, 100, 20, "Recall")
 
  ButtonGadget(#BUTTON_Sort, 520, 210, 100, 20, "Sort")

 
  OptionGadget(#Option_Uniform, 450, 50, 60, 20, "Uniform")
  OptionGadget(#Option_Skew1, 450, 70, 60, 20, "Skew1")
  OptionGadget(#Option_Skew2, 450, 90, 60, 20, "Skew2")
  SetGadgetState(#Option_Uniform, 1)
 
  DistributionUniform()
  DoTheGraph()

  Exit = #False
  Repeat
       Event = WaitWindowEvent()
       
       Select Event
       
         Case #PB_Event_Gadget
           Select EventGadget()
             Case #BUTTON_Raw
                If GetGadgetState(#Option_Uniform) = 1
                  DistributionUniform()
                ElseIf GetGadgetState(#Option_Skew1) = 1 
                  DistributionSkew1()
                ElseIf GetGadgetState(#Option_Skew2) = 1 
                  DistributionSkew2() 
                EndIf 
                DoTheGraph()
              Case #BUTTON_RecallRaw
                CopyArray(Recall(), Xyz())
                CopyArray(Recall(), GraphArr())
                DoTheGraph()
              Case #BUTTON_Sort
                
                DisableGadget(#BUTTON_Sort, #True)
                DisableGadget(#BUTTON_RecallRaw, #True)
                DisableGadget(#BUTTON_Raw, #True)                
                If GetGadgetState(#Option_StoogeSort) = 1
                  CreateThread(@Stooge_Sort_Thread(), 0)
                ElseIf GetGadgetState(#Option_SlowSort) = 1 
                  CreateThread(@Slow_Sort_Thread(), 0)
                ElseIf GetGadgetState(#Option_InsertSort) = 1 
                  CreateThread(@Insert_Sort_Thread(), 0) 
                ElseIf GetGadgetState(#Option_ShellSort) = 1 
                  CreateThread(@Shell_Sort_Thread(), 0)  
                ElseIf GetGadgetState(#Option_CocktailSort) = 1 
                  CreateThread(@Cocktail_Sort_Thread(), 0) 
                ElseIf GetGadgetState(#Option_BubbleSort) = 1 
                  CreateThread(@Bubble_Sort_Thread(), 0)  
                EndIf 
           EndSelect
       
       EndSelect
     Until Event = #PB_Event_CloseWindow
 
EndIf

Procedure DoTheGraph()
  If StartDrawing(CanvasOutput(#GADGET_Canvas))
    Box(0, 0, #PictureSize, #PictureSize, $000000)
    LineXY(0, 190, 380, 190, $F10000)
    OLDY = 380-GraphArr(0)
    For t = 0 To ArraySize(GraphArr())
      StartX.f = (380/ArraySize(GraphArr()))*t
      StartY = 380-GraphArr(t)
      LineXY(StartX, StartY,OldX, OldY, $ffffff)
      OldX = StartX
      OldY = StartY
    Next t
    StopDrawing()
  EndIf
 
EndProcedure  

[BasicallyPure]

for the app I'm working on, am looking for a very wide range of sorting profiles and speeds (without the imposition of 'artificial' delay devices either in the sort algorithms themselves, or the procedure calls)

Hi Doctornash,
can you use this?

edit: fixed a bug.

Code: Select all

Procedure StackSort(Array a.i(1))
   ; sort an array of one dimension
   ; this sorting algorithm was developed by BasicallyPure
   Protected i, j, n, max
   Protected size = ArraySize(a())
   
   Structure stk
      List stack.i()
   EndStructure
   
   Dim Stacks.stk(size)
   For i = 0 To size
      AddElement(Stacks(i)\stack())
   Next i
   
   Macro PushStack(stackNumber, item)
      AddElement(Stacks(stackNumber)\stack())
      Stacks(stackNumber)\stack() = item
   EndMacro

   Macro PopStack(stackNumber)
      Stacks(stackNumber)\stack()
      DeleteElement(Stacks(stackNumber)\stack())
   EndMacro
   
   Repeat ; this is the sorting loop
      max = 0 ; this variable remembers the maximum stack number used
      
      ; disperse items into sorting stacks
      For n = 0 To size
         i = 0 ; this variable indicates the active stack
         While a(n) < Stacks(i)\stack() : i + 1 : Wend
         If i > max : max = i : EndIf
         PushStack(i, a(n))
      Next n
      
      ; reassemble the array using two active stacks
      i = 0 : j = 1 
      For n = size To 0 Step -1
         If Stacks(i)\stack() >= Stacks(j)\stack()
            a(n) = PopStack(i)
            If ListIndex(Stacks(i)\stack()) = 0
               i = j
               If max > j : j + 1 : EndIf
            EndIf
         Else
            a(n) = PopStack(j)
            If ListIndex(Stacks(j)\stack()) = 0
               If max > j : j + 1 : EndIf
            EndIf
         EndIf 
      Next n
   Until max < 2
EndProcedure

Dim numRandom.i(50)

Debug "*********** unsorted *********"
For i = 0 To 50
   numRandom(i) = Random(1000)
   Debug numRandom(i)
Next i

StackSort(numRandom())

Debug "" : Debug "******* sorted ********"

For i = 0 To 50
   Debug numRandom(i)
Next i

[doctornash]

Stack Sort: Certainly exhibits its own unique sort profile, so have included it as another sort option.
And what can be said other than - Basically brilliant Pure poetry - watching it in action
Thanks for the suggestion

Code: Select all

Enumeration
  #GADGET_Canvas
  #BUTTON_Raw
  #BUTTON_RecallRaw
  #BUTTON_Sort
  #Option_Uniform
  #Option_Skew1
  #Option_Skew2
  #Option_StoogeSort
  #Option_SlowSort
  #Option_ShellSort
  #Option_InsertSort
  #Option_CocktailSort
  #Option_BubbleSort
  #Option_StackSort
EndEnumeration

#PictureSize = 380

Declare DoTheGraph()

Global Dim XYZ.i(50)
Global Dim GraphArr.i(50)
Global Dim Recall.i(50)
Global g.l = 0


Procedure DistributionUniform()
For i = 0 To 50
  xyz(i) = Random(380,0)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i 
EndProcedure


Procedure DistributionSkew1()
For i = 0 To 50
  r.f=Random(1000,1)/1000
  x.f= 1/Pow(r, (1/2))
  If x> 5
    x = 5
  EndIf 
  xyz(i) = (x-1)*(380/4)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i 
EndProcedure

Procedure DistributionSkew2()
For i = 0 To 50
  r.f=Random(1000,0)/1000
  x.f= Tan(3.141592653589*(r-0.5))
  If x>15
    x = 15
  ElseIf x< -15
    x = -15
  EndIf 
  xyz(i) = 190 - ((190/15)*x)
  GraphArr(i) = xyz(i)
  Recall(i) = xyz(i)
Next i   
EndProcedure 

Procedure Insert_Sort(Array a(1))
  Protected low, high
  Protected firstIndex, lastIndex = ArraySize(a())
 
  If lastIndex > firstIndex + 1
    low = firstIndex + 1
    While low <= lastIndex
      high = low
      While high > firstIndex
        If a(high) < a(high - 1)
          Swap a(high), a(high - 1)
        Else
          Break
        EndIf
        high - 1
        Delay(20)
      CopyArray(a(), GraphArr())
      DoTheGraph()
      Wend
      low + 1
    Wend
  EndIf
EndProcedure

Procedure Bubble_Sort(Array a(1))
  Protected i, itemCount, hasChanged
 
  itemCount = ArraySize(a())
  Repeat
    hasChanged = #False
    itemCount - 1
    For i = 0 To itemCount
      If a(i) > a(i + 1)
        Swap a(i), a(i + 1)
        hasChanged = #True
      EndIf 
      Delay(10)
      CopyArray(a(), GraphArr())
      DoTheGraph()
    Next  
  Until hasChanged = #False
EndProcedure

Procedure Cocktail_Sort(Array a(1))
  Protected index, hasChanged, low, high
 
  low = 0
  high = ArraySize(a()) - 1
  Repeat
    hasChanged = #False
    For index = low To high
      If a(index) > a(index + 1)
        Swap a(index), a(index + 1) 
        hasChanged = #True
      EndIf 
      CopyArray(a(), GraphArr())
      DoTheGraph()
      Delay(20)
    Next 
    high - 1
 
    If hasChanged = #False
      Break ;exit the outer loop here if no changes were made
    EndIf 
 
    hasChanged = #False
    For index = high To low Step -1
      If a(index) > a(index + 1)
        Swap a(index), a(index + 1)
        hasChanged = #True
      EndIf
    Next
    low + 1
    CopyArray(a(), GraphArr())
    DoTheGraph()
  Until hasChanged = #False ;if no elements have been changed, then the array is sorted
EndProcedure

Procedure Shell_Sort(Array A(1))
  Protected l=ArraySize(A()), increment=Int(l/2.2)
  Protected i, j, temp
  While increment
    For i= increment To l
      j=i
      temp=A(i)
      While j>=increment And A(j-increment)>temp
        A(j)=A(j-increment)
        j-increment
        CopyArray(a(), GraphArr())
        DoTheGraph()
        Delay(50)
      Wend
      A(j)=temp
    Next i
    If increment=2
      increment=1
    Else
      increment*(5.0/11)
    EndIf
  Wend
EndProcedure


Procedure Stooge_Sort(Array L.i(1), i=0 , j=-1)
  
  If j=-1
    j=ArraySize(L())
  EndIf
  
  If L(i)>L(j)
    Swap L(i), L(j)
  EndIf
  
  If j-i>1
    Protected t=(j-i+1)/3
    Stooge_Sort(L(), i,   j-t)
    Stooge_Sort(L(), i+t, j )
    Stooge_Sort(L(), i,   j-t)
    
    CopyArray(L(), GraphArr())
    DoTheGraph()
  EndIf
  
EndProcedure


Procedure Slow_Sort(Array L.i(1), i=0 , j=-1)
  
  Protected.i m
   
  If j = -1
    j = ArraySize(L())
  EndIf
  
  If i >= j
    ProcedureReturn
  EndIf
  
  m = (i + j) / 2
  Slow_Sort(L(), i, m)
  Slow_Sort(L(), m + 1, j)
  If L(m) > L(j)
    Swap L(m), L(j)
  EndIf
  Slow_Sort(L(), i, j - 1)
  
  CopyArray(L(), GraphArr())
  DoTheGraph()
  
EndProcedure

Procedure Stack_Sort(Array a.i(1))
   ; this sorting algorithm was developed by BasicallyPure
   Protected i, j, n, max
   Protected size = ArraySize(a())
   
   Structure stk
      List stack.i()
   EndStructure
   
   Dim Stacks.stk(size)
   For i = 0 To size
      AddElement(Stacks(i)\stack())
   Next i
   
   Macro PushStack(stackNumber, item)
      AddElement(Stacks(stackNumber)\stack())
      Stacks(stackNumber)\stack() = item
   EndMacro

   Macro PopStack(stackNumber)
      Stacks(stackNumber)\stack()
      DeleteElement(Stacks(stackNumber)\stack())
   EndMacro
   
   Repeat ; this is the sorting loop
      max = 0 ; this variable remembers the maximum stack number used
      
      ; disperse items into sorting stacks
      For n = 0 To size
         i = 0 ; this variable indicates the active stack
         While a(n) < Stacks(i)\stack() : i + 1 : Wend
         If i > max : max = i : EndIf
         PushStack(i, a(n))
      Next n
      
      ; reassemble the array using two active stacks
      i = 0 : j = 1 
      For n = size To 0 Step -1
         If Stacks(i)\stack() >= Stacks(j)\stack()
           a(n) = PopStack(i)
            If ListIndex(Stacks(i)\stack()) = 0
               i = j
               If max > j : j + 1 : EndIf
             EndIf
         Else
           a(n) = PopStack(j)
            If ListIndex(Stacks(j)\stack()) = 0
               If max > j : j + 1 : EndIf
            EndIf
         EndIf 
          CopyArray(a(), GraphArr())
          DoTheGraph()
          Delay(40)
      Next n
   Until max < 2
EndProcedure


Procedure Stooge_Sort_Thread(*Dummy)
  
  Stooge_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


Procedure Slow_Sort_Thread(*Dummy)
  
  Slow_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure

Procedure Shell_Sort_Thread(*Dummy)
  
  Shell_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


Procedure Insert_Sort_Thread(*Dummy)
  
  Insert_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure

Procedure Cocktail_Sort_Thread(*Dummy)
  
  Cocktail_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


Procedure Bubble_Sort_Thread(*Dummy)
  
  Bubble_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure

Procedure Stack_Sort_Thread(*Dummy)
  
  Stack_Sort(Xyz())
  
  DisableGadget(#BUTTON_Sort, #False)
  DisableGadget(#BUTTON_RecallRaw, #False)
  DisableGadget(#BUTTON_Raw, #False)
                
EndProcedure


If OpenWindow(0, 0, 0, 640, 400, "wave-o-sort", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
 
   
  CanvasGadget(#GADGET_Canvas, 10, 10, #PictureSize, #PictureSize, #PB_Canvas_ClipMouse)
  StartDrawing(CanvasOutput(#GADGET_Canvas))
  Box(0, 0, #PictureSize, #PictureSize, $000000)
  LineXY(0, 190, 380, 190, $F10000)
  StopDrawing()
  
  OptionGadget(#Option_ShellSort, 450, 160, 60, 20, "Shell")
  OptionGadget(#Option_InsertSort, 450, 180, 60, 20, "Insert")
  OptionGadget(#Option_CocktailSort, 450, 200, 60, 20, "Cocktail")
  OptionGadget(#Option_BubbleSort, 450, 220, 60, 20, "Bubble")
  OptionGadget(#Option_StoogeSort, 450, 240, 60, 20, "Stooge")
  OptionGadget(#Option_SlowSort, 450, 280, 60, 20, "Slow")
  OptionGadget(#Option_StackSort, 450, 260, 60, 20, "Stack")
  SetGadgetState(#Option_ShellSort, 1)
 
  ButtonGadget(#BUTTON_Raw, 520, 55, 100, 20, "New")
  ButtonGadget(#BUTTON_RecallRaw, 520, 80, 100, 20, "Recall")
 
  ButtonGadget(#BUTTON_Sort, 520, 210, 100, 20, "Sort")

 
  OptionGadget(#Option_Uniform, 450, 50, 60, 20, "Uniform")
  OptionGadget(#Option_Skew1, 450, 70, 60, 20, "Skew1")
  OptionGadget(#Option_Skew2, 450, 90, 60, 20, "Skew2")
  SetGadgetState(#Option_Uniform, 1)
 
  DistributionUniform()
  DoTheGraph()

  Exit = #False
  Repeat
       Event = WaitWindowEvent()
       
       Select Event
       
         Case #PB_Event_Gadget
           Select EventGadget()
             Case #BUTTON_Raw
                If GetGadgetState(#Option_Uniform) = 1
                  DistributionUniform()
                ElseIf GetGadgetState(#Option_Skew1) = 1 
                  DistributionSkew1()
                ElseIf GetGadgetState(#Option_Skew2) = 1 
                  DistributionSkew2() 
                EndIf 
                DoTheGraph()
              Case #BUTTON_RecallRaw
                CopyArray(Recall(), Xyz())
                CopyArray(Recall(), GraphArr())
                DoTheGraph()
              Case #BUTTON_Sort
                
                DisableGadget(#BUTTON_Sort, #True)
                DisableGadget(#BUTTON_RecallRaw, #True)
                DisableGadget(#BUTTON_Raw, #True)                
                If GetGadgetState(#Option_StoogeSort) = 1
                  CreateThread(@Stooge_Sort_Thread(), 0)
                ElseIf GetGadgetState(#Option_SlowSort) = 1 
                  CreateThread(@Slow_Sort_Thread(), 0)
                ElseIf GetGadgetState(#Option_InsertSort) = 1 
                  CreateThread(@Insert_Sort_Thread(), 0) 
                ElseIf GetGadgetState(#Option_ShellSort) = 1 
                  CreateThread(@Shell_Sort_Thread(), 0)  
                ElseIf GetGadgetState(#Option_CocktailSort) = 1 
                  CreateThread(@Cocktail_Sort_Thread(), 0) 
                ElseIf GetGadgetState(#Option_BubbleSort) = 1 
                  CreateThread(@Bubble_Sort_Thread(), 0) 
                ElseIf GetGadgetState(#Option_StackSort) = 1 
                  CreateThread(@Stack_Sort_Thread(), 0)    
                EndIf 
           EndSelect
       
       EndSelect
     Until Event = #PB_Event_CloseWindow
 
EndIf

Procedure DoTheGraph()
  If StartDrawing(CanvasOutput(#GADGET_Canvas))
    Box(0, 0, #PictureSize, #PictureSize, $000000)
    LineXY(0, 190, 380, 190, $F10000)
    OLDY = 380-GraphArr(0)
    For t = 0 To ArraySize(GraphArr())
      StartX.f = (380/ArraySize(GraphArr()))*t
      StartY = 380-GraphArr(t)
      LineXY(StartX, StartY,OldX, OldY, $ffffff)
      OldX = StartX
      OldY = StartY
    Next t
    StopDrawing()
  EndIf
 
EndProcedure