52 lines
854 B
Text
52 lines
854 B
Text
Function farey(n As Long, descending As Long) As Long
|
|
|
|
Dim a, b, c, d, k As Long
|
|
Dim aa, bb, cc, dd, count As Long
|
|
|
|
b = 1
|
|
c = 1
|
|
d = n
|
|
count = 0
|
|
|
|
If descending = True Then
|
|
a = 1
|
|
c = n - 1
|
|
End If
|
|
|
|
count += 1
|
|
If n < 12 Then Print Str(a); "/"; Str(b); " ";
|
|
|
|
While ((c <= n) And Not descending) Or ((a > 0) And descending)
|
|
aa = a
|
|
bb = b
|
|
cc = c
|
|
dd = d
|
|
k = (n + b) \ d
|
|
a = cc
|
|
b = dd
|
|
c = k * cc - aa
|
|
d = k * dd - bb
|
|
count += 1
|
|
If n < 12 Then Print Str(a); "/"; Str(b); " ";
|
|
Wend
|
|
|
|
If n < 12 Then Print
|
|
|
|
Return count
|
|
|
|
End Function
|
|
|
|
Public Sub Main()
|
|
|
|
Dim i As Long
|
|
|
|
For i = 1 To 11
|
|
Print "F"; Str(i); " = ";
|
|
farey(i, False)
|
|
Next
|
|
Print
|
|
For i = 100 To 1000 Step 100
|
|
Print "F"; Str(i); IIf(i <> 1000, " ", ""); " = "; Format$(farey(i, False), "######")
|
|
Next
|
|
|
|
End
|