Better Bubble Sorting
Firstly sorting is a situational process, so picking the right algorithm for your data is very important. However, this example (DB classic code) shows a few
very simple ideas on how improve the performance of the Classic BUBBLE SORT algorithm. While It's never going to be express, one of these ideas might suit your data as some point..
Bubble sorting is conceptually miss understood in the vast majority of classic text book implementations. If you think about it, this sort shuffles/sweeps current data forward through the set. This is a key idea (also it's key flaw!), since the forward pass carries the current item forward, that means the last item after a single pass is now found. So you can increase performance, by merely decreasing the set size each pass.
Obviously if passing the data left to right pushes 'future' values to the end of the set, passing right to left, pulls the end values to the head of the set. So Bi directional passing can be used to further improve the performance here.
These change don't stop the overly man handling nature of this algorithm, But do give you a situational alternative, and that's the key idea.
Have fun.
Sample Code [DarkBasic Classic]
Sync on
MaxItems=50
Dim Table(MaxItems)
Dim Stats#(10,5)
Do
Cls
inc frames
Seed=Timer()
Test=1
SeedTable(Seed,MaxItems)
t=Timer()
ClassicBubbleSort(MaxItems)
t=timer()-t
test=Results("Classic Bubble Sort:",Test,MaxItems,T,Frames)
SeedTable(Seed,MaxItems)
t=Timer()
ClassicBubbleSortFaster(MaxItems)
t=timer()-t
test=Results("Classic Bubble Sort Faster:",Test,MaxItems,T,Frames)
`; ShowTable(Maxitems)
SeedTable(Seed,MaxItems)
t=Timer()
BiDirectionalBubbleSort(MaxItems)
t=timer()-t
test=Results("BiDirectional Bubble Sort:",Test,MaxItems,T,Frames)
Sync
repeat
until returnkey()=0
loop
Function ShowTable(items)
t$=""
n=0
For lp =0 to items
T$=t$+str$(table(lp))+","
inc n
if n>10
t$=Left$(t$,Len(t$)-1)
print t$
t$=""
n=0
endif
next lp
if t$<>"" then print Left$(t$,Len(t$)-1)
EndFunction
Function SeedTable(Seed,Items)
Randomize seed
For lp =0 to Items
Table(lp)=Rnd(32000)
next lp
EndFunction
Function ValidateTable(Items)
result=0
For lp=0 to items-1
if Table(lp)>Table(lp+1)
result=1
exit
endif
next lp
EndFunction Result
Function Results(Name$,index,Items,Time,Frames)
` Total Time
Stats#(index,1)=Stats#(index,1)+time
print "Sort Type:"+name$
print "Total Time:"+str$(Stats#(index,1))
print "Average Time:"+str$(Stats#(index,1)/frames)
if ValidateTable(Items)=0
Print "Array Sorted"
else
print "NOT SORTED - ERROR"
endif
print
inc index
EndFunction index
Function ClassicBubbleSort(Items)
Flag=0
repeat
Done=0
For lp=0 to items-1
if Table(lp)>Table(lp+1)
done=1
t=Table(lp)
Table(lp)=Table(lp+1)
Table(lp+1)=t
endif
Next lp
until done=0
EndFunction
Function ClassicBubbleSortFaster(Items)
Flag=0
repeat
Done=0
dec items
For lp=0 to items
if Table(lp)>Table(lp+1)
done=1
t=Table(lp)
Table(lp)=Table(lp+1)
Table(lp+1)=t
endif
Next lp
until done=0
EndFunction
Function BiDirectionalBubbleSort(Items)
First=0
Last=Items
Repeat
Done=0
dec Last
For lp=First to Last
V=Table(lp+1)
if Table(lp)>V
done=1
Table(lp+1)=Table(lp)
Table(lp)=v
endif
Next lp
if Done=1
Done=0
inc First
For lp=Last to First step -1
V=Table(lp-1)
if V>Table(lp)
Done=1
Table(lp-1)=Table(lp)
Table(lp)=v
endif
Next lp
endif
until Done=0
EndFunction
Bubble Sorting (PlayBasic Port)
This is a drag and drop port of the DarkBasic code above.
[pbcode]
MaxItems=50
Dim Table(MaxItems)
Dim Stats#(10,5)
Do
Cls 0
inc frames
Seed=Timer()
Test=1
SeedTable(Seed,MaxItems)
t=Timer()
ClassicBubbleSort(MaxItems)
t=timer()-t
test=Results("Classic Bubble Sort:",Test,MaxItems,T,Frames)
SeedTable(Seed,MaxItems)
t=Timer()
ClassicBubbleSortFaster(MaxItems)
t=timer()-t
test=Results("Classic Bubble Sort Faster:",Test,MaxItems,T,Frames)
`; ShowTable(Maxitems)
SeedTable(Seed,MaxItems)
t=Timer()
BiDirectionalBubbleSort(MaxItems)
t=timer()-t
test=Results("BiDirectional Bubble Sort:",Test,MaxItems,T,Frames)
Sync
repeat
until enterkey()=0
loop
Function ShowTable(items)
t$=""
n=0
For lp =0 to items
T$=t$+str$(table(lp))+","
inc n
if n>10
t$=Left$(t$,Len(t$)-1)
print t$
t$=""
n=0
endif
next lp
if t$<>"" then print Left$(t$,Len(t$)-1)
EndFunction
Function SeedTable(Seed,Items)
Randomize seed
For lp =0 to Items
Table(lp)=Rnd(32000)
next lp
EndFunction
Function ValidateTable(Items)
result=0
For lp=0 to items-1
if Table(lp)>Table(lp+1)
result=1
exit
endif
next lp
EndFunction Result
Function Results(Name$,index,Items,Time,Frames)
` Total Time
Stats#(index,1)=Stats#(index,1)+time
print "Sort Type:"+name$
print "Total Time:"+str$(Stats#(index,1))
print "Average Time:"+str$(Stats#(index,1)/frames)
if ValidateTable(Items)=0
Print "Array Sorted"
else
print "NOT SORTED - ERROR"
endif
print ""
inc index
EndFunction index
Function ClassicBubbleSort(Items)
Flag=0
repeat
Done=0
For lp=0 to items-1
if Table(lp)>Table(lp+1)
done=1
t=Table(lp)
Table(lp)=Table(lp+1)
Table(lp+1)=t
endif
Next lp
until done=0
EndFunction
Function ClassicBubbleSortFaster(Items)
Flag=0
repeat
Done=0
dec items
For lp=0 to items
if Table(lp)>Table(lp+1)
done=1
t=Table(lp)
Table(lp)=Table(lp+1)
Table(lp+1)=t
endif
Next lp
until done=0
EndFunction
Function BiDirectionalBubbleSort(Items)
First=0
Last=Items
Repeat
Done=0
dec Last
For lp=First to Last
V=Table(lp+1)
if Table(lp)>V
done=1
Table(lp+1)=Table(lp)
Table(lp)=v
endif
Next lp
if Done=1
Done=0
inc First
For lp=Last to First step -1
V=Table(lp-1)
if V>Table(lp)
Done=1
Table(lp-1)=Table(lp)
Table(lp)=v
endif
Next lp
endif
until Done=0
EndFunction
[/pbcode]
Bubble Sorting (PlayBasic Improved)
This version is changes the code to use array passing making it more generic. So PlayBASIC users could use the sorting functions from this in their own projects. By generally we recommend you use the SortArray function.
[pbcode]
MaxItems=100
Dim OriginalTable(MaxItems)
Dim Table(MaxItems)
Dim Stats#(10,5)
Do
Cls 0
inc frames
Seed=Timer()
SeedTable(OriginalTable(),Seed,MaxItems)
CopyArray OriginalTable(),Table()
Test=1
CopyArray OriginalTable(),Table()
t=Timer()
ClassicBubbleSort(Table())
t=timer()-t
test=Results("Classic Bubble Sort:",Test,MaxItems,T,Frames)
CopyArray OriginalTable(),Table()
t=Timer()
ClassicBubbleSortFaster(Table())
t=timer()-t
test=Results("Classic Bubble Sort Faster:",Test,MaxItems,T,Frames)
`; ShowTable(Maxitems)
CopyArray OriginalTable(),Table()
t=Timer()
BiDirectionalBubbleSort(Table())
t=timer()-t
test=Results("BiDirectional Bubble Sort:",Test,MaxItems,T,Frames)
Sync
repeat
until enterkey()=0
loop
Function ShowTable(items)
t$=""
n=0
For lp =0 to items
T$=t$+str$(table(lp))+","
inc n
if n>10
t$=Left$(t$,Len(t$)-1)
print t$
t$=""
n=0
endif
next lp
if t$<>"" then print Left$(t$,Len(t$)-1)
EndFunction
Function SeedTable(Array(),Seed,Items)
Randomize seed
Dim Array(Items)
For lp =0 to Items
Array(lp)=Rnd(32000)
next lp
EndFunction
Function ValidateTable(Array())
For lp=0 to GetArrayElements(Array(),1)-1
if Array(lp)>Array(lp+1)
result=1
exit
endif
next lp
EndFunction Result
Function Results(Name$,index,Items,Time,Frames)
` Total Time
Stats#(index,1)=Stats#(index,1)+time
print "Sort Type:"+name$
print "Total Time:"+str$(Stats#(index,1))
print "Average Time:"+str$(Stats#(index,1)/frames)
if ValidateTable(Table())=0
Print "Array Sorted"
else
print "NOT SORTED - ERROR"
endif
print ""
inc index
EndFunction index
Function ClassicBubbleSort(Array())
Flag=0
Items=GetArrayElements(Array(),1)
repeat
Done=0
For lp=0 to items-1
if Array(lp)>Array(lp+1)
done=1
t=Array(lp)
Array(lp)=Array(lp+1)
Array(lp+1)=t
endif
Next lp
until done=0
EndFunction
Function ClassicBubbleSortFaster(Array())
Flag=0
Items=GetArrayElements(Array(),1)
repeat
Done=0
dec items
For lp=0 to items
if Array(lp)>Array(lp+1)
done=1
t=Array(lp)
Array(lp)=Array(lp+1)
Array(lp+1)=t
endif
Next lp
until done=0
EndFunction
Function BiDirectionalBubbleSort(Array())
First=0
Items=GetArrayElements(Array(),1)
Last=Items
Repeat
Done=0
dec Last
For lp=First to Last
V=Array(lp+1)
if Array(lp)>V
done=1
Array(lp+1)=Array(lp)
Array(lp)=v
endif
Next lp
if Done=1
Done=0
inc First
For lp=Last to First step -1
V=Array(lp-1)
if V>Array(lp)
Done=1
Array(lp-1)=Array(lp)
Array(lp)=v
endif
Next lp
endif
until Done=0
EndFunction
[/pbcode]