Espiral de Ulam

Descargar como Notebook

Creada por el matemático de origen polaco Stanislaw Marcin Ulam (1909-1984) durante una conferencia en la que estaba de asistente en 1963, comenzó a representar sobre una espiral los enteros positivos así: el 1 en el centro, el 2 a su derecha, el 3 arriba del 2, el 4 a la izquierda del tres y así sucesivamente. Luego destacó los números primos en la espiral y encontró algunos patrones, como que los números primos se tendían a alinear sobre algunas diagonales más que sobre otras, es sorprendente que esta tendencia se mantiene así se comience desde otro número la secuencia.

En Mathematica

Primero determinamos las coordenadas de los puntos donde se ubican cada uno de los enteros positivos en la espiral sobre el plano cartesiano.

a = 0; b = 0;
ulam = {{{{0, 0}}}};
Do[If[OddQ[n], 
  AppendTo[ulam, {Table[{a + k, b}, {k, 1, n}], 
    Table[{a + n, b + k}, {k, 1, n}]}]; a = a + n; b = b + n, 
  AppendTo[ulam, {Table[{a - k, b}, {k, 1, n}], 
    Table[{a - n, b - k}, {k, 1, n}]}]; a = a - n; b = b - n], {n, 15}]
espiral = Flatten[ulam, 2]
{{0, 0}, {1, 0}, {1, 1}, {0, 1}, {-1, 1}, {-1, 0}, {-1, -1}, 
{0, -1}, {1, -1}, {2, -1}, {2, 0}, {2, 1}, {2, 2}, {1, 2}, 
{0, 2}, {-1, 2}, {-2, 2}, {-2, 1}, {-2, 0}, {-2, -1}, {-2, -2}, 
{-1, -2}, {0, -2}, {1, -2}, {2, -2}, {3, -2}, {3, -1}, {3, 0}, 
{3, 1}, {3, 2}, {3, 3}, {2, 3}, {1, 3}, {0, 3}, {-1, 3}, 
{-2, 3}, {-3, 3}, {-3, 2}, {-3, 1}, {-3, 0}, {-3, -1}, 
{-3, -2}, {-3, -3}, {-2, -3}, {-1, -3}, {0, -3}, {1, -3}, 
{2, -3}, {3, -3}, {4, -3}, {4, -2}, {4, -1}, {4, 0}, {4, 1}, 
{4, 2}, {4, 3}, {4, 4}, {3, 4}, {2, 4}, {1, 4}, {0, 4}, 
{-1, 4}, {-2, 4}, {-3, 4}, {-4, 4}, {-4, 3}, {-4, 2}, 
{-4, 1}, {-4, 0}, {-4, -1}, {-4, -2}, {-4, -3}, {-4, -4}, 
{-3, -4}, {-2, -4}, {-1, -4}, {0, -4}, {1, -4}, {2, -4}, 
{3, -4}, {4, -4}, {5, -4}, {5, -3}, {5, -2}, {5, -1}, {5, 0}, 
{5, 1}, {5, 2}, {5, 3}, {5, 4}, {5, 5}, {4, 5}, {3, 5}, {2, 5}, 
{1, 5}, {0, 5}, {-1, 5}, {-2, 5}, {-3, 5}, {-4, 5}, {-5, 5}, 
{-5, 4}, {-5, 3}, {-5, 2}, {-5, 1}, {-5, 0}, {-5, -1}, 
{-5, -2}, {-5, -3}, {-5, -4}, {-5, -5}, {-4, -5}, {-3, -5}, 
{-2, -5}, {-1, -5}, {0, -5}, {1, -5}, {2, -5}, {3, -5}, 
{4, -5}, {5, -5}, {6, -5}, {6, -4}, {6, -3}, {6, -2}, 
{6, -1}, {6, 0}, {6, 1}, {6, 2}, {6, 3}, {6, 4}, {6, 5}, 
{6, 6}, {5, 6}, {4, 6}, {3, 6}, {2, 6}, {1, 6}, {0, 6}, {-1, 6}, {-2, 6}, {-3, 6}, {-4, 6}, {-5, 6}, {-6, 6}, {-6, 5}, {-6, 4}, 
{-6, 3}, {-6, 2}, {-6, 1}, {-6, 0}, {-6, -1}, {-6, -2}, 
{-6, -3}, {-6, -4}, {-6, -5}, {-6, -6}, {-5, -6}, {-4, -6}, 
{-3, -6}, {-2, -6}, {-1, -6}, {0, -6}, {1, -6}, {2, -6}, 
{3, -6}, {4, -6}, {5, -6}, {6, -6}, {7, -6}, {7, -5}, {7, -4}, 
{7, -3}, {7, -2}, {7, -1}, {7, 0}, {7, 1}, {7, 2}, {7, 3}, 
{7, 4}, {7, 5}, {7, 6}, {7, 7}, {6, 7}, {5, 7}, {4, 7}, {3, 7}, 
{2, 7}, {1, 7}, {0, 7}, {-1, 7}, {-2, 7}, {-3, 7}, {-4, 7}, 
{-5, 7}, {-6, 7}, {-7, 7}, {-7, 6}, {-7, 5}, {-7, 4}, {-7, 3}, 
{-7, 2}, {-7, 1}, {-7, 0}, {-7, -1}, {-7, -2}, {-7, -3}, 
{-7, -4}, {-7, -5}, {-7, -6}, {-7, -7},{-6, -7}, {-5, -7}, 
{-4, -7}, {-3, -7}, {-2, -7}, {-1, -7}, {0, -7}, {1, -7}, 
{2, -7}, {3, -7}, {4, -7}, {5, -7}, {6, -7}, {7, -7}, {8, -7}, 
{8, -6}, {8, -5}, {8, -4}, {8, -3}, {8, -2}, {8, -1}, {8, 0}, 
{8, 1}, {8, 2}, {8, 3}, {8, 4}, {8, 5}, {8, 6}, {8, 7}, {8, 8}}

Graficando la espiral, tenemos :

Graphics[Table[Text[k, espiral[[k]]], {k, Length[espiral]}]]

Seleccionando los números primos:

Graphics[Table[
  If[PrimeQ[k], Text[k, espiral[[k]]]], {k, Length[espiral]}]]

Realizando todo el proceso, pero marcando con punto donde se ubica un número primo sobre la espiral:

a = 0; b = 0;
ulam = {{{{0, 0}}}};
Do[If[OddQ[n], 
  AppendTo[ulam, {Table[{a + k, b}, {k, 1, n}], 
    Table[{a + n, b + k}, {k, 1, n}]}]; a = a + n; b = b + n, 
  AppendTo[ulam, {Table[{a - k, b}, {k, 1, n}], 
    Table[{a - n, b - k}, {k, 1, n}]}]; a = a - n; b = b - n], {n, 
  300}]
espiral = Flatten[ulam, 2];
Graphics[Table[
  If[PrimeQ[k], Point[espiral[[k]]]], {k, Length[espiral]}]]

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