Data commit

Task/Averages-Mode/FreeBASIC/averages-mode.basic

@@ -0,0 +1,66 @@
+' 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