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
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)
the algorythm is relatively fast and seems to work fine up to 250000 items in the list.