Minimizacija funkcija / MP,07-01-2008

Problem jednodimenzionalne minimizacije

q[x_] :=  .4  x^3 - 6 x + 4;      xL = -5; xD = 5;
xp = 2.5; yp = 6;   T = {xp, yp};
f[
        x_] := (x - xp)^2 + (q[x] - yp)^2

      
slq = 
        Plot[q[x], {x, xL, xD}, 
          DisplayFunction -> Identity];
sltoc = 
        ListPlot[{T}, PlotStyle -> AbsolutePointSize[4], 
          DisplayFunction -> Identity];
sl = 
        Show[slq, sltoc, 
          DisplayFunction -> Identity];
slf = 
        Plot[f[x], {x, xL, xD}, PlotRange -> {0, 150}, 
          DisplayFunction -> Identity];
Show[GraphicsArray[{sl, slf}], 
        DisplayFunction -> $DisplayFunction];

Newtonova metoda

x0 = xs = 5;
Print["T0=", {x0, q[x0]}, "   d(Tp,T0)=", 
        Sqrt[f[x0]], "   error=", Abs[f'[x0]]];

x1 = x0 - f'[x0]/f''[x0]; 
    Print["T1=", {x1, q[x1]}, "   d(Tp,T1)=", 
      Sqrt[f[x1]], "   error=", 
      Abs[f'[x1]]];
x0 = x1;

\(\(\( (*\ 
      Modul\ Udaljenost\ izracunava\ udaljenost\ tocke\ Tp \((xp, 
            yp)\)\ do\ krivulje\ q\ primjenom\ Newtonove\ metode\ s\ pocetnom\ aproksimacijom\ x0\ uz\ tocnost\ eps . \ Ako\ je\ P ≠ 0, \ 
      ispisivat\ ce\ se\ svaka\ iteracija\ \ *) \)\(
\)\(Udaljenost[q_, Tp_, x0_, eps_, it_, P_] := 
      Module[{a = N[x0], 
          k = 0}, 
f[
            x_] := \((x - xp)\)^2 + \((q[x] - 
                  yp)\)^2; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ While[\ Abs[\(f'\)[a]] > eps\  && \ 
            k < it, \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[\ P ≠ 0, 
            Print["x", k, "=", a, "   d(Tp,T", k, ") =", 
              Sqrt[f[a]], "   error=", 
              Abs[\(f'\)[
                  a]]]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ a = 
            a - \(f'\)[a]/\(f''\)[
                  a]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ k = 
            k + 1;
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]; \ 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ If[
          P ≠ 0, 
          Print["x", k, "=", a, "    d(Tp,T", k, ") =", 
            Sqrt[f[a]], "  error=", 
            Abs[\(f'\)[
                a]]]]; 
\ \ \ \ \ \ \ \ \ \ \ \ \ \ {{\ a, 
            q[a]}, Sqrt[
            f[a]]}
\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ ]\)\)\)

Udaljenost[q, {2.5, 6}, 5,  .05, 10, 1]

Mathematica moduli

FindMinimum[f[x], {x, 4}]

NMinimize[f[x], x]

Problem visedimenzionalne minimizacije

Clear[x, x1, x2, f, g]
 n = 2; 
      f[x_] :=  2  x[1]^3 + x[1] x[2]^2 + 5  x[1]^2 + 
          x[2]^2;
sl1 = 
        Plot3D[f[x] /. {x[1] -> x1, x[2] -> x2}, {x1, -3, 
            1}, {x2, -2, 2}, 
          DisplayFunction -> 
            Identity];
sl2 = 
        ContourPlot[
          f[x] /. {x[1] -> x1, x[2] -> x2}, {x1, -3, 
            1}, {x2, -2, 2}, Contours -> 40,  
          PlotPoints -> 30, ContourShading -> None, 
          DisplayFunction -> Identity];
Show[
        GraphicsArray[{sl1, sl2}], 
        DisplayFunction -> $DisplayFunction];
g[x_]:=Table[D[f[x], x[i]],{i, n}]
H[x_]:=Table[D[g[x][[i]], x[j]],{i, n},{j, n}]
Print["grad f=",  
      Simplify[g[x] /. {x[1] -> x1, x[2] -> x2}] // 
        MatrixForm,  "    H(f)=",  
      Simplify[H[x] /. {x[1] -> x1, x[2] -> x2}] // 
        MatrixForm]

Newtonova metoda

Newtonova metoda bez regulacije koraka

x0 = {4. , 5. };   w =  
      Table[x[i] -> x0[[i]], {i, n}];  
Print[{x0, f[x] /. w}, "   |grad f|=", 
        Max[Abs[g[x] /. w]]];

p = LinearSolve[H[x] /. w,  g[x] /. w];
x1 = x0 - p;
w =  
        Table[x[i] -> x1[[i]], {i, 
            n}];  
Print[{x1, f[x] /. w}, ",   |grad f|=", 
        Max[Abs[g[x] /. w]]];
x0 = x1;

Newtonova metoda s regulacijom koraka

x0 = {4. , 5. };   w =  
      Table[x[i] -> x0[[i]], {i, n}];  
Print[{x0, f0 = f[x] /. w}, "   |grad f|=", 
        Max[Abs[g[x] /. w]]];

p = LinearSolve[H[x] /. w,  g[x] /. w];

      
al = 1; 
    While[x1 = x0 - al p; w =  Table[x[i] -> x1[[i]], {i, n}];  
      f1 = f[x] /. w; f1 > f0, al = al/2]
Print["alpha=", al]
Print[{x1, f[x] /. w}, ",   |grad f|=", 
        Max[Abs[g[x] /. w]], "    alpha=", 
        al];
x0 = x1;

While petlja

x0 = {4. , 5. };  eps = 0.005; k = 0;  
    w =  Table[
        x[i] -> x0[[i]], {i, n}];  
Print["k=", 
        k, "   ", {x0, f0 = f[x] /. w}, "   |grad f|=", 
        Max[Abs[g[x] /. w]]];
While[
p = 
          LinearSolve[H[x] /. w,  g[x] /. w]; 
  
al = 1; 
        While[x1 = x0 - al p; 
          w =  Table[x[i] -> x1[[i]], {i, n}];  f1 = f[x] /. w; 
          f1 > f0, al = al/2]; 
        k = k + 1; 
Print["k=", 
          k, "   ", {x1, f[x] /. w}, ",   |grad f|=", 
          err = Max[Abs[g[x] /. w]], "    alpha=", 
          al]; 
err > eps, 
x0 = 
          x1];

Mathematica moduli

Clear[x1, x2]
FindMinimum[
      f[x] /. {x[1] -> x1, x[2] -> x2}, {x1, 2}, {x2, 
        1}]

Clear[x1, x2]
NMinimize[
      f[x] /. {x[1] -> x1, x[2] -> x2}, {x1, x2}]