aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Task/Farey-sequence/00-META.yaml Normal file
View file

@ -0,0 +1,2 @@
---
from: http://rosettacode.org/wiki/Farey_sequence

40
Task/Farey-sequence/00-TASK.txt Normal file
View file

@ -0,0 +1,40 @@
The &nbsp; [[wp:Farey sequence|Farey sequence]] &nbsp; ''' ''F''<sub>n</sub>''' &nbsp; of order &nbsp; '''n''' &nbsp; is the sequence of completely reduced fractions between &nbsp; '''0''' &nbsp; and &nbsp; '''1''' &nbsp; which, when in lowest terms, have denominators less than or equal to &nbsp; '''n''', &nbsp; arranged in order of increasing size.
The &nbsp; ''Farey sequence'' &nbsp; is sometimes incorrectly called a &nbsp; ''Farey series''.
Each Farey sequence:
:::* &nbsp; starts with the value &nbsp; '''0''' &nbsp; (zero), &nbsp; denoted by the fraction &nbsp; &nbsp; <math> \frac{0}{1} </math>
:::* &nbsp; ends with the value &nbsp; '''1''' &nbsp; (unity), &nbsp; denoted by the fraction &nbsp; <math> \frac{1}{1}</math>.
The Farey sequences of orders &nbsp; '''1''' &nbsp; to &nbsp; '''5''' &nbsp; are:
:::: <math>{\bf\it{F}}_1 = \frac{0}{1}, \frac{1}{1}</math>
:<br>
:::: <math>{\bf\it{F}}_2 = \frac{0}{1}, \frac{1}{2}, \frac{1}{1}</math>
:<br>
:::: <math>{\bf\it{F}}_3 = \frac{0}{1}, \frac{1}{3}, \frac{1}{2}, \frac{2}{3}, \frac{1}{1}</math>
:<br>
:::: <math>{\bf\it{F}}_4 = \frac{0}{1}, \frac{1}{4}, \frac{1}{3}, \frac{1}{2}, \frac{2}{3}, \frac{3}{4}, \frac{1}{1}</math>
:<br>
:::: <math>{\bf\it{F}}_5 = \frac{0}{1}, \frac{1}{5}, \frac{1}{4}, \frac{1}{3}, \frac{2}{5}, \frac{1}{2}, \frac{3}{5}, \frac{2}{3}, \frac{3}{4}, \frac{4}{5}, \frac{1}{1}</math>
;Task
* &nbsp; Compute and show the Farey sequence for orders &nbsp; '''1''' &nbsp; through &nbsp; '''11''' &nbsp; (inclusive).
* &nbsp; Compute and display the &nbsp; ''number'' &nbsp; of fractions in the Farey sequence for order &nbsp; '''100''' &nbsp; through &nbsp; '''1,000''' &nbsp; (inclusive) &nbsp; by hundreds.
* &nbsp; Show the fractions as &nbsp; <big> '''n/d''' </big> &nbsp; (using the solidus [or slash] to separate the numerator from the denominator).
The length &nbsp; (the number of fractions) &nbsp; of a Farey sequence asymptotically approaches:
::::::::::: <big><big> 3 &times; n<sup>2</sup> &nbsp;<big> ÷ </big>&nbsp; <big><math>\pi</math></big><sup>2</sup> </big></big>
;See also:
* &nbsp; OEIS sequence &nbsp; [[oeis:A006842|A006842 numerators of Farey series of order 1, 2, ···]]
* &nbsp; OEIS sequence &nbsp; [[oeis:A006843|A006843 denominators of Farey series of order 1, 2, ···]]
* &nbsp; OEIS sequence &nbsp; [[oeis:A005728|A005728 number of fractions in Farey series of order n]]
* &nbsp; MathWorld entry &nbsp; [http://mathworld.wolfram.com/FareySequence.html Farey sequence]
* &nbsp; Wikipedia &nbsp; entry &nbsp; [[wp:Farey_sequence|Farey sequence]]
<br><br>

19
Task/Farey-sequence/11l/farey-sequence.11l Normal file
View file

@ -0,0 +1,19 @@
F farey(n)
V a = 0
V b = 1
V c = 1
V d = n
V far = ‘0/1 ’
V farn = 1
L c <= n
V k = (n + b) I/ d
(a, b, c, d) = (c, d, k * c - a, k * d - b)
far ‘’= a‘/’b‘ ’
farn++
R (far, farn)
L(i) 1..11
print(i‘: ’farey(i)[0])
L(i) (100..1000).step(100)
print(i‘: ’farey(i)[1]‘ items’)

38
Task/Farey-sequence/ALGOL-68/farey-sequence.alg Normal file
View file

@ -0,0 +1,38 @@
BEGIN # construct some Farey Sequences and calculate their lengths #
# prints an element of a Farey Sequence #
PROC print element = ( INT a, b )VOID:
print( ( " ", whole( a, 0 ), "/", whole( b, 0 ) ) );
# returns the length of the Farey Sequence of order n, optionally #
# printing it #
PROC farey sequence length = ( INT n, BOOL print sequence )INT:
IF n < 1 THEN 0
ELSE
INT a := 0, b := 1, c := 1, d := n;
IF print sequence THEN
print( ( whole( n, -2 ), ":" ) );
print element( a, b )
FI;
INT length := 1;
WHILE c <= n DO
INT k = ( n + b ) OVER d;
INT old a = a, old b = b;
a := c;
b := d;
c := ( k * c ) - old a;
d := ( k * d ) - old b;
IF print sequence THEN print element( a, b ) FI;
length +:= 1
OD;
IF print sequence THEN print( ( newline ) ) FI;
length
FI # farey sequence length # ;
# task #
FOR i TO 11 DO farey sequence length( i, TRUE ) OD;
FOR n FROM 100 BY 100 TO 1 000 DO
print( ( "Farey Sequence of order ", whole( n, -4 )
, " has length: ", whole( farey sequence length( n, FALSE ), -6 )
, newline
)
)
OD
END

3
Task/Farey-sequence/APL/farey-sequence.apl Normal file
View file

@ -0,0 +1,3 @@
farey←{{⍵[⍋⍵]}∪∊{(0,⍳⍵)÷⍵}¨⍳⍵}
fract←{1∧(0(⍵=0)+⊂⍵)*1 ¯1}
print←{{(⍕⍺),'/',(⍕⍵),' '}⌿↑fract farey ⍵}

27
Task/Farey-sequence/AWK/farey-sequence.awk Normal file
View file

@ -0,0 +1,27 @@
# syntax: GAWK -f FAREY_SEQUENCE.AWK
BEGIN {
for (i=1; i<=11; i++) {
farey(i); printf("\n")
}
for (i=100; i<=1000; i+=100) {
printf(" %d items\n",farey(i))
}
exit(0)
}
function farey(n, a,aa,b,bb,c,cc,d,dd,items,k) {
a = 0; b = 1; c = 1; d = n
printf("%d:",n)
if (n <= 11) {
printf(" %d/%d",a,b)
}
while (c <= n) {
k = int((n+b)/d)
aa = c; bb = d; cc = k*c-a; dd = k*d-b
a = aa; b = bb; c = cc; d = dd
items++
if (n <= 11) {
printf(" %d/%d",a,b)
}
}
return(1+items)
}

26
Task/Farey-sequence/Arturo/farey-sequence.arturo Normal file
View file

@ -0,0 +1,26 @@
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)

34
Task/Farey-sequence/BASIC256/farey-sequence.basic Normal file
View file

@ -0,0 +1,34 @@
for i = 1 to 11
print "F"; i; " = ";
call farey(i, FALSE)
next i
print
for i = 100 to 1000 step 100
print "F"; i;
if i <> 1000 then print " "; else print "";
print " = ";
call farey(i, FALSE)
next i
end
subroutine farey(n, descending)
a = 0 : b = 1 : c = 1 : d = n : k = 0
cont = 0
if descending = TRUE then
a = 1 : c = n -1
end if
cont += 1
if n < 12 then print a; "/"; 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
cont += 1
if n < 12 then print a; "/"; b; " ";
end while
if n < 12 then print else print rjust(cont,7)
end subroutine

49
Task/Farey-sequence/C++/farey-sequence-1.cpp Normal file
View file

@ -0,0 +1,49 @@
#include <iostream>
struct fraction {
fraction(int n, int d) : numerator(n), denominator(d) {}
int numerator;
int denominator;
};
std::ostream& operator<<(std::ostream& out, const fraction& f) {
out << f.numerator << '/' << f.denominator;
return out;
}
class farey_sequence {
public:
explicit farey_sequence(int n) : n_(n), a_(0), b_(1), c_(1), d_(n) {}
fraction next() {
// See https://en.wikipedia.org/wiki/Farey_sequence#Next_term
fraction result(a_, b_);
int k = (n_ + b_)/d_;
int next_c = k * c_ - a_;
int next_d = k * d_ - b_;
a_ = c_;
b_ = d_;
c_ = next_c;
d_ = next_d;
return result;
}
bool has_next() const { return a_ <= n_; }
private:
int n_, a_, b_, c_, d_;
};
int main() {
for (int n = 1; n <= 11; ++n) {
farey_sequence seq(n);
std::cout << n << ": " << seq.next();
while (seq.has_next())
std::cout << ' ' << seq.next();
std::cout << '\n';
}
for (int n = 100; n <= 1000; n += 100) {
int count = 0;
for (farey_sequence seq(n); seq.has_next(); seq.next())
++count;
std::cout << n << ": " << count << '\n';
}
return 0;
}

40
Task/Farey-sequence/C++/farey-sequence-2.cpp Normal file
View file

@ -0,0 +1,40 @@
#include <iostream>
#include <list>
#include <utility>
struct farey_sequence: public std::list<std::pair<uint, uint>> {
explicit farey_sequence(uint n) : order(n) {
push_back(std::pair(0, 1));
uint a = 0, b = 1, c = 1, d = n;
while (c <= n) {
const uint k = (n + b) / d;
const uint next_c = k * c - a;
const uint next_d = k * d - b;
a = c;
b = d;
c = next_c;
d = next_d;
push_back(std::pair(a, b));
}
}
const uint order;
};
std::ostream& operator<<(std::ostream &out, const farey_sequence &s) {
out << s.order << ":";
for (const auto &f : s)
out << ' ' << f.first << '/' << f.second;
return out;
}
int main() {
for (uint i = 1u; i <= 11u; ++i)
std::cout << farey_sequence(i) << std::endl;
for (uint i = 100u; i <= 1000u; i += 100u) {
const auto s = farey_sequence(i);
std::cout << s.order << ": " << s.size() << " items" << std::endl;
}
return EXIT_SUCCESS;
}

26
Task/Farey-sequence/C-sharp/farey-sequence.cs Normal file
View file

@ -0,0 +1,26 @@
using System;
using System.Collections.Generic;
using System.Linq;
public static class FareySequence
{
public static void Main() {
for (int i = 1; i <= 11; i++) {
Console.WriteLine($"F{i}: " + string.Join(", ", Generate(i).Select(f => $"{f.num}/{f.den}")));
}
for (int i = 100; i <= 1000; i+=100) {
Console.WriteLine($"F{i} has {Generate(i).Count()} terms.");
}
}
public static IEnumerable<(int num, int den)> Generate(int i) {
var comparer = Comparer<(int n, int d)>.Create((a, b) => (a.n * b.d).CompareTo(a.d * b.n));
var seq = new SortedSet<(int n, int d)>(comparer);
for (int d = 1; d <= i; d++) {
for (int n = 0; n <= d; n++) {
seq.Add((n, d));
}
}
return seq;
}
}

61
Task/Farey-sequence/C/farey-sequence.c Normal file
View file

@ -0,0 +1,61 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
void farey(int n)
{
typedef struct { int d, n; } frac;
frac f1 = {0, 1}, f2 = {1, n}, t;
int k;
printf("%d/%d %d/%d", 0, 1, 1, n);
while (f2.n > 1) {
k = (n + f1.n) / f2.n;
t = f1, f1 = f2, f2 = (frac) { f2.d * k - t.d, f2.n * k - t.n };
printf(" %d/%d", f2.d, f2.n);
}
putchar('\n');
}
typedef unsigned long long ull;
ull *cache;
size_t ccap;
ull farey_len(int n)
{
if (n >= ccap) {
size_t old = ccap;
if (!ccap) ccap = 16;
while (ccap <= n) ccap *= 2;
cache = realloc(cache, sizeof(ull) * ccap);
memset(cache + old, 0, sizeof(ull) * (ccap - old));
} else if (cache[n])
return cache[n];
ull len = (ull)n*(n + 3) / 2;
int p, q = 0;
for (p = 2; p <= n; p = q) {
q = n/(n/p) + 1;
len -= farey_len(n/p) * (q - p);
}
cache[n] = len;
return len;
}
int main(void)
{
int n;
for (n = 1; n <= 11; n++) {
printf("%d: ", n);
farey(n);
}
for (n = 100; n <= 1000; n += 100)
printf("%d: %llu items\n", n, farey_len(n));
n = 10000000;
printf("\n%d: %llu items\n", n, farey_len(n));
return 0;
}

20
Task/Farey-sequence/Common-Lisp/farey-sequence.lisp Normal file
View file

@ -0,0 +1,20 @@
(defun farey (n)
(labels ((helper (begin end)
(let ((med (/ (+ (numerator begin) (numerator end))
(+ (denominator begin) (denominator end)))))
(if (<= (denominator med) n)
(append (helper begin med)
(list med)
(helper med end))))))
(append (list 0) (helper 0 1) (list 1))))
;; Force printing of integers in X/1 format
(defun print-ratio (stream object &optional colonp at-sign-p)
(format stream "~d/~d" (numerator object) (denominator object)))
(loop for i from 1 to 11 do
(format t "~a: ~{~/print-ratio/ ~}~%" i (farey i)))
(loop for i from 100 to 1001 by 100 do
(format t "Farey sequence of order ~a has ~a terms.~%" i (length (farey i))))

23
Task/Farey-sequence/Crystal/farey-sequence-1.crystal Normal file
View file

@ -0,0 +1,23 @@
require "big"
def farey(n)
a, b, c, d = 0, 1, 1, n
fracs = [] of BigRational
fracs << BigRational.new(0,1)
while c <= n
k = (n + b) // d
a, b, c, d = c, d, k * c - a, k * d - b
fracs << BigRational.new(a,b)
end
fracs.uniq.sort
end
puts "Farey sequence for order 1 through 11 (inclusive):"
(1..11).each do |n|
puts "F(#{n}): 0/1 #{farey(n)[1..-2].join(" ")} 1/1"
end
puts "Number of fractions in the Farey sequence:"
(100..1000).step(100) do |i|
puts "F(%4d) =%7d" % [i, farey(i).size]
end

20
Task/Farey-sequence/Crystal/farey-sequence-2.crystal Normal file
View file

@ -0,0 +1,20 @@
require "big"
def farey(n, length = false)
a = [] of BigRational
if length
(n*(n+3))//2 - (2..n).sum{ |k| farey(n//k, true).as(Int32) }
else
(1..n).each{ |k| (0..k).each{ |m| a << BigRational.new(m,k) } }; a.uniq.sort
end
end
puts "Farey sequence for order 1 through 11 (inclusive):"
(1..11).each do |n|
puts "F(#{n}): 0/1 #{farey(n).as(Array(BigRational))[1..-2].join(" ")} 1/1"
end
puts "Number of fractions in the Farey sequence:"
(100..1000).step(100) do |i|
puts "F(%4d) =%7d" % [i, farey(i, true)]
end

9
Task/Farey-sequence/D/farey-sequence-1.d Normal file
View file

@ -0,0 +1,9 @@
string toString() const /*pure nothrow*/ {
if (den != 0)
//return num.text ~ (den == 1 ? "" : "/" ~ den.text);
return num.text ~ "/" ~ den.text;
if (num == 0)
return "NaRat";
else
return ((num < 0) ? "-" : "+") ~ "infRat";
}

15
Task/Farey-sequence/D/farey-sequence-2.d Normal file
View file

@ -0,0 +1,15 @@
import std.stdio, std.algorithm, std.range, arithmetic_rational2;
auto farey(in int n) pure nothrow @safe {
return rational(0, 1).only.chain(
iota(1, n + 1)
.map!(k => iota(1, k + 1).map!(m => rational(m, k)))
.join.sort().uniq);
}
void main() @safe {
writefln("Farey sequence for order 1 through 11:\n%(%s\n%)",
iota(1, 12).map!farey);
writeln("\nFarey sequence fractions, 100 to 1000 by hundreds:\n",
iota(100, 1_001, 100).map!(i => i.farey.walkLength));
}

53
Task/Farey-sequence/D/farey-sequence-3.d Normal file
View file

@ -0,0 +1,53 @@
import core.stdc.stdio: printf, putchar;
void farey(in uint n) nothrow @nogc {
static struct Frac { uint d, n; }
Frac f1 = { 0, 1 }, f2 = { 1, n };
printf("%u/%u %u/%u", 0, 1, 1, n);
while (f2.n > 1) {
immutable k = (n + f1.n) / f2.n;
immutable aux = f1;
f1 = f2;
f2 = Frac(f2.d * k - aux.d, f2.n * k - aux.n);
printf(" %u/%u", f2.d, f2.n);
}
putchar('\n');
}
ulong fareyLength(in uint n, ref ulong[] cache) pure nothrow @safe {
if (n >= cache.length) {
auto newLen = cache.length;
if (newLen == 0)
newLen = 16;
while (newLen <= n)
newLen *= 2;
cache.length = newLen;
} else if (cache[n])
return cache[n];
ulong len = ulong(n) * (n + 3) / 2;
for (uint p = 2, q = 0; p <= n; p = q) {
q = n / (n / p) + 1;
len -= fareyLength(n / p, cache) * (q - p);
}
cache[n] = len;
return len;
}
void main() nothrow {
foreach (immutable uint n; 1 .. 12) {
printf("%u: ", n);
n.farey;
}
ulong[] cache;
for (uint n = 100; n <= 1_000; n += 100)
printf("%u: %llu items\n", n, fareyLength(n, cache));
immutable uint n = 10_000_000;
printf("\n%u: %llu items\n", n, fareyLength(n, cache));
}

125
Task/Farey-sequence/EDSAC-order-code/farey-sequence-1.edsac Normal file
View file

@ -0,0 +1,125 @@
[Farey sequence for Rosetta Code website.
EDSAC program, Initial Orders 2.
Prints Farey sequences up to order 11
(or other limit determined by a simple edit).]
[Modification of library subroutine P6.
Prints number (absolute value <= 65535)
passed in 0F, without leading spaces.
41 locations.]
T 56 K
GKA3FT35@SFG11@UFS40@E10@O40@T4FE35@O@T4F
H38@VFT4DA13@TFH39@S16@T1FV4DU4DAFG36@TFTF
O5FA4DF4FS4FL4FT4DA1FS13@G19@EFSFE30@J995FJFPD
T 100 K
G K
[Maximum order to be printed. For convenience, entered as
an address, not an integer, e.g. 'P 11 F' not 'P 5 D'.]
[0] P 11 F [<--- edit here]
[Other constants]
[1] P D [1]
[2] # F [figure shift]
[3] X F [slash]
[4] ! F [space]
[5] @ F [carriage return]
[6] & F [line feed]
[7] K4096 F [teleprinter null]
[Variables]
[8] P F [n, order of current Farey sequence]
[9] P F [maximum n + 1, as integer]
[a/b and c/d are consecutive terms of the Farey sequence]
[10] P F [a]
[11] P F [b]
[12] P F [c]
[13] P F [d]
[14] P F [t, temporary store]
[Subroutine to print c/d]
[15] A 3 F [plant link for return]
T 26 @
A 12 @ [load c]
T F [to 0F for printing]
[19] A 19 @ [for subroutine return]
G 56 F [print c]
O 3 @ [print '/']
A 13 @ [load d]
T F [to 0F for printing]
[24] A 24 @ [for subroutine return]
G 56 F [print d]
[26] E F [return]
[Main routine.
Enter with accumulator = 0.]
[27] O 2 @ [set teleprinter to figures]
A @ [max order as address]
R D [shift 1 right to make integer]
A 1 @ [add 1]
T 9 @ [save for comparison]
A 1 @ [start with order 1]
[Here with next order (n) in the accumulator]
[33] S 9 @ [subtract (max order) + 1]
E 84 @ [exit if over maximum]
A 9 @ [restore after test]
T 8 @ [store]
[Prefix the Farey sequence with a formal term -1/0.
The second term is calculated from this and the first term.]
S 1 @ [acc := -1]
T 10 @ [a := -1]
T 11 @ [b := 0]
T 12 @ [c := 0]
A 1 @ [d := 1]
T 13 @
A 43 @ [for subroutine return]
G 15 @ [call subroutine to print c/d]
[Calculate next term; basically same as Wikipedia method]
[45] T F [clear acc]
A 10 @ [t := a]
T 14 @
A 12 @ [a := c;]
T 10 @
S 14 @ [c := -t]
T 12 @
A 11 @ [t := b]
T 14 @
A 13 @ [b := d]
T 11 @
S 14 @ [d := -t]
T 13 @
A 8 @ [t := n + t]
A 14 @
T 14 @
[Inner loop, get t div b by repeated subtraction]
[61] A 14 @ [t := t - b]
S 11 @
G 72 @ [jump out when t < 0]
T 14 @
A 12 @ [c := c + a]
A 10 @
T 12 @
A 13 @ [d := d + b]
A 11 @
T 13 @
E 61 @ [loop back (always, since acc = 0)]
[End of inner loop, print c/d preceded by space]
[72] O 4 @
T F
[74] A 74 @ [for subroutine return]
G 15 @ [call subroutine to print c/d]
A 1 @ [form 1 - d, to test for d = 1]
S 13 @
G 45 @ [if d > 1, loop for next term]
O 5 @ [else print end of line (CR LF)]
O 6 @
[Next Farey series.]
A 8 @ [load order]
A 1 @ [add 1]
E 33 @ [loop back]
[Here when finished]
[84] O 7 @ [output null to flush teleprinter buffer]
Z F [stop]
E 27 Z [define start of execution]
P F [start with accumulator = 0]

227
Task/Farey-sequence/EDSAC-order-code/farey-sequence-2.edsac Normal file
View file

@ -0,0 +1,227 @@
[Farey sequence for Rosetta Code website.
Get number of terms by using Euler's totient function.
EDSAC program, Initial Orders 2.]
[Euler's totient function for each n = 1..1000 is calculated here as follows.
A wheel is defined for each prime p < sqrt(1000), i.e. for p <= 31.
When n = 0, the wheels are all 0. When n is incremented:
(i) the totient is initialized to n
(ii) the wheel for each prime p is incremented modulo p.
A prime p therefore divides n iff the wheel for p is 0. In this case:
(1) the totient is multiplied by (1 - 1/p)
(2) n is reduced by dividing it by p as many times as possible.
When all primes p have been tested, the reduced n must be either:
(a) 1, in which case the totient is finished; or
(b) a prime q > 31, in which case the totient is multiplied by (1 - 1/q).]
[Library subroutine M3, prints header, terminated by blank row of tape.]
PFGKIFAFRDLFUFOFE@A6FG@E8FEZPF
*!!!!!ORDER!!!!!TERMS@&#..
[PZ]
T 56 K
[Library subroutine P7, prints double-word integer > 0.
10 characters, right justified, padded left with spaces.
Closed, even; 35 storage locations; working position 4D.]
GKA3FT26@H28#@NDYFLDT4DS27@TFH8@S8@T1FV4DAFG31@SFLDUFOFFFSF
L4FT4DA1FA27@G11@XFT28#ZPFT27ZP1024FP610D@524D!FO30@SFL8FE22@
[Subroutine (not from library) for integer short division.
Input: dividend at 4F, divisor at 6F
Output: remainder at 4F, quotient at 6F
Working location 0D. 37 locations.]
T 100 K
GKA3FT34@A6FUFT35@A4FRDS35@G13@T1FA35@LDE4@T1FT6FA4FS35@G22@
T4FA6FA36@T6FT1FAFS35@E34@T1FA35@RDT35@A6FLDT6FE15@EFPFPD
[Put address of primes at 53.
Primes are therefore referred to by code letter B.]
T 53 K
P 160 F
T 160 K
P 11 F [number of primes (as address)]
P1FP1DP2DP3DP5DP6DP8DP9DP11DP14DP15D
[Put address of wheels at 54.
Wheels are therefore referred to by code letter C.
Number of wheels = number of primes, at the moment 11]
T 54 K
P 180 F
[Main routine]
T 200 K
G K
[Long variable]
[0] P F P F [sum of Euler's totient function over all n]
[Short variables]
[2] P F [n = order of Farey sequence]
[3] P F [reduced n, as prime factors are taken out]
[4] P F [partial totient; initially n, finally Euler's phi(n)]
[5] P F [current prime p]
[6] P F [residue of n by prime p]
[7] P F [negative counter for steps]
[8] P F [negative counter within step]
[9] P F [negative counter for primes]
[Short constants]
[10] P D [1]
[11] P 100 F [step, as an address (for convenience)]
[12] P 10 F [number of steps, as an address]
[13] # F [figure shift]
[14] @ F [carriage return]
[15] & F [line feed]
[16] K 4096 F [teleprinter null]
[17] A C [order to read first wheel]
[18] T C [order to write first wheel]
[19] A 1 B [order to read first prime]
[Subroutine to multiply partial totient by (1 - 1/p)]
[20] A 3 F
T 31 @
A 4 @ [load partial totient]
T 4 F [to dividend]
A 5 @ [load prime p]
T 6 F [to divisor]
[26] A 26 @ [for return from next]
G 100 F [call division routine]
A 4 @ [partial totient again]
S 6 F [subtract quotient]
T 4 @ [update partial totient]
[31] E F [exit with acc = 0]
[Enter with accumulator = 0]
[Reset all wheels to 0, working from 31 down to 2.]
[32] A B [load number of wheels]
S 2 F [dec by 1]
[34] A 18 @ [make order 'T m C' for address m]
T 36 @ [plant order]
[36] T C [reset this wheel]
A 36 @ [get order again]
S 2 F [dec address by 1]
S 18 @ [compare with order for first wheel]
E 34 @ [loop back till done]
[Initialize sum to 1]
T F [clear acc]
T #@ [clear sum (both words + sandwich bit)]
A 10 @ [load 1 (single word)]
T @ [to sum (low word)]
T 2 @ [order of Farey sequence := 0]
S 12 @ [load negative number of steps (typically -10)]
[Here acc = negative step count]
[47] T 7 @ [update negative step count]
S 11 @ [load negative step size (typically -100)]
[Here acc = negative count within a step]
[49] T 8 @
A 2 @ [inc n]
A 10 @
U 3 @ [initialize reduced n := n]
U 4 @ [initialize partial totient := n]
T 2 @ [update n]
[Loop through primes p. Inc wheel for prime p by 1 mod p.
If wheel = 0, then p divides n.
If so, update partial totient and reduced n.]
S B
T 9 @ [initialize count]
A 19 @ [order to read first prime]
T 64 @ [plant in code]
A 17 @ [order to read first wheel]
T 66 @ [plant in code]
A 18 @ [order to write first wheel]
T 88 @ [plant in code]
[63] T F
[64] A F [load prime]
T 5 @ [store]
[66] A C [read wheel (residue of n mod p)]
A 10 @ [inc]
U 6 @ [store locally]
S 5 @ [reached p yet?]
G 86 @ [skip if not]
[Here if p divides n.
Need to multiply partial totient by (1 - 1/p)
and divide reduced n by highest possible power of p.]
T F [acc := 0]
T 6 @ [wrap residue from p to 0]
[Update partial totient, multiply by (1 - 1/p)]
[73] A 73 @ [for return from next]
G 20 @ [call subroutine]
[Divide reduced n by p as many times as possible
(it must be divisible by p at least once)]
[75] A 3 @ [load reduced n]
T 4 F [to dividend]
A 5 @ [load prime p]
T 6 F [to divisor]
[79] A 79 @ [for return]
G 100 F [call division routine; clears acc]
S 4 F [load negative of remainder]
G 86 @ [stop dividing if remainder > 0]
A 6 F [quotient from division]
T 3 @ [update reduced n]
E 75 @ [try another division]
[86] T F [clear acc]
A 6 @ [get residue for this prime]
[88] T C [write back]
A 9 @ [load negative prime count]
A 2 F [inc count]
E 103 @ [out if done all primes]
T 9 @ [else update count]
A 64 @ [inc addresses in the above code]
A 2 F
T 64 @
A 66 @
A 2 F
T 66 @
A 88 @
A 2 F
T 88 @
E 63 @ [loop for next prime]
[Tested all primes up to 31 for this n.
Reduced n is now either 1 or a prime > 31]
[103] T F
A 3 @ [get reduced]
S 2 F [subtract 2]
G 111 @ [skip if reduced n = 1]
A 2 F [else restore value]
T 5 @ [copy to prime p]
[109] A 109 @ [for return from next]
G 20 @ [call routine to update partial totient]
[Update sum of Euler's totient over 1..n.
Note sum is double word, while totient is single word.
Totient is converted to double before adding to sum.]
[111] T F [clear acc]
T D [clear 0D (i.e. 0F, 1F and sandwich bit)]
A 4 @ [load totient (single word)]
T F [to 0F]
A D [load totient from 0D as double word]
A #@ [add to sum]
T #@ [update sum]
[On to next n]
A 8 @ [load negative count]
A 2 F [add 1]
G 49 @ [loop until count = 0]
[Here when finished this step.
Typically, n has increased by 100.
Show n and the sum of Euler's totient.
Note accumulator = 0 here.]
T D [clear 0D (i.e. 0F, 1F and sandwich bit)]
A 2 @ [load n (single word)]
T F [to 0F; now 0D = n for printing]
[124] A 124 @ [for return from next]
G 56 F [call library subroutine to print n]
A #@ [load sum (double word)]
T D [to 0D for printing]
[128] A 128 @ [for return from next]
G 56 F [call library subroutine to print sum]
O 14 @ [print new line (CR, LF)]
O 15 @
[On to next step]
A 7 @ [load negative step count]
A 2 F [add 1]
G 47 @ [loop until count = 0]
[Here when finished whole thing]
[135] O 16 @ [output null to flush teleprinter buffer]
Z F [stop]
E 32 Z [define start of execution]
P F [start with accumulator = 0]

19
Task/Farey-sequence/EchoLisp/farey-sequence-1.l Normal file
View file

@ -0,0 +1,19 @@
(define distinct-divisors
(compose make-set prime-factors))
;; euler totient : Φ : n / product(p_i) * product (p_i - 1)
;; # of divisors <= n
(define (Φ n)
(let ((pdiv (distinct-divisors n)))
(/ (* n (for/product ((p pdiv)) (1- p))) (for/product ((p pdiv)) p))))
;; farey-sequence length |Fn| = 1 + sigma (m=1..) Φ(m)
(define ( F-length n) (1+ (for/sum ((m (1+ n))) (Φ m))))
;; farey sequence
;; apply the definition : O(n^2)
(define (Farey N)
(set! N (1+ N))
(make-set (for*/list ((n N) (d (in-range n N))) (rational n d))))

28
Task/Farey-sequence/EchoLisp/farey-sequence-2.l Normal file
View file

@ -0,0 +1,28 @@
(for ((n (in-range 1 12))) ( printf "F(%d) %s" n (Farey n)))
F(1) { 0 1 }
F(2) { 0 1/2 1 }
F(3) { 0 1/3 1/2 2/3 1 }
F(4) { 0 1/4 1/3 1/2 2/3 3/4 1 }
F(5) { 0 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 1 }
F(6) { 0 1/6 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 5/6 1 }
F(7) { 0 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 }
F(8) { 0 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 }
F(9) { 0 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 }
F(10) { 0 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 }
F(11) { 0 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 }
(for (( n (in-range 100 1100 100))) (printf "|F(%d)| = %d" n (F-length n)))
|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
(for (( n '(10_000 100_000))) (printf "|F(%d)| = %d" n (F-length n)))
|F(10000)| = 30397487
|F(100000)| = 3039650755

31
Task/Farey-sequence/Factor/farey-sequence.factor Normal file
View file

@ -0,0 +1,31 @@
USING: formatting io kernel math math.primes.factors math.ranges
locals prettyprint sequences sequences.extras sets tools.time ;
IN: rosetta-code.farey-sequence
! Given the order n and a farey pair, calculate the next member
! of the sequence.
:: p/q ( n a/b c/d -- p/q )
a/b c/d [ >fraction ] bi@ :> ( a b c d )
n b + d / >integer [ c * a - ] [ d * b - ] bi / ;
: print-farey ( order -- )
[ "F(%-2d): " printf ] [ 0 1 pick / ] bi "0/1 " write
[ dup 1 = ] [ dup pprint bl 3dup p/q [ nip ] dip ] until
3drop "1/1" print ;
: φ ( n -- m ) ! Euler's totient function
[ factors members [ 1 swap recip - ] map-product ] [ * ] bi ;
: farey-length ( order -- length )
dup 1 = [ drop 2 ]
[ [ 1 - farey-length ] [ φ ] bi + ] if ;
: part1 ( -- ) 11 [1,b] [ print-farey ] each nl ;
: part2 ( -- )
100 1,000 100 <range>
[ dup farey-length "F(%-4d): %-6d members.\n" printf ] each ;
: main ( -- ) [ part1 part2 nl ] time ;
MAIN: main

54
Task/Farey-sequence/FreeBASIC/farey-sequence.basic Normal file
View file

@ -0,0 +1,54 @@
' version 05-04-2017
' compile with: fbc -s console
' TRUE/FALSE are built-in constants since FreeBASIC 1.04
' But we have to define them for older versions.
#Ifndef TRUE
#Define FALSE 0
#Define TRUE Not FALSE
#EndIf
Function farey(n As ULong, descending As Long) As ULong
Dim As Long a, b = 1, c = 1, d = n, k
Dim As Long aa, bb, cc, dd, count
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
' ------=< MAIN >=------
For i As Long = 1 To 11
Print "F"; Str(i); " = ";
farey(i, FALSE)
Next
Print
For i As Long= 100 To 1000 Step 100
Print "F";Str(i);
Print iif(i <> 1000, " ", ""); " = ";
Print Using "######"; farey(i, FALSE)
Next
' empty keyboard buffer
While Inkey <> "" : Wend
Print : Print "hit any key to end program"
Sleep
End

15
Task/Farey-sequence/FunL/farey-sequence.funl Normal file
View file

@ -0,0 +1,15 @@
def farey( n ) =
res = seq()
a, b, c, d = 0, 1, 1, n
res += "$a/$b"
while c <= n
k = (n + b)\d
a, b, c, d = c, d, k*c - a, k*d - b
res += "$a/$b"
for i <- 1..11
println( "$i: ${farey(i).mkString(', ')}" )
for i <- 100..1000 by 100
println( "$i: ${farey(i).length()}" )

43
Task/Farey-sequence/FutureBasic/farey-sequence.basic Normal file
View file

@ -0,0 +1,43 @@
local fn FareySequence( n as long, descending as BOOL )
long a = 0, b = 1, c = 1, d = n, k = 0
long aa, bb, cc, dd
long count = 0
if descending = YES
a = 1
c = n -1
end if
count++
if n < 12 then print a; "/"; b; " ";
while ( (c <= n) and not descending ) or ( (a > 0) and descending)
aa = a
bb = b
cc = c
dd = d
k = int( (n + b) / d )
a = cc
b = dd
c = k * cc - aa
d = k * dd - bb
count++
if n < 12 then print a;"/"; b; " ";
wend
if n < 12 then print else print count
end fn
long i
for i = 1 to 11
if i < 10 then printf @" F%ld = \b", i else printf @"F%ld = \b", i
fn FareySequence( i, NO )
next
print
for i = 100 to 1000 step 100
if i < 1000 then printf @" F%ld = \b", i else printf @"F%ld = \b", i
fn FareySequence( i, NO )
next
HandleEvents

52
Task/Farey-sequence/Gambas/farey-sequence.gambas Normal file
View file

@ -0,0 +1,52 @@
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

61
Task/Farey-sequence/Go/farey-sequence.go Normal file
View file

@ -0,0 +1,61 @@
package main
import "fmt"
type frac struct{ num, den int }
func (f frac) String() string {
return fmt.Sprintf("%d/%d", f.num, f.den)
}
func f(l, r frac, n int) {
m := frac{l.num + r.num, l.den + r.den}
if m.den <= n {
f(l, m, n)
fmt.Print(m, " ")
f(m, r, n)
}
}
func main() {
// task 1. solution by recursive generation of mediants
for n := 1; n <= 11; n++ {
l := frac{0, 1}
r := frac{1, 1}
fmt.Printf("F(%d): %s ", n, l)
f(l, r, n)
fmt.Println(r)
}
// task 2. direct solution by summing totient function
// 2.1 generate primes to 1000
var composite [1001]bool
for _, p := range []int{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31} {
for n := p * 2; n <= 1000; n += p {
composite[n] = true
}
}
// 2.2 generate totients to 1000
var tot [1001]int
for i := range tot {
tot[i] = 1
}
for n := 2; n <= 1000; n++ {
if !composite[n] {
tot[n] = n - 1
for a := n * 2; a <= 1000; a += n {
f := n - 1
for r := a / n; r%n == 0; r /= n {
f *= n
}
tot[a] *= f
}
}
}
// 2.3 sum totients
for n, sum := 1, 1; n <= 1000; n++ {
sum += tot[n]
if n%100 == 0 {
fmt.Printf("|F(%d)|: %d\n", n, sum)
}
}
}

41
Task/Farey-sequence/Haskell/farey-sequence.hs Normal file
View file

@ -0,0 +1,41 @@
import Data.List (unfoldr, mapAccumR)
import Data.Ratio ((%), denominator, numerator)
import Text.Printf (PrintfArg, printf)
-- The n'th order Farey sequence.
farey :: Integer -> [Rational]
farey n = 0 : unfoldr step (0, 1, 1, n)
where
step (a, b, c, d)
| c > n = Nothing
| otherwise =
let k = (n + b) `quot` d
in Just (c %d, (c, d, k * c - a, k * d - b))
-- A list of pairs, (n, fn n), where fn is a function applied to the n'th order
-- Farey sequence. We assume the list of orders is increasing. Only the
-- highest order Farey sequence is evaluated; the remainder are generated by
-- successively pruning this sequence.
fareys :: ([Rational] -> a) -> [Integer] -> [(Integer, a)]
fareys fn ns = snd $ mapAccumR prune (farey $ last ns) ns
where
prune rs n =
let rs'' = filter ((<= n) . denominator) rs
in (rs'', (n, fn rs''))
fprint
:: (PrintfArg b)
=> String -> [(Integer, b)] -> IO ()
fprint fmt = mapM_ (uncurry $ printf fmt)
showFracs :: [Rational] -> String
showFracs =
unwords .
map (concat . (<*>) [show . numerator, const "/", show . denominator] . pure)
main :: IO ()
main = do
putStrLn "Farey Sequences\n"
fprint "%2d %s\n" $ fareys showFracs [1 .. 11]
putStrLn "\nSequence Lengths\n"
fprint "%4d %d\n" $ fareys length [100,200 .. 1000]

3
Task/Farey-sequence/J/farey-sequence-1.j Normal file
View file

@ -0,0 +1,3 @@
Farey=: x:@/:~@(0 , ~.)@(#~ <:&1)@:,@(%/~@(1 + i.)) NB. calculates Farey sequence
displayFarey=: ('r/' charsub '0r' , ,&'r1')@": NB. format character representation of Farey sequence according to task requirements
order=: ': ' ,~ ": NB. decorate order of Farey sequence

23
Task/Farey-sequence/J/farey-sequence-2.j Normal file
View file

@ -0,0 +1,23 @@
LF joinstring (order , displayFarey@Farey)&.> 1 + i.11 NB. Farey sequences, order 1-11
1: 0/0 1/1
2: 0/0 1/2 1/1
3: 0/0 1/3 1/2 2/3 1/1
4: 0/0 1/4 1/3 1/2 2/3 3/4 1/1
5: 0/0 1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5 1/1
6: 0/0 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/0 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/0 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/0 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/0 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/0 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
LF joinstring (order , ":@#@Farey)&.> 100 * 1 + i.10 NB. Count of Farey sequence items, order 100,200,..1000
100: 3045
200: 12233
300: 27399
400: 48679
500: 76117
600: 109501
700: 149019
800: 194751
900: 246327
1000: 304193

43
Task/Farey-sequence/Java/farey-sequence.java Normal file
View file

@ -0,0 +1,43 @@
import java.util.TreeSet;
public class Farey{
private static class Frac implements Comparable<Frac>{
int num;
int den;
public Frac(int num, int den){
this.num = num;
this.den = den;
}
@Override
public String toString(){
return num + "/" + den;
}
@Override
public int compareTo(Frac o){
return Double.compare((double)num / den, (double)o.num / o.den);
}
}
public static TreeSet<Frac> genFarey(int i){
TreeSet<Frac> farey = new TreeSet<Frac>();
for(int den = 1; den <= i; den++){
for(int num = 0; num <= den; num++){
farey.add(new Frac(num, den));
}
}
return farey;
}
public static void main(String[] args){
for(int i = 1; i <= 11; i++){
System.out.println("F" + i + ": " + genFarey(i));
}
for(int i = 100; i <= 1000; i += 100){
System.out.println("F" + i + ": " + genFarey(i).size() + " members");
}
}
}

30
Task/Farey-sequence/Jq/farey-sequence.jq Normal file
View file

@ -0,0 +1,30 @@
include "rational" ; # actually, only `r/2` and `gcd/2` are actually needed
# Emit an ordered stream of the Farey sequence of order $order
# by recursively generating the mediants
def FS($order):
def f($l; $r; $n):
r($l.n + $r.n; $l.d + $r.d) as $m
| select($m.d <= $n)
| f($l; $m; $n), $m, f($m; $r; $n);
r(0;1) as $l
| r(1;1) as $r
| $l, f($l; $r; .), $r;
# Pretty-print Farey sequences of order $min up to and including order $max
def FareySequences($min; $max):
def rpp: "\(.n)/\(.d)";
def pp(s): [s|rpp] | join(" ");
range($min;$max+1)
| "F(\(.)): " + pp(FS(.));
# Use `count/1` for counting to save space
def count(s): reduce s as $_ (0; .+1);
def FareySequenceMembers($N):
count(FS($N));
# The tasks:
FareySequences(1;11),
"",
(range(100; 1001; 100) | "F\(.): \(FareySequenceMembers(.)|length) members" )

21
Task/Farey-sequence/Julia/farey-sequence.julia Normal file
View file

@ -0,0 +1,21 @@
using DataStructures
function farey(n::Int)
rst = SortedSet{Rational}(Rational[0, 1])
for den in 1:n, num in 1:den-1
push!(rst, Rational(num, den))
end
return rst
end
for n in 1:11
print("F_$n: ")
for frac in farey(n)
print(numerator(frac), "/", denominator(frac), " ")
end
println()
end
for n in 100:100:1000
println("F_$n has ", length(farey(n)), " fractions")
end

28
Task/Farey-sequence/Kotlin/farey-sequence.kotlin Normal file
View file

@ -0,0 +1,28 @@
// version 1.1
fun farey(n: Int): List<String> {
var a = 0
var b = 1
var c = 1
var d = n
val f = mutableListOf("$a/$b")
while (c <= n) {
val k = (n + b) / d
val aa = a
val bb = b
a = c
b = d
c = k * c - aa
d = k * d - bb
f.add("$a/$b")
}
return f.toList()
}
fun main(args: Array<String>) {
for (i in 1..11)
println("${"%2d".format(i)}: ${farey(i).joinToString(" ")}")
println()
for (i in 100..1000 step 100)
println("${"%4d".format(i)}: ${"%6d".format(farey(i).size)} fractions")
}

23
Task/Farey-sequence/Langur/farey-sequence.langur Normal file
View file

@ -0,0 +1,23 @@
val .farey = f(.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 x .c - .a, .k x .d - .b
_while ~= [[.a, .b]]
}
}
val .testFarey = f() {
writeln "Farey sequence for orders 1 through 11"
for .i of 11 {
writeln $"\.i:2;: ", join " ", map(f $"\.f[1];/\.f[2];", .farey(.i))
}
}
.testFarey()
writeln()
writeln "count of Farey sequence fractions for 100 to 1000 by hundreds"
for .i = 100; .i <= 1000; .i += 100 {
writeln $"\.i:4;: ", len(.farey(.i))
}

19
Task/Farey-sequence/Lua/farey-sequence.lua Normal file
View file

@ -0,0 +1,19 @@
-- Return farey sequence of order n
function farey (n)
local a, b, c, d, k = 0, 1, 1, n
local farTab = {{a, b}}
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
end
-- Main procedure
for i = 1, 11 do
io.write(i .. ": ")
for _, frac in pairs(farey(i)) do io.write(frac[1] .. "/" .. frac[2] .. " ") end
print()
end
for i = 100, 1000, 100 do print(i .. ": " .. #farey(i) .. " items") end

25
Task/Farey-sequence/Maple/farey-sequence.maple Normal file
View file

@ -0,0 +1,25 @@
#Displays terms in Farey_sequence of order n
farey_sequence := proc(n)
local a,b,c,d,k;
a,b,c,d := 0,1,1,n;
printf("%d/%d", a,b);
while c <= n do
k := iquo(n+b,d);
a,b,c,d := c,d,c*k-a,d*k-b;
printf(", %d/%d", a,b)
end do;
printf("\n");
end proc:
#Returns the length of a Farey sequence
farey_len := proc(n)
return 1 + add(NumberTheory:-Totient(k), k=1..n);
end proc;
for i to 11 do
farey_sequence(i);
end do;
printf("\n");
for j from 100 to 1000 by 100 do
printf("%d\n", farey_len(j));
end do;

3
Task/Farey-sequence/Mathematica/farey-sequence.math Normal file
View file

@ -0,0 +1,3 @@
farey[n_]:=StringJoin@@Riffle[ToString@Numerator[#]<>"/"<>ToString@Denominator[#]&/@FareySequence[n],", "]
TableForm[farey/@Range[11]]
Table[Length[FareySequence[n]], {n, 100, 1000, 100}]

45
Task/Farey-sequence/Nim/farey-sequence.nim Normal file
View file

@ -0,0 +1,45 @@
import strformat
proc farey(n: int) =
var f1 = (d: 0, n: 1)
var f2 = (d: 1, n: n)
write(stdout, fmt"0/1 1/{n}")
while f2.n > 1:
let k = (n + f1.n) div f2.n
let aux = f1
f1 = f2
f2 = (f2.d * k - aux.d, f2.n * k - aux.n)
write(stdout, fmt" {f2.d}/{f2.n}")
write(stdout, "\n")
proc fareyLength(n: int, cache: var seq[int]): int =
if n >= cache.len:
var newLen = cache.len
if newLen == 0:
newLen = 16
while newLen <= n:
newLen *= 2
cache.setLen(newLen)
elif cache[n] != 0:
return cache[n]
var length = n * (n + 3) div 2
var p = 2
var q = 0
while p <= n:
q = n div (n div p) + 1
dec length, fareyLength(n div p, cache) * (q - p)
p = q
cache[n] = length
return length
for n in 1..11:
write(stdout, fmt"{n:>8}: ")
farey(n)
var cache: seq[int] = @[]
for n in countup(100, 1000, step=100):
echo fmt"{n:>8}: {fareyLength(n, cache):14} items"
let n = 10_000_000
echo fmt"{n}: {fareyLength(n, cache):14} items"

5
Task/Farey-sequence/PARI-GP/farey-sequence.parigp Normal file
View file

@ -0,0 +1,5 @@
Farey(n)=my(v=List()); for(k=1,n,for(i=0,k,listput(v,i/k))); vecsort(Set(v));
countFarey(n)=1+sum(k=1, n, eulerphi(k));
fmt(n)=if(denominator(n)>1,n,Str(n,"/1"));
for(n=1,11,print(apply(fmt, Farey(n))))
apply(countFarey, 100*[1..10])

69
Task/Farey-sequence/Pascal/farey-sequence.pas Normal file
View file

@ -0,0 +1,69 @@
program Farey;
{$IFDEF FPC }{$MODE DELPHI}{$ELSE}{$APPTYPE CONSOLE}{$ENDIF}
uses
sysutils;
type
tNextFarey= record
nom,dom,n,c,d: longInt;
end;
function InitFarey(maxdom:longINt):tNextFarey;
Begin
with result do
Begin
nom := 0; dom := 1; n := maxdom;
c := 1; d := maxdom;
end;
end;
function NextFarey(var fn:tNextFarey):boolean;
var
k,tmp: longInt;
Begin
with fn do
Begin
k := trunc((n + dom)/d);
tmp := c;c:= k*c-nom;nom:= tmp;
tmp := d;d:= k*d-dom;dom:= tmp;
result := nom <> dom;
end;
end;
procedure CheckFareyCount( num: NativeUint);
var
TestF : tNextFarey;
cnt : NativeUint;
Begin
TestF:= InitFarey(num);
cnt := 1;
repeat
inc(cnt);
until NOT(NextFarey(TestF));
writeln('F(',TestF.n:4,') = ',cnt:7);
end;
var
TestF : tNextFarey;
cnt: NativeInt;
Begin
Writeln('Farey sequence for order 1 through 11 (inclusive): ');
For cnt := 1 to 11 do
Begin
TestF:= InitFarey(cnt);
write('F(',cnt:2,') = ');
repeat
write(TestF.nom,'/',TestF.dom,',');
until NOT(NextFarey(TestF));
writeln(TestF.nom,'/',TestF.dom);
end;
writeln;
writeln('Number of fractions in the Farey sequence:');
cnt := 100;
repeat
CheckFareyCount(cnt);
inc(cnt,100);
until cnt > 1000;
end.

29
Task/Farey-sequence/Perl/farey-sequence-1.pl Normal file
View file

@ -0,0 +1,29 @@
use warnings;
use strict;
use Math::BigRat;
use ntheory qw/euler_phi vecsum/;
sub farey {
my $N = shift;
my @f;
my($m0,$n0, $m1,$n1) = (0, 1, 1, $N);
push @f, Math::BigRat->new("$m0/$n0");
push @f, Math::BigRat->new("$m1/$n1");
while ($f[-1] < 1) {
my $m = int( ($n0 + $N) / $n1) * $m1 - $m0;
my $n = int( ($n0 + $N) / $n1) * $n1 - $n0;
($m0,$n0, $m1,$n1) = ($m1,$n1, $m,$n);
push @f, Math::BigRat->new("$m/$n");
}
@f;
}
sub farey_count { 1 + vecsum(euler_phi(1, shift)); }
for (1 .. 11) {
my @f = map { join "/", $_->parts } # Force 0/1 and 1/1
farey($_);
print "F$_: [@f]\n";
}
for (1 .. 10, 100000) {
print "F${_}00: ", farey_count(100*$_), " members\n";
}

27
Task/Farey-sequence/Perl/farey-sequence-2.pl Normal file
View file

@ -0,0 +1,27 @@
use warnings;
use strict;
use Math::BigRat;
sub farey {
my $n = shift;
my %v;
for my $k (1 .. $n) {
for my $i (0 .. $k) {
$v{ Math::BigRat->new("$i/$k")->bstr }++;
}
}
my @f = sort {$a <=> $b }
map { Math::BigRat->new($_) }
keys %v;
@f;
}
for (1 .. 11) {
my @f = map { join "/", $_->parts } # Force 0/1 and 1/1
farey($_);
print "F$_: [@f]\n";
}
for (1 .. 10) {
my @f = farey(100*$_);
print "F${_}00: ", scalar(@f), " members\n";
}

26
Task/Farey-sequence/Phix/farey-sequence.phix Normal file
View file

@ -0,0 +1,26 @@
(phixonline)-->
<span style="color: #008080;">with</span> <span style="color: #008080;">javascript_semantics</span>
<span style="color: #008080;">function</span> <span style="color: #000000;">farey</span><span style="color: #0000FF;">(</span><span style="color: #004080;">integer</span> <span style="color: #000000;">n</span><span style="color: #0000FF;">)</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">a</span><span style="color: #0000FF;">=</span><span style="color: #000000;">0</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">b</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">c</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">d</span><span style="color: #0000FF;">=</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span> <span style="color: #000000;">items</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">11</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"%d: %d/%d"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">n</span><span style="color: #0000FF;">,</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">while</span> <span style="color: #000000;">c</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">n</span> <span style="color: #008080;">do</span>
<span style="color: #004080;">integer</span> <span style="color: #000000;">k</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">floor</span><span style="color: #0000FF;">((</span><span style="color: #000000;">n</span><span style="color: #0000FF;">+</span><span style="color: #000000;">b</span><span style="color: #0000FF;">)/</span><span style="color: #000000;">d</span><span style="color: #0000FF;">)</span>
<span style="color: #0000FF;">{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">,</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">}</span> <span style="color: #0000FF;">=</span> <span style="color: #0000FF;">{</span><span style="color: #000000;">c</span><span style="color: #0000FF;">,</span><span style="color: #000000;">d</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">*</span><span style="color: #000000;">c</span><span style="color: #0000FF;">-</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">k</span><span style="color: #0000FF;">*</span><span style="color: #000000;">d</span><span style="color: #0000FF;">-</span><span style="color: #000000;">b</span><span style="color: #0000FF;">}</span>
<span style="color: #000000;">items</span> <span style="color: #0000FF;">+=</span> <span style="color: #000000;">1</span>
<span style="color: #008080;">if</span> <span style="color: #000000;">n</span><span style="color: #0000FF;"><=</span><span style="color: #000000;">11</span> <span style="color: #008080;">then</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">" %d/%d"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">a</span><span style="color: #0000FF;">,</span><span style="color: #000000;">b</span><span style="color: #0000FF;">})</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">if</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">while</span>
<span style="color: #008080;">return</span> <span style="color: #000000;">items</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">function</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Farey sequence for order 1 through 11:\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">for</span> <span style="color: #000000;">i</span><span style="color: #0000FF;">=</span><span style="color: #000000;">1</span> <span style="color: #008080;">to</span> <span style="color: #000000;">11</span> <span style="color: #008080;">do</span>
<span style="color: #0000FF;">{}</span> <span style="color: #0000FF;">=</span> <span style="color: #000000;">farey</span><span style="color: #0000FF;">(</span><span style="color: #000000;">i</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"\n"</span><span style="color: #0000FF;">)</span>
<span style="color: #008080;">end</span> <span style="color: #008080;">for</span>
<span style="color: #004080;">sequence</span> <span style="color: #000000;">nf</span> <span style="color: #0000FF;">=</span> <span style="color: #7060A8;">apply</span><span style="color: #0000FF;">(</span><span style="color: #7060A8;">tagset</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1000</span><span style="color: #0000FF;">,</span><span style="color: #000000;">100</span><span style="color: #0000FF;">,</span><span style="color: #000000;">100</span><span style="color: #0000FF;">),</span><span style="color: #000000;">farey</span><span style="color: #0000FF;">)</span>
<span style="color: #7060A8;">printf</span><span style="color: #0000FF;">(</span><span style="color: #000000;">1</span><span style="color: #0000FF;">,</span><span style="color: #008000;">"Farey sequence fractions, 100 to 1000 by hundreds:\n%v\n"</span><span style="color: #0000FF;">,{</span><span style="color: #000000;">nf</span><span style="color: #0000FF;">})</span>
<!--

13
Task/Farey-sequence/Picat/farey-sequence-1.picat Normal file
View file

@ -0,0 +1,13 @@
go ?=>
member(N,1..11),
Farey = farey(N),
println(N=Farey),
fail,
nl.
go => true.
farey(N) = M =>
M1 = [0=$(0/1)] ++
[I2/J2=$(I2/J2) : I in 1..N, J in I..N,
GCD=gcd(I,J),I2 =I//GCD,J2=J//GCD].sort_remove_dups(),
M = [ E: _=E in M1]. % extract the rational representation

6
Task/Farey-sequence/Picat/farey-sequence-2.picat Normal file
View file

@ -0,0 +1,6 @@
go2 =>
foreach(N in 100..100..1000)
F = farey(N),
println(N=F.length)
end,
nl.

29
Task/Farey-sequence/Prolog/farey-sequence.pro Normal file
View file

@ -0,0 +1,29 @@
task(1) :-
between(1, 11, I),
farey(I, F),
write(I), write(': '),
rwrite(F), nl, fail; true.
task(2) :- between(1, 10, I),
I100 is I*100,
farey( I100, F),
length(F,N),
write('|F('), write(I100), write(')| = '), writeln(N), fail; true.
% farey(+Order, Sequence)
farey(Order, Sequence) :-
bagof( R,
I^J^(between(1, Order, J), between(0, J, I), R is I rdiv J),
S),
predsort( rcompare, S, Sequence ).
rprint( rdiv(A,B) ) :- write(A), write(/), write(B), !.
rprint( I ) :- integer(I), write(I), write(/), write(1), !.
rwrite([]).
rwrite([R]) :- rprint(R).
rwrite([R, T|Rs]) :- rprint(R), write(', '), rwrite([T|Rs]).
rcompare(<, A, B) :- A < B, !.
rcompare(>, A, B) :- A > B, !.
rcompare(=, A, B) :- A =< B.

85
Task/Farey-sequence/PureBasic/farey-sequence.basic Normal file
View file

@ -0,0 +1,85 @@
EnableExplicit
Structure farey_struc
complex.POINT
quotient.d
EndStructure
#MAXORDER=1000
Global NewList fareylist.farey_struc()
Define v_start.i,
v_end.i,
v_step.i,
order.i,
fractions.i,
check.b,
t$
Procedure farey(order)
NewList sequence.farey_struc()
Define quotient.d,
divisor.i,
dividend.i
For divisor=1 To order
For dividend=0 To divisor
quotient.d=dividend/divisor
AddElement(sequence())
sequence()\complex\x=dividend
sequence()\complex\y=divisor
sequence()\quotient=quotient
Next
Next
SortStructuredList(sequence(),#PB_Sort_Ascending,
OffsetOf(farey_struc\quotient),
TypeOf(farey_struc\quotient))
FirstElement(sequence())
quotient=sequence()\quotient
AddElement(fareylist())
fareylist()\complex\x=sequence()\complex\x
fareylist()\complex\y=sequence()\complex\y
fareylist()\quotient=sequence()\quotient
ForEach sequence()
If quotient=sequence()\quotient : Continue : EndIf
quotient=sequence()\quotient
AddElement(fareylist())
fareylist()\complex\x=sequence()\complex\x
fareylist()\complex\y=sequence()\complex\y
fareylist()\quotient=sequence()\quotient
Next
FreeList(sequence())
EndProcedure
OpenConsole("Farey sequence [Input exit = program end]")
Repeat
Print("Input-> start end step [start>=1; end<=1000; step>=1; (start<end)] : ")
t$=Input() : If Trim(LCase(t$))="exit" : End : EndIf
v_start=Val(StringField(t$,1," "))
v_end=Val(StringField(t$,2," "))
v_step=Val(StringField(t$,3," "))
check=Bool(v_start>=1 And v_end<=#MAXORDER And v_step>=1 And v_start<v_end)
Until check=#True
PrintN(~"\n"+LSet("-",80,"-"))
order=v_start
While order<=v_end
FreeList(fareylist()) : NewList fareylist()
farey(order)
fractions=ListSize(fareylist())
PrintN("Farey sequence for order "+Str(order)+" has "+Str(fractions)+" fractions.")
If fractions<100
ForEach fareylist()
If ListIndex(fareylist()) % 7 = 0 : PrintN("") : EndIf
Print(~"\t"+
RSet(Str(fareylist()\complex\x),2," ")+"/"+
RSet(Str(fareylist()\complex\y),2," "))
Next
EndIf
PrintN(~"\n"+LSet("=",80,"="))
order+v_step
Wend
Input()

21
Task/Farey-sequence/Python/farey-sequence-1.py Normal file
View file

@ -0,0 +1,21 @@
from fractions import Fraction
class Fr(Fraction):
def __repr__(self):
return '(%s/%s)' % (self.numerator, self.denominator)
def farey(n, length=False):
if not length:
return [Fr(0, 1)] + sorted({Fr(m, k) for k in range(1, n+1) for m in range(1, k+1)})
else:
#return 1 + len({Fr(m, k) for k in range(1, n+1) for m in range(1, k+1)})
return (n*(n+3))//2 - sum(farey(n//k, True) for k in range(2, n+1))
if __name__ == '__main__':
print('Farey sequence for order 1 through 11 (inclusive):')
for n in range(1, 12):
print(farey(n))
print('Number of fractions in the Farey sequence for order 100 through 1,000 (inclusive) by hundreds:')
print([farey(i, length=True) for i in range(100, 1001, 100)])

198
Task/Farey-sequence/Python/farey-sequence-2.py Normal file
View file

@ -0,0 +1,198 @@
'''Farey sequence'''
from itertools import (chain, count, islice)
from math import gcd
# farey :: Int -> [Ratio Int]
def farey(n):
'''Farey sequence of order n.'''
return sorted(
nubBy(on(eq)(fromRatio))(
bind(enumFromTo(1)(n))(
lambda k: bind(enumFromTo(0)(k))(
lambda m: [ratio(m)(k)]
)
)
),
key=fromRatio
) + [ratio(1)(1)]
# fareyLength :: Int -> Int
def fareyLength(n):
'''Number of terms in a Farey sequence
of order n.'''
def go(x):
return (x * (x + 3)) // 2 - sum(
go(x // k) for k in enumFromTo(2)(x)
)
return go(n)
# showFarey :: [Ratio Int] -> String
def showFarey(xs):
'''Stringification of a Farey sequence.'''
return '(' + ', '.join(map(showRatio, xs)) + ')'
# TEST ----------------------------------------------------
# main :: IO ()
def main():
'''Tests'''
print(
fTable(
'Farey sequence for orders 1-11 (inclusive):\n'
)(str)(showFarey)(
farey
)(enumFromTo(1)(11))
)
print(
fTable(
'\n\nNumber of fractions in the Farey sequence ' +
'for order 100 through 1,000 (inclusive) by hundreds:\n'
)(str)(str)(
fareyLength
)(enumFromThenTo(100)(200)(1000))
)
# GENERIC -------------------------------------------------
# bind(>>=) :: [a] -> (a -> [b]) -> [b]
def bind(xs):
'''List monad injection operator.
Two computations sequentially composed,
with any value produced by the first
passed as an argument to the second.'''
return lambda f: list(
chain.from_iterable(
map(f, xs)
)
)
# compose (<<<) :: (b -> c) -> (a -> b) -> a -> c
def compose(g):
'''Right to left function composition.'''
return lambda f: lambda x: g(f(x))
# enumFromThenTo :: Int -> Int -> Int -> [Int]
def enumFromThenTo(m):
'''Integer values enumerated from m to n
with a step defined by nxt-m.
'''
def go(nxt, n):
d = nxt - m
return islice(count(0), m, d + n, d)
return lambda nxt: lambda n: (
list(go(nxt, n))
)
# enumFromTo :: (Int, Int) -> [Int]
def enumFromTo(m):
'''Integer enumeration from m to n.'''
return lambda n: list(range(m, 1 + n))
# eq (==) :: Eq a => a -> a -> Bool
def eq(a):
'''Simple equality of a and b.'''
return lambda b: a == b
# fromRatio :: Ratio Int -> Float
def fromRatio(r):
'''A floating point value derived from a
a rational value.
'''
return r.get('numerator') / r.get('denominator')
# nubBy :: (a -> a -> Bool) -> [a] -> [a]
def nubBy(p):
'''A sublist of xs from which all duplicates,
(as defined by the equality predicate p)
are excluded.
'''
def go(xs):
if not xs:
return []
x = xs[0]
return [x] + go(
list(filter(
lambda y: not p(x)(y),
xs[1:]
))
)
return lambda xs: go(xs)
# on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
def on(f):
'''A function returning the value of applying
the binary f to g(a) g(b)
'''
return lambda g: lambda a: lambda b: f(g(a))(g(b))
# ratio :: Int -> Int -> Ratio Int
def ratio(n):
'''Rational value constructed
from a numerator and a denominator.
'''
def go(n, d):
g = gcd(n, d)
return {
'type': 'Ratio',
'numerator': n // g, 'denominator': d // g
}
return lambda d: go(n * signum(d), abs(d))
# showRatio :: Ratio -> String
def showRatio(r):
'''String representation of the ratio r.'''
d = r.get('denominator')
return str(r.get('numerator')) + (
'/' + str(d) if 1 != d else ''
)
# signum :: Num -> Num
def signum(n):
'''The sign of n.'''
return -1 if 0 > n else (1 if 0 < n else 0)
# fTable :: String -> (a -> String) ->
# (b -> String) -> (a -> b) -> [a] -> String
def fTable(s):
'''Heading -> x display function -> fx display function ->
f -> xs -> tabular string.
'''
def go(xShow, fxShow, f, xs):
ys = [xShow(x) for x in xs]
w = max(map(len, ys))
return s + '\n' + '\n'.join(map(
lambda x, y: y.rjust(w, ' ') + ' -> ' + fxShow(f(x)),
xs, ys
))
return lambda xShow: lambda fxShow: lambda f: lambda xs: go(
xShow, fxShow, f, xs
)
# unlines :: [String] -> String
def unlines(xs):
'''A single string derived by the intercalation
of a list of strings with the newline character.
'''
return '\n'.join(xs)
if __name__ == '__main__':
main()

45
Task/Farey-sequence/Quackery/farey-sequence.quackery Normal file
View file

@ -0,0 +1,45 @@
[ $ "bigrat.qky" loadfile ] now!
[ rot + dip + reduce ] is mediant ( n/d n/d --> n/d )
[ 1+ temp put [] swap
dup size 1 - times
[ dup i^ peek
rot over nested join
unrot over i^ 1+ peek
join do mediant
dup temp share < iff
[ join nested
rot swap join
swap ]
else 2drop ]
drop
' [ [ 1 1 ] ] join
temp release ] is nextfarey ( fy n --> fy )
[ witheach
[ unpack vulgar$
echo$ sp ] ] is echofarey ( fy --> )
[ 0 swap dup times
[ i over gcd
1 = rot + swap ]
drop ] is totient ( n --> n )
[ 0 swap times
[ i 1+ totient + ] ] is totientsum ( n --> n )
[ totientsum 1+ ] is fareylength ( n --> n )
say "First eleven Farey series:" cr
' [ [ 0 1 ] [ 1 1 ] ]
10 times
[ dup echofarey cr
i^ 2 + nextfarey ]
echofarey cr
cr
say "Length of Farey series 100, 200 ... 1000: "
[] 10 times
[ i^ 1+ 100 *
fareylength join ]
echo

35
Task/Farey-sequence/R/farey-sequence.r Normal file
View file

@ -0,0 +1,35 @@
farey <- function(n, length_only = FALSE) {
a <- 0
b <- 1
c <- 1
d <- n
if (!length_only)
cat(a, "/", b, sep = "")
count <- 1
while (c <= n) {
count <- count + 1
k <- ((n + b) %/% d)
next_c <- k * c - a
next_d <- k * d - b
a <- c
b <- d
c <- next_c
d <- next_d
if (!length_only)
cat(" ", a, "/", b, sep = "")
}
if (length_only)
cat(count, "items")
cat("\n")
}
for (i in 1:11) {
cat(i, ": ", sep = "")
farey(i)
}
for (i in 100 * 1:10) {
cat(i, ": ", sep = "")
farey(i, length_only = TRUE)
}

31
Task/Farey-sequence/REXX/farey-sequence.rexx Normal file
View file

@ -0,0 +1,31 @@
/*REXX program computes and displays a Farey sequence (or the number of fractions). */
parse arg LO HI INC . /*obtain optional arguments from the CL*/
if LO=='' | LO=="," then LO= 1 /*Not specified? Then use the default.*/
if HI=='' | HI=="," then HI= LO /* " " " " " " */
if INC=='' | INC=="," then INC= 1 /* " " " " " " */
sw= linesize() - 1 /*obtain the linesize of the terminal. */
oLO= LO /*save original value of the the orders*/
do j=abs(LO) to abs(HI) by INC /*process each of the specified numbers*/
#= fareyF(j) /*go ye forth & compute Farey sequence.*/
say center('Farey sequence for order ' j " has " # ' fractions.', sw, "═")
if oLO>=0 then call show /*display the Farey fractions. */
end /*j*/
exit # /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
fareyF: procedure expose n. d.; parse arg x
n.1= 0; d.1= 1; n.2= 1; d.2= x /*some kit parts for the fraction list.*/
do k=1 until n.z>x /*construct from thirds and on "up".*/
y= k+1; z= k+2 /*calculate the next K and the next Z. */
_= d.k + x /*calculation used as a shortcut. */
n.z= _ % d.y*n.y - n.k /* " the fraction numerator. */
d.z= _ % d.y*d.y - d.k /* " " " denominator. */
if n.z>x then leave /*Should the construction be stopped ? */
end /*k*/
return z - 1 /*return the count of Farey fractions. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
show: $= '0/1' /*construct the start of the Farey seq.*/
do k=2 for #-1; _= n.k'/'d.k /*build a fraction: numer. / denom. */
if length($ _)>sw then do; say $; $= _; end /*Is new line too wide? Show it*/
else $= $ _ /*No? Keep it & keep building.*/
end /*k*/
if $\=='' then say $; return /*display any residual fractions. */

20
Task/Farey-sequence/Racket/farey-sequence.rkt Normal file
View file

@ -0,0 +1,20 @@
#lang racket
(require math/number-theory)
(define (display-farey-sequence order show-fractions?)
(define f-s (farey-sequence order))
(printf "-- Farey Sequence for order ~a has ~a fractions~%" order (length f-s))
;; racket will simplify 0/1 and 1/1 to 0 and 1 respectively, so deconstruct into numerator and
;; denomimator (and take the opportunity to insert commas
(when show-fractions?
(displayln
(string-join
(for/list ((f f-s))
(format "~a/~a" (numerator f) (denominator f)))
", "))))
; compute and show the Farey sequence for order:
; 1 through 11 (inclusive).
(for ((order (in-range 1 (add1 11)))) (display-farey-sequence order #t))
; compute and display the number of fractions in the Farey sequence for order:
; 100 through 1,000 (inclusive) by hundreds.
(for ((order (in-range 100 (add1 1000) 100))) (display-farey-sequence order #f))

9
Task/Farey-sequence/Raku/farey-sequence.raku Normal file
View file

@ -0,0 +1,9 @@
sub farey ($order) {
my @l = 0/1, 1/1;
(2..$order).map: { push @l, |(1..$^d).map: { $_/$d } }
unique @l
}
say "Farey sequence order ";
.say for (1..11).hyper(:1batch).map: { "$_: ", .&farey.sort.map: *.nude.join('/') };
.say for (100, 200 ... 1000).race(:1batch).map: { "Farey sequence order $_ has " ~ [.&farey].elems ~ ' elements.' }

47
Task/Farey-sequence/Ring/farey-sequence.ring Normal file
View file

@ -0,0 +1,47 @@
# Project : Farey sequence
for i = 1 to 11
count = 0
see "F" + string(i) + " = "
farey(i, false)
next
see nl
for x = 100 to 1000 step 100
count = 0
see "F" + string(x) + " = "
see farey(x, false)
see nl
next
func farey(n, descending)
a = 0
b = 1
c = 1
d = n
if descending = true
a = 1
c = n -1
ok
count = count + 1
if n < 12
see string(a) + "/" + string(b) + " "
ok
while ((c <= n) and not descending) or ((a > 0) and descending)
aa = a
bb = b
cc = c
dd = d
k = floor((n + b) / d)
a = cc
b = dd
c = k * cc - aa
d = k * dd - bb
count = count + 1
if n < 12
see string(a) + "/" + string(b) + " "
ok
end
if n < 12
see nl
ok
return count

16
Task/Farey-sequence/Ruby/farey-sequence.rb Normal file
View file

@ -0,0 +1,16 @@
def farey(n, length=false)
if length
(n*(n+3))/2 - (2..n).sum{|k| farey(n/k, true)}
else
(1..n).each_with_object([]){|k,a|(0..k).each{|m|a << Rational(m,k)}}.uniq.sort
end
end
puts 'Farey sequence for order 1 through 11 (inclusive):'
for n in 1..11
puts "F(#{n}): " + farey(n).join(", ")
end
puts 'Number of fractions in the Farey sequence:'
for i in (100..1000).step(100)
puts "F(%4d) =%7d" % [i, farey(i, true)]
end

56
Task/Farey-sequence/Rust/farey-sequence.rust Normal file
View file

@ -0,0 +1,56 @@
#[derive(Copy, Clone)]
struct Fraction {
numerator: u32,
denominator: u32,
}
use std::fmt;
impl fmt::Display for Fraction {
fn fmt(&self, f: &mut fmt::Formatter<'_>) -> fmt::Result {
write!(f, "{}/{}", self.numerator, self.denominator)
}
}
impl Fraction {
fn new(n: u32, d: u32) -> Fraction {
Fraction {
numerator: n,
denominator: d,
}
}
}
fn farey_sequence(n: u32) -> impl std::iter::Iterator<Item = Fraction> {
let mut a = 0;
let mut b = 1;
let mut c = 1;
let mut d = n;
std::iter::from_fn(move || {
if a > n {
return None;
}
let result = Fraction::new(a, b);
let k = (n + b) / d;
let next_c = k * c - a;
let next_d = k * d - b;
a = c;
b = d;
c = next_c;
d = next_d;
Some(result)
})
}
fn main() {
for n in 1..=11 {
print!("{}:", n);
for f in farey_sequence(n) {
print!(" {}", f);
}
println!();
}
for n in (100..=1000).step_by(100) {
println!("{}: {}", n, farey_sequence(n).count());
}
}

27
Task/Farey-sequence/Scala/farey-sequence.scala Normal file
View file

@ -0,0 +1,27 @@
object FareySequence {
def fareySequence(n: Int, start: (Int, Int), stop: (Int, Int)): LazyList[(Int, Int)] = {
val (nominator_l, denominator_l) = start
val (nominator_r, denominator_r) = stop
val mediant = ((nominator_l + nominator_r), (denominator_l + denominator_r))
if (mediant._2 <= n) fareySequence(n, start, mediant) ++ mediant #:: fareySequence(n, mediant, stop)
else LazyList.empty
}
def farey(n: Int, start: (Int, Int) = (0, 1), stop: (Int, Int) = (1, 1)): LazyList[(Int, Int)] = {
start #:: fareySequence(n, start, stop) ++ stop #:: LazyList.empty[(Int, Int)]
}
def main(args: Array[String]): Unit = {
for (i <- 1 to 11) {
println(s"$i: " + farey(i).map(e => s"${e._1}/${e._2}").mkString(", "))
}
println
for (i <- 100 to 1000 by 100) {
println(s"$i: " + farey(i).length + " elements")
}
}
}

55
Task/Farey-sequence/Scheme/farey-sequence.ss Normal file
View file

@ -0,0 +1,55 @@
(import (scheme base)
(scheme write))
;; create a generator for Farey sequence n
;; using next term formula from https://en.wikipedia.org/wiki/Farey_sequence
(define (farey-generator n)
(let ((a #f) (b 1) (c #f) (d n))
(lambda ()
(cond ((not a) ; first item in sequence
(set! a 0)
(/ a b))
((not c) ; second item in sequence
(set! c 1)
(/ c d))
((= c d) ; return #f when finished sequence
#f)
(else ; compute next term
(let* ((f (floor (/ (+ n b) d)))
(p (- (* f c) a))
(q (- (* f d) b)))
(set! a c)
(set! b d)
(set! c p)
(set! d q)
(/ p q)))))))
(define (farey-sequence n display?)
(define (display-rat n) ; ensure 0,1 show /1
(display n)
(when (= 1 (denominator n))
(display "/1"))
(display " "))
;
(let ((gen (farey-generator n)))
(do ((res (gen) (gen))
(count 0 (+ 1 count)))
((not res) (when display? (newline))
count)
(when display? (display-rat res)))))
;;
(display "Farey sequence for order 1 through 11 (inclusive):\n")
(do ((i 1 (+ i 1)))
((> i 11) )
(display (string-append "F(" (number->string i) "): "))
(farey-sequence i #t))
(display "\nNumber of fractions in the Farey sequence:\n")
(do ((i 100 (+ i 100)))
((> i 1000) )
(display
(string-append "F(" (number->string i) ") = "
(number->string (farey-sequence i #f))))
(newline))

27
Task/Farey-sequence/Sidef/farey-sequence.sidef Normal file
View file

@ -0,0 +1,27 @@
func farey_count(n) { # A005728
1 + sum(1..n, {|k| euler_phi(k) })
}
func farey(n) {
var seq = [0]
var (a,b,c,d) = (0,1,1,n)
while (c <= n) {
var k = (n+b)//d
(a,b,c,d) = (c, d, k*c - a, k*d - b)
seq << a/b
}
return seq
}
say "Farey sequence for order 1 through 11 (inclusive):"
for n in (1..11) {
say("F(%2d): %s" % (n, farey(n).map{.as_frac}.join(" ")))
}
say "\nNumber of fractions in the Farey sequence:"
for n in (100..1000 -> by(100)) {
say ("F(%4d) =%7d" % (n, farey_count(n)))
}

77
Task/Farey-sequence/Stata/farey-sequence.stata Normal file
View file

@ -0,0 +1,77 @@
mata
function totient(n_) {
n = n_
if (n<4) {
if (n<1) return(.)
else if (n>1) return(n-1)
else return(1)
}
else {
r = 1
if (mod(n,2)==0) {
n = floor(n/2)
while (mod(n,2)==0) {
n = floor(n/2)
r = r*2
}
}
for (k=3; k*k<=n; k=k+2) {
if (mod(n,k)==0) {
r = r*(k-1)
n = floor(n/k)
while (mod(n,k)==0) {
n = floor(n/k)
r = r*k
}
}
}
if (n>1) r = r*(n-1)
return(r)
}
}
function map(f,a) {
n = rows(a)
p = cols(a)
b = J(n,p,.)
for (i=1; i<=n; i++) {
for (j=1; j<=p; j++) {
b[i,j] = (*f)(a[i,j])
}
}
return(b)
}
function farey_length(n) {
return(1+sum(map(&totient(),1::n)))
}
function farey(n) {
m = 1+sum(map(&totient(),1::n))
r = J(m,2,.)
r[1,.] = 0,1
a = 0
b = 1
c = 1
d = n
i = 1
while (c<=n) {
k = floor((n+b)/d)
a = k*c-a
b = k*d-b
swap(a,c)
swap(b,d)
r[++i,.] = a,b
}
return(r)
}
for (n=1; n<=11; n++) {
a = farey(n)
m = rows(a)
for (i=1; i<=m; i++) printf("%f/%f ",a[i,1],a[i,2])
printf("\n")
}
map(&farey_length(),100*(1..10))
end

49
Task/Farey-sequence/Swift/farey-sequence.swift Normal file
View file

@ -0,0 +1,49 @@
class Farey {
let n: Int
init(_ x: Int) {
n = x
}
//using algorithm from wikipedia
var sequence: [(Int,Int)] {
var a = 0
var b = 1
var c = 1
var d = n
var results = [(a, b)]
while c <= n {
let k = (n + b) / d
let oldA = a
let oldB = b
a = c
b = d
c = k * c - oldA
d = k * d - oldB
results += [(a, b)]
}
return results
}
var formattedSequence: String {
var s = "\(n):"
for pair in sequence {
s += " \(pair.0)/\(pair.1)"
}
return s
}
}
print("Sequences\n")
for n in 1...11 {
print(Farey(n).formattedSequence)
}
print("\nSequence Lengths\n")
for n in 1...10 {
let m = n * 100
print("\(m): \(Farey(m).sequence.count)")
}

27
Task/Farey-sequence/Tcl/farey-sequence.tcl Normal file
View file

@ -0,0 +1,27 @@
package require Tcl 8.6
proc farey {n} {
set nums [lrepeat [expr {$n+1}] 1]
set result {{0 1}}
for {set found 1} {$found} {} {
set nj [lindex $nums [set j 1]]
for {set found 0;set i 1} {$i <= $n} {incr i} {
if {[lindex $nums $i]*$j < $nj*$i} {
set nj [lindex $nums [set j $i]]
set found 1
}
}
lappend result [list $nj $j]
for {set i $j} {$i <= $n} {incr i $j} {
lset nums $i [expr {[lindex $nums $i] + 1}]
}
}
return $result
}
for {set i 1} {$i <= 11} {incr i} {
puts F($i):\x20[lmap n [farey $i] {join $n /}]
}
for {set i 100} {$i <= 1000} {incr i 100} {
puts |F($i)|\x20=\x20[llength [farey $i]]
}

57
Task/Farey-sequence/V-(Vlang)/farey-sequence.v Normal file
View file

@ -0,0 +1,57 @@
struct Frac {
num int
den int
}
fn (f Frac) str() string {
return "$f.num/$f.den"
}
fn f(l Frac, r Frac, n int) {
m := Frac{l.num + r.num, l.den + r.den}
if m.den <= n {
f(l, m, n)
print("$m ")
f(m, r, n)
}
}
fn main() {
// task 1. solution by recursive generation of mediants
for n := 1; n <= 11; n++ {
l := Frac{0, 1}
r := Frac{1, 1}
print("F($n): $l ")
f(l, r, n)
println(r)
}
// task 2. direct solution by summing totient fntion
// 2.1 generate primes to 1000
mut composite := [1001]bool{}
for p in [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31] {
for n := p * 2; n <= 1000; n += p {
composite[n] = true
}
}
// 2.2 generate totients to 1000
mut tot := [1001]int{init: 1}
for n := 2; n <= 1000; n++ {
if !composite[n] {
tot[n] = n - 1
for a := n * 2; a <= 1000; a += n {
mut f := n - 1
for r := a / n; r%n == 0; r /= n {
f *= n
}
tot[a] *= f
}
}
}
// 2.3 sum totients
for n, sum := 1, 1; n <= 1000; n++ {
sum += tot[n]
if n%100 == 0 {
println("|F($n)|: $sum")
}
}
}

52
Task/Farey-sequence/Vala/farey-sequence.vala Normal file
View file

@ -0,0 +1,52 @@
struct Fraction {
public uint d;
public uint n;
}
void farey(uint n) {
Fraction f1 = {0, 1};
Fraction f2 = {1, n};
print("0/1 1/%u ", n);
while (f2.n > 1) {
var k = (n + f1.n) / f2.n;
var aux = f1;
f1 = f2;
f2 = {f2.d * k - aux.d, f2.n * k - aux.n};
print("%u/%u ", f2.d, f2.n);
}
print("\n");
}
uint fareyLength(uint n, uint[] cache) {
if (n >= cache.length) {
uint newLen = cache.length;
if (newLen == 0)
newLen = 16;
while (newLen <= n)
newLen *= 2;
cache.resize((int)newLen);
}
else if (cache[n] != 0)
return cache[n];
uint length = n * (n + 3) / 2;
for (uint p = 2, q = 2; p <= n; p = q) {
q = n / (n / p) + 1;
length -= fareyLength(n / p, cache) * (q - p);
}
cache[n] = length;
return length;
}
void main() {
for (uint n = 1; n < 12; n++)
{
print("%8u: ", n);
farey(n);
}
uint[] cache = new uint[0];
for (uint n = 100; n <= 1000; n += 100)
print("%8u: %14u items\n", n, fareyLength(n, cache));
}

53
Task/Farey-sequence/Wren/farey-sequence.wren Normal file
View file

@ -0,0 +1,53 @@
import "/math" for Int
import "/iterate" for Stepped
import "/fmt" for Fmt
import "/rat" for Rat
var f //recursive
f = Fn.new { |l, r, n|
var m = Rat.new(l.num + r.num, l.den + r.den)
if (m.den <= n) {
f.call(l, m, n)
System.write("%(m) ")
f.call(m, r, n)
}
}
/* Task 1: solution by recursive generation of mediants. */
for (n in 1..11) {
var l = Rat.zero
var r = Rat.one
System.write("F(%(n)): %(l) ")
f.call(l, r, n)
System.print(r)
}
System.print()
/* Task 2: direct solution by summing totient function. */
// generate primes to 1000
var comp = Int.primeSieve(1001, false)
// generate totients to 1000
var tot = List.filled(1001, 1)
for (n in 2..1000) {
if (!comp[n]) {
tot[n] = n - 1
for (a in Stepped.ascend(n*2..1000, n)) {
var f = n - 1
var r = (a/n).floor
while (r%n == 0) {
f = f * n
r = (r/n).floor
}
tot[a] = tot[a] * f
}
}
}
// sum totients
var sum = 1
for (n in 1..1000) {
sum = sum + tot[n]
if (n%100 == 0) System.print("F(%(Fmt.d(4, n))): %(Fmt.dc(7, sum))")
}

60
Task/Farey-sequence/XPL0/farey-sequence.xpl0 Normal file
View file

@ -0,0 +1,60 @@
proc Farey(N); \Show Farey sequence for N
\Translation of Python program on Wikipedia:
int N, A, B, C, D, K, T;
[A:= 0; B:= 1; C:= 1; D:= N;
Text(0, "0/1");
while C <= N do
[K:= (N+B)/D;
T:= C;
C:= K*C - A;
A:= T;
T:= D;
D:= K*D - B;
B:= T;
ChOut(0, ^ ); IntOut(0, A);
ChOut(0, ^/); IntOut(0, B);
];
];
func GCD(N, D); \Return the greatest common divisor of N and D
int N, D; \numerator and denominator
int R;
[if D > N then
[R:= D; D:= N; N:= R]; \swap D and N
while D > 0 do
[R:= rem(N/D);
N:= D;
D:= R;
];
return N;
]; \GCD
func Totient(N); \Return the totient of N
int N, Phi, M;
[Phi:= 0;
for M:= 1 to N do
if GCD(M, N) = 1 then Phi:= Phi+1;
return Phi;
];
func FareyLen(N); \Return length of Farey sequence for N
int N, Sum, M;
[Sum:= 1;
for M:= 1 to N do
Sum:= Sum + Totient(M);
return Sum;
];
int N;
[for N:= 1 to 11 do
[IntOut(0, N); Text(0, ": ");
Farey(N);
CrLf(0);
];
for N:= 1 to 10 do
[IntOut(0, N); Text(0, "00: ");
IntOut(0, FareyLen(N*100));
CrLf(0);
];
RlOut(0, 3.0 * sq(1000.0) / sq(3.141592654)); CrLf(0);
]

37
Task/Farey-sequence/Yabasic/farey-sequence.basic Normal file
View file

@ -0,0 +1,37 @@
// Rosetta Code problem: https://rosettacode.org/wiki/Farey_sequence
// by Jjuanhdez, 06/2022
for i = 1 to 11
print "F", i, " = ";
farey(i, FALSE)
next i
print
for i = 100 to 1000 step 100
print "F", i;
if i <> 1000 then print " "; else print ""; : fi
print " = ";
farey(i, FALSE)
next i
end
sub farey(n, descending)
a = 0 : b = 1 : c = 1 : d = n : k = 0
cont = 0
if descending = TRUE then
a = 1 : c = n -1
end if
cont = cont + 1
if n < 12 then print a, "/", b, " "; : fi
while ((c <= n) and not descending) or ((a > 0) and descending)
aa = a : bb = b : cc = c : dd = d
k = int((n + b) / d)
a = cc : b = dd : c = k * cc - aa : d = k * dd - bb
cont = cont + 1
if n < 12 then print a, "/", b, " "; : fi
end while
if n < 12 then print else print cont using("######") : fi
end sub

10
Task/Farey-sequence/Zkl/farey-sequence-1.zkl Normal file
View file

@ -0,0 +1,10 @@
fcn farey(n){
f1,f2:=T(0,1),T(1,n); // fraction is (num,dnom)
print("%d/%d %d/%d".fmt(0,1,1,n));
while(f2[1]>1){
k,t :=(n + f1[1])/f2[1], f1;
f1,f2 = f2,T(f2[0]*k - t[0], f2[1]*k - t[1]);
print(" %d/%d".fmt(f2.xplode()));
}
println();
}

1
Task/Farey-sequence/Zkl/farey-sequence-2.zkl Normal file
View file

@ -0,0 +1 @@
foreach n in ([1..11]){ print("%2d: ".fmt(n)); farey(n); }

12
Task/Farey-sequence/Zkl/farey-sequence-3.zkl Normal file
View file

@ -0,0 +1,12 @@
fcn farey_len(n){
var cache=Dictionary(); // 107 keys to 1,000; 6323@10,000,000
if(z:=cache.find(n)) return(z);
len,p,q := n*(n + 3)/2, 2,0;
while(p<=n){
q=n/(n/p) + 1;
len-=self.fcn(n/p) * (q - p);
p=q;
}
cache[n]=len; // len is returned
}

5
Task/Farey-sequence/Zkl/farey-sequence-4.zkl Normal file
View file

@ -0,0 +1,5 @@
foreach n in ([100..1000,100]){
println("%4d: %7,d items".fmt(n,farey_len(n)));
}
n:=0d10_000_000;
println("\n%,d: %,d items".fmt(n,farey_len(n)));