常用排序演算法之歸併排序

'歸併排序
Option Explicit

Dim Result, I
Dim TestData(100)
const N = 100

Randomize
For I = 0 To N - 1
TestData(I) = ROUND(RND() * 32768)
Next

Sub MergeTo(byRef Array, byRef Dest, low, mid, hi)
Dim i, j, k, d
i = low
j = mid
d = low
Do 
    If i = mid or j = hi+1 Then
        Exit Do
    End If
    If Array(i) < Array(j) Then
        Dest(d) = Array(i)
        i = i + 1
    Else
        Dest(d) = Array(j)
        j = j + 1
    End If
    d = d + 1
Loop
For k = i To mid - 1
    Dest(d) = Array(k)
    d = d + 1 
Next
For k = j To hi
    Dest(d) = Array(k)
    d = d + 1 
Next
End Sub

Sub Merge(byRef Array, byRef Temp, low, hi, length)
Dim i, j
for i = low To hi-length  step length*2
    j = i+2*length-1
    If j > hi Then
        j = hi
    End If
    MergeTo Array, Temp, i, i+length, j
next    
For j = i To hi
    Temp(j) = Array(j)
Next
End Sub

'歸併排序,非遞迴
Sub MergeSort(byRef Array, low, hi)
Dim Temp(100), i, Length
Length = hi-low+1
i = 1
Do
    Merge Array, Temp, low, hi, i
     i = i * 2
    Merge Temp, Array, low, hi, i
    i = i * 2
    If i > Length Then
        Exit Do
    End If    
Loop
End Sub

'歸併排序,遞迴
Sub MergeSort1(byRef Array, low, hi)
Dim Temp(100), i, mid

    If low >= hi Then
        Exit Sub
    End If
    mid = Int((low+hi)/2)
    MergeSort1 Array, low, mid
    MergeSort1 Array, mid+1, hi
    MergeTo Array, temp, low, mid+1, hi
    For i = low To hi
        Array(i) = Temp(i)
    Next
End Sub

MergeSort TestData, 0, N - 1

For I = 0 To N - 1
Result = Result & TestData(I) & VbTab
Next

MsgBox(Result)