fgauss.dem

Delphi Pascal 数据挖掘领域算法包 数值算法大全

PROGRAM d14r10(input,output);
(* driver for routine FGAUSS *)
CONST
   npt=3;
   nlin=2;
   na=6;   (* na=3*nlin *)
TYPE
   glnparam = ARRAY [1..na] OF real;
VAR
   e1,e2,f,x,y : real;
   i,j : integer;
   a,dyda,df : glnparam;

(*$I MODFILE.PAS *)
(*$I FGAUSS.PAS *)

BEGIN
   a[1] := 3.0; a[2] := 0.2; a[3] := 0.5;
   a[4] := 1.0; a[5] := 0.7; a[6] := 0.3;
   writeln;
   writeln('x':6,'y':8,'dyda1':9,'dyda2':8,'dyda3':8,
      'dyda4':8,'dyda5':8,'dyda6':8);
   FOR i := 1 to npt DO BEGIN
      x := 0.3*i;
      fgauss(x,a,y,dyda,na);
      e1 := exp(-sqr((x-a[2])/a[3]));
      e2 := exp(-sqr((x-a[5])/a[6]));
      f := a[1]*e1+a[4]*e2;
      df[1] := e1;
      df[4] := e2;
      df[2] := a[1]*e1*2.0*(x-a[2])/(a[3]*a[3]);
      df[5] := a[4]*e2*2.0*(x-a[5])/(a[6]*a[6]);
      df[3] := a[1]*e1*2.0*sqr(x-a[2])/(a[3]*a[3]*a[3]);
      df[6] := a[4]*e2*2.0*sqr(x-a[5])/(a[6]*a[6]*a[6]);
      writeln('from FGAUSS');
      write(x:8:4,y:8:4);
      FOR j := 1 to 6 DO write(dyda[j]:8:4);
      writeln;
      writeln('independent calc.');
      write(x:8:4,f:8:4);
      FOR j := 1 to 6 DO write(df[j]:8:4);
      writeln;
      writeln
   END
END.