Problema de Optimización por Multiplicadores de Lagrange

Descargar como Notebook

Problema

Determinar el rectángulo  de área máxima que está inscrito en la elipse

Graficamos los diferentes rectángulos junto con su área,

g1 = ContourPlot[(x^2/9) + (y^2/16) == 1, {x, -4, 4}, {y, -5, 5},
   ContourStyle -> Green, Axes -> True, AspectRatio -> Automatic];
Manipulate[
 Column[{Row[{"Area del Rectángulo  ", 16. a Sqrt[1 - a^2/9]}],
   Show[g1,
    Graphics[{Blue,
      Line[{{a, -4 Sqrt[1 - a^2/9]}, {a, 4 Sqrt[1 - a^2/9]}, {-a,
         4 Sqrt[1 - a^2/9]}, {-a, -4 Sqrt[1 - a^2/9]}, {a, -4 Sqrt[
           1 - a^2/9]}}]}]]}], {{a, 1}, 0, 3}]

Analizando las curvas de nivel correspondiente al área del cuadrado y los gradientes de la restricción y la función a Optimizar:

Manipulate[
 Column[{Row[{"Area del Rectángulo  ", 16. a Sqrt[1 - a^2/9]}],
   Show[ContourPlot[(x^2/9) + (y^2/16) == 1, {x, -2, 7}, {y, -2, 7},
     PerformanceGoal -> "Quality", PlotRange -> {{-2, 7}, {-2, 7}},
     ImageSize -> Large, ContourStyle -> Green, Axes -> True],
    ContourPlot[4 x*y == area, {x, -2, 7}, {y, -2, 7},
     ContourShading -> None, PerformanceGoal -> "Quality",
     ContourStyle -> Red],
    Graphics[
     Point[Dynamic[{x, 4 Sqrt[9 - x^2]/3}], VertexColors -> Red]],
    Graphics[{Green,
      Arrow[{{x,
         4 Sqrt[9 - x^2]/3}, {(11 x)/9, (3 Sqrt[9 - x^2])/2}}]}],
    Graphics[{Red,
      Arrow[{{x, 4 Sqrt[9 - x^2]/3}, {x + (6/x), (6/x) + x}}]}],
    If[rectangulo,
     Graphics[{Blue,
       Line[{{a, -4 Sqrt[1 - a^2/9]}, {a, 4 Sqrt[1 - a^2/9]}, {-a,
          4 Sqrt[1 - a^2/9]}, {-a, -4 Sqrt[1 - a^2/9]}, {a, -4 Sqrt[
            1 - a^2/9]}}]}], Graphics[Point[{0, 0}]]]]}], {x, .0001,
  3}, {area, 2, 32}, {rectangulo, {False, True}}, {a, 0, 3}]

Observamos que en el punto óptimo se tiene:

1. La curva de nivel correspondiente a la máxima área es tangente con la elipse,

2. en el punto de tangencia, también coincide el vértice del cuadrado de área máxima,

3. y lo más importante, los gradientes de la curva de nivel del área máxima y el de la elipse, son paralelos, aspecto fundamental para el Método de Multiplicadores de Lagrange.

Solución Analítica 

Sean (x,y) las coordenadas del vértice del cuadrado en el primer cuadrante, entonces:

Función a Optimizar: A(x,y) = 4 x y,

Restricción: g(x,y) = x²/9 + y²/16 = 1.

Por Multiplicadores de Lagrange los puntos óptimos, si existen, satisfacen el sistema de ecuaciones:

que se convierte en,

Resolviendo en Mathematica, tenemos:


Solve[{4 y == 2 n x/9, 4 x == n y/8, x^2/9 + y^2/16 == 1},{x, y, n}]

como x,y>0, la solución es la última:

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 Alan Turing

A veces las personas que todos piensan que no harán nada,
son las que hacen cosas que nadie habría imaginado.

Alan Turing

Sucesión Anti Fibonacci

Descargar como Notebook

Sabemos que la Sucesión de Fibonacci esta definida de forma recurrente como la sucesión donde sus dos primeros términos son unos y los siguientes se obtienen como la suma de los dos términos anteriores.

a ( 1 ) = 1, a ( 2 ) = 1   y   a ( n ) = a ( n-1 ) + a ( n - 2 ).

Y la podemos generar, en sus primeros 20 términos, por :

fib[1] = 1; fib[2] = 1;
fib[n_] := fib[n - 1] + fib[n - 2]
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}

Ahora, la Sucesión AntiFibonacci se define también de forma recurrente, como la sucesión cuyos dos primeros términos son unos y los demás son la suma de los dos términos siguientes, tendríamos que conocer los términos cuarto y quinto para poder determinar el tercero.

a ( 1 ) = 1, a ( 2 ) = 1 y a ( n ) = a ( n + 1 ) + a ( n + 2 ).

A primera vista uno pensaría que tendría que conocer no los dos primeros términos, sino los dos últimos para poder determinar todos los demás. El problema es que la sucesión es infinita así que conocer los últimos es un contrasentido. Ahora apoyándonos en el álgebra tenemos que:

La podemos escribir también como :

a ( 1 ) = 1, a ( 2 ) = 1   y   a ( n - 2 ) = a ( n ) + a ( n - 1 ),

de donde,

a ( n ) = a ( n - 2 ) + a ( n - 1 ).

Así, en Mathematica tenemos :

ifib[1] = 1; ifib[2] = 1;
ifib[n_] := ifib[n - 2] - ifib[n - 1]
Table[ifib[n], {n, 20}]

{1, 1, 0, 1, -1, 2, -3, 5, -8, 13, -21, 34, -55, 89, -144, 233, -377, 610, -987, 1597}

Que corresponde a la sucesión de Fibonacci con los valores iniciales fib(1)= -1 y fib(2)=1.

fib[1] = -1; fib[2] = 1;
fib[n_] := fib[n - 1] + fib[n - 2]
Table[fib[n], {n, 20}]

{-1, 1, 0, 1, 1, 2, 3, 5, 8, 13, 21, 34, 55, 89, 144, 233, 377, 610, 987, 1597}

y multiplicando cada término por (-1)ⁿ:

Table[fib[n] (-1)^n, {n, 20}]

{1, 1, 0, 1, -1, 2, -3, 5, -8, 13, -21, 34, -55, 89, -144, 233, -377, 610, -987, 1597}


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 Stephen Hawking

Inteligencia es la facultad de adaptarse a los cambios.

Stephen Hawking