Farey sequence: Difference between revisions
Added QBasic
No edit summary |
(Added QBasic) |
||
(21 intermediate revisions by 11 users not shown) | |||
Line 228:
1000 | 304193
</pre>
=={{header|Arturo}}==
<syntaxhighlight lang="arturo">farey: function [n][
f1: [0 1]
f2: @[1 n]
result: @["0/1" ~"1/|n|"]
while [1 < f2\1][
k: (n + f1\1) / f2\1
aux: f1
f1: f2
f2: @[
(f2\0 * k) - aux\0,
(f2\1 * k) - aux\1
]
'result ++ (to :string f2\0) ++ "/" ++ (to :string f2\1)
]
return result
]
loop 1..11 'i ->
print [pad (to :string i) ++ ":" 3 join.with:" " farey i]
print ""
print "Number of fractions in the Farey sequence:"
loop range.step: 100 100 1000 'r ->
print "F(" ++ (pad (to :string r) 4) ++ ") = " ++ (pad to :string size farey r 6)
</syntaxhighlight>
{{out}}
<pre> 1: 0/1 1/1
2: 0/1 1/2 1/1
3: 0/1 1/3 1/2 2/3 1/1
4: 0/1 1/4 1/3 1/2 2/3 3/4 1/1
5: 0/1 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 1/1
6: 0/1 1/6 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 5/6 1/1
7: 0/1 1/7 1/6 1/5 1/4 2/7 1/3 2/5 3/7 1/2 4/7 3/5 2/3 5/7 3/4 4/5 5/6 6/7 1/1
8: 0/1 1/8 1/7 1/6 1/5 1/4 2/7 1/3 3/8 2/5 3/7 1/2 4/7 3/5 5/8 2/3 5/7 3/4 4/5 5/6 6/7 7/8 1/1
9: 0/1 1/9 1/8 1/7 1/6 1/5 2/9 1/4 2/7 1/3 3/8 2/5 3/7 4/9 1/2 5/9 4/7 3/5 5/8 2/3 5/7 3/4 7/9 4/5 5/6 6/7 7/8 8/9 1/1
10: 0/1 1/10 1/9 1/8 1/7 1/6 1/5 2/9 1/4 2/7 3/10 1/3 3/8 2/5 3/7 4/9 1/2 5/9 4/7 3/5 5/8 2/3 7/10 5/7 3/4 7/9 4/5 5/6 6/7 7/8 8/9 9/10 1/1
11: 0/1 1/11 1/10 1/9 1/8 1/7 1/6 2/11 1/5 2/9 1/4 3/11 2/7 3/10 1/3 4/11 3/8 2/5 3/7 4/9 5/11 1/2 6/11 5/9 4/7 3/5 5/8 7/11 2/3 7/10 5/7 8/11 3/4 7/9 4/5 9/11 5/6 6/7 7/8 8/9 9/10 10/11 1/1
Number of fractions in the Farey sequence:
F( 100) = 3045
F( 200) = 12233
F( 300) = 27399
F( 400) = 48679
F( 500) = 76117
F( 600) = 109501
F( 700) = 149019
F( 800) = 194751
F( 900) = 246327
F(1000) = 304193</pre>
=={{header|AWK}}==
Line 284 ⟶ 339:
</pre>
=={{header|
==={{header|BASIC256}}===
<syntaxhighlight lang="basic256">for i = 1 to 11
print "F"; i; " = ";
Line 319 ⟶ 375:
if n < 12 then print else print rjust(cont,7)
end subroutine</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
==={{header|QBasic}}===
{{works with|QBasic|1.1}}
{{works with|QuickBasic|4.5}}
<syntaxhighlight lang="qbasic">FUNCTION farey (n, dsc)
b = 1: c = 1: d = n
IF dsc = TRUE THEN a = 1: c = n - 1
cnt = cnt + 1
IF n < 12 THEN PRINT a; "/"; b;
WHILE ((c <= n) AND NOT dsc) OR ((a > 0) AND dsc)
aa = a: bb = b: cc = c: dd = d
k = (n + b) \ d
a = cc: b = dd: c = k * cc - aa: d = k * dd - bb
cnt = cnt + 1
IF n < 12 THEN PRINT a; "/"; b;
WEND
IF n < 12 THEN PRINT
farey = cnt
END FUNCTION
CLS
CONST TRUE = -1: FALSE = NOT TRUE
FOR i = 1 TO 9
PRINT USING "F# ="; i;
t = farey(i, FALSE)
NEXT i
FOR i = 10 TO 11
PRINT USING "F## ="; i;
t = farey(i, FALSE)
NEXT i
PRINT
FOR i = 100 TO 900 STEP 100
PRINT USING "F#### = ######"; i; farey(i, FALSE)
NEXT i
PRINT USING "F1000 = ######"; farey(1000, FALSE)</syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
Line 848 ⟶ 947:
=={{header|Delphi}}==
See [https://www.rosettacode.org/wiki/Farey_sequence#Pascal Pascal].
=={{header|EasyLang}}==
{{trans|AWK}}
<syntaxhighlight lang="easylang">
proc farey n . .
b = 1 ; c = 1 ; d = n
write n & ": "
repeat
if n <= 11
write " " & a & "/" & b
.
until c > n
k = (n + b) div d
aa = c ; bb = d ; cc = k * c - a ; dd = k * d - b
a = aa ; b = bb ; c = cc ; d = dd
items += 1
.
if n > 11
print items & " items"
else
print ""
.
.
for i = 1 to 11
farey i
.
for i = 100 step 100 to 1000
farey i
.
</syntaxhighlight>
=={{header|EchoLisp}}==
Line 1,568 ⟶ 1,698:
=={{header|Fōrmulæ}}==
{{FormulaeEntry|page=https://formulae.org/?script=examples/Farey_sequence}}
'''Solution'''
[[File:Fōrmulæ - Farey sequence 01.png]]
'''Case 1.''' Compute and show the Farey sequence for orders 1 through 11 (inclusive).
[[File:Fōrmulæ - Farey sequence 02.png]]
[[File:Fōrmulæ - Farey sequence 03.png]]
'''Case 2.''' Compute and display the number of fractions in the Farey sequence for order 100 through 1,000 (inclusive) by hundreds.
[[File:Fōrmulæ - Farey sequence 04.png]]
[[File:Fōrmulæ - Farey sequence 05.png]]
=={{header|Gambas}}==
{{trans|FreeBASIC}}
<syntaxhighlight lang="vbnet">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 </syntaxhighlight>
{{out}}
<pre>Same as FreeBASIC entry.</pre>
=={{header|Go}}==
Line 2,001 ⟶ 2,201:
=={{header|langur}}==
<syntaxhighlight lang="langur">val .farey = fn(.n) {
var .a, .b, .c, .d = 0, 1, 1, .n
while[=[[0, 1]]] .c <= .n {
val .k = (.n + .b) // .d
.a, .b, .c, .d = .c, .d, .k
_while ~= [[.a, .b]]
}
}
val .testFarey =
writeln "Farey sequence for orders 1 through 11"
for .i of 11 {
writeln $"\.i:2;: ", join " ", map(fn(.f) $"\.f[1];/\.f[2];", .farey(.i))
}
}
Line 2,170 ⟶ 2,367:
{3045, 12233, 27399, 48679, 76117, 109501, 149019, 194751, 246327, 304193}</pre>
=={{header|MATLAB}}==
{{trans|Kotlin}}
<syntaxhighlight lang="MATLAB">
clear all;close all;clc;
% Print Farey sequences for 1 to 11
for i = 1:11
farey_sequence = farey(i);
fprintf('%2d: %s\n', i, strjoin(farey_sequence, ' '));
end
fprintf('\n');
% Print the number of fractions in Farey sequences for 100 to 1000 step 100
for i = 100:100:1000
farey_sequence = farey(i);
fprintf('%4d: %6d fractions\n', i, length(farey_sequence));
end
function farey_sequence = farey(n)
a = 0;
b = 1;
c = 1;
d = n;
farey_sequence = {[num2str(a) '/' num2str(b)]}; % Initialize the sequence with "0/1"
while c <= n
k = fix((n + b) / d);
aa = a;
bb = b;
a = c;
b = d;
c = k * c - aa;
d = k * d - bb;
farey_sequence{end+1} = [num2str(a) '/' num2str(b)]; % Append the fraction to the sequence
end
end
</syntaxhighlight>
{{out}}
<pre>
1: 0/1 1/1
2: 0/1 1/2 1/1
3: 0/1 1/3 1/2 2/3 1/1
4: 0/1 1/4 1/3 1/2 2/3 3/4 1/1
5: 0/1 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 1/1
6: 0/1 1/6 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 5/6 1/1
7: 0/1 1/7 1/6 1/5 1/4 2/7 1/3 2/5 3/7 1/2 4/7 3/5 2/3 5/7 3/4 4/5 5/6 6/7 1/1
8: 0/1 1/8 1/7 1/6 1/5 1/4 2/7 1/3 3/8 2/5 3/7 1/2 4/7 3/5 5/8 2/3 5/7 3/4 4/5 5/6 6/7 7/8 1/1
9: 0/1 1/9 1/8 1/7 1/6 1/5 2/9 1/4 2/7 1/3 3/8 2/5 3/7 4/9 1/2 5/9 4/7 3/5 5/8 2/3 5/7 3/4 7/9 4/5 5/6 6/7 7/8 8/9 1/1
10: 0/1 1/10 1/9 1/8 1/7 1/6 1/5 2/9 1/4 2/7 3/10 1/3 3/8 2/5 3/7 4/9 1/2 5/9 4/7 3/5 5/8 2/3 7/10 5/7 3/4 7/9 4/5 5/6 6/7 7/8 8/9 9/10 1/1
11: 0/1 1/11 1/10 1/9 1/8 1/7 1/6 2/11 1/5 2/9 1/4 3/11 2/7 3/10 1/3 4/11 3/8 2/5 3/7 4/9 5/11 1/2 6/11 5/9 4/7 3/5 5/8 7/11 2/3 7/10 5/7 8/11 3/4 7/9 4/5 9/11 5/6 6/7 7/8 8/9 9/10 10/11 1/1
100: 3045 fractions
200: 12233 fractions
300: 27399 fractions
400: 48679 fractions
500: 76117 fractions
600: 109501 fractions
700: 149019 fractions
800: 194751 fractions
900: 246327 fractions
1000: 304193 fractions
</pre>
=={{header|Maxima}}==
<syntaxhighlight lang="maxima">
farey(n):=if n=1 then ["0/1","1/1"] else block(
create_list([i,j],i,0,n-1,j,1,n),
map(lambda([x],if x[1]=0 and x[2]#1 then false else if x[1]=x[2] and x[1]#1 then false else if x[1]<=x[2] then x),%%),
delete(false,%%),
unique(map(lambda([x],x[1]/x[2]),%%)),
append(rest(append(["0/1"],rest(%%)),-1),["1/1"])
)$
/* Test cases */
/* Sequences from order 1 through 11 */
farey(1);
farey(2);
farey(3);
farey(4);
farey(5);
farey(6);
farey(7);
farey(8);
farey(9);
farey(10);
farey(11);
/* Length of sequences from order 100 through, 1000 by hundreds */
length(farey(100));
length(farey(200));
length(farey(300));
length(farey(400));
length(farey(500));
length(farey(600));
length(farey(700));
length(farey(800));
length(farey(900));
length(farey(1000));
</syntaxhighlight>
{{out}}
<pre>
["0/1","1/1"]
["0/1",1/2,"1/1"]
["0/1",1/3,1/2,2/3,"1/1"]
["0/1",1/4,1/3,1/2,2/3,3/4,"1/1"]
["0/1",1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,"1/1"]
["0/1",1/6,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,5/6,"1/1"]
["0/1",1/7,1/6,1/5,1/4,2/7,1/3,2/5,3/7,1/2,4/7,3/5,2/3,5/7,3/4,4/5,5/6,6/7,"1/1"]
["0/1",1/8,1/7,1/6,1/5,1/4,2/7,1/3,3/8,2/5,3/7,1/2,4/7,3/5,5/8,2/3,5/7,3/4,4/5,5/6,6/7,7/8,"1/1"]
["0/1",1/9,1/8,1/7,1/6,1/5,2/9,1/4,2/7,1/3,3/8,2/5,3/7,4/9,1/2,5/9,4/7,3/5,5/8,2/3,5/7,3/4,7/9,4/5,5/6,6/7,7/8,8/9,"1/1"]
["0/1",1/10,1/9,1/8,1/7,1/6,1/5,2/9,1/4,2/7,3/10,1/3,3/8,2/5,3/7,4/9,1/2,5/9,4/7,3/5,5/8,2/3,7/10,5/7,3/4,7/9,4/5,5/6,6/7,7/8,8/9,9/10,"1/1"]
["0/1",1/11,1/10,1/9,1/8,1/7,1/6,2/11,1/5,2/9,1/4,3/11,2/7,3/10,1/3,4/11,3/8,2/5,3/7,4/9,5/11,1/2,6/11,5/9,4/7,3/5,5/8,7/11,2/3,7/10,5/7,8/11,3/4,7/9,4/5,9/11,5/6,6/7,7/8,8/9,9/10,10/11,"1/1"]
3045
12233
27399
48679
76117
109501
149019
194751
246327
304193
</pre>
=={{header|Nim}}==
Line 3,470 ⟶ 3,792:
F900 = 246327
F1000 = 304193
</pre>
=={{header|RPL}}==
{{trans|Lua}}
{{works with|Halcyon Calc|4.2.7}}
{| class="wikitable"
! RPL code
! Comment
|-
|
≪ "'" OVER RE →STR + "/" + SWAP IM + STR→
≫ ''''C→EXP'''' STO
≪ → n
≪ { '0/1' }
0 1 R→C 1 n R→C
'''WHILE''' DUP RE n ≤ '''REPEAT'''
OVER IM n + OVER IM / FLOOR
OVER * ROT -
ROT 3 PICK '''C→EXP''' + ROT ROT
'''END'''
DROP2
≫ ≫ 'FAREY' STO
|
''' C→EXP''' ''( (a,b) -- 'a/b' )''
.
.
'''FAREY''' ''( n -- { f1..fk } ) ''
local farTab = { {0, 1} }
local a, b, c, d, k = 0, 1, 1, n
while c <= n do
k = math.floor((n + b) / d)
a, b, c, d = c, d, k * c - a, k * d - b
table.insert(farTab, {a, b})
end
return farTab - only
.
|}
{{in}}
<pre>
1 FAREY
11 FAREY
100 FAREY SIZE
</pre>
{{out}}
<pre>
3: { '0/1' '1/11' }
2: { '0/1' '1/11' '1/10' '1/9' '1/8' '1/7' '1/6' '2/11' '1/5' '2/9' '1/4' '3/11' '2/7' '3/10' '1/3' '4/11' '3/8' '2/5' '3/7' '4/9' '5/11' '1/2' '6/11' '5/9' '4/7' '3/5' '5/8' '7/11' '2/3' '7/10' '5/7' '8/11' '3/4' '7/9' '4/5' '9/11' '5/6' '6/7' '7/8' '8/9' '9/10' '10/11' '1/1' }
1: 3045
</pre>
To count the number of fractions above F(100), thus avoiding to handle huge lists in memory, the above code must be slightly changed into:
≪ → n
≪ 1
0 1 R→C 1 n R→C
'''WHILE''' DUP RE n ≤ '''REPEAT'''
OVER IM n + OVER IM / FLOOR
OVER * ROT -
ROT 1 + ROT ROT
'''END'''
DROP2
≫ ≫ '∑FAREY' STO
{{in}}
<pre>
≪ {} 100 700 FOR n n ∑FAREY + 100 STEP ≫ EVAL
≪ {} 800 1000 FOR n n ∑FAREY + 100 STEP ≫ EVAL
</pre>
{{out}}
<pre>
2: { 3045 12233 27399 48679 76117 109501 149019 }
1: { 194751 246327 304193 }
</pre>
Line 4,036 ⟶ 4,428:
</pre>
=={{header|uBasic/4tH}}==
{{Trans|BASIC256}}
<syntaxhighlight lang="qbasic">For i = 1 To 11
Print "F"; i; " = ";
Proc _Farey(i, 0)
Next
Print
For i = 100 To 1000 Step 100
Print "F"; i;
If i # 1000 Then Print " ";
Print " = ";
Proc _Farey (i, 0)
Next
End
_Farey
Param (2)
Local (11)
c@ = 0 : d@ = 1 : e@ = 1 : f@ = a@ : g@ = 0
h@ = 0
If b@ = 1 Then c@ = 1 : e@ = a@ - 1
h@ = h@ + 1
If a@ < 12 Then Print c@; "/"; d@; " ";
Do While (((e@ > a@) = 0) * (b@ = 0)) + ((c@ > 0) * b@)
i@ = c@ : j@ = d@ : k@ = e@ : l@ = f@
m@ = (a@ + d@) / f@
h@ = h@ + 1
c@ = k@ : d@ = l@ : e@ = m@ * k@ - i@ : f@ = m@ * l@ - j@
If a@ < 12 Then Print c@; "/"; d@; " ";
Loop
If a@ < 12 Then
Print
Else
Print Using "______#"; h@
EndIf
Return</syntaxhighlight>
=={{header|Vala}}==
{{trans|Nim}}
Line 4,181 ⟶ 4,616:
{{trans|Go}}
{{libheader|Wren-math}}
{{libheader|Wren-
{{libheader|Wren-fmt}}
{{libheader|Wren-rat}}
<syntaxhighlight lang="
import "./
import "./fmt" for Fmt
import "./rat" for Rat
var f //recursive
|