sw/src/pascal/REGRES.PS

   1 PROGRAM AUSGLEICHSPOLYNOM(INPUT,OUTPUT);
   2
   3   CONST NMAX=15;  NRMAX=16;
   4
   5   VAR   M,      (* ANZAHL DER PUNKTE *)
   6         N,      (* GRAD DES POLYNOMS *)
   7         NR,     (*   NR = N + 1      *)
   8         I,J,K: INTEGER;
   9         X,Y,U,V,W: REAL;
  10         A: ARRAY[0..NRMAX,0..NRMAX] OF REAL;
  11         P,C: ARRAY[0..NMAX] OF REAL;
  12
  13 BEGIN READ(M,N);  NR := N + 1;
  14     WRITELN;
  15     WRITELN("A U S G L E I C H S P O L Y N O M");
  16     WRITELN;
  17 (*
  18   LOESCHEN DER GLEICHUNGSMATRIX
  19 *)
  20     FOR I := 0 TO N DO
  21         FOR J := I TO NR DO A[I,J] := 0;
  22 (*
  23   EINLESEN DER PUNKTE, ANGABEPROTOKOLL.
  24   BERECHNUNG DER KOEFF. DER NORMALGLEICHUNGEN UND
  25   BELEGUNG DER RECHTEN OBEREN DREIECKSMATRIX
  26   A[I,J]    ( 0<=I<=N,  I<=J<=N ),
  27   RECHTE SEITEN IN  A[I,N+1].
  28 *)
  29     FOR K := 1 TO M  (* FUER ALLE PUNKTE *)  DO
  30         BEGIN
  31             READ(X,Y);  WRITELN("P",K:2,X:8:2,"  ,",Y:8:2);
  32             U := 1;
  33             FOR I := 0 TO N DO
  34                 BEGIN V := U;
  35                     FOR J := I TO N DO
  36                         BEGIN
  37                             A[I,J] := A[I,J] + U*V;
  38                             V := V*X
  39                         END;
  40                     A[I,NR] := A[I,NR] + U*Y;
  41                     U := U*X
  42                 END
  43         END;
  44 (*
  45   BERECHNUNG DER LINKEN UNTEREN DREIECKSMATRIX
  46   NACH   C H O L E S K Y   UND SPEICHERUNG IN
  47   A[I,J]    ( 0<=I<=N,  0<=J<I ).
  48   P[I] ENTHALTEN DIE ELEMENTE A[I,I] DER HAUPTDIAGONALE,
  49   TRANSFORMIERTE RECHTE SEITEN IN  A[N+1,I].
  50 *)
  51     FOR I := 0 TO N DO
  52         FOR J := I TO NR DO
  53             BEGIN W := A[I,J];
  54                 FOR K := I-1 DOWNTO 0 DO W := W - A[J,K]*A[I,K];
  55                 IF I=J  THEN P[I] := 1/SQRT(W)
  56                         ELSE A[J,I] := W*P[I]
  57             END;
  58 (*
  59   LOESUNG DES GESTAFFELTEN GLEICHUNGSSYSTEMS
  60   LIEFERT DIE KOEFFIZIENTEN DES AUSGLEICHSPOLYNOMS
  61 *)
  62     FOR I := N DOWNTO 0 DO
  63         BEGIN W := A[NR,I];
  64             FOR J := N DOWNTO I+1 DO W := W - C[J]*A[J,I];
  65             C[I] := W*P[I]
  66         END;
  67 (*
  68   AUSGABE DER KOEFFIZIENTEN
  69 *)
  70     WRITELN;
  71     WRITELN("DIE KOEFFIZIENTEN SIND:");
  72     FOR I := 0 TO N DO  WRITELN("C",I:1," =",C[I])
  73 END.