|
=={{header|ALGOL 68}}==
Based on...
{{trans|Lua}}...with somebut refactoringcalculates soand itoptionally can calculateprints the sequence lengthsequences without actually storing the sequencethem.<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 prints an element of a Farey Sequence #
MODEPROC FRACprint element = STRUCT( INT numa, denb );VOID:
# calculates the next element ofprint( the( farey" sequence", ofwhole( ordera, n0 ), "/", whole( b, 0 ) #) );
PROC# nextreturns fareythe elementlength =of (the REFFarey INTSequence a,of b,order cn, d,optionally INT n )VOID:#
# # ifprinting it necessary # ▼
PROC farey sequence length = ( INT kn, BOOL print = ( n + bsequence ) OVER d;INT:
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 #
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;
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 Sequence 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;
▲ IF length >= UPBprint resultsequence THEN
▲ print( ( whole( n, result-2 ), ": =" new) result);
▲ d := ( k *print delement( )a, -b old b)
INT length := 1;
WHILE c <= n DO
nextINT fareyk element( a, b, c, d,= ( n + b ) OVER d;
▲ c := ( k *INT cold )a -= a, old ab = b;
▲ a c := ( k * c ) - old a;
▲ b d := ( k * d ) - old b;
▲ nextIF fareyprint sequence THEN print element( a, b , c,) d, n )FI;
length +:= 1
OD;
IF print sequence THEN print( ( newline ) ) FI;▼
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;
END # print farey sequence # ;
# task #
FOR i TO 11 DO farey sequence length( i, TRUE ) OD;
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( farey sequence length( n, FALSE ), -6 )
, newline
)
|