# Mathematica Farey Sequence program

• Mathematica
Here is an overview of Farey sequences; http://mathworld.wolfram.com/FareySequence.html" [Broken]

I need to write a program in Mathematica 8, FareySequence[n_], that takes a positive integer n and returns, as a list, the nth Farey sequence.

So far I have,

Module[{denleft, denright, f, i, j, k, numleft, numright, result, s},
(*Given a positive integer n, this function returns, as a list, the nth Farey sequence.)

But we have to deal with n=1 in a special way, i.e -
If[n==1, {0/1, 1/1},

I want to compute the "left half", L[SUB]n[/SUB] of the nth Farey sequence, first.
So, I figure I can start with L2 and then compute L3, L4,..., Ln in order. For this I would use two lists, f and s:

f[] would be the ith fraction to appear as the various left-halves are computed
and
s[] = j iff the sucessor of f[] is f[[j]].

For example, for L5,
f = {0/1, 1/2, 1/3, 1/4, 1/5, 2/5} and s = {5, 0, 6, 3, 4, 2}

Now, the variable k keeps track of which left half is being computed. So,
For[k=3, k less/equal n, k++, [B]??[/B]];
result = {};

So, I have all these pieces of code that, when I attempt to put together, looks like:

FareySequence[n_] := Module[{denleft, denright, f, i, j, k, numleft, numright, result, s}, If[n==1, {0/1, 1/1}, f={0/1, 1/2}; s={2,0}; For[k=3, k≤n, k++, [B]??[/B]]; result={}; result]]

I need to figure out how to:
(a) Copy the left half of the Farey sequence into result.
(b) Insert the right half of the Farey sequence into result.

Any help is much appreciated.

Last edited by a moderator:

Dale
Mentor
2020 Award
Why not just do:

FareySequence[n_] := Union[Flatten[Table[j/i, {i, 1, n}, {j, 0, i}]]]

Why not just do:

FareySequence[n_] := Union[Flatten[Table[j/i, {i, 1, n}, {j, 0, i}]]]

Unfortunately, I have never been introduced to how the Flatten[] and Union[] functions work. Therefore I can not use them. Is there some way I could use the Append[] function instead?

Dale
Mentor
2020 Award
Hit F1, then type Flatten or Union. Append is generally a function to avoid.

DaleSpam: That's exactly the method used in http://demonstrations.wolfram.com/FareySequence/.

INdeWATERS: Here's a recursive definition of FareySequence with memoization
Code:
Clear[FareySequence]
FareySequence[1] := {0/1, 1/1};
FareySequence[n_Integer?Positive] :=
FareySequence[n] = Module[{oldFS = FareySequence[n - 1], FS = {}},
Do[AppendTo[FS, oldFS[[i]]];
med = Total /@ Through[{Numerator, Denominator}[oldFS[[{i, i + 1}]]]];
If[med[[2]] == n && GCD @@ med == 1, AppendTo[FS, Divide @@ med]],
{i, 1 Length[oldFS] - 1}];
AppendTo[FS, Last[oldFS]]
]
]
It gives the same answer as
Code:
FareySequenceUFT[n_Integer?Positive] := Union[Flatten[Table[j/i, {i, 1, n}, {j, 0, i}]]]
but is a lot slower. It could probably be sped up if it is http://reference.wolfram.com/mathematica/ref/Compile.html" [Broken].

Last edited by a moderator:
Thank you all for your help. It's greatly appreciated. I took some time to understand how the Flatten and Union commands work. Then, I approached my instructor about using them in my FareySequence code and I was, unfortunately, turned down. This FareySequence code is not meant to be efficient but more to enhance my understanding of how, (a) to compute the Farey sequnence's by hand, (which I can do just fine) and (b) to be able to loosely translate an algorithm or theorem into Latex code...
So I am back at square one.

My code is as follows,

FareySequence[n_] := Module[{denleft, denright, f, i, j, k, numleft, numright, result, s}, If[n==1, {0/1, 1/1}, f={0/1, 1/2}; s={2,0}; For[k=3, k≤n, k++, ??]; result={}; result]]

You can look to my original post for more information but I need to fill in the ?? with some code, that I do not know. I feel like I am close to having a complete code, I just need to fill in the "blanks".

thanks again everyone

Thank you all for your help. It's greatly appreciated. I took some time to understand how the Flatten and Union commands work. Then, I approached my instructor about using them in my FareySequence code and I was, unfortunately, turned down. This FareySequence code is not meant to be efficient but more to enhance my understanding of how, (a) to compute the Farey sequnence's by hand, (which I can do just fine) and (b) to be able to loosely translate an algorithm or theorem into Latex code...
So I am back at square one.

My code is as follows,

FareySequence[n_] := Module[{denleft, denright, f, i, j, k, numleft, numright, result, s}, If[n==1, {0/1, 1/1}, f={0/1, 1/2}; s={2,0}; For[k=3, k≤n, k++, ??]; result={}; result]]

You can look to my original post for more information but I need to fill in the ?? with some code, that I do not know. I feel like I am close to having a complete code, I just need to fill in the "blanks".

thanks again everyone

Dale
Mentor
2020 Award
What do you want ?? to do, step-by-step, in detail? If you need to be able to translate an algorithm into code the first step is to specify what the algorithm actually does in excruciating detail.

INdeWATERS: You can turn the recursive solution I gave into a single loop, but that will make it even slower since you can't use memoization. This solution works by taking the previous Farey sequence then for each consecutive pair adding in their mediant if its denominator is not too big.

Or you can use the algorithm given in Wikipedia that I reproduced https://www.physicsforums.com/showthread.php?t=489669".

But you should really put some more work in yourself. Your code fragment hasn't changed since the original post...

Last edited by a moderator: