Merge Sort Algorythm

[siskinedge]

I've recently needed to have a sorting algorythm and I think that it would be useful for other people to use as well. it uses a simple merge sort and it's got plenty of comments in it so you can read through on how It works.

Code: Select all

Declare Function SimpleMergeSort( ByRef Array As Single Ptr, ByRef IndexCount As Integer ) As Integer Ptr

Function SimpleMergeSort( ByRef Array As Single Ptr, ByRef IndexCount As Integer ) As Integer Ptr
	' Allocate end index
	Dim EndIndex As Integer Ptr
	Dim TemploopA As Integer
	Dim TemploopB As Integer
	' Sub Array carried to next stage
	Dim SubArrayCount As Integer
	Dim SubArraySizes As Integer Ptr
	Dim SubArrayStart As Integer Ptr
	' temp sub array for working
	Dim NextIndex As Integer Ptr
	Dim NextArrayCount As Integer
	Dim NextArraySizes As Integer Ptr
	Dim NextArrayStart As Integer Ptr
	' current merge container
	Dim MergeA As Integer
	Dim MergeB As Integer
	Dim MergeAcount As Integer
	Dim MergeBcount As Integer
	Dim MergeTarget As Integer
	' Allocate initle variables
	EndIndex = Callocate( IndexCount, SizeOf(Integer) )
	SubArraySizes = Callocate( IndexCount, SizeOf(Integer) )
	SubArrayStart = Callocate( IndexCount, SizeOf(Integer) )
	SubArrayCount = IndexCount
	' set Initile Indexs to numercal order
	For TemploopA = 0 To IndexCount-1
		EndIndex[TemploopA] = TemploopA
		SubArraySizes[TemploopA] = 1
		SubArrayStart[TemploopA] = TemploopA
	Next
	' Set Next Array count to index count
	NextArrayCount = IndexCount
	' perform simple merge sort
	While NextArrayCount>1
		' calculate size of produced array
		NextArrayCount = Int(SubArrayCount/2)
		'allocate temp array, allow for odd variable space
		NextIndex = Callocate( IndexCount, SizeOf(Integer) )
		NextArraySizes = Callocate( NextArrayCount+1, SizeOf(Integer) )
		NextArrayStart = Callocate( NextArrayCount+1, SizeOf(Integer) )
		'set start point for merging
		MergeTarget = 0
		'begin merging pass
		For TempLoopA = 0 To NextArrayCount-1
			'set merging array indexes
			MergeA = TempLoopA * 2
			MergeB = TempLoopA * 2 + 1
			'set merged array size and location
			NextArraySizes[TempLoopA] = SubArraySizes[MergeA] + SubArraySizes[MergeB]
			NextArrayStart[TempLoopA] = MergeTarget
			'reset merge count, to advoid bugs
			MergeAcount = 0
			MergeBcount = 0
			' merge sort the variables
			While SubArraySizes[MergeA]>MergeAcount And SubArraySizes[MergeB]>MergeBcount
				' compare each variable
				If Array[(EndIndex[SubArrayStart[MergeA]+MergeAcount])]<Array[(EndIndex[SubArrayStart[MergeB]+MergeBcount])] Then
					' merge index
					NextIndex[MergeTarget] = EndIndex[SubArrayStart[MergeA]+MergeAcount]
					' increment position in array
					MergeAcount = MergeAcount + 1
				Else
					' merge index
					NextIndex[MergeTarget] = EndIndex[SubArrayStart[MergeB]+MergeBcount]
					' increment position in array B
					MergeBcount = MergeBcount + 1
				EndIf
				'increment current merge target index
				MergeTarget = MergeTarget + 1
			Wend
			' remaining unmerged sorted data is added to the end of the sub array
			If SubArraySizes[MergeA]>MergeAcount Then
				For TemploopB = 1 To (SubArraySizes[MergeA]-MergeAcount)
					'add index
					NextIndex[MergeTarget] = EndIndex[SubArrayStart[MergeA]+MergeAcount]
					'increment current merge target index
					MergeTarget = MergeTarget + 1
					' increment position in array
					MergeAcount = MergeAcount + 1
				Next
			Else
				For TemploopB = 1 To (SubArraySizes[MergeB]-MergeBcount)
					'add index
					NextIndex[MergeTarget] = EndIndex[SubArrayStart[MergeB]+MergeBcount]
					'increment current merge target index
					MergeTarget = MergeTarget + 1
					' increment position in array B
					MergeBcount = MergeBcount + 1
				Next
			EndIf
		Next
		' Catch Odd arrays and add them to the end of the new array
		If IndexCount>MergeTarget Then
			'cache one calculation
			TempLoopB = NextArrayCount * 2
			'copy array data
			NextArrayStart[NextArrayCount] = MergeTarget
			NextArraySizes[NextArrayCount] = SubArraySizes[TempLoopB]
			For TempLoopA = 0 To (SubArraySizes[TempLoopB] - 1)
				NextIndex[MergeTarget] = EndIndex[(SubArrayStart[TempLoopB] + TempLoopA)]
				'Increment MergeTarget
				MergeTarget = MergeTarget + 1
			Next
			'increment array count
			NextArrayCount = NextArrayCount + 1
		EndIf
		' deallocate the old array and point first pointer to temp array 
		DeAllocate( EndIndex )
		DeAllocate( SubArraySizes )
		DeAllocate( SubArrayStart )
		EndIndex = NextIndex
		SubArrayCount = NextArrayCount
		SubArraySizes = NextArraySizes
		SubArrayStart = NextArrayStart
	Wend
	' deallocate variables
	DeAllocate( NextArraySizes )
	DeAllocate( NextArrayStart )
	' return value
	Return EndIndex
End Function

just put the declare before you use the function and the function itself wherever. it works by you passing it a pointer to the first item in an array of single variables and the amount of elements in that array. it then returns a pointer to the first item of an array of intergers that in lowest first order the indexs of the first array. you must deallocate this array of intergers yourself when you are done with that sorted list.

the following code is an example of how to use the function:

Code: Select all

Dim SortedIndex As Integer Ptr
Dim List(1 To 10) As Single
Dim TempLoop As Integer
SortedIndex = SimpleMergeSort( @List(1), 10 )
Print "Begin List"
For Temploop = 1 to 10
	Print List( SortedIndex[Temploop - 1] + 1 )
Next
DeAllocate(SortedIndex)

temploop has one taken from it due to sorted index starting at 0 and ending at 9 for a ten item list. sortedindex has one added to it as the list array is numbered 1 to 10 and the sort function percives it as 0 to 9. I must stress again that it's nessesary for you to deallocate the returned sorted indexes and only after you have finished useing them.

the algorythm is relatively fast and seems to work fine up to 250000 items in the list.

[agamemnus]

Always nice to see more interest in sorting techniques and functions, but MIB!! (Mine Is Better :P)

http://www.freebasic.net/forum/viewtopic.php?t=12765

[dodicat]

Hi siskinedge
Nice sort, and pretty fast for 250000 elements.
But you can't whack the old quicksort for simplicity and speed.
Here's your example with quicksort for singles integrated and random numbers set into the list array.

Code: Select all

'GET RANDOM NUMBERS
Function rnd_range (first As Double, last As Double) As Double
    Function = Rnd * (last - first) + first
End Function
'**************** QUICKSORT FOR SINGLE ************************
Sub MF(g As Long,d As Long,a()As single)
Dim As single v,t:Dim As byte o:Dim As Long i,j
  If g<d Then:v=a(d):i=g-1:j=d:Do:Do:i=i+1:Loop Until a(i)>=v:o=0
     Do:If j>Lbound(a) Then:j=j-1:Else:o=1:Endif:If a(j)<=v Then o=1
     Loop Until o<>0:Swap a(i),a(j):Loop Until j<=i
    t=a(j):a(j)=a(i):a(i)=a(d):a(d)=t:MF(g,i-1,a()):MF(i+1,d,a()):Endif:End Sub
    Sub sortsingle(arr() As single,D As String)
    D=Lcase$(D):MF(Lbound(arr),Ubound(arr),arr()):Select Case D
    Case "up":Case "down":Dim As Long lb,ub:lb=Lbound(arr):ub=Ubound(arr)
    For n As Long=Lb To int((lb+Ub)/2):Swap arr(n),arr(ub+lb-n):Next:End Select:End Sub
'******************** END QUICKSORT **************************************
print "Starting"
Dim SortedIndex As Integer Ptr
Dim List(1 To 250000) As Single
dim as double t1,t2  'for the timer
Dim TempLoop As long
for temploop=1 to 250000
    list(temploop)=rnd_range(0,1000000) 'random numbers 0 to 1000000
next
print
print "list filled"
t1=timer

'SortedIndex = SimpleMergeSort( @List(1), 250000 ) 'THE MERGESORT
sortsingle list(),"up"                             'THE QUICKSORT 

t2=timer
print "list sorted"
Print "Begin List, print the first 25 elements only"
For Temploop = 1 To 25
    
        'Print List( SortedIndex[Temploop - 1] + 1 ); 'PRINTOUT MERGESORT
        print list(temploop);                         'PRINTOUT QUICKSORT
        
Next
print
print "done"
print "Time taken to sort ";t2-t1
DeAllocate(SortedIndex)
 sleep

[siskinedge]

I found merge sort easier to get my head around while being relatively fast, quicksort with optimisations or mabey a combo sort algorythm would be faster but I made this one mostly to fit three things:
1) needed a sort function
2) wanted to do it myslf to learn
3) wanted to do it quick to move back to particle effect physics
4) wanted a fast stable sort for 50 to 250 long lists

took a day to code, fit the parameters. I didn't really get how quick sort worked from the youtube video. when it comes down to it I need a stable sort for the code as it will be called fairly often and quick sort is O(N^2) worst case. and due to the processor limits it's likely only have to sort from 40 to 200 physics particles at a time. if I need more performance I can optimise later, plus as I made it myself I dont need to worry about licensing or sharing credit lol.

[dodicat]

Hi siskinedge
Yes, well done to code a sort in a day.
I must confess my quicksorts are not totally original, I picked up an algorithm years ago, from another language and converted it to Sinclair Spectrum basic, then to Pascal, it lies so far back in the mist of time,I've forgotten the source, perhaps Fortran in the days of the old punch cards, so the ink will now have turned brown on any copyright.
Anyway, good luck with your Physics.

[siskinedge]

I might in the future as practice update the code to be multi threaded, seems like it'd be ideal for that sorta thing and it'd be good practice. the algorythm would almost proportionally increse in speed for however many cores are used.

[j0wq]

It's an old thread but your merge sort code looks good with helpful comments. I also found this tutorial helpful.