80 lines
2.3 KiB
Plaintext
80 lines
2.3 KiB
Plaintext
' version 22-06-2015
|
|
' compile with: fbc -s console
|
|
' for boundry checks on array's compile with: fbc -s console -exx
|
|
' from the rosetta code FreeBASIC entry
|
|
#Define out_of_data 99999999 ' any number that is not in the set will do
|
|
|
|
Sub shellsort(s() As Integer)
|
|
' from the FreeBASIC entry at rosetta code
|
|
' sort from lower bound to the highter bound
|
|
Dim As Integer lb = LBound(s)
|
|
Dim As Integer ub = UBound(s)
|
|
Dim As Integer done, i, inc = ub - lb
|
|
|
|
Do
|
|
inc = inc / 2.2
|
|
If inc < 1 Then inc = 1
|
|
Do
|
|
done = 0
|
|
For i = lb To ub - inc
|
|
If s(i) > s(i + inc) Then
|
|
Swap s(i), s(i + inc)
|
|
done = 1
|
|
End If
|
|
Next
|
|
Loop Until done = 0
|
|
Loop Until inc = 1
|
|
|
|
End Sub
|
|
|
|
' ------=< TASK DATA >=------
|
|
|
|
Data 12, 127, 28, 42, 39, 113, 42, 18, 44, 118, 44, 37, 113, 124
|
|
Data 37, 48, 127, 36, 29, 31, 125, 139, 131, 115, 105, 132, 104, 123
|
|
Data 35, 113, 122, 42, 117, 119, 58, 109, 23, 105, 63, 27, 44, 105
|
|
Data 99, 41, 128, 121, 116, 125, 32, 61, 37, 127, 29, 113, 121, 58
|
|
Data 114, 126, 53, 114, 96, 25, 109, 7, 31, 141, 46, 13, 27, 43
|
|
Data 117, 116, 27, 7, 68, 40, 31, 115, 124, 42, 128, 52, 71, 118
|
|
Data 117, 38, 27, 106, 33, 117, 116, 111, 40, 119, 47, 105, 57, 122
|
|
Data 109, 124, 115, 43, 120, 43, 27, 27, 18, 28, 48, 125, 107, 114
|
|
Data 34, 133, 45, 120, 30, 127, 31, 116, 146
|
|
Data out_of_data
|
|
|
|
' ------=< MAIN >=------
|
|
|
|
Dim As String read_in
|
|
Dim As Integer i, x, y, count = -1 ' to let the index start on 0
|
|
Dim As Integer d()
|
|
ReDim d(300) ' big enough to hold data index start at 0
|
|
|
|
Do
|
|
Read i
|
|
If i = out_of_data Then Exit Do
|
|
count = count + 1
|
|
d(count) = i
|
|
Loop
|
|
|
|
ReDim Preserve d(count) ' trim the data array
|
|
shellsort(d()) ' sort data array
|
|
|
|
i = 0
|
|
For y = d(0) \ 10 To d(UBound(d)) \ 10
|
|
Print Using "#### |"; y;
|
|
Do
|
|
x = d(i) \ 10 ' \ = integer division
|
|
If y = x Then
|
|
Print Using "##"; d(i) Mod 10;
|
|
i = i + 1
|
|
Else
|
|
Exit Do
|
|
End If
|
|
Loop While i <= UBound(d)
|
|
Print ' force linefeed
|
|
Next
|
|
|
|
' empty keyboard buffer
|
|
While Inkey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|