4-20 Cannabis

Descargar como Notebook

Colaboración del Profesor Jony Romero

420, 4 : 20 o 4/20 (pronunciado cuatro - veinte) es un término de código en la cultura del cannabis que se refiere al consumo de marihuana.

Una explicación del origen del término proviene de la historia de un grupo de adolescentes del colegio San Rafael, en California en 1971, quienes se autodenominaron los Waldos. Se reunían después de clases a las 4:20 p.m. para fumar marihuana en la estatua de Louis Pasteur. Se eligió esa hora porque las clases terminaban a las 3:20 y las actividades extracurriculares o los castigos terminaban a las 4:20. Por costumbre, el 20 de abril (4/20, en el calendario estadounidense) se convirtió en una fiesta y posteriormente en el Día Mundial del Cannabis, fecha en la que mucha gente acudía a consumirla.1 En algunas localidades, esta celebración coincide con el Día de la Tierra.

PolarPlot[(1 + 0.9 Cos[8 t]) (1 + 0.1 Cos[24 t]) (0.9 + 
    0.05 Cos[200 t]) (1 + Sin[t]), {t, -Pi, Pi}, PlotStyle -> Green]

Otra Forma

PolarPlot[
 Evaluate@Table[
   a (1 + 0.9 Cos[8 t]) (1 + 0.1 Cos[24 t]) (0.9 + 
      0.05 Cos[200 t]) (1 + Sin[t]), {a, 0.1, 1, 0.05}], {t, -Pi, Pi},PlotStyle -> Green, PlotRange -> {{-2.5, 2.5}, {-0.5, 4.2}}]

Otra Forma

Show@Table[
  PolarPlot[
   a (1 + 0.9 Cos[8 t]) (1 + 0.1 Cos[24 t]) (0.9 + 
      0.05 Cos[200 t]) (1 + Sin[t]), {t, -Pi, Pi}, 
   PlotStyle -> RGBColor[0, a, 0], Axes -> None, 
   PlotRange -> {{-2.5, 2.5}, {-0.5, 4.2}}], {a, 0.1, 1, 0.02}]

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 Cecilia Payne-Gaposchkin

Los jóvenes, especialmente las chicas me piden consejo. 
Este es mi consejo.
No emprendas una carrera científica es busca de fama o dinero.
Hay maneras más fáciles y mejores de conseguir eso.
Emprende una carrera científica 
solo sino hay nada más que te satisfaga;
porque propiamente eso es lo único que recibirás.
Tu recompensa será ir ampliando el horizonte 
según vayas subiendo.
Y si consigues esa recompensa no querrás otra.

Cecilia Payne-Gaposchkin

Problema de Optimización por Multiplicadores de Lagrange: con restricción no acotada

Descargar como Notebook

Enunciado del Problema

Optimizar la función f (x, y, z) = x² + y² + z² sujeto a las restricciones g(x,y,z) = x - y = 1 y
h(x,y,z) = y² - z² = 1.


solución


Por Multiplicadores de Lagrange se tiene que los puntos óptimos, si existe, satisfacen el sistema de ecuaciones generado por:

que corresponde :

Resolviéndolo tenemos :

Solve[{2 x == la, 2 y == -la + 2 mu y, 2 z == -2 mu z, y^2 - z^2 == 1, x - y == 1}, {x, y, z, la, mu}, Reals]

Es decir, obtenemos dos puntos (0,-1,0) y (2,1,0), al calcularlos en f, tenemos:

f[x_, y_, z_] := x^2 + y^2 + z^2
{f[0, -1, 0], f[2, 1, 0]}

{1,5}

Graficando las dos restricciones :

h1 = ContourPlot3D[1 == y^2 - z^2, {x, -5, 5}, {y, -5, 5}, {z, -5, 5},ContourStyle -> {Red, Opacity[0.2]}, Mesh -> None];
h2 = ContourPlot3D[1 == x - y, {x, -5, 5}, {y, -5, 5}, {z, -5, 5}, 
   ContourStyle -> {Blue, Opacity[0.2]}, Mesh -> None];
Show[h1, h2]

La curva restricción, junto con los puntos óptimos:

h3 = ParametricPlot3D[{{t + 1, t, Sqrt[t^2 - 1]}, {t + 1, 
     t, -Sqrt[t^2 - 1]}}, {t, 1, 10}, 
   PlotStyle -> {{Thickness[0.015], Red}}];
h4 = ParametricPlot3D[{{t + 1, t, Sqrt[t^2 - 1]}, {t + 1, 
     t, -Sqrt[t^2 - 1]}}, {t, -10, -1}, 
   PlotStyle -> {{Thickness[0.015], Red}}];
h5 = Graphics3D[{{Yellow, PointSize[0.03], Point[{0, -1, 0}]}, {Green,
      PointSize[0.03], Point[{2, 1, 0}]}}];
Show[h1, h2, h3, h4, h5]

Determinando puntos sobre cada una de las ramas de la curva restricción y calculándolos en f,
primera rama:

Table[{t + 1, t, Sqrt[t^2 - 1]}, {t, 1, 10, 1}]

f @@@ %

{5, 16, 33, 56, 85, 120, 161, 208, 261, 320}

Segunda rama:

Table[{t + 1, t, Sqrt[t^2 - 1]}, {t, -10, -1, 1}]

f @@@ %

{280, 225, 176, 133, 96, 65, 40, 21, 8, 1}

vemos que el 1 y el 5 son los valores mínimos sobre cada uno de las ramas de la curva restricción, es decir hemos encontrado son mínimos locales:

Utilizando la función Minimize, tenemos:

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

y con restricciones sobre y, por cada rama:

Minimize[{x^2 + y^2 + z^2, y^2 - z^2 == 1, x - y == 1, y > 0}, {x, y, z}]

Minimize[{x^2 + y^2 + z^2, y^2 - z^2 == 1, x - y == 1, y < 0}, {x, y, z}]

Determinando el máximo total:

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

Al no estar acotada la curva restricción, tenemos mínimos para cada rama pero no existe un máximo.

Graficando junto la función f :

Manipulate[
 Show[ContourPlot3D[
   x^2 + y^2 + z^2 == r, {x, -4, 4}, {y, -4, 4}, {z, -4, 4},
   Mesh -> 2, PlotPoints -> 10, ContourStyle -> Opacity[0.2]], h3, h4,
   h5], {r, 0, 10}]

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 Carl Sagan

La imaginación nos suele llevar a mundos 
en los que nunca hemos estado.
Pero sin ella, no iríamos a ningún sitio.

Carl Sagan