Frase Célebre de Paul Halmos

Las matemáticas no son una ciencia deductiva: eso es un tópico.
Cuando se trata de probar un teorema, uno no lista las hipótesis y luego empieza a razonar. 
No, uno prueba, se equivoca, experimenta, conjetura...

Paul Halmos

El Juego del Caos

Descargar como Notebook

El matemático Británico Michael Barnsley en 1988 dio a conocer el siguiente proceso. Se parte de tres puntos en una hoja A, B y C no colineales, sobre la misma recta, (que llamaremos vértices) y otro punto P (que llamaremos punto de partida), se toma un dado y se lanza si el resultado es 1 o 2 nos dirigimos desde P hasta A pero nos quedamos a mitad de camino, si es 3 o 4 lo mismo pero dirigiéndonos a B y si es 5 o 6 dirigiéndonos a C, marcamos el punto sobre la hoja y volvemos a repetir el procedimiento desde el punto que nos habíamos quedado.

El resultado que se obtiene al realizar un número considerable de veces este proceso es sorprendente.

En Mathematica

Consideremos como vértices los puntos (0,0), (1,0) y (0,1), como punto de partida el punto (1,1) y la función ran que se comporta como el dado solo que nos da los valores 1, 2 o 3 con una probabilidad aproximada de 0.33 para cada uno.

vertices = {{0, 0}, {1, 0}, {0, 1}};
inicio = {1, 1};
ran := RandomChoice[{0.33, 0.33, 0.33} -> {1, 2, 3}, 1][[1]]

La función siguiente[ ] nos da las coordenadas del punto medio dependiendo del resultado del dado simulado por la función ran

siguiente[punto_] := (vertices[[ran]] + punto)/2

Definimos la función T[n_] que nos va a repetir n veces el procedimiento del juego del caos

T[n_] := ListPlot[NestList[siguiente, inicio, n], 
  PlotRange -> {{-0.2, 1.5}, {-0.2, 1.5}}, AspectRatio -> 1, 
  Axes -> False, PlotStyle -> PointSize[0.001]]

Grafiquemos algunos resultados de la función T[n]

Show[GraphicsGrid[{{T[10], T[50], T[100]}, {T[200], T[500], 
    T[1000]}, {T[5000], T[20000], T[50000]}}]]

Eliminando algunos puntos iniciales, el resultado es una aproximación al Triángulo de Sierpinski

T[100000]

Este proceso da origen a un método estocástico o probabilístico para la construcción de fractales denominado ping pong fractal, del cual hablaremos en una próxima entrada.



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 Cedric Villani

... por eso es que estamos siendo más y más manipulados por los algoritmos que controlan nuestro mundo digital. 
Pero si sos capaz de entender cómo funcionan estos algoritmos, podés evitar ser "peloteado" de acá para allá y podés empoderarte al tener un conocimiento más profundo de la tecnología.

Cedric Villani

Transformaciones Afines

Descargar como Notebook

Una Transformación Afín es una transformación lineal seguida de una traslación, en términos de álgebra lineal la escribimos A X + B, donde X es el vector que se transforma, A la matriz que identifica la transformación lineal y B es la traslación. En el plano la podemos ver como:

equivalentemente

por tanto, tenemos un campo vectorial lineal sobre el plano

 F (x, y) = ( a x + b y + c, d x + e y + f )

Dada una figura en el plano al aplicarle a todos sus puntos la función F obtenemos otra figura en el plano que corresponde a la imagen afín de la primera mediante F.

En el siguiente aplicativo vemos como es transformado el cuadrado unidad, de vértices (0,0), (1,0), (1,1) y (0,1), pudiendo manipular los valores a, b, c, d, e y f.

Los cambios que cada parámetro produce son:
a: aumenta o reduce horizontalmente
e: aumenta o reduce verticalmente
b: traslada el lado horizontal, que no tiene al origen, de forma horizontal
d: traslada el lado vertical, que no tiene al origen, de forma vertical
c: traslada la figura horizontalmente
f: traslada la figura verticalmente.

Una combinación de estos movimientos interesante, se tiene cuando:

que produce una rotación un ángulo θ en el sentido contrario a las manecillas del reloj. Para el presente aplicativo se debe primero realizar la rotación del a figura y luego sí modificar los parámetros, ahora lo que queda es la invitación a experimentar:

Clear[a, b, c, d, e, f, x, y]
cuadrado = {{0, 0}, {1, 0}, {1, 1}, {0, 1}, {0, 0}};
Grid[{{Manipulate[theta = θ; 
    pol := Polygon[
      Transpose[{{a, b}, {d, e}}.Transpose[cuadrado] + {c, f}]]; 
    Graphics[{{Red, Line[cuadrado]}, pol}, 
     PlotLabel -> "Area del poligono = " <> ToString[Area[pol]], 
     Axes -> True, 
     PlotRange -> {{-zoom + 1, zoom}, {-zoom + 1, zoom}}], {{zoom, 2, 
      "Zoom de la figura"}, 2, 1.2, ControlPlacement -> Top}, 
    Style["Movimientos Lineales", 
     "Text"], {{a, Cos[θ Degree]}, -2, 2, 
     Appearance -> "Open"}, {{b, -Sin[θ Degree]}, -2, 2, 
     Appearance -> "Open"}, {{d, Sin[θ Degree]}, -2, 2, 
     Appearance -> "Open"}, {{e, Cos[θ Degree]}, -2, 2, 
     Appearance -> "Open"}, 
    Style["Rotación", "Text", Small], {{θ, 0}, 0, 359.9, 
     Appearance -> "Labeled"}, 
    Style["Traslaciones", "Text"], {{c, 0}, -2, 2, 
     Appearance -> "Open"}, {{f, 0}, -2, 2, Appearance -> "Open"}, 
    ControlPlacement -> Left], MatrixForm[{{x'}, {y'}}], "=", 
   MatrixForm[{{a, b}, {d, e}}], MatrixForm[{{x}, {y}}], "+", 
   MatrixForm[{{c}, {f}}]}}]

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 Jean le Rond D´Alembert

El álgebra es muy generosa,
siempre nos dice más de lo que le preguntamos.

Jean le Rond D´Alembert

Optimización sin restricciones de funciones escalares sobre el plano

Descargar como Notebook

Colaboración del Profesor Nicolás Marciales

Dada una función escalar sobre el plano f(x,y) se determinan y clasifican sus puntos críticos como extremos locales, para esto definimos la función criticos[ ]

criticos[f_] := 
 Module[{a, h, det}, 
  hessiana[f] := {{D[f, x, x], D[f, x, y]}, {D[f, y, x], D[f, y, y]}};
   a = NSolve[{D[f, x] == 0, D[f, y] == 0}, {x, y}, Reals];
  det = Det[hessiana[f] /. a[[1]]];
  For[i = 1, i <= Length[a], i++, det = Det[hessiana[f] /. a[[i]]]; 
   h = hessiana[f] /. a[[i]];
   If[det < 0, Print[{x, y} /. a[[i]], "  Punto de silla."], 
    If[h[[1]][[1]] > 0, Print[{x, y} /. a[[i]], "  Mínimo."], 
     Print[{x, y} /. a[[i]], "  Máximo."]]]
   ]]

Veamos un ejemplo

criticos[y^3 + 3 x^2 y - 6 x^2 - 6 y^2 + 2 ]

{2.,2.}  Punto de silla.
{0.,4.}  Mínimo.
{-2.,2.}  Punto de silla.
{0.,0.}  Máximo.

Gráficamente, de rojo los puntos de silla, amarillo el máximo local y de verde el mínimo local:

f[x_, y_] := y^3 + 3 x^2 y - 6 x^2 - 6 y^2 + 2 
Show[Plot3D[f[x, y] , {x, -5, 5}, {y, -5, 5}], 
 Graphics3D[{PointSize[0.03], {Red, 
    Point[{{2, 2, f[2, 2]}, {-2, 2, f[-2, 2]}}]}, {Green, 
    Point[{0, 4, f[0, 4]}]}, {Yellow, Point[{0, 0, f[0, 0]}]}}]]

en curvas de nivel

Show[ContourPlot[f[x, y], {x, -5, 5}, {y, -5, 5}], 
 Graphics[{PointSize[0.03], {Red, Point[{{2, 2}, {-2, 2}}]}, {Green, Point[{0, 4}]}, {Yellow, Point[{0, 0}]}}]]

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 Peter Fraser

Las matemáticas son el código que envuelve todo

 Peter Fraser

Buscador de cadenas en algunas constantes matemáticas

Descargar como Notebook

Dada una cadena de dígitos las buscamos entre las cifras decimales de algunas de las principales constantes irracionales matemáticas, siguiendo los siguientes pasos:

1. En el teclado ingrese el número que desea buscar
2. Seleccione la constante irracional donde en su expansión decimal desea encontrar la cadena del            paso 1
3. Seleccione el número de cifras decimales de la constante
4. Oprima "Buscar"
5. Para ingresar una nueva cadena oprima "Limpiar" y vuelva al paso 1.

Este código lo publique en el año 2012 en la web Proyectos de Demostraciones Wolfram en el siguiente link http://demonstrations.wolfram.com/FindingStringsOfDigitsInTheDecimalDigitsOfFamousNumbers/

buscar[numero_, num_, decimales_] := 
  StringPosition[ToString[N[num, 10^decimales]], numero] - 
   IntegerLength[IntegerPart[num]] - 1;
zz = {};
lista := {};
a = 0;
Manipulate[If[a == 0, lista = {}]; cifras = StringJoin[zz];
 Grid[{{"Ingrese la cadena a buscar"}, {Grid@
     Partition[
      Join[Button[#, AppendTo[zz, ToString[#]]] & /@ 
        Range[1, 9], {Button["Limpiar", a = 0; zz = {}], 
        Button[0, AppendTo[zz, ToString[0]]], Button["Buscar",a = 1; 
         lista = buscar[cifras, numero, decimales];]}], 3]}, {Grid[{{Row[{"En las primeras ", 
         TraditionalForm[10^decimales], 
         " cifras decimales"}]}, {Row[{"del número ", 
         TraditionalForm[numero], 
         " la cadena "}]}, {}, {Row[{Framed[
          TraditionalForm[Style[cifras, Red, Large]], 
          RoundingRadius -> 10]}]}, {}, {Row[{"aparece ", 
         Length[lista], 
         Which[Length[lista] == 0, a = 0; " veces", 
          Length[lista] == 1, " vez en la posición", 
          Length[lista] > 1, " veces en las posiciones"]}]}}]}, {If[
     a == 0, "                                             ", 
     StandardForm[lista]]}}], {{numero, \[Pi], 
   "Constante"}, {Pi -> "Pi", E -> "Euler", GoldenRatio -> "Aúrea", 
   Catalan -> "Catalán", Glaisher, Khinchin, EulerGamma, 
   ChampernowneNumber[] -> "Champernowne"}, 
  ControlType -> SetterBar}, {{decimales, 3, 
   "Decimales"}, {1 -> "10¹", 2 -> "10²", 3 -> "10³", 4 -> "10⁴", 
   5 -> "10⁵", 6 -> "10⁶", 7 -> "10⁷"}}, 
 ContentSize -> {400, 320}, SaveDefinitions -> True]

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