Amor y Amistad

Descargar como Notebook

Para terminar el mes de amor y amistad

color = Directive[RGBColor[1.`, 0.06`, 0.46`], AbsoluteThickness[5]];
Grid[{{Plot[1/x, {x, -1, 5}, PlotRange -> {0, 6}, PlotStyle -> color],
    ContourPlot[x^2 + y^2 == 1, {x, -1.5, 1.5}, {y, -1.5, 1.5}, 
    ContourStyle -> color], 
   Plot[Abs[2 x], {x, -2, 2}, PlotStyle -> color], 
   ContourPlot[x == -3 Abs[Sin[y]], {x, -3, 1}, {y, -3, 3}, 
    ContourStyle -> color]}}]

ContourPlot[x^2 + (y - (x^2)^(1/3))^2 == 1, {x, -1.5, 1.5}, {y, -1, 1.7}, ContourStyle -> color]

Criba de la Parábola

Descargar como Notebook

La criba de Eratóstenes es un método muy conocido para hallar los números primos menores que un cierto número K dado inicialmente. Su funcionamiento es muy sencillo :
Se comienza escribiendo los números desde el 2 hasta K.
Se marca el 2 como número primo y a continuación se tachan todos los múltiplos de 2.
Después se marca como primo el primer número no tachado que nos encontremos, el 3 en este caso, y se tachan todos los múltiplos de éste que no estuvieran tachados ya.
Y así sucesivamente.
Los números marcados son exactamente todos los números primos que hay entre 2 y K.

Veamoslo en esta criba creada por Stephen Wolfram y publicado en demonstrations.wolfram.com

Manipulate[
 ArrayPlot[Partition[Array[PrimeQ, n^2], n], Mesh -> mesh, 
  MeshStyle -> Green, 
  ColorRules -> {True -> Lighter[Red, .4], 
    False -> Lighter[Blue, .9]}, 
  Epilog -> 
   If[labs, 
    Table[Text[Style[(i - 1) n + j, 200/n], {j - 1, n - i} + 1/2], {i,
       n}, {j, n}], {}]],
 {{n, 10, "table size"}, 2, 50, 
  1}, Delimiter, {{labs, n < 20, "show numbers"}, {True, 
   False}}, {{mesh, True, "show mesh"}, {True, False}}]

 Pero esta criba no es ni mucho menos el único método de este tipo para encontrar los números primos más pequeños que un número dado. Existen otros métodos aritméticos, aunque es cierto que en ocasiones se tratan de variantes de la criba de Eratóstenes. Pero existe uno geométrico muy curioso e interesante, que podemos denominar la criba de la parábola. Los creadores de esta criba de la parábola fueron los matemáticos rusos Yuri Matiyasevich y Boris Stechkin, y el funcionamiento de la misma es el siguiente :
Representamos gráficamente una parábola cuyo eje sea el eje X, nos puede valer 2x=y^2:

Para cada número natural del 2 en adelante que sea un cuadrado perfecto (4, 9, 16, 25, \[Ellipsis]) marcamos los puntos en los que la recta perpendicular al eje X que pasa por él corta a la parábola. Hay uno por encima del eje X y otro por debajo.

Ahora unimos todos los puntos que han quedado marcados por encima del eje X con todos los de abajo, se afirma que los únicos valores enteros sobre el eje X por los cuales no pasa ningún segmento corresponden a los números primos.

En Mathematica

puntos = 10;
pa = Table[{n^2, Sqrt[2 n^2]}, {n, 2, puntos, 1}];
pb = Table[{n^2, -Sqrt[2 n^2]}, {n, 2, puntos, 1}];
ticks = Table[{Prime[i], Prime[i]}, {i, 30}];
puntoprimo = Table[{Prime[i], 0}, {i, 30}];
Show[Graphics[
  Line@Flatten[
    Table[{pa[[i]], pb[[j]]}, {i, 1, puntos - 1}, {j, 1, puntos - 1}],
     1], Axes -> True, Ticks -> {ticks, None}], 
 Graphics[{PointSize[Large], Pink, Point[puntoprimo]}], 
 ContourPlot[2 x == y^2, {x, 0, Prime[30]}, {y, -20, 20}], 
 ListPlot[pa, PlotStyle -> Directive[PointSize[Large], Red]], 
 ListPlot[pb, PlotStyle -> Directive[PointSize[Large], Red]]]

Propuesta

Demostrar la veracidad del funcionamiento de la criba de la parábola.

Constante de Legendre

Descargar como Notebook

El matemático francés Adrien-Marie Legendre (1752-1833) conjeturó que correspondía aproximadamente al número 1.08366, que se obtenía al calcular el límite:

donde Pi (n) corresponde al número de primos menores o iguales a un número real dado. La existencia de la Constante de Legendre demostraba el comportamiento asintótico de Pi(n) con respecto a n/ln(n).

Table[Log[n] - n/PrimePi[n], {n, 100000, 1000000, 200000}] // N

{1.08757, 1.07174, 1.08519, 1.07888, 1.08282}

Muestra un valor aproximado a la función, y su comportamiento lo vemos en el gráfico

Show[Plot[1.08366, {x, 0, 1000000}, PlotStyle -> Red], 
 ListPlot[Table[Log[n] - n/PrimePi[n], {n, 1000000}]]]

Pero, posteriormente se demostró que el valor del límite es 1, así la Constante de Legendre paso a ser más una anécdota.

AbsoluteTiming[

 ParallelTable[

   Log[n] - n/PrimePi[n], {n, 1000000000000, 10000000000000, 

    1000000000000}] // N]

{36.587541, {1.04087, 1.03974, 1.03911, 1.03868, 1.03834, 1.03807, 

  1.03785, 1.03766, 1.03749, 1.03735}}

Aquí, vemos como ya el valor tiende a 1.

Cantidad de primos

Descargar el Notebook

Desde el siglo III a.c. ya en los Elementos de Euclides se tenía la demostración de la infinidad de los números primos, la pregunta latente desde entonces es cómo se distribuyen sobre los números naturales? 

En el siglo XVIII de forma independiente Gauss y Legendre aproximaron el número de primos menores o iguales a un número real positivo x por la función:

x / ln(x)

En Mathematica

Contamos con la función PrimePi[ ] que nos muestra el número de números primos menores o iguales a un número real positivo

Manipulate[
 Show[ListPlot[Table[PrimePi[n], {n, 2, numero}], 
   AspectRatio -> Automatic], 
  Plot[x/Log[x], {x, 2, numero}, PlotStyle -> Red]], {numero, 100, 
  10000, 100}]

donde la línea azul es PrimePi y la roja es x / ln(x).

Comparando mediante una tabla el crecimiento asistólico de PrimePi[ ] y x / ln(x)

AbsoluteTiming[

 ParallelTable[(PrimePi[x] Log[x])/x, {x, 5000000000000, 

    10000000000000, 1000000000000}] // N]

{0.071366, {1.03682, 1.03657, 1.03637, 1.03619, 1.03604, 1.0359}}

Evolución de Mathematica

Descargar como Notebook

Desde la versión 1 de Mathematica en junio de 1987 hasta la versión 11 en  agosto de 2016, vemos como ha crecido el número de funciones propias:

funcs = WolframLanguageData[];
versions = WolframLanguageData[funcs, "VersionIntroduced"];
out = SortBy[Tally[versions], First];
out[[All, 2]] = Accumulate[out[[All, 2]]];
out = {#1, {If[IntegerQ[#1], 100, 50], #2}} & @@@ out;
blue = RGBColor[0.37, 0.51, 0.71];
cols = If[IntegerQ[#], blue, Lighter[blue]] & /@ out[[All, 1]];
RectangleChart[Labeled[#2, Rotate[#1, \[Pi]/4], Below] & @@@ out, 
 BarSpacing -> 0, ImageSize -> 600, ChartStyle -> cols, Frame -> True,
  GridLines -> Automatic, 
 FrameTicks -> {{Automatic, Automatic}, {None, None}}]

Tips Mathematica: 3. Asignaciones del Usuario

Para realizar asignaciones dentro de una sección de Mathematica, las variables se pueden nombrar con letras o combinaciones de letras y números (el primer elemento debe ser una letra) y se aconseja que sea en minúscula. La asignación se realiza con un igual = (para las ecuaciones es doble igual ==)

a = 4;

El punto y coma al final es para que calcule pero no nos muestre el resultado,

a^2 + a - 1

reemplazó el valor de a = 4 en la expresión. Ahora,

Solve[a^2 - a - 6 == 0, a]

como se le asignó un valor a la letra a en esta sección, Mathematica no la asume como una variable en la ecuación a resolver. Para limpiar (quitar la asignación hecha) lo hacemos por

Clear[a]

o también,

a=.

Es importante fijarse en los colores que va tomando las letras con asignaciones (negras) y las no asignadas (azules)

ASIGNACIONES POSTERGADAS

Al asignar con = la variable inmediatamente toma el valor (o la fórmula) de la derecha, pero al realizarlo con := la variable tomará el valor de la derecha al ser llamada (no inmediatamente), en la mayoría de los casos básicos no hay diferencia pero veamos el siguiente caso

ran1 = Random[];

Table[ran1, {5}]

ran2 := Random[];

Table[ran2, {5}]

aquí Random[ ] genera un número seudoaleatorio entre 0 y 1, y Table[  ,{5}] una lista calculando 5 veces ran1 y ran2 en cada caso, analice los resultados y verá la diferencia entre los dos tipos de asignaciones.

CREACION DE FUNCIONES

Las funciones las definimos name[var_]:=expr donde para el nombre(name) y la variable (var) se sigue las mismas indicaciones dadas para la asignación de variables, las funciones pueden definirse sólo con = y no necesariamente := pero es aconsejable este último.

f[x_] := x^2

f[3]

f[{1, 2, 3, 4, 5}]

f (3)

Observe que en el último caso Mathematica interpretó el producto de f por 3 y no f calculado en 3.

Constante de Kaprekar para números de 2,5 y 6 dígitos

Descargar el notebook

Continuando con la entrada del 12 de septiembre, ahora analizaremos como se comporta el proceso de Kaprekar para números de 2, 5 y 6 dígitos.

Vamos a ver que para este número de dígitos el proceso de Kaprekar puede converger a un número en algunos casos y en otros a un bucle (secuencia de números cíclica).

En Mathematica

Generamos nuevamente una función kaprekar[len, num] que realiza el proceso de Kaprekar : donde la variable len nos indica el número de cifras del número y num corresponde al número que le aplicamos el proceso de Kaprekar.

kaprekar[len_Integer, num_Integer] := 
 Module[{lis}, lis = IntegerDigits[num, 10, len]; 
  FromDigits@Sort[lis, Greater] - FromDigits@Sort[lis]]

Números de dos cifras

Realicemos el procedimiento con dos ejemplos: 12 y 13

NestList[kaprekar[2, #] &, 12, 20]

{12, 9, 81, 63, 27, 45, 9, 81, 63, 27, 45, 9, 81, 63, 27, 45, 9, 81, 63, 27, 45}

NestList[kaprekar[2, #] &, 13, 20]

{13, 18, 63, 27, 45, 9, 81, 63, 27, 45, 9, 81, 63, 27, 45, 9, 81, 63, 27, 45, 9}

Se forma un bucle {9, 81, 63, 27, 45}, veamos si para todos

kap21 = {};
kap22 = {};
Do[If[NestWhile[kaprekar[2, #] &, n, # != 9 &, 1, 20] == 9, 
  AppendTo[kap21, n], AppendTo[kap22, n]], {n, 10, 99}]
kap21
kap22

{10, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98}

{11, 22, 33, 44, 55, 66, 77, 88, 99}

Se crea una sucesión como bucle 9, 81, 63, 27, 45 excepto obvio los que tienen cifras iguales que dan cero en la primera iteración.

Números de cinco cifras

Aquí existen tres conjuntos de bucles, formados por :

{82962, 75933, 63954, 61974}, {74943, 62964, 71973, 83952} y {53955, 59994}

Veamos que números corresponden a cada uno : kap51 a {82962, 75933, 63954, 61974}, kap52 a {74943, 62964, 71973, 83952}, kap53 a {53955, 59994} y kap54 los que convergen a cero.

kap51 = {};
kap52 = {};
kap53 = {};
kap54 = {};
Do[Switch[NestWhile[kaprekar[5, #] &, n, 
   And[# != 82962, # != 74943, # != 53955] &, 1, 20], 82962, 
  AppendTo[kap51, n], 74943, AppendTo[kap52, n], 53955, AppendTo[kap53, n], 0,
   AppendTo[kap54, n]], {n, 10000, 99999}]
kap51
kap52
kap53
kap54

Obtenemos en : 43770 en kap51, 43219 en kap52, 3002 en kap53 y 9 en kap54,

Length[kap51] + Length[kap52] + Length[kap53] + Length[kap54]

90000

La totalidad de los números de cinco cifras.

Números de seis cifras

Realicemos el procedimiento con un ejemplo: 123456

NestList[kaprekar[6, #] &, 123456, 20]

{123456, 530865, 829962, 771723, 653544, 310887, 873522, 651744, 620874, 851742, 750843, 840852, 860832, 862632, 642654, 420876, 851742, 750843, 840852, 860832, 862632}

Al igual que en los números de dos cifras, no existe Constante de Kaprekar para números de seis cifras, se crea con este ejemplo un bucle formado por los números: 851742, 750843, 840852, 860832, 862632, 642654, 420876.

Veamos con otro ejemplo 458661:

NestList[kaprekar[6, #] &, 458661, 20]

{458661, 720873, 853542, 620874, 851742, 750843, 840852, 860832, 862632, 642654, 420876, 851742, 750843, 840852, 860832, 862632, 642654, 420876, 851742, 750843, 840852}

También aparece la misma cadena de números.

Existen números de seis cifras que son fijos para el proceso de Kaprekar, por ejemplo : 631764 y otros que convergen a ellos como: 631763

NestList[kaprekar[6, #] &, 631764, 10]

{631764, 631764, 631764, 631764, 631764, 631764, 631764, 631764, 631764, 631764, 631764}

NestList[kaprekar[6, #] &, 631763, 10]

{631763, 632664, 431766, 631764, 631764, 631764, 631764, 631764, 631764, 631764, 631764}

Ahora, veamos cuales son los números que no terminan en la sucesión que inicia con 851742

kap61 = {};
kap62 = {};
kap63 = {};
kap64 = {};
Do[Switch[NestWhile[kaprekar[6, #] &, n, # != 851742 &, 1, 20], 851742, 
  AppendTo[kap61, n], 631764, AppendTo[kap62, n], 549945, AppendTo[kap63, n], 
  0, AppendTo[kap64, n]], {n, 100000, 999999}]
kap61
kap62
kap63
kap64

El conjunto kap61 con 841996 números son los que convergen al bucle, el conjunto kap62 con 56180 números son los que convergen a 631764, el conjunto kap63 con 1815 convergen a 549945 y kap64 con 9 números, todas las cifras iguales, son los que convergen a cero.

Los números de kap63 son todas las posibles permutaciones de los conjuntos de dígitos, siguiente :

DeleteDuplicates[Table[Sort@IntegerDigits[kap63[[n]]], {n, Length[kap63]}]]

{{0, 0, 1, 1, 5, 5}, {1, 1, 1, 1, 6, 6}, {1, 1, 2, 2, 6, 6}, 
{1, 1, 3, 3, 6, 6}, {1, 1, 4, 4, 6, 6}, {1, 1, 5, 5, 6, 6}, 
{1, 1, 6, 6, 6, 6}, {0, 0, 2, 2,5, 5}, {2, 2, 2, 2, 7, 7}, 
{2, 2, 3, 3, 7, 7}, {2, 2, 4, 4, 7, 7}, {2, 2, 5, 5, 7, 7}, 
{2, 2, 6, 6, 7, 7}, {2, 2, 7, 7, 7, 7}, {0, 0, 3, 3, 5, 5}, 
{3,3, 3, 3, 8, 8}, {3, 3, 4, 4, 8, 8}, {3, 3, 5, 5, 8, 8}, 
{3, 3, 6, 6, 8, 8}, {3, 3, 7, 7, 8, 8}, {3, 3, 8, 8, 8, 8}, 
{0, 0, 4, 4, 5, 5}, {4, 4, 4, 4,9, 9}, {4, 4, 5, 5, 9, 9}, 
{4, 4, 6, 6, 9, 9}, {4, 4, 7, 7, 9, 9}, {4, 4, 8, 8, 9, 9}, 
{4, 4, 9, 9, 9, 9}, {0, 0, 0, 0, 5, 5}, {0, 0, 5, 5, 5, 5}}

Propuesta

Para los números de 7, 8, 9 y 10 cifras es indispensable disponer de un buen equipo pues los cómputos son largos. Si dispone de varios núcleos en su computador puede utilizar la orden ParallelDo[ ] en lugar de Do[ ].
Pero es un buen ejercicio ver su comportamiento.

Espero sus comentarios!!!

Primos de Mersenne

Descargar el notebook

Pierre de Mersenne fue un filósofo del siglo XVII que en su obra Cognitata Physico-Mathematica enunció una serie de afirmaciones sobre teoría de números.

Un número de Mersenne es de la forma M(n)= 2^n-1 para n un número natural, y es un primo de Mersenne si su resultado es un número primo, es necesario más no suficiente que n sea un número primo. Mersenne realizó una lista con exponentes hasta 257 de los que el conjeturó eran todos los primos de Mersenne que existían. Esta lista tenía errores pues incluyó a  M(67) y M(257) que son compuestos y excluyó a M(61), M(89) y M(107) que son primos.

Hasta enero de 2016 se conocen 49 primos de Mersenne, siendo el último

M(74207281)

un número de más de veintidós millones de cifras.

La actual conocida como Conjetura de Mersenne es :

Existen infinitos números primos de la forma 2^n-1

Si n es un número compuesto también 2^n-1 es compuesto, luego realizaremos la búsqueda entre los primos n buscando primos de Mersenne.

Para optimizar los tiempos de ejecución, utilizaré la orden ParallelelDo que hace que se aprovechen al máximo los diferentes núcleos del computador dividiendo las tareas, así se hace necesario acompañarla de la orden SetSharedVariable para distribuir las variables entre los núcleos, la orden AbsoluteTiming nos muestra el tiempo en segundos de ejecución.

mers = {};

SetSharedVariable[mers];

AbsoluteTiming[
 ParallelDo[If[PrimeQ[2^n - 1], AppendTo[mers, n]], {n, 10000}]; mers]

{126.061473, {1, 1, 1, 1, 2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521,607, 1279, 2203, 2281, 3217, 4253, 4423, 9689, 9941, 11213, 2, 3, 89, 5,107, 7, 13, 17, 127, 19, 31, 61, 521, 607, 2, 3, 5, 7, 521, 13, 17, 19, 31,607, 61, 89, 107, 127, 1279, 2281, 2203, 3217, 4253, 4423, 9689, 9941}}

DeleteDuplicates[mers]

{1, 2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279, 2203, 2281,3217, 4253, 4423, 9689, 9941, 11213}

Length[DeleteDuplicates[mers]]

24

Estos son los primeros 24 primos de Mersenne.

mersenne = Table[2^n - 1, {n, mers}]

Con una longitud en cifras de:

IntegerLength[mersenne]

{1, 1, 2, 3, 4, 6, 6, 10, 19, 27, 33, 39, 157, 183, 386, 664, 687, 969, 1281,1332, 2917, 2993}

Otra forma de determinación es:

mersenneprimeQ[n_Integer] := PrimeQ[2^n - 1]

DistributeDefinitions[mersenneprimeQ]

SetSharedVariable[mersenneprimeQ]

AbsoluteTiming[Parallelize[Select[Range[10000], mersenneprimeQ]]]

{68.971097, {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279,2203, 2281, 3217, 4253, 4423, 9689, 9941}}

AbsoluteTiming[Select[Range[10000], mersenneprimeQ]]

{130.129557, {2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279,2203, 2281, 3217, 4253, 4423, 9689, 9941}}

Así, M(2), M(3),..., M(9689), M(9941) son primos de Mersenne.

Otra forma más :

Parallelize[Select[Range[9000, 10000], PrimeQ[2^# - 1] &],
 Method -> "FinestGrained"]

{9689, 9941}

Así, M(9689) y M(9941), son primos de Mersenne.

Propuesta

Buscar los primos de Mersenne 23,24 y 25.

Referencias

Wikipedia

Tips Mathematica: 2. Sintaxis de Mathematica

Reglas Básicas de la Sintaxis en MATHEMATICA

En el software Mathematica debemos tener presente las siguientes reglas de la sintaxis del programa :

1. Los comandos y nombres propios de Mathematica comienzan con mayúscula, y en inglés.

2. Los argumentos de las funciones se escriben entre paréntesis cuadrados [ ].

3. Las listas o rangos se escriben entre corchetes { , , } separados por comas.

4. Los paréntesis redondos ( ) se utilizan para agrupar, como en álgebra.

Por ejemplo si me piden calcular el sen(pi/3):

Por la regla 1. debo escribir en mayúscula el comando Sen, pero en inglés sabemos que es Sin

Por la regla 2. el argumento es sobre lo que se aplica o calcula el comando, en este caso pi/3, luego:

Sin[pi/3]

Por la regla 1. nuevamente recordemos que pi es un nombre propio de una constante por tanto es Pi:

Sin[Pi/3]

al realizar los cambios en Mathematica notaran como sin y pi están en azul y pasan a negro en Sin y Pi, cuando los comandos aparecen en negro es que los ha reconocido.

Veamos álgunos ejemplos más del uso de las anteriores reglas:

Factor[x^2 - x - 6]

Mayúscula en F y los paréntesis [ ]

Solve[x^2 - x - 6 == 0, x]

La igualdad en las ecuaciones es doble igual ==

N[2/7]

Para obtener la presentación aproximada

N[Pi, 100]

Aproximación a cien cifras decimales, observe la P de \[Pi] en mayúscula

Expand[(x + y)^10]

Uso algebráico de los paréntesis ( )

Simplify[%]

Con el símbolo de porcentaje % hacemos referencia a la salida inmediatamente anterior

Plot[x^2 - x - 6, {x, -5, 5}]

El rango de los valores que va a tomar x entre { } y separados por comas.

Table[{x, x^2 - x - 6}, {x, -5, 5}]

Esta es la tabla de valores de la gráfica anterior avanzando desde -5 hasta 5 de una unidad cada paso. Vea la similitud de escritura en el comando Plot

ListPlot[%]

Como ListPlot es una orden compuesta por dos palabras cada una comienza con mayúscula pero estan pegadas (sin espacio)

Solve[{x + y == 4, x - y == 2}, {x, y}]

Se agrupan con { } las ecuaciones (es una lista) y las incógnitas (es otra lista) separadas por comas entre ellas como interiormente sus elementos.

Recuerde que puede encontrar una fundamentación más completa en la parte de capacitación de la página ustamathematica.wix.com/basicas

Espero comentarios!!!

Tips Mathematica: 1. Como calcular entradas

A l abrir Mathematica nos da la opción de comenzar a trabajar sobre un nuevo Notebook, un cuaderno de trabajo que tiene como extensión .nb, podemos directamente desde el teclado introducir las operaciones que queramos realizar:

12+8

12*5

2^5

24/6

para calcularlas debemos tener presente que la mayoría de los teclados de computadores de mesa y algunos pocos portátiles vienen con un teclado extendido: teclado numérico:

Aquí se distinguen dos Teclas Enter, una el Enter alfabético y otro el Enter numérico. Para realizar un cálculo debemos estar parados sobre la línea que vamos a calcular (al comienzo, al final o en medio, no importa) realizar combinación de teclas Shift+Enter alfabético o simplemente el Enter numérico, así si el computador no tiene teclado numérico es obligatorio para calcular la combinación Shift+Enter.

Mathematica nos va enumerando las entradas y las salidas In[1]: y Out[1]: y encerrándolas dentro de celdas que aparecen al lado derecho:

Desde la celda se puede seleccionar para copiar o borrar, tanto la entrada, la salida o ambas.

Para una completa capacitación visite la página ustamathematica.wix.com/basicas

Números de Lychrel o Conjetura del 196

Descargar el notebook

Estos números de Lychrel se construyen de forma parecida al proceso de Kaprekar, el cual ya lo comentamos. Para el proceso de Lychrel tomamos un número natural y lo sumamos con el número que se obtiene al invertir sus dígitos, y el proceso se repite hasta obtener un número capicúa, al invertir el orden de sus dígitos se obtiene el mismo número. Los números de Lychrel son aquellos que al repetir indefinidamente el proceso de Lychrel NO se obtiene un número capicúa, ellos se deben al matemático Wade VanLandingham y el nombre es casi un anagrama del nombre de su novia : Cheryl.

Por ejemplo, con el número 79:

        79 + 97 = 176

    176 + 671 = 847

      847 + 748 = 1595

  1595 + 5951 = 7546

    7546 + 6457 = 14003

14003 + 30041 = 44044

Así, a partir de 79 obtenemos un número capicúa 44044.

No se conoce una demostración de que existan números de Lychrel, el primer candidato es el 196 por esto se conoce como la conjetura del 196.

En Mathematica

Creamos dos funciones : inverso[n] que genera el número con las cifras en orden inverso de n, y con[n] que nos da el número de iteraciones necesarias para encontrar el primer número capicúa partiendo del número n por el proceso de Lychrel.

inverso[n_] := FromDigits@Reverse@IntegerDigits[n]
con[n_] := 
 Length[NestWhileList[# + inverso[#] &, n, # != inverso[#] &, 1, 100]]-1

Determinemos para los números naturales del 1 al 195 el número de iteraciones necesarias para encontrar el primer número capicúa.

tabla1 = Table[{n, con[n]}, {n, 195}];
ListPlot[Tooltip[tabla1], PlotRange -> All]

Vemos que para en número 89 se necesitan de 24 iteraciones, desde el notebook se ve al pasar el mouse por la gráfica :

lista89 = NestWhileList[# + inverso[#] &, 89, # != inverso[#] &]

{89, 187, 968, 1837, 9218, 17347, 91718, 173437, 907808, 1716517,
8872688, 17735476, 85189247, 159487405, 664272356, 1317544822,
3602001953, 7193004016, 13297007933, 47267087164, 93445163438,
176881317877, 955594506548, 1801200002107, 8813200023188}

Length[lista89]

24

Al realizar 10000 este proceso con 196 obtenemos un número no capicúa de 4159 cifras:

IntegerLength@NestWhile[# + inverso[#] &, 196, # != inverso[#] &, 1, 10000]

4159

Los primeros números que se sospechan son de Lychrel son:

lychrel = {};
Do[If[con[n] > 99, AppendTo[lychrel, n]], {n, 3000}]
lychrel

{196, 295, 394, 493, 592, 689, 691, 788, 790, 879, 887, 978, 986,
1495, 1497, 1585, 1587, 1675, 1677, 1765, 1767, 1855, 1857, 1945,
1947, 1997, 2494, 2496, 2584, 2586, 2674, 2676, 2764, 2766, 2854,
2856, 2944, 2946, 2996}

Propuesta

1. Qué pasaría si el proceso de Lychrel se definiera como el de Kaprekan pero en vez de restar, sumando? Existirían así números candidatos para ser de Lychrel?

2. Cuál es el número entre los primeros 1000, con mayor número de iteraciones necesarias para dar un capicúa?

Referencias

Página de gaussianos.com gaussianos.com/la-conjetura-del-196 

Humor: físicos y matemáticos

Un físico y un matemático van en un avión de Bogotá a Cartagena.
Cuando sobrevuelan Antioquia ven una oveja negra.
El físico dirá que: " en Antioquia hay una oveja negra".
El matemático que: "en un punto sobre Antioquia existe una oveja con la parte superior negra".

Qué opinan?

Espero comentarios!!!

Constante de Kaprekar

Descargar como notebook

Conocí sobre esta constante por un artículo publicado en gaussianos.com, manteniendo la esencia del mismo. 

  

Tomamos cualquier número de 4 cifras que no todas sean iguales. Por ejemplo el 5843. Ahora ordenamos las cifras de mayor a menor y de menor a mayor, obteniendo así otros dos números de 4 cifras. En este caso 8543 y 3458. Ahora al mayor le restamos el menor, llamemos a este proceso de Kaprekar, y con el número obtenido repetimos el procedimiento. En este ejemplo sería así : 

  

8543 - 3458 = 5085

8550 - 0558 = 7992

9972 - 2799 = 7173

7731 - 1377 = 6354

6543 - 3456 = 3087

8730 - 0378 = 8352

8532 - 2358 = 6174

7641 - 1467 = 6174

Si intentamos seguir siempre aparecerá este número 6174. Esto ocurre con cualquier número de 4 cifras en un máximo de 7 pasos. Pues este número se denomina constante de Kaprekar por su descubridor, el matemático indio Shri Dattatreya Ramachandra Kaprekar. Él se dedicó principalmente a la teoría de números donde obtuvo ciertos resultados interesantes. Y uno puede preguntarse : para los números de 4 cifras existe una constante de Kaprekar.¿Y para el resto?.Pues es sencillo ver que existe una Constante de Kaprekar para los números de 3 cifras y más complicado ver que también existe para los números de 6, 8, 9 y 10 cifras, pero no para los de 2, 5 ó 7 cifras.

Inicialmente presentaré para los números de tres y cuatro cifras, las que el articulo manifiesta son las fáciles,  como se pueden trabajar en Mathematica. Es recomendable descargar el archivo anexo kaprekar34.nb para poder manipularlo, no sólo leerlo.

En Mathematica

Generamos una función kaprekar[len,num] que realiza el proceso de Kaprekar: donde la variable len nos indica el número de cifras del número y num corresponde al número que le aplicamos el proceso de Kaprekar.

kaprekar[len_Integer,num_Integer]:=Module[{lis},lis=IntegerDigits[num,10,len];FromDigits@Sort[lis,Greater]-FromDigits@Sort[lis]]

Números de tres cifras

Realicemos el procedimiento con un ejemplo: 123

NestList[kaprekar[3,#]&,123,10]

{123,198,792,693,594,495,495,495,495,495,495}

Tal parece que la Constante de Kaprekar para números de tres cifras es : 495

Realicemos el procedimiento para todos los números de tres cifras

lista3=Table[{n,FixedPoint[kaprekar[3,#]&,n]},{n,100,999,1}];

DeleteDuplicates[Transpose[lista3][[2]]]

{495,0}

El resultado al que convergen es cero o 495, veamos como se distribuyen:

ListPlot[lista3]

Los números que convergen a cero son :

kar3={};

Do[If[FixedPoint[kaprekar[3,#]&,n]==0,AppendTo[kar3,n]],{n,100,999}]

kar3

{111,222,333,444,555,666,777,888,999}

que corresponden a todos los números de tres cifras que tienen todas sus cifras iguales.

Sí, es cierto, la Constante de Kaprekar de tres cifras es : 495

En cuántos pasos se alcanza?

ListPlot[Table[Tooltip[{n,Length[FixedPointList[kaprekar[3,#]&,n]]-2}],{n,100,999,1}]]

Máximo en seis pasos, por ejemplo con 101:

NestList[kaprekar[3,#]&,101,10]

{101,99,891,792,693,594,495,495,495,495,495}

Números de cuatro cifras

Realicemos el procedimiento con un ejemplo: 1234

NestList[kaprekar[4,#]&,1234,10]

{1234,3087,8352,6174,6174,6174,6174,6174,6174,6174,6174}

Tal parece que la Constante de Kaprekar para números de cuatro cifras es : 6174

Realicemos el procedimiento para todos los números de cuatro cifras

lista4=Table[{n,FixedPoint[kaprekar[4,#]&,n]},{n,1000,9999,1}];

DeleteDuplicates[Transpose[lista4][[2]]]

{6174,0}

Sí, es cierto, la Constante de Kaprekar de cuatro cifras es : 6174

Cómo se distribuyen?

ListPlot[Tooltip[lista4]]

Los números que convergen a cero son :

kar4={};

Do[If[FixedPoint[kaprekar[4,#]&,n]==0,AppendTo[kar4,n]],{n,1000,9999}]

kar4

{1111,2222,3333,4444,5555,6666,7777,8888,9999}

En cuántos pasos converge cada número?

ListPlot[Table[Tooltip[{n,Length[FixedPointList[kaprekar[4,#]&,n]]-2}],{n,1000,9999,1}]]

Máximo en siete pasos.

Propuesta

Basados en el presente trabajo, o cualquier otra forma que encuentren, planteó estudiar lo siguiente :

1. Qué pasa para los números de 6, 8, 9 y 10 cifras? Cuál es la Constante de Kaprekar?

2. Qué pasa para los números de 2, 5 y 7 cifras?

3. Es la función de kaprekar inyectiva? Tiene inversa?

Referencias

La página de gaussianos.com http://gaussianos.com/la-constante-de-kaprekar/

Espero sus comentarios!!!