home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 11 / tricks / det_calc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-08-06  |  2.2 KB  |  92 lines
  1. (* ------------------------------------------------------ *)
  2. (*                     DET_CALC.PAS                       *)
  3. (*            Berechnung von Determinanten                *)
  4. (*           (c) 1990 Stefan Kriso & TOOLBOX              *)
  5. (* ------------------------------------------------------ *)
  6. PROGRAM Berechnung_von_Determinanten;  { txMath }
  7.  
  8. USES Crt;
  9.  
  10. CONST
  11.   max = 10;
  12.  
  13. TYPE
  14.   WerteFeld = ARRAY [1..max, 1..max] OF REAL;
  15.  
  16. VAR
  17.   a : WerteFeld;
  18.   n : INTEGER;
  19.  
  20.   PROCEDURE Eingabe;
  21.   VAR
  22.     i, j : 1..max;
  23.   BEGIN
  24.     ClrScr;
  25.     WriteLn('Berechnung von Determinanten');
  26.     WriteLn;  WriteLn;
  27.     Write('Zeilen-/Spaltenzahl: ');
  28.     Read(n);
  29.     IF (n < 2) OR (n > max) THEN Exit;
  30.     WriteLn;
  31.     FOR i := 1 TO max DO
  32.       FOR j := 1 TO max DO a[i,j] := 0;
  33.     Write(' ':6);
  34.     HighVideo;
  35.     FOR i := 1 TO n DO Write(i:6);
  36.     WriteLn;
  37.     FOR i := 1 TO n DO WriteLn(i:2, ' ':4);
  38.     NormVideo;
  39.     FOR i := 1 TO n DO
  40.       FOR j := 1 TO n DO BEGIN
  41.         GotoXY(6 * (j+1), i+7);  Read(a[i,j]);
  42.       END;
  43.     WriteLn;  WriteLn;
  44.   END;
  45.  
  46.   FUNCTION Det(n      : INTEGER;
  47.                a      : WerteFeld;
  48.                Spalte : INTEGER) : REAL;
  49.   VAR
  50.     i, j : 1..max;
  51.     d    : REAL;
  52.     b    : WerteFeld;
  53.   BEGIN
  54.     FOR i := 1 TO n DO
  55.       FOR j := 1 TO n DO BEGIN
  56.         b[i,j] := 0;
  57.         IF j <  Spalte THEN b[i,j] := a[i,j];
  58.         IF j >= Spalte THEN b[i,j] := a[i,j+1];
  59.       END;
  60.     IF n = 2 THEN
  61.       Det := b[1,1] * b[2,2] - b[1,2] * b[2,1]
  62.     ELSE BEGIN
  63.       d := 0;
  64.       { rekursiver Funktionsaufruf:
  65.         Entwicklung der Determinanten jeweils nach der
  66.         letzten Zeile }
  67.       FOR j := 1 TO n DO
  68.         IF Odd(n+j) THEN
  69.           d := d - b[n,j] * Det(n-1, b, j)
  70.         ELSE
  71.           d := d + b[n,j] * Det(n-1, b, j);
  72.       Det := d;
  73.     END;
  74.   END;
  75.  
  76.   PROCEDURE Ausgabe;
  77.   VAR
  78.     ch : CHAR;
  79.   BEGIN
  80.     WriteLn('Determinantenwert = ', Det(n, a, max+1):1:5);
  81.     WriteLn;
  82.     ch := ReadKey;
  83.   END;
  84.  
  85. BEGIN
  86.   REPEAT
  87.     Eingabe;
  88.     IF (n > 1) AND (n <= max) THEN Ausgabe;
  89.   UNTIL (n < 2) OR (n > max);
  90. END.
  91. (* ------------------------------------------------------ *)
  92. (*                Ende von DET_CALC.PAS                   *)