powell.txt

来自「《Delphi常用数值算法集》的配书源码」· 文本 代码 · 共 55 行

Procedure POWELL(var P:array of real;var XI:matrx2;
              N, NP:integer; FTOL:real;var ITER:integer;var FRET:real);
const
    ITMAX = 200;
var
    PT, PTT, XIT:array[0..20] of real;
    I,J,IBIG:integer;  FP,DEL,FPTT,DUM,T:real;
begin
    FRET:=FUNC2(P, N);
    For J:=1 To N do
        PT[J]:=P[J];
    ITER:=0;
    while true do
    begin
      repeat
        repeat
          ITER:=ITER + 1;
          FP:=FRET;
          IBIG:=0;
          DEL:=0; 
          For I:=1 To N do
          begin
              For J:=1 To N do
                  XIT[J]:=XI[J, I];
              FPTT:=FRET;
              LINMIN(P, XIT, N, FRET);
              If Abs(FPTT - FRET) > DEL Then
              begin
                  DEL:=Abs(FPTT - FRET);
                  IBIG:=I;
              end;
          end; 
          If 2 * Abs(FP - FRET) <= FTOL * (Abs(FP) + Abs(FRET)) Then
              Exit;
          If ITER = ITMAX Then
          begin
              ShowMessage('POWELL exceeding maximum iterations');
              Exit;
          end;
          For J:=1 To N do
          begin
              PTT[J]:=2  * P[J] - PT[J];
              XIT[J]:=P[J] - PT[J];
              PT[J]:=P[J];
          end; 
          FPTT:=FUNC2(PTT, N);
        until  FPTT >= FP;
        DUM:=FP - 2 * FRET + FPTT;
        T:=2 * DUM * Sqr(FP - FRET - DEL) - DEL * Sqr(FP - FPTT);
      until  T >= 0;
      LINMIN(P, XIT, N, FRET);
      For J:=1 To N do
          XI[J, IBIG]:=XIT[J]
    end;
end;