'计数排序,基数排序 OptionExplicit Dim Result, I Dim TestData(100) const N =100 Randomize For I =0To N -1 TestData(I) =ROUND(RND() *32768) Next '以base^pow位上的数映射到Map Sub MapTo(byRef Array, byRef Map, low, hi, base, pow) Dim i, n n =1 For i =1To pow n = n * base Next For i = low To hi Map(i) =Int(Array(i) / n) Mod base Next End Sub '以映射进行计数排序 Sub CSortWithMap(byRef Array, byRef Map, low, hi) Dim Counter(16), Temp(100), i For i =0TouBound(Counter) Counter(i) =0 Next For i = low To hi Counter(Map(i)) = Counter(Map(i)) +1 Next For i =1TouBound(Counter) Counter(i) = Counter(i) + Counter(i-1) Next For i = hi To low Step -1 Counter(Map(i)) = Counter(Map(i)) -1 Temp(Counter(Map(i))) =Array(i) Next For i = low To hi Array(i) = Temp(i) Next End Sub '基数排序 Sub BSort(byRef Array, low, hi) Dim Map(100), i For i =0To4 MapTo Array, Map, low, hi, 16, i CSortWithMap Array, Map, low, hi Next End Sub BSort TestData, 0, N -1 For I =0To N -1 Result = Result & TestData(I) & VbTab Next MsgBox(Result)
'桶排序 OptionExplicit Dim Result, I Dim TestData(100) const N =100 Randomize For I =0To N -1 TestData(I) =ROUND(RND() *32768) Next '桶排序 Sub BSort(byRef Array, low, hi) Dim Bucket(400, 100), Counter(400), i, j, t, idx For i =0To399 Counter(i) =0 Next For i = low To hi idx =Int(Array(i) /100) j = Counter(idx) -1 t =Array(i) Do If j <0Then ExitDo EndIf IfArray(j) > t Then Bucket(idx, j+1) = Bucket(idx, j) j = j -1 Else ExitDo EndIf Loop Bucket(idx, j+1) = t Counter(idx) = Counter(idx) +1 Next t = low For i =0To399 For j =1To Counter(i) Array(t) = Bucket(i, j-1) t = t +1 Next Next End Sub BSort TestData, 0, N -1 For I =0To N -1 Result = Result & TestData(I) & VbTab Next MsgBox(Result)