Primo Morada

Descargar como Notebook

Dado un número entero n mayor que 1. Se listan todos sus factores primos en orden ascendente, incluyendo los factores repetidos, este producto se concatena obteniendo un nuevo número. Al número obtenido se le realiza el mismo procedimiento hasta obtener un número primo, este se denomina el primo morada del número inicial pm(n).

Por ejemplo, si n = 14, sus factores primos ordenados son (2,7) y obtendríamos el número 27. Sus factores primos son (3,3,3) y conseguiríamos así el número 333. Los factores primos de 333 son (3,3,37), y lograríamos el número 3337. El anterior número factoriza en (47,71), obteniendo al concatenarlos 4771, que es el producto de los primos 13 y 367. Y 13367 es primo, con lo cual habríamos terminado. Así pm(14)=13367. En resumen,

pm (14) = pm (27) = pm (333) = pm (3337) = pm (4771) = pm (13367) = 13367

también, si n es primo se tiene que pm (n) = n .

En Mathematica

Primero, se define la función pm[ ] que dado un número genera la concatenación de sus factores primos:

vv[aa_] := IntegerDigits@Table[aa[[1]], {i, aa[[2]]}]

pm[n_] := FromDigits@Flatten@Map[vv, FactorInteger[n]]

Aplicado al número 14 tenemos :

FactorInteger[14]

{{2, 1}, {7, 1}}

Aparecen, 2 una vez por 7 una vez,

pm[14]

27

Es importante que tenga presente también factores primos de más de una cifra:

FactorInteger[333]

{{3, 2}, {37, 1}}

Aparecen, 3 dos veces y 37 una vez,

pm[333]

3337

Ahora, se define la función pmlist[ ] que genera la lista del proceso hasta conseguir el Primo Morada,

pmlist[n_] := NestWhileList[pm, n, CompositeQ[#] &]

Aplicado al 14, tenemos :

pmlist[14]

{14, 27, 333, 3337, 4771, 13367}

Aplicando la función pmlist[ ] a los enteros de 2 a 10 :

Table[{n, pmlist[n]}, {n, 2, 10}] // TableForm

Definimos la función pmorada[ ] que nos muestra el número de elementos en pmlist[ ] y el Primo Morada,

pmorada[n_] := 

 Module[{lista}, lista = pmlist[n]; {Length[lista], Last[lista]}]

TableForm[Table[Flatten[{n, pmorada[n]}], {n, 2, 48}], 

 TableHeadings -> {None, {"Número", "Iteraciones", "Primo Morada"}}]

Conjetura

Para el número 49 no se ha podido establecer si este proceso tiene un fin, es decir si en algún momento se alcanza un número primo.

pmlistr[n_] := NestWhileList[pm, n, CompositeQ[#] &, 50, 30]

pmlistr[49]

{49, 77, 711, 3379, 31109, 132393, 344131, 1731653, 71143523, 11115771019, 31135742029, 717261644891, 11193431873899, 116134799345907, 3204751189066719, 31068250396355573, 

62161149980213343, 336906794442245927, 734615161567701999, 31318836286194043641, 333431436916146111627309, 33205716184556772142207827, 31367222155734752971376323127, 

733915126325777821480557336017, 476734743112036198712947236602187, 

377171280957470909577133234490256751, 3096049809383121823389214993262890297, 

73796236325118712936424989555929478399, 13118114526141133089538087518197265265053, 

319521441731977174163487542111577539726749, 595415617656474189392601483764603009147911}

Primeros 30 números para 49 y no se encuentra el Primo Morada.

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