(Gast)
n/a Beiträge
|
AW: Gauß-Verfahren - Matrix lösen
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.
|