Einzelnen Beitrag anzeigen

nahpets
(Gast)

n/a Beiträge
 
#30

AW: Gauß-Verfahren - Matrix lösen

  Alt 1. Sep 2015, 10:53
Habe mal in meinen Ururururururururalt-Sourcen aus Turbo-Pascal-Zeiten gesucht und noch was gefunden (ließ sich eben mit Delphi 7 kompilieren, aber ich gehe nicht davon aus, dass es fehlerfrei ist):
Delphi-Quellcode:
program LongIntRechnen;

{$APPTYPE CONSOLE}

uses
  SysUtils;

{ INI-Datei schreiben, aus der die Anzahl der Vorkomma- und Nachkomma- }
{ stellen gelesen wird, sowie das Maximum je Stelle                    }
{ Maxi müßte sich aus Maximum errechnen lassen.                        }
{ Im Programm müßte dazu noch eine Plausi eingebaut werden, Maximum    }
{ darf höchstens 10000 sein und mindestens 10.                         }

Const { eine Multiplikation muß je Zahl möglich sein        }
          { deshalb Maximum = 10000, 10000 * 10000 = 100000000  }
          Maximum : Integer = 10;
          { Maxi enthält die Anzahl der Nullen in Maximum       }
          Maxi : Byte = 1;
          { ohne Multiplikation ist bis      1000000000 möglich }

          { Anzahl der LongInt-Werte für Vor- und Nachkommastellen }
          { jede Vor- bzw. Nachkommastelle enthält 5 Ziffern (= 50)}
          MaxVorkomma = 99 ; { Zusammen maximal 5400 }
          MaxNachkomma = 99 ; { immer gerade Zahlen   }
                                           { Stellenzahl muß durch }
                                           { zwei zu dividieren    }
                                           { sein, da bei Multipli-}
                                           { kation sich die Stel- }
                                           { len verdoppeln        }

Type
          TPlusMinus = (Plus,Minus);
          TLangzahl = Record
                                     Vorzeichen : tPlusMinus;
                                     Vorkomma : ARRAY[1..MaxVorkomma ] OF LongInt;
                                     Nachkomma : ARRAY[1..MaxNachkomma] OF LongInt;
                                   END;

{.INFO}
FUNCTION Replicate
          ( ReplicateStr : String;
               Replicatei : Integer) : String;
{*------------------------------------------------------------------*}
{¦  wiederholt angegebenes Zeichen i mal.                           ¦}
{*------------------------------------------------------------------*}
{.INFO}
VAR
          ReplicateStrTemp : String;
          Replicatei2 : Integer;
 
BEGIN
  ReplicateStrTemp := '';
  FOR Replicatei2 := 1 TO Replicatei DO
  ReplicateStrTemp := ReplicateStrTemp + ReplicateStr;
  Replicate := ReplicateStrTemp
END;

FUNCTION LongAdd
          ( a : TLangZahl;
               b : TLangZahl;
           Var c : TLangZahl): BOOLEAN; FORWARD;

FUNCTION LongSub
          ( a : TLangZahl;
               b : TLangZahl;
           Var c : TLangZahl): BOOLEAN; FORWARD;

FUNCTION LongPlausi
          (Var c : TLangZahl) : BOOLEAN;

Var
          i : Word;

BEGIN
  LongPlausi := True;
  WITH c DO BEGIN
    FOR i := 1 TO MaxVorkomma DO IF Vorkomma [i] >= Maximum THEN LongPlausi := FALSE;
    FOR i := 1 TO MaxNachkomma DO IF Nachkomma[i] >= Maximum THEN LongPlausi := FALSE;
  END;
END;

FUNCTION LongKorrektur
          (Var c : TLangZahl) : BOOLEAN;

Var
          i : Word;
          bool : Boolean;

BEGIN
  LongKorrektur := FALSE;
  WITH c DO BEGIN
    FOR i := MaxNachkomma DownTo 2 DO BEGIN
      IF (Nachkomma[i] < 0) THEN BEGIN
        Nachkomma[i ] := Maximum - Nachkomma[i] * -1;
        Nachkomma[i-1] := Nachkomma[i-1] - 1;
      END;
    END;
    IF (Nachkomma[1] < 0) THEN BEGIN
      Nachkomma[1] := Maximum - Nachkomma[1] * -1;
      Vorkomma[1] := Vorkomma[1] - 1;
    END;
    FOR i := 1 TO MaxVorkomma - 1 DO BEGIN
      IF (Vorkomma[i] < 0) THEN BEGIN
        Vorkomma[i] := Maximum - Vorkomma[i] * -1;
        Vorkomma[i+1] := Vorkomma[i+1] - 1;
      END;
    END;

    i := MaxVorkomma;

    IF (Vorkomma[i] < 0) THEN BEGIN
      IF (Vorkomma[i] * -1) >= Maximum THEN BEGIN
        Vorkomma[i] := Maximum + Maximum - Vorkomma[i] * -1;
      END ELSE BEGIN
        Vorkomma[i] := Vorkomma[i] * -1;
      END;
    END;
    FOR i := MaxNachkomma DownTo 2 DO BEGIN
      While Nachkomma[i] >= Maximum DO BEGIN
        Nachkomma[i-1] := Nachkomma[i-1] + 1;
        Nachkomma[i ] := Nachkomma[i ] - Maximum;
      END;
    END;
    While Nachkomma[1] >= Maximum DO BEGIN
      Vorkomma[1] := Vorkomma[1] + 1;
      Nachkomma[1] := Nachkomma[1] - Maximum;
    END;
    FOR i := 1 To MaxVorkomma - 1 DO BEGIN
      While Vorkomma[i] >= Maximum DO BEGIN
        Vorkomma[i+1] := Vorkomma[i+1] + 1;
        Vorkomma[i] := Vorkomma[i ] - Maximum;
      END;
    END;

    IF Vorkomma[MaxVorkomma] <= Maximum THEN LongKorrektur := TRUE;

    { Null ist immer positiv }
    Bool := TRUE;
    FOR i := 1 TO MaxVorkomma DO IF Vorkomma[i] <> 0 THEN Bool := False;
    FOR i := 1 TO MaxNachkomma DO IF Nachkomma[i] <> 0 THEN Bool := False;
    IF Bool THEN Vorzeichen := Plus;
  END;
END;

FUNCTION LongGreater
          ( a : TLangZahl;
               b : TLangZahl) : Boolean;

VAR
          i : Integer;

BEGIN
  LongKorrektur(a);
  LongKorrektur(b);
  IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Minus) THEN BEGIN
    LongGreater := TRUE;
    EXIT;
  END;
  IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Plus) THEN BEGIN
    LongGreater := FALSE;
    EXIT;
  END;
  IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Plus) THEN BEGIN
    FOR i := MaxVorkomma DownTo 1 DO BEGIN
      IF (a.Vorkomma[i] > b.Vorkomma[i]) THEN BEGIN
        LongGreater := TRUE;
        EXIT;
      END ELSE IF (a.Vorkomma[i] < b.Vorkomma[i]) THEN BEGIN
        LongGreater := FALSE;
        EXIT;
      END;
    END;
    FOR i := 1 TO MaxNachkomma DO BEGIN
      IF (a.Nachkomma[i] > b.Nachkomma[i]) THEN BEGIN
        LongGreater := TRUE;
        EXIT;
      END ELSE IF (a.Nachkomma[i] < b.Nachkomma[i]) THEN BEGIN
        LongGreater := FALSE;
        EXIT;
      END;
    END;
  END;
  IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Minus) THEN BEGIN
    FOR i := MaxVorkomma DownTo 1 DO BEGIN
      IF (a.Vorkomma[i] < b.Vorkomma[i]) THEN BEGIN
        LongGreater := TRUE;
        EXIT;
      END ELSE IF (a.Vorkomma[i] > b.Vorkomma[i]) THEN BEGIN
        LongGreater := FALSE;
        EXIT;
      END;
    END;
    FOR i := 1 TO MaxNachkomma DO BEGIN
      IF (a.Nachkomma[i] < b.Nachkomma[i]) THEN BEGIN
        LongGreater := TRUE;
        EXIT;
      END ELSE IF (a.Nachkomma[i] > b.Nachkomma[i]) THEN BEGIN
        LongGreater := FALSE;
        EXIT;
      END;
    END;
  END;
  LongGreater := FALSE;
END;

FUNCTION LongLower
          ( a : TLangZahl;
               b : TLangZahl) : Boolean;
VAR
          i : Integer;

BEGIN
  LongLower := FALSE;
  LongKorrektur(a);
  LongKorrektur(b);
  IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Minus) THEN BEGIN
    LongLower := FALSE;
    EXIT;
  END;
  IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Plus) THEN BEGIN
    LongLower := TRUE;
    EXIT;
  END;
  IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Plus) THEN BEGIN
    FOR i := MaxVorkomma DownTo 1 DO BEGIN
      IF (a.Vorkomma[i] < b.Vorkomma[i]) THEN BEGIN
        LongLower := TRUE;
        EXIT;
      END ELSE IF (a.Vorkomma[i] > b.Vorkomma[i]) THEN BEGIN
        LongLower := FALSE;
        EXIT;
      END;
    END;
    FOR i := 1 TO MaxNachkomma DO BEGIN
      IF (a.Nachkomma[i] < b.Nachkomma[i]) THEN BEGIN
        LongLower := TRUE;
        EXIT;
      END ELSE IF (a.Nachkomma[i] > b.Nachkomma[i]) THEN BEGIN
        LongLower := FALSE;
        EXIT;
      END;
    END;
  END;
  IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Minus) THEN BEGIN
    FOR i := MaxVorkomma DownTo 1 DO BEGIN
      IF (a.Vorkomma[i] > b.Vorkomma[i]) THEN BEGIN
        LongLower := TRUE;
        EXIT;
      END ELSE IF (a.Vorkomma[i] < b.Vorkomma[i]) THEN BEGIN
        LongLower := FALSE;
        EXIT;
      END;
    END;
    FOR i := 1 TO MaxNachkomma DO BEGIN
      IF (a.Nachkomma[i] > b.Nachkomma[i]) THEN BEGIN
        LongLower := TRUE;
        EXIT;
      END ELSE IF (a.Nachkomma[i] < b.Nachkomma[i]) THEN BEGIN
        LongLower := FALSE;
        EXIT;
      END;
    END;
  END;
END;

FUNCTION LongEqual
         ( a : TLangZahl;
              b : TLangZahl) : Boolean;
Var
         i : Integer;
         bool : Boolean;

BEGIN
  Bool := True;
  FOR i := 1 TO MaxVorkomma DO IF a.Vorkomma[i] <> b.Vorkomma[i] THEN bool := FALSE;
  FOR i := 1 TO MaxNachkomma DO IF a.Nachkomma[i] <> b.Nachkomma[i] THEN bool := FALSE;
  LongEqual := Bool;
END;

FUNCTION LongIsZero
          ( a : TLangZahl) : Boolean;
Var
          i : Integer;
          bool : Boolean;

BEGIN
  Bool := True;
  FOR i := 1 TO MaxVorkomma DO IF a.Vorkomma[i] <> 0 THEN bool := FALSE;
  FOR i := 1 TO MaxNachkomma DO IF a.Nachkomma[i] <> 0 THEN bool := FALSE;
  LongIsZero := Bool;
END;

FUNCTION LongSub
          ( a : TLangZahl;
               b : TLangZahl;
           Var c : TLangZahl) : Boolean;

VAR
          i : Word;
          bool : Boolean;

BEGIN
  LongSub := FALSE;
  IF LongKorrektur(a) AND LongKorrektur(b) THEN BEGIN
    IF LongGreater(a,b) THEN BEGIN
      IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Plus) THEN BEGIN
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := a.Vorkomma[i] - b.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := a.Nachkomma[i] - b.Nachkomma[i];
        c.Vorzeichen := Plus;
      END ELSE
      IF (a.Vorzeichen = Plus ) AND (b.Vorzeichen = Minus) THEN BEGIN
        a.Vorzeichen := Plus;
        b.Vorzeichen := Plus;
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := a.Vorkomma[i] + b.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := a.Nachkomma[i] + b.Nachkomma[i];
        c.Vorzeichen := Plus;
      END ELSE
      IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Minus) THEN BEGIN
        a.Vorzeichen := Plus;
        b.Vorzeichen := Plus;
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := b.Vorkomma[i] - a.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := b.Nachkomma[i] - a.Nachkomma[i];
        c.Vorzeichen := Plus;
      END
    END ELSE BEGIN
      IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Plus) THEN BEGIN
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := b.Vorkomma[i] - a.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := b.Nachkomma[i] - a.Nachkomma[i];
        c.Vorzeichen := Minus;
      END ELSE
      IF (a.Vorzeichen = Plus ) AND (b.Vorzeichen = Minus) THEN BEGIN
        a.Vorzeichen := Plus;
        b.Vorzeichen := Plus;
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := a.Vorkomma[i] + b.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := a.Nachkomma[i] + b.Nachkomma[i];
        c.Vorzeichen := Plus;
      END ELSE
      IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Minus) THEN BEGIN
        a.Vorzeichen := Plus;
        b.Vorzeichen := Plus;
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := a.Vorkomma[i] - b.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := a.Nachkomma[i] - b.Nachkomma[i];
        c.Vorzeichen := Minus;
      END ELSE
      IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Plus) THEN BEGIN
        a.Vorzeichen := Plus;
        b.Vorzeichen := Plus;
        For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := a.Vorkomma[i] + b.Vorkomma[i];
        For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := a.Nachkomma[i] + b.Nachkomma[i];
        c.Vorzeichen := Minus;
      END
    END;
  END ELSE BEGIN
    Writeln('a oder b sind zu groß',#7);
    EXIT;
  END;
  LongKorrektur(c);
  LongSub := TRUE;
END;

FUNCTION LongAdd
          ( a : TLangZahl;
               b : TLangZahl;
           Var c : TLangZahl) : BOOLEAN;

VAR
          i : Word;

BEGIN
  LongAdd := FALSE;
  IF LongKorrektur(a) AND LongKorrektur(b) THEN BEGIN
    IF ((a.Vorzeichen = Plus) AND (b.Vorzeichen = Plus))
    OR ((a.Vorzeichen = Minus) AND (b.Vorzeichen = Minus)) THEN BEGIN
      For i := 1 TO MaxVorkomma DO c.Vorkomma[i] := a.Vorkomma[i] + b.Vorkomma[i];
      For i := 1 TO MaxNachkomma DO c.Nachkomma[i] := a.Nachkomma[i] + b.Nachkomma[i];
      IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Minus) THEN c.Vorzeichen := Minus;
      IF (a.Vorzeichen = Plus ) AND (b.Vorzeichen = Plus ) THEN c.Vorzeichen := Plus ;
    END ELSE
    IF (a.Vorzeichen = Plus) AND (b.Vorzeichen = Minus) THEN BEGIN
      b.Vorzeichen := Plus;
      LongSub(a,b,c);
    END ELSE
    IF (a.Vorzeichen = Minus) AND (b.Vorzeichen = Plus) THEN BEGIN
      a.Vorzeichen := Plus;
      LongSub(b,a,c);
    END;
  END ELSE BEGIN
    Writeln(a.Vorkomma[Maxvorkomma]:10);
    Writeln(b.Vorkomma[Maxvorkomma]:10);
    Writeln('a oder b sind zu groß');
    EXIT;
  END;
  LongKorrektur(c);
  LongAdd := TRUE;
END;

FUNCTION Einezahl
         ( z : LongInt) : STRING;

Var
          s : STRING;
          b : Byte;
          ch : Char Absolute b;
          i : Byte;
          l : LongInt;

BEGIN
  IF z < 0 THEN z := z * -1;
  l := Maximum DIV 10;
  s := Copy('00000000000000',1,Maxi);
  FOR i := 1 To Maxi DO BEGIN
    b := 48 + z DIV l;
    s[i] := ch;
    z := z - ((b - 48) * l);
    l := l DIV 10;
  END;
  ch := s[1];
  { Korrektur, wenn in der ersten Stelle ein Überlauf ist }
  IF b > 57 THEN BEGIN
    b := b - 10;
    s[1] := ch;
    s := '1' + s;
  END;
  EineZahl := s;
END;

FUNCTION LongString
          ( c : TLangZahl): String;

Var
          LangZahl : String;
          b : Byte Absolute Langzahl;
          i : Word;

BEGIN
  WITH c DO BEGIN
    IF Vorzeichen = Plus THEN Langzahl := '+ELSE Langzahl := '-';
    For i := MaxVorkomma Downto 1 DO Langzahl := Langzahl + EineZahl(Vorkomma[i]);
    Langzahl := Langzahl + ',';
    For i := 1 TO MaxNachkomma DO Langzahl := Langzahl + EineZahl(Nachkomma[i]);
  END;
  WHILE b < 75 do Langzahl := ' ' + Langzahl;
  LongString := Langzahl;
END;

FUNCTION LongMul
          ( a : TLangZahl;
               b : TLangZahl;
           Var c : TLangZahl): BOOLEAN;

Var
          Help1 : TLangzahl;
          Help2 : TLangzahl;
          i : Integer;
          j : Integer;
          Test1 : Boolean;
          Test2 : Boolean;
          l : LongInt;
          k : Integer;
          n : Extended;

BEGIN
  LongMul := FALSE;
  Test1 := FALSE;
  Test2 := FALSE;
  For i := 1 TO MaxVorkomma DO BEGIN
    Help1.Vorkomma[i] := 0;
    Help2.Vorkomma[i] := 0;
    c.Vorkomma[i] := 0;
    IF a.Vorkomma[i] <> 0 THEN Test1 := TRUE;
    IF b.Vorkomma[i] <> 0 THEN Test2 := TRUE;
  END;
  For i := 1 TO MaxNachkomma DO BEGIN
    Help1.Nachkomma[i] := 0;
    Help2.Nachkomma[i] := 0;
    c.Nachkomma[i] := 0;
    IF a.Nachkomma[i] <> 0 THEN Test1 := TRUE;
    IF b.Nachkomma[i] <> 0 THEN Test2 := TRUE;
  END;
  { es soll ein Wert mit Null multipliziert werden und raus c ist schon Null }
  IF NOT Test1 AND NOT Test2 THEN EXIT;
  { Kommastellen sind hier MaxNachkommastellen * 5 * 2 }
  IF LongKorrektur(a) AND LongKorrektur(b) THEN BEGIN
    { für die Multiplikation werden insgesamt doppelt soviele Stellen }
    { an Speicher benötigt, wie berechnet werden können               }
    { alle weiteren Stellen führen zu einem Überlauf                  }
    FOR i := MaxVorkomma DownTo 1 DO BEGIN
      FOR j := 1 to MaxVorkomma DO BEGIN
        k := i + j - 1;
        l := a.Vorkomma[j] * b.Vorkomma[i];
        IF (k > MaxVorkomma) AND (l <> 0) THEN BEGIN
          { Ist das Ergebnis größer als die maximal darstellbare Zahl }
          { Fehlermeldung ausgeben und raus                           }
          Writeln('Multiplikation: Überlauf in den Vorkommastellen',#7);
          Exit;
        END ELSE BEGIN
          IF k <= MaxVorkomma THEN help1.Vorkomma[k] := Help1.Vorkomma[k] + l;
        END;
      END;
    END;
    { Die Nachkommastellen haben ihren Übertrag in den Vorkommastellen }
    { zuerst nur die Nachkommastellen, deren Übertrag in die Nachkom-  }
    { mastellen paßt                                                   }
    FOR i := MaxNachkomma DOWNTO 1 DO BEGIN
      FOR j := 1 to MaxNachkomma DO BEGIN
        k := i + j;
        { Werte hinter der letzten Kommastelle werden ignoriert }
        { ein Auf- oder Abrunden findet nicht statt             }
        { die letzten Kommastellen werden aber Falsch           }
        IF k <= MaxNachkomma THEN BEGIN
          help1.Nachkomma[k] := Help1.Nachkomma[k] + a.Nachkomma[j] * b.Nachkomma[i];
        END ELSE BEGIN
          { Werte der Nachkommastellen sammeln, die außerhalb des ansprechbaren }
          { Bereiches liegen ( Gegenstück zum Überlauf bei den Vorkommastellen  }
          Help2.Nachkomma[k - MaxNachkomma] := Help2.Nachkomma[k - MaxNachkomma] + a.Nachkomma[j] * b.Nachkomma[i];
        END;
      END;
    END;
    { Umrechnen des Überlaufes der Nachkommastellen auf die letzte Nachkommastelle }
    { wenn Maximum =  10 dann i = 1 bis 9
                    100      i = 1 bis 5
                    1000      i = 1 bis 4
                   10000      i = 1 bis 3 }

    l := 1;
    i := 0;
    IF Maximum = 10 THEN j := 9 ELSE
    IF Maximum = 100 THEN j := 4 ELSE
    IF Maximum = 1000 THEN j := 3 ELSE
    IF Maximum = 10000 THEN j := 2 ELSE j := 1;
    IF j > MaxNachkomma THEN j := MaxNachkomma;
    REPEAT
      i := i + 1;
      l := l * Maximum;
      Help1.Nachkomma[MaxNachkomma] := Help1.Nachkomma[MaxNachkomma] + Help2.Nachkomma[i] DIV l;
    UNTIL (i >= j) ;
    { Nachkommastellen mit Übertrag in Vorkommastellen          }
    FOR i := MaxNachkomma DOWNTO 1 DO BEGIN
      FOR j := 1 TO MaxVorkomma DO BEGIN
        k := i - j + 1;
        IF k > 0 THEN BEGIN
          help1.Nachkomma[k] := help1.Nachkomma[k] + a.Vorkomma[j] * b.Nachkomma[i];
        END ELSE BEGIN
          k := (k * -1) + 1;
          help1.Vorkomma[k] := help1.Vorkomma[k] + a.Vorkomma[j] * b.Nachkomma[i];
        END;
      END;
    END;
    { Nachkommastellen mit den Vorkommastellen multiplizieren }
    FOR i := MaxNachkomma DOWNTO 1 DO BEGIN
      FOR j := MaxVorkomma DOWNTO 1 DO BEGIN
        k := j - i;
        IF k <= 0 THEN BEGIN
          k := (k * -1) + 1;
          IF k <= MaxNachkomma THEN help1.Nachkomma[k] := help1.Nachkomma[k] + a.Nachkomma[i] * b.Vorkomma[j];
        END ELSE BEGIN
          help1.Vorkomma[k] := help1.Vorkomma[k] + a.Nachkomma[i] * b.Vorkomma[j];
        END;
      END;
    END;
    { sofern eine Variabel einen Übertrag enthält, diesen an die }
    { nächste Variabel weiter geben                              }
    FOR i := MaxNachkomma DownTo 2 DO BEGIN
      IF help1.Nachkomma[i] > Maximum THEN BEGIN
        l := Help1.Nachkomma[i] DIV Maximum;
        Help1.Nachkomma[i - 1] := Help1.Nachkomma[i - 1] + l;
        Help1.Nachkomma[i ] := Help1.Nachkomma[i ] - l * Maximum;
      END;
    END;
    IF help1.Nachkomma[1] > Maximum THEN BEGIN
      l := Help1.Nachkomma[1] DIV Maximum;
      Help1.Vorkomma[1] := Help1.Vorkomma[1] + l;
      Help1.Nachkomma[1] := Help1.Nachkomma[1] - l * Maximum;
    END;
    FOR i := 1 TO MaxVorkomma - 1 DO BEGIN
      IF help1.Vorkomma[i] > Maximum THEN BEGIN
        l := Help1.Vorkomma[i] DIV Maximum;
        Help1.Vorkomma[i + 1] := Help1.Vorkomma[i + 1] + l;
        Help1.Vorkomma[i ] := Help1.Vorkomma[i ] - l * Maximum;
      END;
    END;
    c := Help1;
  END ELSE BEGIN
    Writeln('a oder b sind zu groß');
    EXIT;
  END;
  IF ((a.Vorzeichen = plus ) AND (b.Vorzeichen = plus ))
  OR ((a.Vorzeichen = minus) AND (b.Vorzeichen = Minus)) THEN c.Vorzeichen := plus
  ELSE c.Vorzeichen := minus;
  LongKorrektur(c);
  LongMul := TRUE;
END;

FUNCTION LongDiv
          ( a : TLangZahl;
               b : TLangZahl;
           Var c : TLangZahl): BOOLEAN;

Var
          Help1 : TLangzahl;
          Help2 : TLangzahl;
          Help3 : TLangzahl;
          Help4 : TLangzahl;
          i : Integer;
          j : LongInt;
          k : Integer;
          l : Integer;
          m : Integer;
          n : Integer;
          Test1 : Boolean;
          Test2 : Boolean;

BEGIN
  LongKorrektur(a);
  LongKorrektur(b);
  Test1 := FALSE;
  Test2 := FALSE;
  Help1.Vorzeichen := plus;
  Help2.Vorzeichen := plus;
  Help3.Vorzeichen := plus;
  Help4.Vorzeichen := plus;
  c.Vorzeichen := plus;
  For i := 1 TO MaxVorkomma DO BEGIN
    Help1.Vorkomma[i] := 0;
    Help2.Vorkomma[i] := 0;
    Help3.Vorkomma[i] := 0;
    Help4.Vorkomma[i] := 0;
    c.Vorkomma[i] := 0;
    IF a.Vorkomma[i] <> 0 THEN Test1 := TRUE;
    IF b.Vorkomma[i] <> 0 THEN Test2 := TRUE;
  END;
  For i := 1 TO MaxNachkomma DO BEGIN
    Help1.Nachkomma[i] := 0;
    Help2.Nachkomma[i] := 0;
    Help3.Nachkomma[i] := 0;
    Help4.Nachkomma[i] := 0;
    c.Nachkomma[i] := 0;
    IF a.Nachkomma[i] <> 0 THEN Test1 := TRUE;
    IF b.Nachkomma[i] <> 0 THEN Test2 := TRUE;
  END;
  { es soll ein Wert durch Null dividiert werden und raus, geht nicht }
  IF NOT Test1 AND NOT Test2 THEN EXIT;
  { Kehrwert von b errechnen                      }
  { erste Stelle in b suchen, die <> 0 ist        }
  l := MaxVorkomma;
  While (b.Vorkomma[l] = 0) DO l := l - 1;
  IF l = 0 THEN BEGIN
    l := 1;
    While (b.Nachkomma[l] = 0) DO l := l + 1;
    l := l - 1;
    Help1.Nachkomma[l] := Maximum;
  END ELSE BEGIN
    Help1.Vorkomma[l] := Maximum;
  END;
  m := l * 2;
  FOR i := l DOWNTO 1 DO BEGIN
    FOR j := 1 TO MaxVorkomma DO BEGIN
      Help2.Vorkomma[j] := 0;
      Help3.Vorkomma[j] := 0;
    END;
    FOR j := 1 TO MaxNachkomma DO BEGIN
      Help2.Nachkomma[j] := 0;
      Help3.Nachkomma[j] := 0;
    END;
    j := 0;
    REPEAT
      Help3 := Help2;
      j := j + 1;
      Help2.Vorzeichen := Plus;
      Help1.Vorzeichen := Plus;
      b.Vorzeichen := Plus;
      FOR k := MaxNachKomma DOWNTO 1 DO Help2.Nachkomma[k] := Help2.Nachkomma[k] + b.Nachkomma[k];
      FOR k := 1 TO MaxVorkomma DO Help2.Vorkomma[k] := Help2.Vorkomma[k] + b.Vorkomma[k];
      LongKorrektur(Help2);
    Until LongGreater(Help2,Help1) OR LongEqual(Help2,Help1);
    c.Vorkomma[i] := c.Vorkomma[i] + j - 1;
    LongKorrektur(c);
    LongSub(Help1,Help3,Help4);
    FOR k := MaxNachKomma DOWNTO 1 DO Help3.Nachkomma[k] := 0;
    FOR k := 1 TO MaxVorkomma DO Help3.Vorkomma[k] := 0;
    Help3.Vorkomma[1] := 10;
    LongMul(Help4,Help3,Help1);
  END;

  { Hier liegt ggfls. noch ein Rest in Help1 vor, der noch berechnet werden muß, }
  { er ist jedoch auf die Nachkommastellen zu verteilen }
  FOR k := MaxNachKomma DOWNTO 1 DO Help3.Nachkomma[k] := 0;
  FOR k := 1 TO MaxVorkomma DO Help3.Vorkomma[k] := 0;
  IF LongGreater(Help1,Help3) THEN BEGIN
    FOR i := 1 TO MaxNachkomma DO BEGIN
      FOR j := 1 TO MaxVorkomma DO BEGIN
        Help2.Vorkomma[j] := 0;
        Help3.Vorkomma[j] := 0;
      END;
      FOR j := 1 TO MaxNachkomma DO BEGIN
        Help2.Nachkomma[j] := 0;
        Help3.Nachkomma[j] := 0;
      END;
      j := 0;
      REPEAT
        Help3 := Help2;
        j := j + 1;
        Help2.Vorzeichen := Plus;
        Help1.Vorzeichen := Plus;
        b.Vorzeichen := Plus;
        FOR k := MaxNachKomma DOWNTO 1 DO Help2.Nachkomma[k] := Help2.Nachkomma[k] + b.Nachkomma[k];
        FOR k := 1 TO MaxVorkomma DO Help2.Vorkomma[k] := Help2.Vorkomma[k] + b.Vorkomma[k];
        LongKorrektur(Help2);
      Until LongGreater(Help2,Help1) OR LongEqual(Help2,Help1);
      c.Nachkomma[i] := c.Nachkomma[i] + j - 1;
      LongKorrektur(c);
      LongSub(Help1,Help3,Help4);
      FOR k := MaxNachKomma DOWNTO 1 DO Help3.Nachkomma[k] := 0;
      FOR k := 1 TO MaxVorkomma DO Help3.Vorkomma[k] := 0;
      Help3.Vorkomma[1] := 10;
      LongMul(Help4,Help3,Help1);
    END;
  END;
  { a mit dem Kehrwert von b multiplizieren }
  Help1 := c;
  LongMul(a,Help1,c);
  { Kommastellen korrigieren }
  m := m - 1;
  FOR i := 1 TO m DO BEGIN
    FOR k := MaxNachkomma - 1 DOWNTO 2 DO c.Nachkomma[k] := c.Nachkomma[k - 1];
  END;
  FOR i := 1 TO m DO BEGIN
    n := m - i + 1;
    IF (n > 0) AND (n <= MaxVorkomma) AND (i > 0) AND (i <= MaxNachkomma) THEN c.Nachkomma[i] := c.Vorkomma[n];
  END;
  FOR i := 1 TO m DO BEGIN
    FOR k := 1 TO MaxVorkomma - 1 DO c.Vorkomma[k] := c.Vorkomma[k + 1];
    c.Vorkomma[MaxVorkomma] := 0;
  END;
  { stimmt das so? }
  IF ((a.Vorzeichen = plus ) AND (b.Vorzeichen = plus ))
  OR ((a.Vorzeichen = minus) AND (b.Vorzeichen = Minus)) THEN c.Vorzeichen := plus
  ELSE c.Vorzeichen := minus;
  LongDiv := TRUE;
END;

PROCEDURE Linie1
          (Var f : Text);
Var
          i : Integer;
BEGIN
  FOR i := 1 TO (MaxVorkomma + MaxNachkomma + 4) + (MaxVorkomma DIV 3) + (MaxNachkomma DIV 3) DO Write(f,'-');
  Writeln(f);
END;

PROCEDURE Linie2
          (Var f : Text);
Var
          i : Integer;
BEGIN
  FOR i := 1 TO (MaxVorkomma + MaxNachkomma + 4) + (MaxVorkomma DIV 3) + (MaxNachkomma DIV 3) DO Write(f,'=');
  Writeln(f);
  Writeln(f);
END;

PROCEDURE Zahl
          (Var f : Text;
               c : TLangzahl;
               ch : Char);

Var
          i : Integer;

BEGIN
  Write(f,ch,' ');
  case c.Vorzeichen of
    Plus : Write(f,'+');
    minus : Write(f,'-');
  end;
  FOR i := MaxVorkomma DOWNTO 1 DO BEGIN
    Write(f,c.Vorkomma[i]);
    IF ((i + 2) MOD 3 = 0) AND (i > 3) AND (i <= MaxVorkomma) THEN Write(f,'.');
  END;
  Write(f,',');
  FOR i := 1 TO MaxNachkomma DO BEGIN
    Write(f,c.Nachkomma[i]);
    IF ((i ) MOD 3 = 0) AND (i < MaxNachkomma) THEN Write(f,'.');
  END;
  Writeln(f);
END;

Var
          a : TLangZahl;
          b : TLangZahl;
          c : TLangZahl;
          i : Word;
          f : Text;
BEGIN
  Assign(f,'LONGRECH.TXT');
  If FileExists('LONGRECH.TXT') then Append(f) else ReWrite(f);
  a.Vorzeichen := Plus;
  b.Vorzeichen := Plus;
  c.Vorzeichen := Plus;
  For i := 1 TO MaxVorkomma Do BEGIN
    a.Vorkomma[i] := 0;
    b.Vorkomma[i] := 0;
    c.Vorkomma[i] := 0;
  END;
  For i := 1 TO MaxNachkomma Do BEGIN
    a.Nachkomma[i] := 0;
    b.Nachkomma[i] := 0;
    c.Nachkomma[i] := 0;
  END;
  Randomize;

  { höchster Wert je Variabel = Maximum - 1}
  a.Vorzeichen := Plus ; {minus}
  b.Vorzeichen := Plus ; {plus}

  For i := 1 TO MaxVorkomma DIV 2 do a.Vorkomma[i] := Random(Maximum - 1);
  For i := 1 TO MaxNachkomma - 1 do a.Nachkomma[i] := Random(Maximum - 1);
  For i := 1 TO MaxVorkomma DIV 2 do b.Vorkomma[i] := Random(Maximum - 1);
  For i := 1 TO MaxNachkomma - 1 do b.Nachkomma[i] := Random(Maximum - 1);

  LongKorrektur(a);
  LongKorrektur(b);
  IF LongPlausi(a) AND LongPlausi(b) THEN BEGIN
    Writeln(' ',LongString(a));
    Writeln(' + ',LongString(b));
    Writeln(Replicate('-',79));
    LongAdd(a,b,c);
    Writeln(' = ',LongString(c));
    Writeln(Replicate('=',79));

    Zahl(f,a,' ');
    Zahl(f,b,'+');
    Linie1(f);
    Zahl(f,c,'=');
    Linie2(f);

    Writeln(' ',LongString(a));
    Writeln(' - ',LongString(b));
    Writeln(Replicate('-',79));
    LongSub(a,b,c);
    Writeln(' = ',LongString(c));
    Writeln(Replicate('=',79));

    Zahl(f,a,' ');
    Zahl(f,b,'-');
    Linie1(f);
    Zahl(f,c,'=');
    Linie2(f);

    Writeln(' ',LongString(a));
    Writeln(' * ',LongString(b));
    Writeln(Replicate('-',79));
    LongMul(a,b,c);
    Writeln(' = ',LongString(c));
    Writeln(Replicate('=',79));

    Zahl(f,a,' ');
    Zahl(f,b,'*');
    Linie1(f);
    Zahl(f,c,'=');
    Linie2(f);

    Writeln(' ',LongString(a));
    Writeln(' / ',LongString(b));
    Writeln(Replicate('-',79));
    LongDiv(a,b,c);
    Writeln(' = ',LongString(c));
    Writeln(Replicate('=',79));

    Zahl(f,a,' ');
    Zahl(f,b,'/');
    Linie1(f);
    Zahl(f,c,'=');
    Linie2(f);

  END ELSE BEGIN
    Writeln('irgend ein Wert in a oder b ist zu groß');
  END;
  Close(f);
  WriteLn('Fertig');
  Readln;
END.

BEGIN
  Abbruch := 0; { Zähler Abbruchschranke }
  Wurzelwert := Radikand / 2; { der wird die Wurzel   }
  TestRadikand := Wurzelwert; { Testvariabel }
  TeilerRadikand := Radikand; { Variabel zum Annähern }
  REPEAT
    TeilerRadikand := TeilerRadikand / 2;
    TestRadikand := Wurzelwert;
    Potenzwert := 1;
    REPEAT
      TestRadikand := TestRadikand * Wurzelwert;
      Potenzwert := Potenzwert + 1;
    UNTIL (Potenzwert = Wurzelexponent) OR (TestRadikand >= Radikand);
    IF TestRadikand > Radikand THEN Wurzelwert := Wurzelwert - TeilerRadikand;
    IF TestRadikand < Radikand THEN Wurzelwert := Wurzelwert + TeilerRadikand;
    Abbruch := Abbruch + 1;
  UNTIL (TestRadikand > (Radikand - Genauigkeit)) AND (TestRadikand < (Radikand + Genauigkeit))
        OR (TestRadikand = Radikand)
        OR (TeilerRadikand = 0)
        OR (Abbruch >= MaximalSchleifen);
  Wurzelziehen := WurzelWert;
END;

{.INFO}
FUNCTION LongWur
          ( Radikand : TLangzahl;
               Wurzelexponent : Word;
               MaximalSchleifen : Integer;
           Var c : TLangZahl) : Boolean;
{*------------------------------------------------------------------*}
{¦ Berechnet die wurzelexponente Wurzel aus dem Radikand.           ¦}
{¦ Je kleiner der Wert von Genauigkeit, um so präziser wird das     ¦}
{¦ Ergebnis bestimmt.                                               ¦}
{*------------------------------------------------------------------*}
{.INFO}

VAR
          Abbruch : Integer;
          TestRadikand : TLangzahl;
          TeilerRadikand : TLangzahl;
          Wurzelwert : TLangzahl;
          PotenzWert : Word;
          Help1 : TLangzahl;
          Help2 : TLangzahl;
          i : Integer;

BEGIN
  LongWur := FALSE;
  Abbruch := 0; { Zähler Abbruchschranke }
  Help1.Vorzeichen := Plus;
  Help2.Vorzeichen := Plus;
  FOR i := 1 TO MaxVorkomma DO BEGIN
    Help1.Vorkomma[i] := 0;
    Help2.Vorkomma[i] := 0;
    c.Vorkomma[i] := 0;
    TestRadikand.Vorkomma[i] := 0;
    TeilerRadikand.Vorkomma[i] := 0;
    Wurzelwert.Vorkomma[i] := 0;
  END;
  FOR i := 1 TO MaxNachkomma DO BEGIN
    Help1.Nachkomma[i] := 0;
    Help2.Nachkomma[i] := 0;
    c.Nachkomma[i] := 0;
    TestRadikand.Nachkomma[i] := 0;
    TeilerRadikand.Nachkomma[i] := 0;
    Wurzelwert.Nachkomma[i] := 0;
  END;
  Help1.Nachkomma[1] := 5;
  LongMul(Radikand,Help1,WurzelWert);
  (*  Wurzelwert        := Radikand / 2;   { der wird die Wurzel   }*)
  TestRadikand := Wurzelwert; { Testvariabel }
  TeilerRadikand := Radikand; { Variabel zum Annähern }
  REPEAT
    LongMul(TeilerRadikand,Help1,Help2);
    TeilerRadikand := Help2;
{    TeilerRadikand := TeilerRadikand / 2;}
    TestRadikand := Wurzelwert;
    Potenzwert := 1;
    REPEAT
      LongMul(TestRadikand,WurzelWert,Help2); {      TestRadikand := TestRadikand * Wurzelwert;}
      TestRadikand := Help2;
      Potenzwert := Potenzwert + 1;
    UNTIL (Potenzwert = Wurzelexponent)
    OR LongGreater(TestRadikand,Radikand)
    OR LongEqual(TestRadikand,Radikand); {(TestRadikand >= Radikand);}
    IF LongGreater(TestRadikand,Radikand) THEN BEGIN
      LongSub(Wurzelwert,TeilerRadikand,Help2);
      Wurzelwert := Help2;
    END;
    IF LongLower(TestRadikand,Radikand) THEN BEGIN
      LongAdd(Wurzelwert,TeilerRadikand,Wurzelwert);
      Wurzelwert := Help2;
    END;
    Abbruch := Abbruch + 1;
  UNTIL (LongGreater(TestRadikand,Radikand) AND LongLower(TestRadikand,Radikand))
        OR LongEqual(TestRadikand,Radikand)
        OR LongIsZero(TeilerRadikand)
        OR (Abbruch >= MaximalSchleifen);
  c := WurzelWert;
  LongWur := TRUE;
END;
Das Teil hat 99 LongInts als Vorkommastellen und ebensoviele als Nachkommastellen.

Meine Kommentare von damals verstehe ich nicht mehr so unbedingt, aber vielleicht ist's ja ein Ansatz für die Ideenfindung zur Lösung des Problems.
Ansonsten: et is wie et is, frage mich bitte niemand, was ich mir seinerzeit dabei gedacht habe oder warum ich das produziert habe Müsste mit Turbo-Pascal 4 entstanden sein.
  Mit Zitat antworten Zitat