unit2.pas

用于开发税务票据管理的软件

unit Unit2;

interface
uses
  unit1;
Function GASDEV:real;
Procedure MRQCOF(X,Y,SIG:array of real; NDATA:integer;var A:array of real;
     MA:integer; LISTA:array of integer; MFIT:integer;var ALPHA:matrx2;
     var BETA:array of real; NALP:integer;var CHISQ:real);
     
implementation
Function GASDEV:real;
var
   V1,V2,FAC,R:real;
begin
    If ISET^= 0 Then
    begin
      repeat
        V1:=2 * Random - 1;
        V2:=2 * Random - 1;
        R:=Sqr(V1) + Sqr(V2);
      until (R < 1);
      FAC:=Sqrt(-2 * Ln(R) / R);
      GSET^:=V1 * FAC;
      GASDEV:=V2 * FAC;
      ISET^:=1;
    end
    Else
    begin
      GASDEV:=GSET^;
      ISET^:=0;
    end;
end;

Procedure FGAUSS(X:real; A:array of real;
                  var Y:real;var DYDA:array of real; NA:integer);
var
    I,II:integer;  ARG,EX,FAC:real;
begin
    Y:=0;
    For II:=1 To (NA DIV 3) do
    begin
        I:=3*II-2;
        ARG:=(X - A[I + 1]) / A[I + 2];
        EX:=Exp(-Sqr(ARG));
        FAC:=A[I] * EX * 2 * ARG;
        Y:=Y + A[I] * EX;
        DYDA[I]:=EX;
        DYDA[I + 1]:=FAC / A[I + 2];
        DYDA[I + 2]:=FAC * ARG / A[I + 2];
    end; 
end;

Procedure MRQCOF(X,Y,SIG:array of real; NDATA:integer;var A:array of real;
     MA:integer; LISTA:array of integer; MFIT:integer;var ALPHA:matrx2;
     var BETA:array of real; NALP:integer;var CHISQ:real);
var
    DYDA:array[0..20] of real;
    J,I,K:integer;   YMOD,SIG2I,DY,WT:real;
begin
    For J:=1 To MFIT do
    begin
      For K:=1 To J do
        ALPHA[J, K]:=0;
      BETA[J]:=0;
    end; 
    CHISQ:=0; 
    For I:=1 To NDATA do
    begin
        FGAUSS(X[I], A, YMOD, DYDA, MA);
        SIG2I:=1 / (SIG[I] * SIG[I]);
        DY:=Y[I] - YMOD;
        For J:=1 To MFIT do
        begin
            WT:=DYDA[LISTA[J]] * SIG2I;
            For K:=1 To J do
                ALPHA[J, K]:=ALPHA[J, K] + WT * DYDA[LISTA[K]];
            BETA[J]:=BETA[J] + DY * WT;
        end; 
        CHISQ:=CHISQ + DY * DY * SIG2I;
    end; 
    For J:=2 To MFIT do
        For K:=1 To J - 1 do
            ALPHA[K, J]:=ALPHA[J, K];
end;
end.