4. Jednodimenzionalna globalna optimizacija

6.4.1 Pijavskijeva metoda slomljenih pravaca

Input:	- funkcija f ∈ (Subscript[Lip, L]) [a,b]
	- rubovi intervala a i b
	- Lipshitzova konstanta L>0
	- početna točka u0
	- broj iteracija It
	Opcionalni argumenti:
	- indikator ispisa Ind
	- indikator prikaza slika Sl

Modul

Pijavskij[f_, a_, b_, L_, u0_, It_, Ind_:1,Sl_:1]:=Module[{k=0,xx={u0},slf=Plot[f[x],{x,a,b}],slike={},vrhovi,van,fvan},
vrhovi={{a,f[u0]-L* Abs[a-u0]},{b,f[u0]-L* Abs[b-u0]}};
vrhovi=Sort[vrhovi,#1[[2]]>#2[[2]]&];
While[k<It,
k++;
van=Last[vrhovi];
fvan=f[van[[1]]];
vrhovi=Drop[vrhovi,-1];
If[van[[1]]≠a, AppendTo[vrhovi,{van[[1]] + 1/(2 L)*(van[[2]]-fvan), (van[[2]]+fvan)/2}]];
If[van[[1]]≠b,AppendTo[vrhovi,{van[[1]] - 1/(2 L)*(van[[2]]-fvan), (van[[2]]+fvan)/2}]];
vrhovi=Sort[vrhovi,#1[[2]]>#2[[2]]&];
If[Sl≠ 0,AppendTo[slike, Show[{slf,Plot[Max[Table[f[xx[[i]]]-L* Abs[u-xx[[i]]],{i,Length[xx]}]],{u,a,b},PlotStyle->Red], ListPlot[{van},PlotStyle->PointSize[0.03]]},PlotRange->All]]];
AppendTo[xx,van[[1]]];
];
If[Ind≠0,Print[TableForm[Table[{i-1,xx[[i]],f[xx[[i]]]},{i,1,k+1}], TableHeadings->{None,{"k", "(Subscript[u, k])","f((Subscript[u, k]))"}}]]];
If[Sl≠ 0,Print[GraphicsRow[slike,ImageSize->k*200]]];
Return[{f[Last[xx]],{x->Last[xx]}}];
]

Primjer 1.

f[x_]:=Piecewise[{{-x+4,1≤x≤2},{2,2≤x≤3},{2x-4,3≤x≤4},{-3x+16,4≤x≤5},{x-4,5≤x≤6}}]
Pijavskij[f,1,6,3,3.,10]

Primjer 2.

f[x_]:=Sin[5 x-2]/x+x/10+1
a=1.;b=4;
Plot[f[x],{x,a,b},AxesOrigin->{1,0}]
Plot[Abs[f'[x]],{x,a,b}]
L=Abs[f'[1]]//N
Pijavskij[f,a,b,L,a,10]
Pijavskij[f,a,b,L,a,1000,0,0]

6.4.2 Shubertova metoda

Input:	- funkcija f ∈ (Subscript[Lip, L]) [a,b]
	- rubovi intervala a i b
	- Lipshitzova konstanta L>0
	- broj iteracija It
	Opcionalni argumenti:
	- indikator ispisa Ind
	- indikator prikaza slika Sl

Modul

Shubert[f_,  a_, b_, L_, It_, Ind_:1,Sl_:1]:=Module[{k=0,xx={(a+b)/2},slf=Plot[f[x],{x,a,b}],slike={},U,B,int,van},
U[l_,d_]:=1/2*(l+d)+1/(2 L)*(f[l]-f[d]);
B[l_,d_]:=1/2*(f[l]+f[d])-L/2*(d-l);
int={{a,b,B[a,b]}};
While[k<It,
k++;
van=Last[int];
AppendTo[xx,U[van[[1]],van[[2]]]];
int=Drop[int,-1];
AppendTo[int,{van[[1]],U[van[[1]],van[[2]]], B[van[[1]],U[van[[1]],van[[2]]]]}];
AppendTo[int,{U[van[[1]],van[[2]]],van[[2]], B[van[[1]],U[van[[1]],van[[2]]]]}];
int=Sort[int,#1[[3]]>#2[[3]]&];
If[Sl≠ 0,AppendTo[slike, Show[{slf,Show[Table[Plot[Max[f[int[[i,1]]]-L*(u-int[[i,1]]),f[int[[i,2]]]+L*(u-int[[i,2]])],{u,int[[i,1]],int[[i,2]]},PlotStyle->Red],{i,1,Length[int]}]]},PlotRange->All]]];
];
If[Ind≠0,Print[TableForm[Table[{i-1,xx[[i]],f[xx[[i]]]},{i,1,k+1}], TableHeadings->{None,{"k", "(Subscript[u, k])","f((Subscript[u, k]))"}}]]];
If[Sl≠ 0,Print[GraphicsRow[slike,ImageSize->k*200]]];
Return[{f[Last[xx]],{x->Last[xx]}}];
]

Primjer 1.

f[x_]:=Piecewise[{{-x+4,1≤x≤2},{2,2≤x≤3},{2x-4,3≤x≤4},{-3x+16,4≤x≤5},{x-4,5≤x≤6}}]
Shubert[f,1.,6,3,10]

Primjer 2.

f[x_]:=Sin[5 x-2]/x+x/10+1
a=1.;b=4;
Plot[f[x],{x,a,b},AxesOrigin->{1,0}]
Plot[Abs[f'[x]],{x,a,b}]
L=Abs[f'[1]]//N
Shubert[f,a,b,L,10]
Shubert[f,a,b,L,1000,0,0]
NMinimize[{f[x],a≤x≤b},x]

6.4.3 Optimizacijski algoritam DIRECT - poznata Lipschitzova konstanta

Input:	- funkcija f ∈ (Subscript[Lip, L]) [a,b]
	- rubovi intervala a i b
	- Lipshitzova konstanta L>0
	- broj iteracija n
	Opcionalni argumenti:
	- indikator ispisa Ind
	- indikator prikaza slika Sl

Modul

DIRECT1DL[f_,  a_, b_,L_, It_, Ind_:1,Sl_:1]:=Module[{k=0,podijeljeni={},slf=Plot[f[x],{x,a,b}],slike={},B,int,van, minlist={{(a+b)/2,f[(a+b)/2]}}, min},
B[c_,d_]:=f[c]-L*d;
int={{(a+b)/2,(b-a)/2,B[(a+b)/2,(b-a)/2]}};
While[k<It,
k++;
van=Last[int];
AppendTo[podijeljeni,{van[[1]]-van[[2]],van[[1]]+van[[2]]}];
int=Drop[int,-1];
int=Join[int, {{van[[1]]-2*van[[2]]/3, van[[2]]/3, B[van[[1]]-2*van[[2]]/3, van[[2]]/3]}, {van[[1]], van[[2]]/3, B[van[[1]], van[[2]]/3]}, {van[[1]]+2*van[[2]]/3, van[[2]]/3, B[van[[1]]+2*van[[2]]/3, van[[2]]/3]}}];
min=Last[minlist];
If[f[van[[1]]-2*van[[2]]/3]<min[[2]], min={van[[1]]-2*van[[2]]/3,f[van[[1]]-2*van[[2]]/3]};];
If[f[van[[1]]+2*van[[2]]/3]<min[[2]], min={van[[1]]+2*van[[2]]/3,f[van[[1]]+2*van[[2]]/3]};];
AppendTo[minlist,min];
int=Sort[int,#1[[3]]>#2[[3]]&];
If[Sl≠ 0,AppendTo[slike, Show[{slf,Show[Table[Plot[f[int[[i,1]]]-L*Abs[u-int[[i,1]]],{u,int[[i,1]]-int[[i,2]],int[[i,1]]+int[[i,2]]},PlotStyle->Red],{i,1,Length[int]}]]},PlotRange->All]]];
];
AppendTo[podijeljeni,{" ",""}];
If[Ind≠0,Print[TableForm[Table[{i-1,StringJoin["[",ToString[podijeljeni[[i,1]]],", ",ToString[podijeljeni[[i,2]]],"]"],minlist[[i,1]],minlist[[i,2]]},{i,1,k+1}], TableHeadings->{None,{"k", "interval koji se dijeli", "trenutni minimum (Subscript[c, k]^( * ))","f((Subscript[c, k]^( * )))"}}]]];
If[Sl≠ 0,Print[GraphicsRow[slike,ImageSize->k*200]]];
Return[{Last[minlist][[2]],{x->Last[minlist][[1]]}}];
]

Primjer 1.

f[x_]:=Piecewise[{{-x+4,1≤x≤2},{2,2≤x≤3},{2x-4,3≤x≤4},{-3x+16,4≤x≤5},{x-4,5≤x≤6}}]
DIRECT1DL[f,1.,6,3,10]

Primjer 2.

f[x_]:=Sin[5 x-2]/x+x/10+1
a=1.;b=4.;
Plot[f[x],{x,a,b},AxesOrigin->{1,0}]
Plot[Abs[f'[x]],{x,a,b}]
L=Abs[f'[1]]//N
DIRECT1DL[f,a,b,L,10]
DIRECT1DL[f,a,b,L,1000,0,0]
NMinimize[{f[x],a≤x≤b},x]

6.4.4 Optimizacijski algoritam DIRECT - nepoznata Lipschitzova konstanta

Input:	- funkcija f ∈ (Subscript[Lip, L]) [a,b]
	- rubovi intervala a i b
	- Lipshitzova konstanta L>0
	- broj iteracija n
	Opcionalni argumenti:
	- indikator ispisa Ind
	- indikator prikaza slika Sl

Modul

DIRECT1D[f_,  a_, b_, It_, Ind_:1,Sl_:1]:=Module[{k=0,potoptint,slf=Plot[f[x],{x,a,b}],slike={},int,inttemp, novi,maxL,minL,ok,i,j,kk,minlist={}, min},
int={{(5 a+b)/6,(b-a)/6,f[(5 a+b)/6]},{(a+b)/2,(b-a)/6,f[(a+b)/2]},{(a+5b)/6,(b-a)/6,f[( a+5b)/6]}};
min=Sort[int,#1[[3]]>#2[[3]]&][[-1]][[{1,3}]];
minlist={min};
While[k<It,
k++;
potoptint={};
For[j=1,j≤Length[int],j++,
maxL=0;
minL=Infinity;
For[i=1,i≤Length[int],i++,
If[int[[i,2]]<int[[j,2]],
maxL=Max[maxL,(int[[j,3]]-int[[i,3]])/(int[[j,2]]-int[[i,2]])];,
If[int[[i,2]]>int[[j,2]],
minL=Min[minL,(int[[j,3]]-int[[i,3]])/(int[[j,2]]-int[[i,2]])];,
If[int[[j,3]]>int[[i,3]], ok=0;  Break[];, ok=1;]
];
];
];
If[maxL<minL &&ok==1, AppendTo[potoptint,{j, int[[j]]}];];
];
int=Delete[int,ArrayReshape[potoptint[[All,1]],{Length[potoptint],1}]];
 For[kk=1,kk≤Length[potoptint],kk++,
inttemp=potoptint[[kk,2]];
novi={{inttemp[[1]]-2*inttemp[[2]]/3, inttemp[[2]]/3, f[inttemp[[1]]-2*inttemp[[2]]/3]}, {inttemp[[1]], inttemp[[2]]/3, inttemp[[3]]}, {inttemp[[1]]+2*inttemp[[2]]/3, inttemp[[2]]/3, f[inttemp[[1]]+2*inttemp[[2]]/3]}};
int=Join[int, novi];
If[novi[[1,3]]<min[[2]], min={novi[[1,1]],novi[[1,3]]};];
If[novi[[3,3]]<min[[2]], min={novi[[3,1]],novi[[3,3]]};];
];
AppendTo[minlist,min];
];
If[Ind≠0,Print[TableForm[Table[{i,minlist[[i,1]],minlist[[i,2]]},{i,1,k}], TableHeadings->{None,{"k",  "trenutna aproksimacija (Subscript[c, k]^( * ))","f((Subscript[c, k]^( * )))"}}]]];
If[Sl≠ 0,Print[Plot[f[x],{x,a,b},Ticks->{Transpose[{int[[All,1]],ConstantArray["",Length[int]]}],Automatic},ImageSize->Medium]]];
Return[{min[[2]],{x->min[[1]]}}];
];

Primjer 1.

f[x_]:=Piecewise[{{-x+4,1≤x≤2},{2,2≤x≤3},{2x-4,3≤x≤4},{-3x+16,4≤x≤5},{x-4,5≤x≤6}}]
DIRECT1D[f,1.,6.,10]

DIRECT1D[f,1.,6.,20,0,0]

Primjer 2.

f[x_]:=Sin[5 x-2]/x+x/10+1
a=1.;b=4.;
DIRECT1D[f,a,b,10]
DIRECT1D[f,a,b,20,0,0]
NMinimize[{f[x],a≤x≤b},x]