Espiral de Sacks

Descargar como Notebook

Construida por Robert Sacks en 1994. Se parte de una espiral de Arquimedes, en radianes el radio es una función lineal creciente que depende del ángulo, tomaremos la más sencilla posible la función idéntica r = θ :

PolarPlot[θ, {θ, 0, 20}, Ticks -> None]

y se ubican los números naturales sobre ella en orden empezando desde cero, de tal forma que los números cuadrados perfectos se ubiquen sobre el eje real positivo, los números entre dos cuadrados perfectos se ubican sobre un mismo giro de forma homogénea.

Para su construcción en Mathematica definimos la función s[n] que genera la lista de los números que se encuentran entre dos cuadrados perfectos, incluyendo el último:

s[0] = {0};
s[n_] := Range[(n - 1)^2 + 1, n^2]

s[1]
{1}

s[2]
{2,3,4}

s[5]
{17, 18, 19, 20, 21, 22, 23, 24, 25}

Definimos la función t[n] que nos genera las coordenadas de los números sobre la espiral:

t[n_] := Graphics[{Red, 
   Table[Text[
     s[n][[k]], {(2 π k/Length[s[n]] + 2 π (n - 1)) Cos[
        2 π k/Length[s[n]]], (2 π k/Length[s[n]] + 
         2 π (n - 1)) Sin[2 π k/Length[s[n]]]}], {k, 1, 
     Length[s[n]]}]}]

y la función sackst[n] que nos representa los números sobre la espiral hasta n^2,

sackst[n_] := 
 Show[PolarPlot[θ, {θ, 0, 2 n π}, Ticks -> None], 
  Table[t[j], {j, 0, n}]]

sackst[10]

Y con las funciones tp[n] y sacksp[n] vamos a dejar únicamente los números primos:

tp[n_] := 
 Graphics[{Red, 
   Table[If[PrimeQ[s[n][[k]]], 
     Text[s[n][[k]], {(2 π k/Length[s[n]] + 2 π (n - 1)) Cos[
        2 π k/Length[s[n]]], (2 π k/Length[s[n]] + 
         2 π (n - 1)) Sin[2 π k/Length[s[n]]]}]], {k, 1, 
     Length[s[n]]}]}]
sacksp[n_] := 
 Show[PolarPlot[θ, {θ, 0, 2 n π}, Ticks -> None], 
  Table[tp[j], {j, n}]]
sacksp[10]

Para mejorar la visualización y poder representar una mayor cantidad de números, pondremos un punto en el lugar que se encuentra un número primo:

p[n_] := Graphics[{Red, 
   Table[If[PrimeQ[s[n][[k]]], 
     Tooltip[Point[{(2 π k/Length[s[n]] + 2 π (n - 1)) Cos[
        2 π k/Length[s[n]]], (2 π k/Length[s[n]] + 
         2 π (n - 1)) Sin[2 π k/Length[s[n]]]}], 
      ToString[s[n][[k]]]]], {k, 1, Length[s[n]]}]}]
sacks[n_] := 
 Show[PolarPlot[θ, {θ, 0, 2 n π}, Ticks -> None], 
  Table[p[j], {j, n}]]

sacks[100]

quitando la espiral de fondo,

sacks[n_] := 
 Show[(*PolarPlot[θ,{θ,0,2n π},Ticks->None],*)
  Table[p[j], {j, n}]]

sacks[100]

se observan curvas donde tienden a organizarse un gran número de primos y otras donde no aparecen, destacamos algunas:

Alineaciones libres de números primos : 

1. Semirrecta horizontal derecha : cuadrados perfectos

2. Línea inmediatamente inferior : números de la forma n² - 1, divisibles siempre por n + 1 y n - 1

3. Semirrecta horizontal izquierda : números de la forma n² + n, divisibles siempre por n y n + 1.

Curvas aparentemente densas en números primos : 

4. Una espiral que, en la ilustración, termina cerca de la parte inferior del disco : números de la forma n² + n + 41, el polinomio descubierto por Euler.

5. Otra espiral situada 24 lugares por encima de la anterior : números de la forma n²+ n + 17

6. Línea inmediatamente superior a la semirrecta horizontal izquierda : números de la forma n² + n - 1

Para mayor información visite la página http://www.numberspiral.com


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