OptionExplicit Global Const ZERO =0 Global Const ASCENDING_ORDER =0 Global Const DESCENDING_ORDER =1 Global gIterations Sub BubbleSort()Sub BubbleSort(MyArray(), ByVal nOrder AsInteger) Dim Index Dim TEMP Dim NextElement NextElement = ZERO DoWhile (NextElement <UBound(MyArray)) Index =UBound(MyArray) DoWhile (Index > NextElement) If nOrder = ASCENDING_ORDER Then If MyArray(Index) < MyArray(Index -1) Then TEMP = MyArray(Index) MyArray(Index) = MyArray(Index -1) MyArray(Index -1) = TEMP EndIf ElseIf nOrder = DESCENDING_ORDER Then If MyArray(Index) >= MyArray(Index -1) Then TEMP = MyArray(Index) MyArray(Index) = MyArray(Index -1) MyArray(Index -1) = TEMP EndIf EndIf Index = Index -1 gIterations = gIterations +1 Loop NextElement = NextElement +1 gIterations = gIterations +1 Loop End Sub Sub Bucket()Sub Bucket(MyArray(), ByVal nOrder AsInteger) Dim Index Dim NextElement Dim TheBucket NextElement =LBound(MyArray) +1 While (NextElement <=UBound(MyArray)) TheBucket = MyArray(NextElement) Index = NextElement Do If Index >LBound(MyArray) Then If nOrder = ASCENDING_ORDER Then If TheBucket < MyArray(Index -1) Then MyArray(Index) = MyArray(Index -1) Index = Index -1 Else ExitDo EndIf ElseIf nOrder = DESCENDING_ORDER Then If TheBucket >= MyArray(Index -1) Then MyArray(Index) = MyArray(Index -1) Index = Index -1 Else ExitDo EndIf EndIf Else ExitDo EndIf gIterations = gIterations +1 Loop MyArray(Index) = TheBucket NextElement = NextElement +1 gIterations = gIterations +1 Wend End Sub Sub Heap()Sub Heap(MyArray()) Dim Index Dim Size Dim TEMP Size =UBound(MyArray) Index =1 While (Index <= Size) Call HeapSiftup(MyArray(), Index) Index = Index +1 gIterations = gIterations +1 Wend Index = Size While (Index >0) TEMP = MyArray(0) MyArray(0) = MyArray(Index) MyArray(Index) = TEMP Call HeapSiftdown(MyArray(), Index -1) Index = Index -1 gIterations = gIterations +1 Wend End Sub Sub HeapSiftdown()Sub HeapSiftdown(MyArray(), M) Dim Index Dim Parent Dim TEMP Index =0 Parent =2* Index DoWhile (Parent <= M) If (Parent < M And MyArray(Parent) < MyArray(Parent +1)) Then Parent = Parent +1 EndIf If MyArray(Index) >= MyArray(Parent) Then ExitDo EndIf TEMP = MyArray(Index) MyArray(Index) = MyArray(Parent) MyArray(Parent) = TEMP Index = Parent Parent =2* Index gIterations = gIterations +1 Loop End Sub Sub HeapSiftup()Sub HeapSiftup(MyArray(), M) Dim Index Dim Parent Dim TEMP Index = M DoWhile (Index >0) Parent =Int(Index /2) If MyArray(Parent) >= MyArray(Index) Then ExitDo EndIf TEMP = MyArray(Index) MyArray(Index) = MyArray(Parent) MyArray(Parent) = TEMP Index = Parent gIterations = gIterations +1 Loop End Sub Sub Insertion()Sub Insertion(MyArray(), ByVal nOrder AsInteger) Dim Index Dim TEMP Dim NextElement NextElement =LBound(MyArray) +1 While (NextElement <=UBound(MyArray)) Index = NextElement Do If Index >LBound(MyArray) Then If nOrder = ASCENDING_ORDER Then If MyArray(Index) < MyArray(Index -1) Then TEMP = MyArray(Index) MyArray(Index) = MyArray(Index -1) MyArray(Index -1) = TEMP Index = Index -1 Else ExitDo EndIf ElseIf nOrder = DESCENDING_ORDER Then If MyArray(Index) >= MyArray(Index -1) Then TEMP = MyArray(Index) MyArray(Index) = MyArray(Index -1) MyArray(Index -1) = TEMP Index = Index -1 Else ExitDo EndIf EndIf Else ExitDo EndIf gIterations = gIterations +1 Loop NextElement = NextElement +1 gIterations = gIterations +1 Wend End Sub Sub QuickSort()Sub QuickSort(MyArray(), L, R) Dim I, J, X, Y I = L J = R X = MyArray((L + R) /2) While (I <= J) While (MyArray(I) < X And I < R) I = I +1 Wend While (X < MyArray(J) And J > L) J = J -1 Wend If (I <= J) Then Y = MyArray(I) MyArray(I) = MyArray(J) MyArray(J) = Y I = I +1 J = J -1 EndIf gIterations = gIterations +1 Wend If (L < J) ThenCall QuickSort(MyArray(), L, J) If (I < R) ThenCall QuickSort(MyArray(), I, R) End Sub Sub Selection()Sub Selection(MyArray(), ByVal nOrder AsInteger) Dim Index Dim Min Dim NextElement Dim TEMP NextElement =0 While (NextElement <UBound(MyArray)) Min =UBound(MyArray) Index = Min -1 While (Index >= NextElement) If nOrder = ASCENDING_ORDER Then If MyArray(Index) < MyArray(Min) Then Min = Index EndIf ElseIf nOrder = DESCENDING_ORDER Then If MyArray(Index) >= MyArray(Min) Then Min = Index EndIf EndIf Index = Index -1 gIterations = gIterations +1 Wend TEMP = MyArray(Min) MyArray(Min) = MyArray(NextElement) MyArray(NextElement) = TEMP NextElement = NextElement +1 gIterations = gIterations -1 Wend End Sub Sub ShellSort()Sub ShellSort(MyArray(), ByVal nOrder AsInteger) Dim Distance Dim Size Dim Index Dim NextElement Dim TEMP Size =UBound(MyArray) -LBound(MyArray) +1 Distance =1 While (Distance <= Size) Distance =2* Distance Wend Distance = (Distance /2) -1 While (Distance >0) NextElement =LBound(MyArray) + Distance While (NextElement <=UBound(MyArray)) Index = NextElement Do If Index >= (LBound(MyArray) + Distance) Then If nOrder = ASCENDING_ORDER Then If MyArray(Index) < MyArray(Index - Distance) Then TEMP = MyArray(Index) MyArray(Index) = MyArray(Index - Distance) MyArray(Index - Distance) = TEMP Index = Index - Distance gIterations = gIterations +1 Else ExitDo EndIf ElseIf nOrder = DESCENDING_ORDER Then If MyArray(Index) >= MyArray(Index - Distance) Then TEMP = MyArray(Index) MyArray(Index) = MyArray(Index - Distance) MyArray(Index - Distance) = TEMP Index = Index - Distance gIterations = gIterations +1 Else ExitDo EndIf EndIf Else ExitDo EndIf Loop NextElement = NextElement +1 gIterations = gIterations +1 Wend Distance = (Distance -1) /2 gIterations = gIterations +1 Wend End Sub