mrqmin.txt

《Delphi常用数值算法集》的配书源码

Procedure MRQMIN(var X,Y,SIG:array of real; NDATA:integer;var A:array of real;
     MA:integer;var LISTA:array of integer; MFIT:integer;var COVAR,ALPHA:matrx2;
     NCA:integer;var CHISQ, ALAMDA:real);
var
    I,J,KK,K,IHIT:integer;
begin
  If ALAMDA < 0  Then
  begin
    KK:=MFIT + 1;
    For J:=1 To MA do
    begin
      IHIT:=0;
      For K:=1 To MFIT do
        If LISTA[K] = J Then IHIT:=IHIT + 1;
      If IHIT = 0 Then
      begin
        LISTA[KK]:=J;
        KK:=KK + 1;
      end
      Else If IHIT > 1 Then
      begin
        ShowMessage('Improper permutation in LISTA');
        Exit;
      end;
    end;
    If KK <> MA + 1 Then ShowMessage('Improper permutation in LISTA');
    ALAMDA:=0.001;
    MRQCOF(X,Y,SIG,NDATA,A,MA,LISTA,MFIT,ALPHA,BETA,NCA,CHISQ);
    OCHISQ:=CHISQ;
    For J:=1 To MA do
      ATRY[J]:=A[J];
  end;
  For J:=1 To MFIT do
  begin
    For K:=1 To MFIT do
      COVAR[J, K]:=ALPHA[J, K];
    COVAR[J, J]:=ALPHA[J, J] * (1 + ALAMDA);
    DA[J]:=BETA[J];
  end;
  GAUSSJ(COVAR, MFIT, DA);
  If ALAMDA = 0 Then
  begin
    COVSRT(COVAR, NCA, MA, LISTA, MFIT);
    Exit;
  end;
  For J:=1 To MFIT do
    ATRY[LISTA[J]]:=A[LISTA[J]] + DA[J];
  MRQCOF(X,Y,SIG,NDATA,ATRY,MA,LISTA,MFIT,COVAR,DA,NCA,CHISQ);
  If CHISQ < OCHISQ Then
  begin
    ALAMDA:=0.1 * ALAMDA;
    OCHISQ:=CHISQ;
    For J:=1 To MFIT do
    begin
      For K:=1 To MFIT do
        ALPHA[J, K]:=COVAR[J, K];
      BETA[J]:=DA[J];
      A[LISTA[J]]:=ATRY[LISTA[J]];
    end;
  end
  else
  begin
    ALAMDA:=10 * ALAMDA;
    CHISQ:=OCHISQ;
  end;
end;