Teorema de Moessner

Descargar como Notebook

Propuesto por el matemático Alfred Moessner en 1951, pero demostrado al año siguiente por Oskar Perrone.

Es un método de constructivo que partiendo de la sucesión de los números enteros positivos {1,2,3,4,5,6,7,8,9,10,11,...}, consigue la sucesión de las potencias cuadradas {1,4,9,16,...}, cúbicas {1,8,27,64,...} , cuartas {1,16,81,256,..}, etc. de los números enteros positivos.

Teorema de Moessner

dado un número n, mayor que 1, se genera una primera sucesión al tachar de n en n elementos en la sucesión de los números enteros positivos 1, 2, 3, 4, 5, 6, . . . Para generar la segunda sucesión se realizan las sumas acumulativas de los números no tachados, y entonces se tacha de (n - 1) en (n - 1) elementos de la sucesión. Y se continúa así hasta que se tache uno de cada dos elementos de la correspondiente sucesión. Entonces, la sucesión de las sumas acumulativas de los números no tachados de la última sucesión que ha quedado, es precisamente la sucesión de las potencias enésimas de los números naturales, es decir, 1ⁿ, 2ⁿ, 3ⁿ, 4ⁿ, etc.

Cuadrados

Partiendo de la lista de los 20 primeros enteros positivos,

Range[20]

{1,2,3,4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20}

Eliminamos de ella los números de dos en dos, es decir en este caso los pares,

Drop[Range[20], {2, 20, 2}]

{1, 3, 5, 7, 9, 11, 13, 15, 17, 19}

Realizamos las sumas acumuladas en cada posición,

Accumulate@Drop[Range[20], {2, 20, 2}]

{1, 4, 9, 16, 25, 36, 49, 64, 81, 100}

Obteniendo los cuadrados de los enteros positivos.

Range[10]^2

{1, 4, 9, 16, 25, 36, 49, 64, 81, 100}

Cubos

Nuevamente partiendo de la lista de los primeros 20 números enteros positivos, ahora vamos a eliminar de tres en tres :

Range[20]

{1,2,3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,20}

Drop[Range[20], {3, 20, 3}]

{1, 2, 4, 5, 7, 8, 10, 11, 13, 14, 16, 17, 19, 20}

Realizamos sus sumas parciales

Accumulate@Drop[Range[20], {3, 20, 3}]

{1, 3, 7, 12, 19, 27, 37, 48, 61, 75, 91, 108, 127, 147}

Eliminamos de dos en dos y volvemos a sumar,

Accumulate@Drop[Accumulate@Drop[Range[20], {3, 20, 3}], {2, 14, 2}]

{1, 8, 27, 64, 125, 216, 343}

Obtenemos los cubos, potencias terceras, de los enteros positivos.

Range[7]^3

{1, 8, 27, 64, 125, 216, 343}

Generalización del Método

Definimos la función moessner[n,m], donde n representa el orden de potencia que deseamos y m la longitud de la lista de potencias deseada.

moessner[n_Integer, m_Integer] := 

 Module[{p, q}, p[0] = Range[n m]; 

  Print[Column[{Row[{"De la lista de los primeros ", n m, 

       " enteros positivos, marcamos los multiplos de " , n, 

       " que se van a eliminar:"}], 

     Table[If[Mod[k, n] == 0, Text[p[0][[k]], Background -> Yellow], 

       p[0][[k]]], {k, n m}]}]]; i = 1; 

  While[i < n, 

   q[i] = Drop[p[i - 1], {n - i + 1, Length[p[i - 1]], n - i + 1}]; 

   p[i] = Accumulate[q[i]]; 

   Print[Column[{"Lista resultante después de la eliminación de los términos antes señalados:", q[i]}]];

   

   If[i < n - 1, 

    Print[Column[{Row[{"Sumas acumuladas de la lista anterior, marcando de ", n - i, " en ", n - i, " los próximos a eliminar:"}], 

       Table[If[Mod[k, n - i] == 0, 

         Text[p[i][[k]], Background -> Yellow], p[i][[k]]], {k, 

         Length[p[i]]}]}]], 

    Print[Column[{"Al realizar las sumas acumuladas obtenemos las potencias deseadas:", p[i]}]]]; i++]]

La función moessner así definida, nos va "narrando" el proceso que se sigue durante la construcción dada en el Teorema de Moessner. 

Por ejemplo,  determinaremos las potencias sextas de los primeros 10 enteros positivos. 

Comprobemos la respuesta que hemos obtenido:

Range[10]^6
{1, 64, 729, 4096, 15625, 46656, 117649, 262144, 531441, 1000000}

que corresponde a la última salida de la función moessner.


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