Arte Matemático de Hamid Naderi Yeganeh

Descargar como Notebook

Generando 10000 circulos con centros en (x[k], y[k]) y radios r[k] se generan estas hermosas figuras, puede encontrar más en la página del artista mathematics.culturalspot.org/home Aquí unos ejemplos para explorar

En Blanco y Negro

x[k_] := 2/3 Sin[14 \[Pi] k/10000] + 
  1/3 Sin[6 \[Pi] k/10000]^3 Cos[24 \[Pi] k/10000] + 
  1/10 Sin[106 \[Pi] k/10000]
y[k_] := 2/3 Cos[10 \[Pi] k/10000] + 
  1/3 Cos[6 \[Pi] k/10000]^3 Cos[24 \[Pi] k/10000] + 
  1/10 Cos[106 \[Pi] k/10000]
r[k_] := 1/150 + 
  1/18 Sin[38 \[Pi] k/10000]^4 (1 + Sin[8 \[Pi] k/10000]^2)

Graphics[Table[{(*RGBColor[Sin[k],Cos[k],1-Cos[k]],*)Opacity[0.2], 
   Circle[{x[k], y[k]}, r[k]]}, {k, 1, 10000}]]

En Color

x1[k_] := 
 1/2 Sin[38 \[Pi] k/10000] Cos[36 \[Pi] k/10000] + 
  1/2 Sin[18 \[Pi] k/10000]^3
y1[k_] := 
 2/3 Cos[18 \[Pi] k/10000] + 
  1/3 Cos[38 \[Pi] k/10000] Cos[36 \[Pi] k/10000] + 
  1/4 Cos[18 \[Pi] k/10000]^3
r1[k_] := 
 1/150 + 1/10 Sin[18 \[Pi] k/10000]^10 Sin[100 \[Pi] k/10000]^6 + 
  1/20 Sin[72 \[Pi] k/10000]^8 Cos[18 \[Pi] k/10000]^6

Graphics[Table[{RGBColor[Sin[k], Cos[k], 1 - Cos[k]], Opacity[0.2], 
   Circle[{x1[k], y1[k]}, r1[k]]}, {k, 1, 10000}]]

x2[k_] := 
 2/3 Sin[14 \[Pi] k/10000] + 
  1/3 Sin[36 \[Pi] k/10000]^3 Cos[24 \[Pi] k/10000] + 
  1/10 Sin[102 \[Pi] k/10000]
y2[k_] := 
 2/3 Cos[10 \[Pi] k/10000] + 
  1/3 Cos[10 \[Pi] k/10000]^3 Cos[28 \[Pi] k/10000] + 
  1/10 Cos[102 \[Pi] k/10000]
r2[k_] := 
 1/150 + 1/18 Sin[52 \[Pi] k/10000]^4 (1 + Sin[8 \[Pi] k/10000]^2)

Graphics[Table[{RGBColor[Sin[k], Cos[k], 1 - Cos[k]], Opacity[0.2], 
   Circle[{x2[k], y2[k]}, r2[k]]}, {k, 1, 10000}]]

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

Frase Célebre de Albert Einstein

Pero existe otra razón para la gran reputación de la matemática: 
la matemática ofrece a las ciencias naturales exactas 
un cierto grado de seguridad que sin ella no podrían alcanzar.

Albert Einstein

Otra Conjetura de Goldbach

Descargar como Notebook

Aparte de la famosa, y aún no resuelta, Conjetura propuesta por Goldbach sobre que todo número par mayor que dos es la suma de dos primos (de la cual publique aquí el 2 de Octubre de 2016), la Conjetura débil de Goldbach (publicada aquí el 5 de Octubre de 2016) y algunas conjeturas anexas a la de Goldbach (publicada aquí el 19 de Mayo de 2017), existe otra conjetura propuesta por Goldbach cuyo enunciado es:

Cada número impar se puede escribir como la suma de 

un número primo más el doble de un cuadrado.

Esta conjetura es falsa y los números más pequeños para los cuales falla son:

Determinamos el conjunto imcom formado por los números impares menores que 10000 y que no son primos, y el conjunto gold formado por todas las posibles combinaciones de un primo más dos veces un cuadrado:

imcom = Complement[Table[2 n + 1, {n, 10000}], 
   Table[Prime[n], {n, PrimePi[20000]}]];
gold = Flatten@Table[Prime[n] + 2 k^2, {n, 2000}, {k, 2000}];

El complemento de imcom con respecto a gold nos da los números que no satisfacen la conjetura

Complement[imcom, gold]

{5777, 5993}

Así, los números 5777 y 5993 no son representables como la suma de un número primo más el doble de un cuadrado.


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

Frase Célebre de Bertrand Russell

Para crear una filosofía sana hay que renunciar a la metafísica, 
pero ser un buen matemático.

Bertrand Russell

Caminos entre Esquinas de un Cuadrado

Descargar como Notebook

Dado un cuadrado n × n dibujar todos los posibles caminos que unen su esquina inferior izquierda con su esquina superior derecha.

Asignando 0 ir a la derecha y 1 ir hacia arriba, los caminos son todas las posibles permutaciones de n ceros y n unos, lo realizaremos para un cuadrado 2 × 2, entonces consideraremos todas las permutaciones posibles del conjunto {0,0,1,1}

caminos = {0, 0, 1, 1};
Permutations[caminos]

{{0, 0, 1, 1}, {0, 1, 0, 1}, {0, 1, 1, 0}, {1, 0, 0, 1}, {1, 0, 1, 
  0}, {1, 1, 0, 0}}

Generamos la función que nos va a graficar cada uno de los caminos:

camino[lista_List] := 
 Module[{cam = {{0, 0}}}, 
  Do[If[lista[[n]] == 0, AppendTo[cam, Last[cam] + {1, 0}], 
    AppendTo[cam, Last[cam] + {0, 1}]], {n, Length[lista]}]; 
  Graphics[{Red, Arrowheads[0.08], Thickness[0.01], Arrow[cam]}, 
   GridLines -> {Range[0, Length[lista]], Range[0, Length[lista]]}]]

camino[{0, 1, 1, 0, 1, 0, 0, 1}]

El total de caminos que se tiene en un arreglo n × n, está dado por Binomial[2n,n], en nuestro caso es Binomial[4,2].  Así,

Grid[{Table[camino[Permutations[caminos][[n]]], {n, Binomial[4, 2]}]}]

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

Frase Célebre de David Hilbert

¡El infinito!

Ninguna otra cuestión ha conmovido tan profundamente
el espíritu humano.

David Hilbert

Suma de los términos pares de la Sucesión de Fibonacci

Descargar como Notebook

Vamos a determinar la suma de todos los términos pares de la sucesión de Fibonacci menores a cuatro millones.

La sucesión de Fibonacci fue creada por Leonardo de Pisa un matemático Italiano del siglo XIII, conocido como Fibonacci. Él estaba interesado en resolver un problema sobre la cantidad de parejas de conejos que se tenían empezando con una pareja y sabiendo que después de un mes cada mes una pareja genera una nueva pareja de conejos.

Genera una sucesión recurrente (ver publicación de mayo 6 de 2017) donde los dos primeros términos son unos y los siguientes se obtienen como la suma de los dos anteriores, así obtenemos:

{1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765, ...}

En Mathematica la podemos definir como :

fib[1] = 1;
fib[2] = 1;
fib[n_] := fib[n - 1] + fib[n - 2]

Calculando sus primeros 20 términos:

Table[fib[n], {n, 20}]
{1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}

Vemos que los términos pares se encuentran en las posiciones múltiplos de tres, por tanto, la solución a nuestro problema es:

sum = 0; n = 1; m = 2;
While[m < 4000000, sum = sum + m; n++; m = fib[3 n]]
sum

4613732

También Mathematica ya trae incorporada la sucesión de Fibonacci en el comando Fibonacci[ ]

Table[Fibonacci[n], {n, 20}]
{1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597, 2584, 4181, 6765}

Puesto que tenemos que :

Fibonacci[33]
3524578

Fibonacci[36]
14930352

Así, para n = 11

Sum[Fibonacci[3 n], {n, 11}]
4613732

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

Frase Célebre de Silvester

Las matemáticas son la música de la razón.

Silvester