Farey sequence: Difference between revisions
Added Algol 68
(Farey sequence in Yabasic) |
(Added Algol 68) |
||
Line 87:
900: 246327 items
1000: 304193 items
</pre>
=={{header|ALGOL 68}}==
{{trans|Lua}}...with some refactoring so it can calculate the sequence length without actually storing the sequence.<br>
n^2 ( very approximately 3n^2/pi ) is used as the initial estimate of how many elements the sequence will contain, if this proves too small, a larger array is allocated. It seems that the estimate is enough for all the sequences constructed for the task ( apart from F1 which is treated as a special case ).
<lang algol68>BEGIN # construct some Farey Sequences and calculate their lengths #
# rational number mode #
MODE FRAC = STRUCT( INT num, den );
# calculates the next element of the farey sequence of order n #
PROC next farey element = ( REF INT a, b, c, d, INT n )VOID:
BEGIN
INT k = ( n + b ) OVER d;
INT old a = a;
INT old b = b;
a := c;
b := d;
c := ( k * c ) - old a;
d := ( k * d ) - old b
END # next farey element # ;
# returns the Farey Sequence of order n #
PROC farey sequence = ( INT n )[]FRAC:
IF n < 1 THEN []FRAC()
ELSE
# note the length of the sequence tends towards 3n^2 / pi as #
# n tends towards infinity - we will approximate this with #
# n^2 with 1 as a special case but increase the array size #
# if necessary #
FLEX[ 1 : IF n = 1 THEN 2 ELSE n * n FI ]FRAC result;
PROC ensure result is long enough = VOID:
IF length >= UPB result THEN
# must increase the length of the result #
[ 1 : UPB result + 100 ]FRAC new result;
new result[ 1 : UPB result ] := result;
result := new result
FI # ensure result is long enough #;
INT a := 0, b := 1, c := 1, d := n;
INT length := 1;
result[ 1 ] := FRAC( 0, 1 );
WHILE c <= n DO
next farey element( a, b, c, d, n );
ensure result is long enough;
result[ length +:= 1 ] := FRAC( a, b )
OD;
result[ 1 : length ]
FI # farey sequence # ;
# returns the length of the Farey Seuernce of length n #
PROC farey sequence length = ( INT n )INT:
IF n < 1 THEN 0
ELSE
# calculate the sequence without returning it #
INT a := 0, b := 1, c := 1, d := n;
INT length := 1;
WHILE c <= n DO
next farey element( a, b, c, d, n );
length +:= 1
OD;
length
FI # farey sequence length # ;
# prints the Farey Sequence of order n #
PROC print farey sequence = ( INT n )VOID:
BEGIN
print( ( whole( n, -2 ), ":" ) );
[]FRAC s = farey sequence( n );
FOR i TO UPB s DO
FRAC f = s[ i ];
print( ( " ", whole( num OF f, 0 ), "/", whole( den OF f, 0 ) ) )
OD;
print( ( newline ) )
END # print farey sequence # ;
# task #
FOR i TO 11 DO
print farey sequence( i )
OD;
FOR n FROM 100 BY 100 TO 1 000 DO
INT length = farey sequence length( n );
print( ( "Farey Sequence of order ", whole( n, -4 )
, " has length: ", whole( length, -6 )
, newline
)
)
OD
END</lang>
{{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
Farey Sequence of order 100 has length: 3045
Farey Sequence of order 200 has length: 12233
Farey Sequence of order 300 has length: 27399
Farey Sequence of order 400 has length: 48679
Farey Sequence of order 500 has length: 76117
Farey Sequence of order 600 has length: 109501
Farey Sequence of order 700 has length: 149019
Farey Sequence of order 800 has length: 194751
Farey Sequence of order 900 has length: 246327
Farey Sequence of order 1000 has length: 304193
</pre>
| |||