StarBasic Sort Algorithms

[MrProgrammer]

This topic contains several algorithms to sort an array, written in the OpenOffice StarBasic language. Usually the algorithm is presented as a subroutine which accepts one parameter, the array to sort. The array type can be String or one of the numeric types. The subroutine rearranges the array into non-descending order. For example, if the array is declared as Dim Array(4) As Integer with values (3,1,4,1,5) the array will be (1,1,3,4,5) when the subroutine finishes. Arrays to sort should have only one subscript, but any lower and upper bounds are acceptable, so the subroutines will sort arrays which have been defined as Dim Foo(-8 To -3) As Long.

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

Shell Sort is similar to Insertion Sort but adds an extra loop which allows the algorithm to shift elements more than one position in the array. To sort array Foo() use Call ShellSort(Foo). Shell Sort is a better choice than Insertion Sort when the array size exceeds a dozen or so elements. This version's run time is proportional to N^1.25.

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

Heap Sort's algorithm is a bit longer but guaranteed to sort even large arrays quickly. To sort array Foo() use Call HeapSort(Foo). It requires a second subroutine HeapSortSub which you do not call yourself. Heap Sort's run time is proportional to N×LN(N) where LN is the natural logarithm function.

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

Sort1 is a surprising algorithm which looks too simple to work. It is slower than Insertion Sort. The main advantage is that if one is typing this from memory it is hard to get wrong. Even if one reverses the subscripts in the IF test or uses > instead of <, the algorithm still sorts, just in descending order.

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

Stooge Sort is just for fun. As might be expected from the name, this is not an efficient algorithm. To sort an array dimensioned as Dim Foo(-8 To -3) you would use Call StoogeSort(Foo,-8,-3).

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

MergeSort is the longest algorithm in this post and presented as a function instead of a subroutine. To sort an array dimensioned as Foo(-8 To -3), declare a second array, say FooX, using Dim FooX(-8 To -3) As Long. Keep the same dimensions but use Long as the type. Use StarBasic statement FooX = MergeSort(Foo). The function does not change Foo. FooX is set to the subscripts which access the elements of Foo in non-descending order. So Foo(FooX(-8)) is the smallest element of Foo, Foo(FooX(-7)) is the next smallest element, …, and Foo(FooX(-3)) is the largest element. This result is helpful when more than one array needs to be sorted in the same order. For example, suppose Acct() contains account numbers and Bill() contains the corresponding billing address. To print the data in account number order:

• AcctX = MergeSort(Acct)
  For I = LBOUND(Acct) To UBOUND(Acct)
     Print Acct(AcctX(I)), Bill(AcctX(I))
  Next I

This implementation of Merge Sort is Algorithm L from Donald Knuth's The Art of Computer Programming, Volume 3, Section 5.2.4. The last WHILE loop is the solution to exercise 5.2-12.

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

Advanced topic: Sorting with multiple keys
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

This is not the right place to ask questions. Ask them in the Macros and UNO API → OpenOffice Basic, Python, BeanShell, JavaScript section.

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