Entrada destacada

Distancia media de dos puntos en un cuadrado unitario

lunes, 26 de diciembre de 2016

Conjetura de Gilbreath



Propuesta por el matemático Norman Gilbreath en el año de 1958, aunque después se supo que en 1878 ya había sido propuesta por François Proth quien además la probó de forma errónea.

Consideremos una lista de los primeros números primos, y realizamos la resta de cada uno con el siguiente tomando valor absoluto, obtenemos una lista con un elemento menos. Realizamos este procedimiento hasta que obtengamos una lista con un sólo elemento.

Conjetura

Los primeros elementos de todas las listas anteriores son unos.

En Mathematica

Calculamos los primeros 25 números primos :

primos = Table[Prime[n], {n, 25}]
{2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97}

Consideramos el siguiente código donde primero definimos el conjunto listas={primos} donde vamos a ir guardando las listas que vamos obteniendo, primos será la única lista que no comienza en 1. Definimos también la operación difer[p] que realizará la resta entre los elementos consecutivos tomando al final valor absoluto.

listas = {primos};
difer[p_] :=
 Table[Abs[listas[[p, k + 1]] - listas[[p, k]]], {k,
   Length[listas[[p]]] - 1}]
Do[AppendTo[listas, difer[p]], {p, Length[primos] - 1}]
TableForm[PadLeft[listas, {Length[primos], Length[primos]}, " "]]
















Inicialmente se puede pensar que es obvio, pues como todos salvo el primero son números impares al ir restando se debe llega a 2, y como el primer elemento es 1 pues la diferencia será 1. Pero supongamos que los primeros elementos fueran:

primos = {2, 3, 7, 11, 17, 19};

no estamos considerando: 5 y 13 como primos.

listas = {primos};
difer[p_] :=
 Table[Abs[listas[[p, k + 1]] - listas[[p, k]]], {k,
   Length[listas[[p]]] - 1}]
Do[AppendTo[listas, difer[p]], {p, Length[primos] - 1}]
TableForm[PadLeft[listas, {Length[primos], Length[primos]}, " "]]












Luego ya no es tan obvia la Conjetura de Gilbreath. El matemático húngaro Paul Erdös afirmó que era cierta pero que le tomaría unos 200 años en resolverla (demostrarla). El matemático Andrew Odlyzko probó en 1993 que es cierta para los primos menores de 3.4*10^11.


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


lunes, 19 de diciembre de 2016

Algunas Clases de Números y sus Conjeturas




Números Perfectos

Son los números enteros positivos que al sumar sus divisores propios se obtiene el mismo número.

Por ejemplo el número 6 , sus divisores son:

Divisors[6]
{1, 2, 3, 6}

Y la suma de sus divisores propios:

Total[Divisors[6]] - 6
6

resto 6 para dejar únicamente la suma de los divisores propios, como se obtiene el mismo número quiere decir que es perfecto.

Se conocen muy pocos de ellos y se conjetura la existencia de más, ya veremos por qué?, calculemos algunos entre el primer millón de enteros positivos:

perfectos = {};
Do[If[Total[Divisors[n]] == 2 n, AppendTo[perfectos, n]], {n, 1, 
  1000000}]
perfectos

{6, 28, 496, 8128}

Hasta aquí hemos trabajado con las funciones básicas de Mathematica, pero por la labor que se puede realizar en investigación con Mathematica entre otras ramas como teoría de números, se tienen funciones que facilitan el trabajo, en este caso PerfectNumber. Aquí pedimos que nos calcule los diez primeros números perfectos:

Table[PerfectNumber[n], {n, 10}]

{6, 28, 496, 8128, 33550336, 8589869056, 137438691328,
2305843008139952128, 2658455991569831744654692615953842176,
191561942608236107294793378084303638130997321548169216}

El décimo con 54 cifras de longitud.

Euclides observó que los cuatro primeros números perfectos, los que se conocían hasta el momento, cumplían la fórmula:


recordemos que ya en una entrada del 19 de septiembre de 2016 hablamos de los primos de Mersenne que son los primos de la forma 2^p-1, de los cuales se conocen hasta el momento 49, los mismos que números perfectos.

Otra curiosidad, si los escribimos en forma binaria:

BaseForm[perfectos, 2]



siempre son unos seguidos de ceros, pues son de la forma:


potencias de dos que generan unos menos una potencia menor de dos que genera los ceros al final.

Conjeturas

1. Existen infinitos números perfectos, ligada a la Conjetura de Mersenne.
2. Existen números perfectos impares.

Y una pregunta fácilmente demostrable, que todos los números perfectos pares terminan en 6 o 8. Demuéstrelo!!!

Números Deficientes

Son los números enteros positivos que al sumar sus divisores propios se obtiene una cantidad menor que el número inicial.

El código para encontrarlos es sencillo, trabájelo!!

Números Abundantes

Son los números enteros positivos que al sumar sus divisores propios se obtiene una cantidad mayor que el número inicial.

El código para encontrarlos es sencillo, trabájelo!!

Si unimos los números perfectos, con los deficientes y los abundantes obtenemos todos los enteros positivos.

Números Amigos

Son dos enteros positivos diferentes tales que la suma de los divisores propios de uno dan el otro y viceversa. Se especifica diferentes para excluir las parejas de números perfectos con ellos mismos.

Estos números tienen una larga historia entre los griegos y los árabes, junto con matemáticos destacados como Leonhard Euler, Pierre de Fermat y René Descartes.

amigos = {};
Do[If[Total[Divisors[Total[Divisors[n]] - n]] == Total[Divisors[n]] && 2 n != Total[Divisors[n]], AppendTo[amigos, {n, Total[Divisors[n]] - n}]], {n, 100000}]
amigos

{{220, 284}, {284, 220}, {1184, 1210}, {1210, 1184}, {2620, 2924}, {2924, 2620}, {5020, 5564}, {5564, 5020}, {6232, 6368}, {6368, 6232}, {10744, 10856}, {10856, 10744}, {12285, 14595}, {14595, 12285}, {17296, 18416}, {18416, 17296}, {63020, 76084}, {66928, 66992}, {66992, 66928}, {67095, 71145}, {69615, 87633}, {71145, 67095}, {76084, 63020}, {79750, 88730}, {87633, 69615}, {88730, 79750}}

Ejercicio: Modifique el código para que cada pareja aparezca una sola vez.

Alrededor del año 850, Tabit ibn Qurra (826-901) descubrió una fórmula general para determinar números amigos: si


con n entero mayor que uno y p, q y r son primos, entonces



son amigos. Esta fórmula nos da una condición suficiente más no necesaria, pues existen parejas de números amigos que no la satisfacen.

Ejercicio : Desarrolle un código que genere parejas de números amigos utilizando la fórmula de Tabit ibn Qurra. Encuentre una pareja de números amigos que no cumpla esta fórmula.

Conjetura

Existen infinitas parejas de números amigos que no cumplen la fórmula de Tabit ibn Qurra.

Números Sociables

Generaliza la idea de números amigos a más de dos. Se genera una sucesión donde la suma de los divisores propios de un término generan el siguiente y se pide que se repita el primero en la sucesión.

No se conocen ternas de números sociables, pero sí cuartetas como por ejemplo:

(1264460, 1547860, 1727636, 1305184) Compruébelo!!!

Ejercicio : Realice un código para probar que no existen ternas de números sociables menores que un millón.

Conjetura

No existen ternas de números sociables.

Números Semiperfectos

Son los números enteros positivos cuya suma de algunos de sus divisores propios da el número inicial. Por tanto estos números son abundantes.

Por ejemplo en número 12 es semiperfecto, pues:

Divisors[12]
{1, 2, 3, 4, 6, 12}

1 + 2 + 3 + 6 = 12, sin tomar el 4,
2 + 4 + 6 = 12, sin tomar el 1 y 3. No hay más posibilidades.

Código para determinar números semiperfectos menores que 100:

semiperfectos = {};
Do[If[MemberQ[Total /@ Drop[Subsets[Drop[Divisors[n], -1]], Length[Divisors[n]]],n], AppendTo[semiperfectos, n]], {n, 100}]
semiperfectos

{6, 12, 18, 20, 24, 28, 30, 36, 40, 42, 48, 54, 56, 60, 66, 72, 78, 
80, 84, 88, 90, 96, 100}

Conjetura

Sea m un número natural mayor que cero, si n es un número semiperfecto que resulta de multiplicar m por un número perfecto y el resultado de este producto dividido entre dos es par, entonces existen por lo menos m formas de expresar el número n mediante la suma de sus divisores propios.

Aclaremos, supongamos que vamos a tomar como m=2 y n=12, claramente n resulta de multiplicar el número perfecto 6 por m. Al dividir por dos este producto, el número semiperfecto, obtenemos un número par 6, por tanto se pueden encontrar m=2 formas de expresar el número semiperfecto como la suma de sus divisores propios. Observe el ejemplo con 12 al comienzo en la definición.

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


miércoles, 14 de diciembre de 2016

Números Primos por Cortes



El número 357686312646216567629137 de 24 cifras tiene la característica de ser primo, y todos los números que se generan al ir quitando cifras a la izquierda también son primos.

La gracia de este número es que no tiene ceros, pues así se podrían encontrar soluciones demasiados triviales, que no tendrían gracia, como por ejemplo:

PrimeQ[1000000000000000000000007]
True

Verifiquemos que el número 357686312646216567629137 es primo:

PrimeQ[357686312646216567629137]
True

Sí es primo. Ahora para irle retirando cifras a la izquierda, obtenemos la lista de sus dígitos :

numlis = IntegerDigits[357686312646216567629137]
{3, 5, 7, 6, 8, 6, 3, 1, 2, 6, 4, 6, 2, 1, 6, 5, 6, 7, 6, 2, 9, 1, 3, 7}

Retiramos su primer elemento y formamos el número:

Rest[numlis]
{5, 7, 6, 8, 6, 3, 1, 2, 6, 4, 6, 2, 1, 6, 5, 6, 7, 6, 2, 9, 1, 3,7}

Formamos el número que se obtiene:

FromDigits[%]
57686312646216567629137

verificamos que también es primo:

PrimeQ[57686312646216567629137]
True

Ahora, realicemos de forma más eficiente esta comprobación :

cortes = {num};

Do[AppendTo[cortes, FromDigits[Rest@IntegerDigits[cortes[[n]]]]], {n,23}]
cortes

{357686312646216567629137, 57686312646216567629137, 7686312646216567629137, 686312646216567629137, 86312646216567629137, 6312646216567629137, 312646216567629137, 12646216567629137, 2646216567629137, 646216567629137, 46216567629137, 6216567629137, 216567629137, 16567629137, 6567629137, 567629137, 67629137, 7629137, 629137, 29137, 9137, 137, 37, 7}

PrimeQ[cortes]
{True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True, True}

Así, todos los números obtenidos por este procedimiento de retirar la primera cifra de la izquierda a partir de 357686312646216567629137 son números primos.

Ahora, desarrollemos algunas ideas y preguntas sobre este procedimiento.

Demostremos que es el número más grande, sin ceros, con esta característica.

A partir de el conjunto de los primos de una cifra pri[1]={2,3,5,7}, agregamos dígitos a la izquierda conformando conjuntos de primos, y así sucesivamente:

Clear[p]
Table[pri[n] = {}, {n, 2, 30}];
pri[1] = {2, 3, 5, 7};
Do[Do[Do[If[PrimeQ[pri[p][[n]] + k 10^p], 
    AppendTo[pri[p + 1], pri[p][[n]] + k 10^p]], {k, 1, 9}], {n, 
   Length[pri[p]]}], {p, 25}]
pri[24]
Length[pri[25]]

{357686312646216567629137}
0

Vemos que es el último número de 24 cifras y no existen de 25 cifras.

Graficamos por cantidad de dígitos cuantos números con esta propiedad se encuentran:

Table[Length[pri[n]], {n, 24}]
{4, 11, 39, 99, 192, 326, 429, 521, 545, 517, 448, 354, 276, 212, 117, 72, 42, 24, 13, 6, 5, 4, 3, 1}

Show[ListPlot@Table[Length[pri[n]], {n, 24}], 
 AxesLabel -> {HoldForm[Dígitos], HoldForm[Cantidad de Números]}, 
 PlotLabel -> HoldForm[Números que cumplen la propiedad], 
 LabelStyle -> {GrayLevel[0]}]


Cuál es el número más pequeño, de una, dos o tres cifras, que se puede agregar a 357686312646216567629137 a la izquierda tal que sea primo?

n = 1;
cand = {};
While[! PrimeQ[357686312646216567629137 + n 10^24], AppendTo[cand, 357686312646216567629137 + n 10^24]; n++]
cand

{1357686312646216567629137, 2357686312646216567629137,
3357686312646216567629137, 4357686312646216567629137, 
5357686312646216567629137, 6357686312646216567629137, 
7357686312646216567629137, 8357686312646216567629137, 
9357686312646216567629137, 10357686312646216567629137,
11357686312646216567629137, 12357686312646216567629137, 
13357686312646216567629137, 14357686312646216567629137, 
15357686312646216567629137, 16357686312646216567629137, 
17357686312646216567629137, 18357686312646216567629137, 
19357686312646216567629137, 20357686312646216567629137}

PrimeQ[cand]
{False, False, False, False, False, False, False, False, False, 
False, False, False, False, False, False, False, False, False, False, 
False}

PrimeQ[357686312646216567629137 + 21 10^24]
True

357686312646216567629137 + 21 10^24
21357686312646216567629137

Si únicamente hubiéramos agregado 1 a la izquierda el número obtenido no es primo.

Cuál el número más grande posible terminado en 3 con la misma característica y sin ceros?

Los números tienen que terminar en primo 2,3,5,7. En 2 y 5 no puede ser pues ya de dos cifras no es primo,  por tanto estos números sólo pueden terminar en 3 o 7. En los números de 20 dígitos únicamente de los seis restantes hay uno que termina en tres que es: 36484957213536676883

pri[20]
{36484957213536676883, 67986315421273233617, 86312646216567629137,
18918997653319693967, 15396334245663786197, 66276812967623946997}

En los de 21 dígitos ya no hay terminados en tres:

pro[21]
{367986315421273233617, 686312646216567629137, 918918997653319693967,
315396334245663786197, 666276812967623946997}

Ejercicio : Si la propiedad fuera agregando cifras a la derecha con la misma característica que los números obtenidos en cada paso sean primos. Cuál sería el número más grande que se puede obtener?


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


viernes, 9 de diciembre de 2016

Conjetura de Collatz como un Fractal



La Conjetura de Collatz de la cual hablamos en la entrada del 20 de noviembre de 2016, es uno de esos problemas abiertos que fascinan por su gran sencillez y sobre todo por el hecho que aún no se tenga una demostración o refutación. Para completar la fascinación por esta conjetura vamos a realizar una representación gráfica de la función de Collatz en los complejos basados en los puntos que convergen y divergen al iterarlos, componer la función con ella misma, continuamente.

La función de Collatz la podemos escribir como :


la podemos extender a los números complejos, como :


Pero esta función no es continua en los enteros, entonces la vamos a modificar por una función que tenga el mismo comportamiento en los enteros pero que allí sea continua:


Observen que aquí, si z es par el primer término es z/2 y el segundo cero, y si z es impar el primer término da cero y el segundo 3z+1. Es decir, se comporta de forma parecida a nuestra función inicial de Collatz, claro está en los números enteros. Como es dispendioso trabajar con el término (-1)^z vamos a utilizar:



de donde obtenemos que :

Ahora, determinando la convergencia después de 20 iteraciones que sea menor a 10^(-6) tenemos :

DensityPlot[
 Length[FixedPointList[(1/4) (2 + 7 # - (2 + 5 #) Cos[\[Pi] #]) &, 
   x + y I, 20, SameTest -> (Abs[#1 - #2] < 10^-6 &)]], {x, -2, 
  2}, {y, -2, 2}, Mesh -> False, PlotPoints -> 100, 
 ColorFunction -> "Rainbow", ImageSize -> 300]



Aquí, vemos de color blanco los puntos de mayor convergencia y cada cambio en los colores hacia las capas exteriores es una zona de menor convergencia que la interior pero mayor que la zona exterior.

Haciendo modificaciones sobre el rango de la gráfica se pueden realizar acercamientos a regiones donde se ve mejor el comportamiento fractal.

DensityPlot[
 Length[FixedPointList[(1/4) (2 + 7 # - (2 + 5 #) Cos[\[Pi] #]) &, 
   x + y I, 20, 
   SameTest -> (Abs[#1 - #2] < 10^-6 &)]], {x, -1, -0.5}, {y, 0, 0.2},
  Mesh -> False, PlotPoints -> 100, ColorFunction -> "Rainbow", 
 ImageSize -> 300]




Basado en el Blog Rhapsody in Numbers aquí


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

lunes, 5 de diciembre de 2016

Conjetura de los Primos de la forma n^2+1


Estudiaremos la siguiente conjetura:

Existen infinitos números primos de la forma n^2+1, con n natural.

Vamos a buscar entre el primer millón de números primos cuales de ellos tienen la característica de ser de la forma n^2+1. Para esto pedimos que seleccione los números primos que cumplen que:


sea un número entero.

numero = 1000000;
lista = {};
Do[If[IntegerQ@Sqrt[Prime[n] - 1], AppendTo[lista, Prime[n]]], {n, 
   numero}];
lista

{2, 5, 17, 37, 101, 197, 257, 401, 577, 677, 1297, 1601, 2917, 3137, 4357, 5477, 7057, 8101, 8837, 12101, 13457, 14401, 15377, 15877, 16901, 17957, 21317, 22501, 24337, 25601, 28901, 30977, 32401, 33857, 41617, 42437, 44101, 50177, 52901, 55697, 57601, 62501, 65537, 67601, 69697, 72901, 78401, 80657, 90001, 93637, 98597, 106277, 115601, 122501, 147457, 148997, 156817, 160001, 164837, 176401, 184901, 190097, 193601, 197137, 215297, 217157, 220901, 224677, 240101, 246017, 287297, 295937, 309137, 324901, 331777, 341057, 352837, 401957, 404497, 414737, 417317, 427717, 454277, 462401, 470597, 476101, 484417, 490001, 495617, 509797, 512657, 547601, 562501, 577601, 583697, 608401, 614657, 665857, 682277, 739601, 746497, 792101, 820837, 828101, 846401, 864901, 876097, 894917, 902501, 921601, 933157, 972197, 1008017, 1020101, 1073297, 1110917, 1123601, 1136357, 1144901, 1166401, 1196837, 1201217, 1223237, 1263377, 1299601, 1308737, 1313317, 1322501, 1336337, 1378277, 1382977, 1401857, 1464101, 1547537, 1552517, 1623077, 1628177, 1664101, 1674437, 1705637, 1726597, 1731857, 1742401, 1752977, 1795601, 1822501, 1833317, 1865957, 1887877, 1893377, 1943237, 1976837, 1988101, 2005057, 2016401, 2044901, 2056357, 2073601, 2119937, 2131601, 2232037, 2262017, 2322577, 2390117, 2402501, 2421137, 2446097, 2452357, 2464901, 2483777, 2496401, 2515397, 2604997, 2611457, 2689601, 2702737, 2735717, 2755601, 2768897, 2802277, 2808977, 2835857, 2842597, 2890001, 2944657, 3013697, 3083537, 3118757, 3147077, 3182657, 3204101, 3218437, 3297857, 3326977, 3422501, 3459601, 3496901, 3519377, 3549457, 3587237, 3648101, 3686401, 3763601, 3857297, 3865157, 3880901, 3896677, 3920401, 3960101, 4024037, 4104677, 4137157, 4202501, 4218917, 4227137, 4260097, 4301477, 4326401, 4343057, 4351397, 4384837, 4393217, 4435237, 4477457, 4494401, 4519877, 4562497, 4639717, 4726277, 4884101, 4946177, 5107601, 5134757, 5225797, 5262437, 5308417, 5336101, 5354597, 5382401, 5410277, 5428901, 5456897, 5541317, 5569601, 5664401, 5779217, 5788837, 5856401, 5904901, 6022117, 6031937, 6051601, 6071297, 6100901, 6230017, 6330257, 6421157, 6431297, 6502501, 6604901, 6635777, 6728837, 6760001, 6780817, 6885377, 7001317, 7043717, 7096897, 7107557, 7160977, 7203857, 7290001, 7322437, 7452901, 7485697, 7540517, 7584517, 7617601, 7650757, 7672901, 7706177, 7728401, 7806437, 7862417, 7974977, 8031557, 8042897, 8122501, 8202497, 8271377, 8317457, 8352101, 8386817, 8410001, 8503057, 8549777, 8561477, 8608357, 8667137, 8761601, 8785297, 8844677, 8916197, 9096257, 9156677, 9278117, 9326917, 9449477, 9572837, 9647237, 9672101, 9821957, 9834497, 9859601, 9960337, 9985601, 10074277, 10137857, 10214417, 10265617, 10329797, 10368401, 10497601, 10536517, 10588517, 10666757, 10719077, 10758401, 10824101, 10916417, 10929637, 10982597, 11062277, 11115557, 11155601, 11222501, 11262737, 11289601, 11383877, 11492101, 11806097, 11874917, 12068677, 12110401, 12180101, 12278017, 12362257, 12390401, 12460901, 12489157, 12503297, 13133377, 13278737, 13322501, 13395601, 13468901, 13586597, 13808657, 13912901, 13942757, 14032517, 14092517, 14107537, 14167697, 14243077, 14258177, 14318657, 14364101, 14394437, 14440001, 14485637, 14638277, 14822501, 14976901, 15085457, 15132101, 15163237, 15210001, 15288101, 15397777}

Length[lista]
380

Así, entre el primer millón de números primos existen 380 que son de la forma n^2+1 para algún número natural. Veamos como se distribuyen, viendo cuantos primos de la forma n^2+1 hay en cada paquete de 1000 en 1000 hasta un millón.

cantidad[numero_] := Module[{lista = {}},
  Do[If[IntegerQ@Sqrt[Prime[n] - 1], AppendTo[lista, Prime[n]]], {n, 
    1000*numero + 1, 1000*(numero + 1)}];
  Length[lista]]

dist = Table[{p, cantidad[p]}, {p, 0, 1000, 1}]

Show[dist, 
 AxesLabel -> {HoldForm[por miles], 
   HoldForm[cantidad de primos n^2 + 1]}, PlotLabel -> None, 
 LabelStyle -> {GrayLevel[0]}]






















Tally[Transpose[dist][[2]]]

{{17, 1}, {8, 1}, {5, 1}, {4, 4}, {3, 3}, {1, 265}, {2, 30}, {0, 696}}

Aquí vemos que hay 696 intervalos de mil en mil en el primer millón de números naturales, donde no existe ningún número primo de la forma n^2 + 1, 265 donde sólo hay uno.

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