Frase Célebre de Eric Temple Bell

Si un lunático hace un garabato 
de un montón de símbolos matemáticos, 
no resulta que la escritura signifique algo 
meramente porque para el ojo inexperto 
sea indistinguible de las más complejas matemáticas.

Eric Temple Bell

Dos años del Blog y más de 20000 vistas

Descargar como Notebook

Aprovechando la coincidencia de cumplir en septiembre dos años del lanzamiento del Blog y lograr pasar de las 20000 vistas, quiero agradecerle a todas las personas que han contribuido a lograr estas dos metas.

Creación del Logo

Manipulate[
 Show[Graphics[
   Table[Translate[
     Rotate[Style[Text["2 Años"], 24, 
       RGBColor[Cos[n] - Sin[n], Cos[n]^2, Sin[n]]], 
      n], {{Cos[n], Sin[n]}}], {n, Pi/6 + a, 4 Pi, Pi/6}]], 
  Graphics[Text[
    Style[Column[{"20000", "Vistas"}], 50, 
     RGBColor[Cos[a] - Sin[a], Cos[a]^2, Sin[a]]], {0, 0}]], 
  PlotRange -> 1.4], {a, 0, 2 Pi}, AutoAction -> True, 
 Deployed -> True]

Generación del GIF

Export[NotebookDirectory[] <> "cumple2.gif", 
 Manipulate[
  Show[Graphics[
    Table[Translate[
      Rotate[Style[Text["2 Años"], 24, 
        RGBColor[Cos[n] - Sin[n], Cos[n]^2, Sin[n]]], 
       n], {{Cos[n], Sin[n]}}], {n, Pi/6 + a, 4 Pi, Pi/6}]], 
   Graphics[
    Text[Style[Column[{"20000", "Vistas"}], 50, 
      RGBColor[Cos[a] - Sin[a], Cos[a]^2, Sin[a]]], {0, 0}]], 
   PlotRange -> 1.4`], {a, 0, 2 Pi}, AutoAction -> True, 
  Deployed -> True], "AnimationRepetitions" -> Infinity]


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

Así como los objetos más fáciles de ver 
no son los demasiado grandes ni los demasiado pequeños, 
también en matemáticas las ideas más fáciles 
no son las demasiado complejas ni las demasiado simples.

Bertrand Russell

Corazón generado desde una Matriz

Descargar como Notebook

Septiembre mes del amor y la amistad, en Colombia, representamos su símbolo.

MatrixPlot[
 Table[(a + b)/((b^2 + a^2 - 2)^3 + b^2 a^3), {a, -2.5, 2, 
   0.01}, {b, -2.25, 2.25, 0.01}], Frame -> None]

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 Eugenia Cheng

Algunas personas piensan que las matemáticas 
trata sobre obtener respuestas correctas.
Pero ella trata es sobre hacer las preguntas correctas.

Eugenia Cheng

Optimización de una función sin utilizar Cálculo

Descargar como Notebook

Normalmente al optimizar una función recurrimos inevitablemente a conceptos de cálculo diferencial: Derivar la función, igualar a cero y clasificar los puntos encontrados.

Vamos a determinar un Mínimo Local de una función, sin utilizar Cálculo, simplemente realizando aproximaciones sucesivas.

El método que utilizaremos es partiendo de un intervalo se generan sucesiones al estilo del Método de Encaje de Cantor alrededor de su punto medio verificando que sean decrecientes, buscando la determinación de un mínimo con un grado satisfactorio de aproximación predeterminado.

La función que ejemplificaremos es:

Con una aproximación de 0.01.

Clear[a, b, f, n, an, bn, ln, mn, k]
f[x_] := 0.25 x^4 - (5/3) x^3 - 6 x^2 + 19 x - 7
k = 1;
a = -4;
b = 12;
long = 0.1;
ep = long/10;
an[0] = a;
bn[0] = b;
ln[n_] := ((an[n] + bn[n])/2) - ep;
mn[n_] := ((an[n] + bn[n])/2) + ep;
While[bn[k - 1] - an[k - 1] > long, 
 If[f[ln[k - 1]] >= f[mn[k - 1]], an[k] = ln[k - 1]; 
  bn[k] = bn[k - 1], an[k] = an[k - 1]; bn[k] = mn[k - 1]]; k++]
(an[k - 1] + bn[k - 1])/2
data = Table[{j, an[j], bn[j], ln[j], mn[j], f[ln[j]] > f[mn[j]]}, {j, 0, k - 1, 1}];
TableForm[data, 
 TableHeadings -> {None, {"k", "a_k", 
    "b_k", 
    "λ_k", 
    "μ_k", "decrece"}}]
gra1 = Plot[f[x], {x, a - 1, b + 1}];
Manipulate[
 Show[gra1, 
  ListPlot[Table[{(an[j] + bn[j])/2, f[(an[j] + bn[j])/2]}, {j, 0, i, 
     1}], PlotStyle -> Red]], {i, 0, k - 1, 1}]

6.40324

Utilizando la función Minimize obtenemos:

Minimize[{0.25 x^4 - (5/3) x^3 - 6 x^2 + 19 x - 7, x > 1}, x]

{-148.638, {x -> 6.4097}}

Así, vemos que nuestra aproximación es buena.


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 Jules Henri Pincaré

Un científico merecedor de tal nombre, 
sobre todo un matemático, 
experimenta en su trabajo la misma impresión que un artista; 
su placer es tan grande y de la misma naturaleza.

Jules Henri Pincaré

Puntos máximos y mínimos con respecto a las simetrías

Descargar como Notebook

Un ejercicio sencillo de Pre Cálculo sobre los puntos óptimos y las simetrías

f5[x_] := -(x - 3)^2 + 1
Manipulate[
 Show[Plot[f5[x], {x, 1, 5}, AxesLabel -> {"X", "Y"}], 
  Which[a == 0, Plot[f5[x], {x, 1, 5}], a == 1, 
   Show[Plot[f5[-x], {x, -5, -1}, PlotStyle -> Red], 
    Graphics[Style[Text["Punto Máximo de f(-x)", {-4, 2}], Red]]], 
   a == 2, Show[Plot[-f5[x], {x, 1, 5}, PlotStyle -> Red], 
    Graphics[Style[Text["Punto Mínimo de -f(x)", {4, -2}], Red]]], 
   a == 3, Show[Plot[-f5[-x], {x, -5, -1}, PlotStyle -> Red], 
    Graphics[Style[Text["Punto Mínimo de -f(-x)", {-4, -2}], Red]]]], 
  Graphics[Text["Punto Máximo de f(x)", {4, 2}]], 
  PlotRange -> {{-10, 10}, {-6, 6}}, 
  AxesOrigin -> {0, 0}], {{a, 0, "Simetría"}, {0 -> "función", 
   1 -> "eje y", 2 -> "eje x", 3 -> "origen"}}]

Creación del GIF

Código para la generación del GIF.

Export[NotebookDirectory[] <> "optimos.gif", 
 Manipulate[
  Show[Which[a == 0, Plot[f5[x], {x, 1, 5}], a == 1, 
    Show[Plot[f5[-x], {x, -5, -1}, PlotStyle -> Red], 
     Graphics[Style[Text["Punto Máximo de f(-x)", {-4, 2}], Red]]], 
    a == 2, Show[Plot[-f5[x], {x, 1, 5}, PlotStyle -> Red], 
     Graphics[Style[Text["Punto Mínimo de -f(x)", {4, -2}], Red]]], 
    a == 3, Show[Plot[-f5[-x], {x, -5, -1}, PlotStyle -> Red], 
     Graphics[Style[Text["Punto Mínimo de -f(-x)", {-4, -2}], Red]]]],
    g7, Graphics[Text["Punto Máximo de f(x)", {4, 2}]], 
   PlotRange -> {{-10, 10}, {-6, 6}}, 
   AxesOrigin -> {0, 0}], {{a, 0, "Simetría"}, {0 -> "función", 
    1 -> "eje y", 2 -> "eje x", 3 -> "origen"}}], 
 "AnimationRepetitions" -> Infinity]

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