Insertion Sort is a simple, short technique which is efficient for small arrays. To sort array Foo() use Call InsertionSort(Foo). It can be quite fast if the array elements are already mostly in order. However the algorithm is "quadratic", that is, if the number of elements to be sorted in N, the sort time is proportional N², so Insertion Sort would not be the best choice for an array with a hundred elements.
Code: Select all
Sub InsertionSort(A() As Variant)
Dim LB As Long, I As Long, J As Long, Temp As Variant
LB = LBOUND(A)
For I = LB+1 To UBOUND(A)
Temp = A(I)
For J = I-1 To LB Step -1
A(J+1) = A(J) : If Temp >= A(J) Then Exit For
Next J
A(J+1) = Temp
Next I
End Sub
Code: Select all
Sub ShellSort(A() As Variant)
Dim LB As Long, UB As Long, Incr As Long, Temp As Variant
LB = LBOUND(A) : UB = UBOUND(A) : Incr = 12
While Incr<=UB-LB : Incr = Incr*3+3 : Wend
Incr = Incr/9
While Incr
For I = LB+Incr To UB
Temp = A(I)
For J = I-Incr To LB Step -Incr
A(J+Incr) = A(J) : If Temp >= A(J) Then Exit For
Next J
A(J+Incr) = Temp
Next I
Incr = Incr/3
Wend
End Sub
Code: Select all
Sub HeapSort(A() As Variant)
Rem Requires subroutine HeapSortSub below
Dim Node As Long, LB As Long, UB As Long, Temp As Variant
LB = LBOUND(A) : UB = UBOUND(A)
For Node = INT((UB+LB-1)/2) To LB Step -1
Call HeapSortSub(A,LB,Node,UB)
Next Node
For Node = UB to LB+1 Step -1
Temp = A(LB) : A(LB) = A(Node) : A(Node) = Temp
Call HeapSortSub(A,LB,LB,Node-1)
Next Node
End Sub
Sub HeapSortSub(A() As Variant, LB As Long, Node As Long, Last As Long)
Dim Lchild As Long, Rchild As Long, Larger As Long, Temp As Variant
Lchild = Node+Node-LB+1 : If Lchild > Last Then Exit Sub
If Lchild<Last Then Rchild = Lchild+1 Else Rchild = Lchild
If A(Node)>=A(Lchild) And A(Node)>=A(Rchild) Then Exit Sub
Larger = Iif(A(Lchild)>A(Rchild),Lchild,Rchild)
Temp = A(Node) : A(Node) = A(Larger) : A(Larger) = Temp
Call HeapSortSub(A,LB,Larger,Last)
End Sub
Code: Select all
Sub Sort1(A() As Variant)
Dim I As Long, J As Long, Temp As Variant
For I = LBOUND(A) To UBOUND(A)
For J = LBOUND(A) To UBOUND(A)
If A(I) < A(J) Then Temp=A(J) : A(J)=A(I) : A(I)=Temp
Next J
Next I
End Sub
Code: Select all
Sub StoogeSort(A() As Variant,LB As Long,UB As Long)
Rem Sort array into non-descending order; Pass array, lower bound, upper bound
Dim Temp As Variant, Third As Long
If A(LB) > A(UB) Then Temp = A(LB) : A(LB) = A(UB) : A(UB) = Temp
Third = INT((UB-LB+1)/3) : If Third = 0 Then Exit Sub
Call StoogeSort(A,LB,UB-Third)
Call StoogeSort(A,LB+Third,UB)
Call StoogeSort(A,LB,UB-Third)
End Sub
AcctX = MergeSort(Acct) For I = LBOUND(Acct) To UBOUND(Acct) Print Acct(AcctX(I)), Bill(AcctX(I)) Next I
Code: Select all
Function MergeSort(A() As Variant) As Variant
Dim LA As Long : LA = LBOUND(A)
Dim UA As Long : UA = UBOUND(A)
Dim LL As Long : LL = 1
Dim DB As Long : DB = LA-LL
Dim UL As Long : UL = UA-DB
Dim QP As Long : QP = UL+1
Dim I As Long, P As Long, Q As Long, S As Long, T As Long
Dim TempA As Variant, TempL As Long
ReDim X(LA To UA) As Long
For I = LA To UA : X(I) = I : Next I
If QP < 3 Then MergeSort = X : Exit Function
ReDim LINK(QP) As Long
LINK(0) = 1 : LINK(QP) = 2 : Q = 2
For I = 1 to UL-2 : LINK(I) = -I-2 : Next I
LINK(UL-1) = 0 : LINK(UL) = 0
While Q
S = 0 : T = QP : P = LINK(0)
While Q
While P>0 And Q>0
If A(P+DB) <= A(Q+DB) Then
LINK(S) = Iif(LINK(S)<0,-P,P) : S = P : P = LINK(P)
Else
LINK(S) = Iif(LINK(S)<0,-Q,Q) : S = Q : Q = LINK(Q)
End If
Wend
If P<=0 Then
LINK(S)=Q : S=T
While Q>0 : T=Q : Q=LINK(Q) : Wend
Else
LINK(S)=P : S=T
While P>0 : T=P : P=LINK(P) : Wend
End If
P = -P : Q = -Q
Wend
LINK(S) = Iif(LINK(S)<0,-P,P) : LINK(T) = 0 : Q = LINK(QP)
Wend
P = LINK(0) : Q = 1
While P>0
While P<Q : P = LINK(P) : Wend
TempA = X(P+DB) : X(P+DB) = X(Q+DB) : X(Q+DB) = TempA
TempL = LINK(P) : LINK(P) = LINK(Q) : LINK(Q) = P : P = TempL
Q = Q+1
Wend
MergeSort = X
End Function
The easiest way to sort with multiple keys is concatenate them and sort on the concatenation. However concatenating numeric values requires caution. Simple concatenation of keys (3;14) will sort after (15;9) since 314 > 159. MergeSort is a "stable" sort, so it can be used instead of concatenation. Suppose array F() contains first names, M() contains middle initials, L() contains last names, and P() contains phone numbers. The arrays use the same subscript to hold corresponding data, for example F(5), M(5), L(5), and P(5) are related. Sorting is done with the least significant key first and ending with the most significant key last. Thus to print a telephone directory, the data is sorted by middle initial, then first name, then last name.
Dim F(12) As String, M(12) As String, L(12) As String, P(12) As String Dim FX(12) As Long, MX(12) As Long, LX(12) As Long, I As Long Dim Temp(12) As String, MFL As Long F = Array("Jenny","Ann","Terry","Kathy","Jean","Ann","Kathy", _ "Jean","Kathy","Terry","Terry","Ann","Kathy") M = Array("M","R","","P","R","O","G","R","A","M","M","E","R") L = Array("Smith","Green","Brown","Brown","Smith","Brown","Green", _ "Green","Smith","Smith","Green","Smith","Green") P = Array("867-5309","677-7838","894-5029","993-4818","899-6881", _ "253-6310","229-1880","694-9970","251-7587","222-1450", _ "785-1306","720-3370","807-9182") MX = MergeSort(M) ' Middle initial sort For I = 0 To 12 : Temp(I) = F(MX(I)) : Next I ' Get first names FX = MergeSort(Temp) ' First name sort For I = 0 To 12 : Temp(I) = L(MX(FX(I))) : Next I ' Get last names LX = MergeSort(Temp) ' Last name sort For I = 0 To 12 MFL = MX(FX(LX(I))) Print L(MFL) & ", " & F(MFL) & " " & M(MFL) & ": " & P(MFL) Next I
The message BASIC runtime error. Object variable not set. probably means the array you've passed to the algorithm is an array of objects, not an array of strings or an array of numbers, the requirement stated in the third sentence of the tutorial. It is your responsibility to pass the correct parameter to the algorithm. See [Solved] Testing StarBasic Sort Algorithms with Calc cells.
To claim that an algorithm did not sort correctly provide:
• The listing of the algorithm which you used
• StarBasic statements with data to demonstrate the situation
• The locale in option Language Settings → Languages → Locale Setting
• An explanation of why you believe the sort is incorrect
• Do not attach a picture; I will ignore it