witam!!!
Mam napisać na zajecia program, który bedzie realizował metode simplex, jezeli ma ktos dostep do kodu napisanego w niezaleznie jakim jezyku i moze uzyczyc bede wdzieczny
pzdr</b>
0
0
Mam ale myśle że sobie poradzisz dużo jest wiadomości w necie na temat samego algorytmu i dużo rozwiązań pamiętam że coś znalazłem kiedyś na codeproject.com ale to wymaga poszukania. Jak pamiętam algorytm ten to metoda optymalizacji jak uważałeś na zajęciach to i w excelu można napisać.
Co do samego algorytmu jak znajde to ci go wyśle ale szybciej znajdziesz na jakimś formu zagranicznym. pozdrawiam
0
Proszę bardzo:
unit Simplex;
interface
type
TVect1Double= array of double;
TVect2Double= array of array of double;
TUsrFn= function(y: TVect1Double): double;
TSimplex=class
private
xr,xr2,xmx,xmn,x1,x2,y: TVect1Double;
xexp,xprime:TVect1Double;
x: TVect2Double;
yr, yr2: double;
procedure MTXGCL(var c: TVect1Double; a: TVect2Double; k:integer); //c[i]=a[i,k]
procedure MTXADV(var w: TVect1Double; u,v: TVect1Double); //w=u+v
procedure MTXMSV(var v: TVect1Double;u: TVect1Double; s:double); //v=s*u
procedure MTXPCL(var a: TVect2Double; c: TVect1Double; k:integer); //a[i,k]=c[i]
procedure MTXCPV(var v: TVect1Double; u: TVect1Double); //v=u
procedure MTXZRV(var u: TVect1Double); //u=0
procedure MTXSBV(var w: TVect1Double;u,v: TVect1Double); //w=u-v
procedure Compression(const mx: integer);
procedure Reflection(const mx: integer);
procedure Extension(const mx: integer);
public
constructor Create(var x0:TVect1Double; var fmin:double; Epsiln:double; var Nstep:integer; fn: TUsrFn);
destructor Destroy; override;
end;
function UsrFn1(y: TVect1Double): double;
function Gauss(a0, a1, a2, a3, x: double): double;
var StartIndex, EndIndex: integer;
implementation
uses main, Math;
////////////////////////////////////////////////////////////////////////////
procedure TSimplex.MTXGCL(var C: TVect1Double; A: TVect2Double; k:integer);
var i:integer;
begin
for i:=0 to High(C) do C[i]:=A[k,i];
end;
procedure TSimplex.MTXADV(var w: TVect1Double; u,v: TVect1Double);
var i:integer;
begin
for i:=0 to High(w) do w[i]:=u[i]+v[i];
end;
procedure TSimplex.MTXMSV(var v: TVect1Double; u: TVect1Double;s :double);
var i:integer;
begin
for i:=0 to High(v) do v[i]:=s*u[i];
end;
procedure TSimplex.MTXPCL(var A: TVect2Double; C: TVect1Double; k:integer);
var i:integer;
begin
for i:=0 to High(C) do A[k,i]:=C[i];
end;
procedure TSimplex.MTXCPV(var v:TVect1Double; u:TVect1Double);
var i:integer;
begin
for i:=Low(v) to High(v) do v[i]:=u[i];
end;
procedure TSimplex.MTXZRV(var u: TVect1Double);
var i:integer;
begin
for i:=0 to High(u) do u[i]:=0.0;
end;
procedure TSimplex.MTXSBV(var w: TVect1Double;u,v:TVect1Double);
var i:integer;
begin
for i:=0 to High(v) do w[i]:=u[i]-v[i];
end;
procedure TSimplex.Compression(const mx: integer);
begin
MTXPCL(x,xr2,mx); //perform compression
y[mx]:=yr2;
end;
procedure TSImplex.Reflection(const mx: integer);
begin
MTXPCL(x,xr,mx);
y[mx]:=yr;
end;
procedure TSimplex.Extension(const mx: integer);
begin
MTXPCL(x,xr2,mx);
y[mx]:=yr2;
end;
constructor TSimplex.Create(var x0:TVect1Double; var fmin:double;
Epsiln:double;var Nstep:integer; Fn: TUsrFn);
var i, ne, mn, mx, nst, n0:integer;
istep:integer;
d,f,eps:double;
begin
n0:=High(x0)+1;
SetLength(y,n0+1);
SetLength(x1,n0); SetLength(x2,n0);
SetLength(xr,n0); SetLength(xr2,n0);
SetLength(xmx,n0); SetLength(xmn,n0);
SetLength(xexp,n0); SetLength(xprime,n0);
SetLength(x,n0+1, n0);
if Epsiln>0 then eps:=Epsiln else eps:=1e-25;
if Nstep>0 then nst:=Nstep else nst:=1000;
y[0]:=Fn(x0);
MTXCPV(x1,x0);
MTXPCL(x,x1,0);
d:=fmin;
if d<=0 then d:=1e-5;
for i:=0 to n0-1 do
begin
MTXCPV(x2,x1);
x2[i]:=x2[i]+d;
MTXPCL(x,x2,i+1);
MTXCPV(xexp,x2); //!!
y[i+1]:=Fn(xexp);
end;
istep:=1; mn:=0;
////////////////////////////////////////////////////////////////////
while istep<=nst do
begin
mn:=0;
if y[0]>y[1] then
begin
mx:=0; ne:=1;
end else
begin
mx:=1; ne:=0;
end;
for i:=1 to n0 do
begin
if y[i]<y[mn] then mn:=i;
if y[i]>y[mx] then
begin
ne:=mx;
mx:=i;
end else
if y[i]>y[ne] then
if i<>mx then ne:=i;
end;
if (abs(y[mx]-y[mn]))< (eps*abs(y[mn])+1e-30) then break;
// compute Xprime
MTXGCL(xmx,x,mx);
MTXGCL(xmn,x,mn);
MTXZRV(xprime);
for i:=0 to n0 do begin
if i<>mx then begin
MTXGCL(x1,x,i);
MTXADV(xprime,x1,xprime);
end;
end; //40
f:=1/high(y);
MTXMSV(xprime,xprime,f);
MTXMSV(x1,xprime,2.0); //construct points by
MTXMSV(x2,xmx,1.0); //refection Xr and extention Xr2
MTXSBV(xr,x1,x2); //xr=x1-x2
MTXCPV(xexp,xr); //!!!!!
yr:=Fn(xexp);
if yr<=y[mn] then
begin
MTXMSV(x1,xr,2.0);
MTXMSV(x2,xprime,-1);
MTXADV(xr2,x1,x2);
MTXCPV(xexp,xr2); //!!!!!-
yr2:=Fn(xexp);
if yr2<y[mn] then Extension(mx) else Reflection(mx);
end else //***
if yr>=y[ne] then
begin
if yr<y[mx] then Reflection(mx);
MTXMSV(x1,xmx,0.5);
MTXMSV(x2,xprime,0.5);
MTXADV(xr2,x1,x2);
MTXCPV(xexp,xr2); //!!
yr2:=Fn(xexp);
if yr2<y[mx] then Compression(mx)
else //perform contraction
for i:=0 to n0 do //DO 50
if i<>mn then begin
MTXGCL(x1,x,i); //x1=x[i]
MTXADV(x2,xmn,x1); //x2=xmn+x1
MTXMSV(x2,x2,0.5); //x2:=0.5*x2
MTXPCL(x,x2,i); //x[i]=x2
MTXCPV(xexp,x2); //!!
y[i]:=Fn(xexp);
end; //50
end else Reflection(mx);
inc(istep);
end;
dec(istep);
fmin:=y[mn];
MTXGCL(x1,x,mn);
MTXCPV(x0,x1); //!!
if istep>nst then nstep:=-1 else nstep:=istep;
//========================
end;
destructor TSimplex.Destroy;
begin
SetLength(y,0);
SetLength(x1,0); SetLength(x2,0);
SetLength(xr,0); SetLength(xr2,0);
SetLength(xmx,0); SetLength(xmn,0);
SetLength(xexp,0); SetLength(xprime,0);
SetLength(x,0,0);
inherited Destroy;
end;
//=============================
end.
Prosze nie pytaj o szczegóły dla mnie to stare czasy.