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