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


martes, 29 de noviembre de 2016

WolframAlpha: Datos curados, actuales y computables.



Desde la versión 8 de Mathematica se han presentado grandes novedades, no únicamente en sus algoritmos, sino en la posibilidad de adquirir datos que tienen las siguientes tres características: Curados: podemos estar seguros de su veracidad; Actuales: estas bases de datos están constantemente actualizando sus datos; y Computables: al adquirir los datos desde un notebook en Mathematica podemos trabajar con ellos como listas.

Desde un notebook en Mathematica podemos conectarnos con WolframAlpha simplemente al escribir un igual al comienzo de una línea de cálculo, que son las que por defecto (primera opción) abre Mathematica. Este igual aparece blanco en un rectángulo naranja, aquí de forma libre, a veces en español, pero preferiblemente en inglés uno puede realizar su consulta y ejecutar únicamente con Enter.


También para mayor precisión existen comandos desde Mathematica que pueden llamar estas bases de datos:

?*Data
































Además existen funciones que utilizan las bases de WolframAlpha que no aparecen aquí, por ejemplo: ¿A cuánto equivalía un peso Colombiano de 1970 en 2008?

InflationAdjust[Quantity[1, DatedUnit["Colombian pesos", 1970]], 2008]

$ 584.40(Colombian pesos 2008)

O podemos preguntarnos: ¿$100 000ºº pesos Colombianos de 2016, a cuántos pesos equivalían cada año desde 1960?

Table[InflationAdjust[Quantity[100000, DatedUnit["Colombian pesos", 2016]],n],{n, 1960,2015, 1}]












 Que es una lista totalmente computable.

WolframAlpha Pro

Al escribir dos iguales seguidos al comienzo de una línea de cálculo obtenemos un igual blanco dentro de un estrella naranja, nos estamos conectando con WolframAlpha Pro que corresponde a versión un poco más profesional de WolframAlpha, ¿Cuál es la diferencia?




Principalmente un detalle: los símbolos más en la parte derecha superior de cada una de las salidas, por ejemplo dando click sobre el más del primer gráfico que aparece y tomando la opción "Computable Data" automáticamente aparece la siguiente salida al final del documento:

WolframAlpha["population of colombia", {{"RecentHistory:Population:CountryData", 1}, "ComputableData"}]
















lista de listas, que no son más que datos computables, con ellos podemos trabajar.

Y si damos click en el último más que aparece a la derecha de WolframAlpha y si tomamos por ejemplo la opción "Source Data" o "Feedback" nos permite establecer las bases de datos que se han utilizado, si es necesario referenciarlas.

Ahora, como siempre lo que le corresponde a cada uno es explorar las opciones que nos presenta esta herramienta.

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

viernes, 25 de noviembre de 2016

Relación entre los Hiperboloides y el Cono



Sabemos que las formas canónicas de los hiperboloides de una y dos hojas y el cono, corresponden a:

Hiperboloide de una hoja





ContourPlot3D[x^2 + y^2 - z^2 == 1, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}]





Hiperboloide de dos hojas





ContourPlot3D[-x^2 - y^2 + z^2 == 1, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}]



Cono





ContourPlot3D[x^2 + y^2 - z^2 == 0, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}]



Todas las formas anteriores tienen simetría con respecto al eje z, y los valores de a, b y c representan que tanto la figura abre en los ejes x, y y z respectivamente.

Pregunta

¿A cuál figura de las anteriores corresponde la ecuación:
x^2 + y^2 - z^2 = p?

La mejor respuesta es : depende del valor que tome p.

Si p > 0 : es un hiperboloide de una hoja.

Si p < 0 : es un hiperboloide de dos hojas.

Si p = 0 : es un cono.

Veamos este comportamiento en un manipulate

Manipulate[ContourPlot3D[x^2 + y^2 - z^2 == p, {x, -5, 5}, {y, -5, 5}, {z, -4, 4}], {p, -2, 2}]

Si p=-2:



Si p=0:


Si p=2:



Actividad

Realice manipulates para cada una de las anteriores figuras donde varié los valores de a, b, y c.

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

domingo, 20 de noviembre de 2016

La Conjetura de Collatz



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

martes, 8 de noviembre de 2016

Rutas de Viaje desde WolframAlpha en Bogotá


Otros datos que podemos adquirir y computar desde WolframAlpha tienen que ver con las rutas de tráfico que podemos seguir al estilo un GPS o la aplicación Wade.

Viaje inter municipal

Establezcamos primero a Bogotá y Villeta como las ciudades a las cuales deseamos tener como punto de partida y destino respectivamente, las vemos como entidades:







Llamaremos tt la ruta que seguiremos:




Representándola gráficamente :

GeoGraphics[tt["TravelPath"]]


Mostrándonos la ruta que debemos implementar:

tt["Dataset"]




























Viaje dentro de la ciudad

Establecemos dos destinos, primero el Museo del Oro

























BuildingData[Entity["Building", "MuseoDelOro::4jzpd"], "Position"]

GeoPosition[{4.640140000000002`, -74.12208999999999`}]

GeoPosition[{4.64014, -74.1221}]

y la Universidad Nacional de Colombia





GeoPosition[{4.638525, -74.084134}]

Llamamos aa la ruta de viaje


aa = TravelDirections[{GeoPosition[{4.638525, -74.084134}], 
   GeoPosition[{4.607340, -74.079740}]}]

La representamos gráficamente :

GeoGraphics[aa["TravelPath"]]







































Describimos la ruta a seguir :

aa["Dataset"]




























Con estos datos se pueden realizar comparaciones de alternativas de diferentes caminos y posibilidades, sólo hay que explorarlas.

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

jueves, 3 de noviembre de 2016

Sismos en Colombia


Entre los datos que se pueden adquirir desde las bases de datos de WolframAlpha encontramos también datos de sismos y terremotos, aquí en particular trabajaremos con los datos para Colombia:

Descargamos los datos históricos de los sismos para Colombia, encontramos datos desde el año 1566 pero realmente datos continuos y completos desde el año 1900

tecol = EarthquakeData[Entity["Country", "Colombia"]];

filtramos los datos que queremos mostrar: año, ubicación (latitud, longitud) y magnitud en la escala de Richter.

tecoldatos = Table[{DateList[tecol[[n, 1]]][[1]], tecol[[n, 5]], tecol[[n, 9]]}, {n, Length[tecol]}]

Ahora generamos una presentación interactiva y dinámica con el uso del comando Manipulate[ ], que nos permite ubicar sobre el mapa de Colombia año por año los sismos de una intensidad mayor a un número determinado

Manipulate[
 Graphics[{EdgeForm[Black], LightBrown, 
   CountryData["Colombia", "FullPolygon"], Red, 
   Point[Select[tecoldatos, And[#[[1]] == anio, #1[[2]] >= mag] &][[
     All, 3]]]}, ImageSize -> {500, 500}], {{anio, 2000, "Año"}, 1900,
   2016, 1, Appearance -> "Labeled"}, {{mag, 3, "Magnitud mayor a"}, 
  3, 6.5, Appearance -> "Labeled"}, SaveDefinitions -> True]


Aquí hay que observarlo descargando el Notebook.