Sucesión de Farey

Descargar como Notebook

Dado un número entero positivo n la Sucesión de Farey de orden n, notada F(n), corresponde a la lista ordenada de forma creciente de todas las fracciones irreducibles entre 0 y 1 que tienen denominador menor o igual a n.

Su nombre se debe al geólogo británico Jhon Farey, quien publicó en 1816 en forma de conjetura que: "cada término de la sucesión es la suma de los numeradores de sus vecinos sobre la suma de los denominadores de los mismos".

Construcción

Para la construcción por ejemplo de F (5), se toman todas las fracciones posibles menores o iguales a 1 con denominador 1, 2, 3, 4 y 5:

farey[p_, q_] :=HoldForm[p/q](*es provisional para asegurarnos que                       no simplifique aún las fracciones*)

Flatten[Table[farey[p, q], {q, 1, 5}, {p, 0, q}], 1]

Se simplifican y descartan las repetidas:

DeleteDuplicates@Flatten[Table[p/q, {q, 1, 5}, {p, 0, q}], 1] /. {0 ->  "⁰/₁",  1 -> "¹/₁"}

Se ordenan en forma creciente :

Sort@DeleteDuplicates@Flatten[Table[p/q, {q, 1, 5}, {p, 0, q}], 1] /.{0 ->  "⁰/₁",  1 -> "¹/₁"}

Definimos una función dependiendo de n para generar las Sucesiones de Farey:

farey[n_] := 
 DeleteDuplicates@Sort@Flatten[Table[p/q, {q, 1, n}, {p, 0, q}], 1] /.{0 ->  "⁰/₁",  1 -> "¹/₁"}


farey[1]

farey[2]

farey[3]

Mathematica tiene incorporado el comando FareySequence[ ] :

FareySequence[5]

Propiedades

Longitud de cada Sucesión de Farey

Calculemos la longitud de las primeras 20 Sucesiones de Farey :

Table[Length[farey[n]], {n, 20}]
{2, 3, 5, 7, 11, 13, 19, 23, 29, 33, 43, 47, 59, 65, 73, 81, 97, 103, 121, 129}

Buscamos una fórmula para el término general :

FindSequenceFunction[{2, 3, 5, 7, 11, 13, 19, 23, 29, 33, 43, 47, 59, 65, 73, 81, 97, 103, 121, 129}, n]

Mathematica no la encuentra, pero observemos que: F(n-1) está contenido en F(n) para todo n mayor que 1, y que F(n) contiene fracciones de denominador n y por numerador los números que son coprimos (primos relativos) con n. Por tanto,

Long (F (n)) =
 Long (F (n - 1)) +  φ(n), donde φ(n) la función de Euler

Así,

Long (F (1)) = 2
Long (F (2)) = Long (F (1)) + φ(2) = 2 +  φ (2)
Long (F (3)) = Long (F (2)) + φ(3) = 2 +  φ(2) +  φ(3)

Por tanto,

Como φ (2) = 1 y  φ n) es par para n > 2, se tiene que Long (F (n)) es siempre impar para n mayor que 1, donde los extremos son las fracciones 0/1 y 1/1 y el término de la mitad es 1/2. Cuando n toma un valor grande se tiene que:

Long(F(n)) ~ 3n^2/π

Cada término de la sucesión es la suma de los numeradores de sus vecinos sobre la suma de los denominadores de los mismos


Por ejemplo para F (10), tenemos:

fa = FareySequence[10]

Table[If[(Numerator[fa[[n - 1]]] + 
      Numerator[fa[[n + 1]]])/(Denominator[fa[[n - 1]]] + 
      Denominator[fa[[n + 1]]]) == fa[[n]], "Cumple"], {n, 2, 
  Length[fa] - 1}]

{Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple,
Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple,
Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple, Cumple,
Cumple, Cumple, Cumple}

Representaciones

Círculos de Ford 

(Publicados aquí el 10 de Octubre de 2017) Para cada término de una sucesión de Farey p/q, se le asocia los círculos centrados en (p/q,1/(2q^2)) y con radio 1/(2q^2), obteniendo:

Show@Table[
   Graphics[
    If[CoprimeQ[p, q], Tooltip@Circle[{p/q, 1/(2 q^2)}, 1/(2 q^2)]], 
    Axes -> True, PlotRange -> {{-0.5, 1.5}, {0, 1}}], {q, 1, n}, {p, 0, q}], {n, 1, 10, 1}]

Diagrama de Círculos

Se construyen arcos de circunferencia uniendo términos consecutivos de cada Sucesión de Farey.

FareyPairArc[r1_, r2_] := 
 Circle[{(r1 + r2)/2, 0}, (r2 - r1)/2, {0, Pi}]
Show[Table[Graphics[{ColorData[94, n], 
    FareyPairArc @@@ Partition[FareySequence[n], 2, 1]}], {n, 1,6}]]

Denominadores de las Sucesiones de Farey en Representación Matricula

Representando los denominadores de F (12) en una matriz, donde la posición es la columna y su valor la fila.

Denominator /@ FareySequence[12]

{1, 12, 11, 10, 9, 8, 7, 6, 11, 5, 9, 4, 11, 7, 10, 3, 11, 8, 5, 12, 7, 9, 11, 2, 11, 9, 7, 12, 5, 8, 11, 3, 10, 7, 11, 4, 9, 5, 11, 6, 7, 8, 9, 10, 11, 12, 1}

MatrixPlot[SparseArray[MapIndexed[Prepend[#2, #1] -> 1 &, %]], 
 Mesh -> All]

Para F (100),

MatrixPlot[
 SparseArray[MapIndexed[Prepend[#2, #1] -> 1 &,Denominator/@FareySequence[100]]]]

Para aprender más sobre Mathematica ingrese aquí sitio de aprendizaje de Wolfram o en mi website ustamathematica.wixsite.com/basicas