67 lines
1.8 KiB
Plaintext
67 lines
1.8 KiB
Plaintext
' FB 1.05.0 Win64
|
|
|
|
Sub quicksort(a() As Integer, first As Integer, last As Integer)
|
|
Dim As Integer length = last - first + 1
|
|
If length < 2 Then Return
|
|
Dim pivot As Integer = a(first + length\ 2)
|
|
Dim lft As Integer = first
|
|
Dim rgt As Integer = last
|
|
While lft <= rgt
|
|
While a(lft) < pivot
|
|
lft +=1
|
|
Wend
|
|
While a(rgt) > pivot
|
|
rgt -= 1
|
|
Wend
|
|
If lft <= rgt Then
|
|
Swap a(lft), a(rgt)
|
|
lft += 1
|
|
rgt -= 1
|
|
End If
|
|
Wend
|
|
quicksort(a(), first, rgt)
|
|
quicksort(a(), lft, last)
|
|
End Sub
|
|
|
|
' The modal value(s) is/are stored in 'm'.
|
|
' The function returns the modal count.
|
|
Function mode(a() As Integer, m() As Integer, sorted As Boolean = false) As Integer
|
|
Dim lb As Integer = LBound(a)
|
|
Dim ub As Integer = UBound(a)
|
|
If ub = -1 Then Return 0 '' empty array
|
|
If Not sorted Then quicksort(a(), lb, ub)
|
|
Dim cValue As Integer = a(lb)
|
|
Dim cCount As Integer = 1
|
|
Dim cMax As Integer = 0
|
|
'' We iterate to the end of the array plus 1 to ensure the
|
|
'' final value is dealt with properly
|
|
For i As Integer = lb + 1 To ub + 1
|
|
If i <= ub AndAlso a(i) = cValue Then
|
|
cCount += 1
|
|
Else
|
|
If cCount > cMax Then
|
|
Erase m
|
|
Redim m(1 To 1)
|
|
m(1) = cValue
|
|
cMax = cCount
|
|
ElseIf cCount = cMax Then
|
|
Redim Preserve m(1 To UBound(m) + 1)
|
|
m(UBound(m)) = cValue
|
|
End If
|
|
If i = ub + 1 Then Exit For
|
|
cValue = a(i)
|
|
cCount = 1
|
|
End If
|
|
Next
|
|
Return cMax
|
|
End Function
|
|
|
|
Dim a(1 To 14) As Integer = {1, 2, 3, 1, 2, 4, 2, 5, 2, 3, 3, 1, 3, 6}
|
|
Dim m() As Integer '' to store the mode(s)
|
|
Dim mCount As Integer = mode(a(), m())
|
|
Print "The following are the modes which occur"; mCount; " times : "
|
|
For i As Integer = LBound(m) To UBound(m) : Print m(i); " "; : Next
|
|
Print
|
|
Print "Press any key to quit"
|
|
Sleep
|