La Conjetura de Collatz

Descargar como Notebook

El matemático Lothar Collatz (1910-1990) la dio a conocer en 1937, su enunciado es muy sencillo, como toda buena conjetura:

Dado un número entero positivo cualquiera : si es par se divide por dos y si es impar se multiplica por tres y se le suma uno al resultado. Si este proceso se repite iterativamente siempre se obtendrá el número uno.

Es decir, dada la función:

la órbita para todo número natural siempre se estabiliza en 4,2,1,4,2,1,...

En Mathematica

Limpiamos la variable f y definimos la función de Collatz :

Clear[f]

f[n_Integer]:= Piecewise[{{n/2, EvenQ[n]}, {3 n + 1, OddQ[n]}}]

Calculamos la órbita que recorre 9 para llegar a uno :

NestWhileList[f, 9, # != 1 &]

{9, 28, 14, 7, 22, 11, 34, 17, 52, 26, 13, 40, 20, 10, 5, 16, 8, 4, 2, 1}

Calculamos su longitud:


Length@NestWhileList[f, 9, # != 1 &]
20

Ahora, para los primeros 10000 números naturales calculamos la cantidad de pasos necesarios, la longitud de la órbita, para obtener el número uno y lo graficamos:


numero = 10000;
collatz = {};
Do[AppendTo[collatz, {k, Length@NestWhileList[f, k, # != 1 &]}], {k, 
   numero}];
ListPlot[Tooltip[collatz]]

Observamos como para el número 6171 son necesarios 262 pasos.



NestWhileList[f, 6171, # != 1 &]

{6171, 18514, 9257, 27772, 13886, 6943, 20830, 10415, 31246, 15623, 46870, 23435, 70306, 35153, 105460, 52730, 26365, 79096, 39548, 19774, 9887, 29662, 14831, 44494, 22247, 66742, 33371, 100114, 50057, 150172, 75086, 37543, 112630, 56315, 168946, 84473, 253420, 126710, 63355, 190066, 95033, 285100, 142550, 71275, 213826, 106913, 320740, 160370, 80185, 240556, 120278, 60139, 180418, 90209, 270628, 135314, 67657, 202972, 101486, 50743, 152230, 76115, 228346, 114173, 342520, 171260, 85630, 42815, 128446, 64223, 192670, 96335, 289006, 144503, 433510, 216755, 650266, 325133, 975400, 487700, 243850, 121925, 365776, 182888, 91444, 45722, 22861, 68584, 34292, 17146, 8573, 25720, 12860, 6430, 3215, 9646, 4823, 14470, 7235, 21706, 10853, 32560, 16280, 8140, 4070, 2035, 6106, 3053, 9160, 4580, 2290, 1145, 3436, 1718, 859, 2578, 1289, 3868, 1934, 967, 2902, 1451, 4354, 2177, 6532, 3266, 1633, 4900, 2450, 1225, 3676, 1838, 919, 2758, 1379, 4138, 2069, 6208, 3104, 1552, 776, 388, 194, 97, 292, 146, 73, 220, 110, 55, 166, 83, 250, 125, 376, 188, 94, 47, 142, 71, 214, 107, 322, 161, 484, 242, 121, 364, 182, 91, 274, 137, 412, 206, 103, 310, 155, 466, 233, 700, 350, 175, 526, 263, 790, 395, 1186, 593, 1780, 890, 445, 1336, 668, 334, 167, 502, 251, 754, 377, 1132, 566, 283, 850, 425, 1276, 638, 319, 958, 479, 1438, 719, 2158, 1079, 3238, 1619, 4858, 2429, 7288, 3644, 1822, 911, 2734, 1367, 4102, 2051, 6154, 3077, 9232, 4616, 2308, 1154, 577, 1732, 866, 433, 1300, 650, 325, 976, 488, 244, 122, 61, 184, 92, 46, 23, 70, 35, 106, 53, 160, 80, 40, 20, 10, 5, 16, 8, 4, 2, 1}

Length@NestWhileList[f, 6171, # != 1 &]
262

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