J o a c h i m M o h r Mathematik Musik Programmieren
Die Unit jmbruch
{ "Extended integer" werden mit extended simuliert.
extended hat 18-19 signifikante Stellen, d.h. man kann damit
Integer darstellen, die 18-19 Dezimalstellen haben.
Gespeichert werden diese Integer als extended.
Int64 wären aucg möglich ... Nur dort entstehen Überlauffehler, die werden
hier abgefangen mit "zugross". Dann wird die Zahl "unde" (Magic).
Die Grundoperationen mit e(xttended) gekennzeichnet sind dann:
Adde a+b //Muss nicht extra programmiert werden, bis auf unde(fined)
Sube a-b
Multe a*b
Dive(a,b) a div b //Funktionen implementiert
Mode(a,b) a mod b
ggTe(a,b) ggT(a,b)
hoche(a,b) a^b
}
unit jmbruch;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls, WinSpool, ComCtrls;
const maxNennerMalZaehler = 1E12; //z.B. Nenner/Zähler 123456/765432 //geändert Februar 2003 vorher 1E14
eps_fuerBruch = 1E-15;
g_eps =1E-12; //von jmMath?????????????
zugross = 1.0*high(Int64) + 0.5;
undefined_e = 8642E97531; //undefined_extended = magic
var nPZe: integer; //nPZe: "n=Anzahl für PZe"
PZe: array of Integer; //PZe: "Primzahl extended"
//Betrifft extended als Integer
function alsIntegergleich(const a,b: extended): boolean;
function adde(const a,b: extended): extended;
function sube(const a,b: extended): extended;
function multe(const a,b: extended): extended;
function dive(const a,b: extended): extended; //<> a/b
function mode(const a,b: extended): extended;
function odd(const a:extended): boolean;
function ggTInt(const a,b: integer): integer; //siehe pyth Zahlentripel
function ggTe(const a,b: extended): extended;
procedure kuerzee(var a,b:Extended);
function hoche(const m,e: extended): extended;
//Allgemeine Hilfsfunktionen
function IsInteger(const x: extended; eps_Genauigkeit: extended): boolean;
//z.B. x=2,000..0001 x=1,999..9
function RealIsIntegerToStr(x:extended): string;
//Primzahlen
//lokal function PrZe(const n:Integer): integer; // die n. Primzahl, gezählt ab 0
function Primzahlausgabe(const n:extended): integer; // die n. Primzahl, gezählt ab 1
function kleinsterPrimfaktor(const x: extended): extended; //2, 3 ... oder x
function groessterPrimfaktor(const x: extended): extended;
function PFZ(x0: extended): string; // Teste mit 304 250 263 527 211
//Ausgabe als Bruch
function ErmittleBruche(const q:extended;var a,b:extended; eps_Genauigkeit:Extended):boolean;
//Die Hauptpozedur
function ReellZuBruch_(const q:extended;const alsGemZahl:boolean):string; //stets Ergebnis
function ReellZuBruch(const q:extended):string; //stets Ergebnis, unechterBruch oder float
function ReellZuGemZahl(const q:extended):string; //Stets Ergebnis: Gem Zahl oder float
function GleichBruchfallsBruchsonstleer(r: extended): string;
function GleichBruchoderWurzelsonstleer(r: extended): string;
//Ausgabe als Wurzel oder Vielfaches von Pi
function AlsWurzeloderPi(x0:extended; wur:string):string; //evtl. ''
function AlsVielfachesVonPioderleer(x:extended):string;
//es wird versucht x=a/b*wur(c)
//-> x^2=z/n Nenner klein genug, dann x=1/n*wur(z*n)
function AlsBruchoderWurzel(r: extended): string; //nie ''
function AlsBruchoderWurzelmitNaeherung(r: extended): string;
implementation
uses unitrechne, jmabbrechen, jmhilf;
function IsInteger(const x: extended; eps_Genauigkeit: extended): boolean;
begin
result := frac(abs(x) + eps_Genauigkeit) < eps_Genauigkeit * 2;
end;
function alsIntegergleich(const a,b: extended): boolean;
begin
result := (abs(a - b) < 0.5) //Es handelt sich um ganze Zahlen
end;
function adde(const a,b: extended): extended;
begin
if (a = undefined_e) or (b = undefined_e) then result := undefined_e
else result := a + b;
if abs(result) > zugross then result := undefined_e;
end;
function sube(const a,b: extended): extended;
begin
if (a = undefined_e) or (b = undefined_e) then
result := undefined_e else result := a - b;
if abs(result) > zugross then result := undefined_e;
end;
function multe(const a,b: extended): extended;
begin
if (a = undefined_e) or (b = undefined_e)
then result := undefined_e else result := a * b;
if abs(result) > zugross then result := undefined_e;
end;
function dive(const a,b: extended): extended;
begin
if (a = undefined_e) or (b = undefined_e) or (b = 0)
then result := undefined_e else result := int(a/b);
end;
function mode(const a,b: extended): extended;
begin
if (a = undefined_e) or (b = undefined_e) or (b = 0)
then result := undefined_e else
result := a - b*dive(a,b);
end;
function odd(const a:extended): boolean;
begin
result := alsIntegergleich(mode(a,2),1);
end;
function ggTInt(const a,b: integer): integer;
begin
if b = 0 then result:=a else result:=abs(ggTInt(b,a mod b));
end;
function ggTe(const a,b: extended): extended;
begin
if (a = undefined_e) or (b = undefined_e) then result := undefined_e else
if b = 0 then result:=a else result:=abs(ggTe(b,mode(a,b)));
end;
function hoche(const m,e: extended): extended;
begin
if abs(m) > zugross then result := undefined_e else Begin
if e = 0 then result := 1 else
if odd(e) then result := m*hoche(m,e-1) //da m^e=m*m(e-1)
else result := hoche(m*m,dive(e,2)) //da m^e=(m*m)(e/2)
End;
if abs(result) > zugross then result := undefined_e;
end;
procedure suchenaechstePrimzahl;
var groesstePZ: integer;
function hatKeineTeiler:boolean; //Versuch, ob groesstePrimzahl wirklich PZ ist, d.h.
//nicht durch bisherige PZ geteilt werden kann
//Prüfung:primzahl[j] Teiler von GroesstePrimzahl? bis
// primzahl[j] > Wurzel(groesstePrimzahl) nil then Begin
abbrechen.labbrechen.Caption := IntToStr(nPZe);
application.ProcessMessages;
if abbrechen.stop then exit;
End else Begin
abbrechen := TFormabbrechen.create(nil);
FRechne.Enabled := false;
abbrechen.Caption := 'Primzahlahlen werden berechnet';
abbrechen.show;
End;
groesstePZ:=PZe[nPZe]; //Größte bisher gefundene PZ
repeat
inc(groesstePZ,2); //Eine noch groesserPZ wird gesucht, evl. PZ-Zwilling
until hatkeineTeiler;
inc(nPZe); //Jetzt gibt's eine PZ mehr
if length(PZe) <= nPZe + 1 then setlength(PZe,nPZe + 500);
PZe[nPZe] := groesstePZ; //Neue größte PZ
end;
procedure garantierePZe(const i: integer);
begin
while nPZe < i do Begin
if abbrechen <> nil then if abbrechen.stop then exit;
suchenaechstePrimzahl;
End;
end;
function PrZe(const n:Integer): integer; // die n. Primzahl, gezählt ab 0
begin
garantierePZe(n);
if abbrechen <> nil then if abbrechen.stop then Begin
result := 0;
exit;
End;
//Bei Abbruch n < nPrZe
if n <= nPZe then result := PZe[n] else result := 0;
end;
function Primzahlausgabe(const n:extended): integer; // die n. Primzahl, gezählt ab 1
begin
if (n < 1) or (n > high(integer)) then
result := 0 else result := PrZe(round(n)-1);
if abbrechen <> nil then Begin
if abbrechen.stop then result := 0;
abbrechen.free; //Jetzt auf jeden Fall
abbrechen := nil;
FRechne.Enabled := true;
frechne.Show;
End;
end;
function RealIsIntegerToStr(x:extended):string;
begin
result:=trim(floatToStrf(x,ffGeneral,4,18));
if pos('E',result) > 0 then result := floattostr(x);
end;
function kleinsterPrimfaktor(const x: extended): extended;
var i:integer;
begin
for i := 0 to round(sqrt(x)) do Begin
if alsIntegergleich(mode(x,PrZe(i)),0) then BEgin
result := PrZe(i);
exit;
ENd;
End;
result := x; //x ist Primzahl
if abbrechen <> nil then Begin
abbrechen.free;
abbrechen := nil;
FRechne.Enabled := true;
frechne.Show;
End;
end;
function groessterPrimfaktor(const x: extended): extended;
var i:integer;
begin
i := 0;
while PrZe(i)*PrZe(i) < x do inc(i);
while i >= 0 do Begin
if alsIntegergleich(mode(x,PZe[i]),0) then BEgin
result := PrZe(i);
exit;
ENd;
dec(i);
End;
result := x; //x ist Primzahl
if abbrechen <> nil then Begin
abbrechen.free;
abbrechen := nil;
FRechne.Enabled := true;
frechne.Show;
End;
end;
procedure rundeWennInteger(var x: Extended);
begin if isInteger(x, g_eps) then Begin
if x >= 0 then x := int(x + 0.5) else
x := -int(abs(x) + 0.5);
End;
end;
function PFZ(x0: extended): string; // Teste mit 304 250 263 527 211
var x,faktor: extended;
begin
x := x0;
RundeWennInteger(x); //sonst bei Fibonacci 144=..*3*1
result := '';
if abs(x) <= 1 then exit;
if abs(x) > 1E19 then Begin //geprüft mit 10^19+1=100...001
showmessage('Durch Rundungsfehler der Fließkommazahl ist PFZ möglicherweise nicht korrekt!');
result := '?';
End;
if x < 0 then result := '-' else result := ' ';
x := abs(x);
repeat
faktor := kleinsterPrimfaktor(x);
x := x/faktor;
if length(result) > 1 then result := result + '*';
result := result + FloatToStr(faktor);
until x <= 1.5;
Try
result := trim(result);
if alsIntegergleich(abs(x0),faktor) then result := result + '(PZ)'
except result := '' End;
end;
PROCEDURE kuerzee(var a,b:Extended);
var t:Extended;
begin
t := ggte(a,b);
a := dive(a,t);
b := dive(b,t)
end;
function ErmittleBruche(const q:extended; var a,b:extended; eps_Genauigkeit:Extended):boolean;
//=true, falls erfolgreich
const MaxIteration=50;
var q0,Qabs,GanzZahligerAnteilVonQ,NachkommaVonQ,am,amm,bmm,bm:extended;
{am=a index -1 amm index -2}
zaehl:integer;
begin //Methode: Kettenbruchentwicklung
result := false;
qabs := abs(q); //Es wird mit positiven Werten gerechnet
q0 := qabs;
a := 1;
b := 0;
am := 0; //altes a
bm := 1; //altes b
zaehl := 0;
try //damit nach exit Finally ausgeführt wird
repeat
inc(zaehl);
if zaehl>MaxIteration then exit;
GanzZahligerAnteilVonQ:=int(q0+eps_Genauigkeit); //wg. Rundungsfeler muss z.B. 4.99.. zu 5.00.. werden
NachkommaVonQ:=q0-GanzZahligerAnteilVonQ; //=fraq(qabs)
amm := am; //uraltes a
bmm := bm; //uraltes b
am := a; //altes a
bm := b; //altes a
try // möglich overflow (kommt nur vor, falls eps_Gen. zu klein)
a := adde(GanzZahligerAnteilVonQ*am,amm); //Anfang: ak=GanzZahligerAnteilVonQ
b := adde(GanzZahligerAnteilVonQ*bm,bmm); // bk=1
kuerzee(a,b);
if NachkommaVonq < eps_Genauigkeit then exit;//endlicher Kettenbruch siehe finally
q0 := 1/NachkommaVonq; //Jetzt ja NachkommaVonq>=eps_Genauigkeit
Except exit End;
until abs(qabs - a/b)=eps_Genauigkeit then result:=false else result := true;
except result := false End;
if q<0 then a:=-a;
End;
end;
function reellZuBruchefallsmoeglichsonstleer(const q: extended;
gemischteZahl: boolean; eps: extended): string;
//liefert ganze Zahl oder Bruch oder -falls nicht möglich- leeren String
const Hochkomma = #39;
var a,b: extended;
begin
try
if ErmittleBruche(q,a,b,eps) then Begin
if abs(a*b) > maxNennerMalZaehler then BEgin
result := '';
exit;
End;
if abs(b-1) < eps then Begin
result := IntToStr(round(a));
exit;
End;
if gemischteZahl and (abs(q) > 1) then Begin
if q < 0 then result := '-' else result := '';
result := result + intToStr(round(dive(abs(a),b))) + Hochkomma
+ intToStr(round(mode(abs(a),b))) + '/' + IntToStr(round(b));
End else result := IntToStr(round(a)) + '/' + IntToStr(round(b));;
End else result := '';
{Teste mit +/- ... 1/2+1/7, 999.9999999, Pi, 15, 13579/246810}
except result := '' End;
end;
function ReellZuBruch_(const q:extended;const alsGemZahl:boolean):string;
//liefert ganze Zahl oder Bruch oder -falls nicht möglich- floatToStr
begin
result := reellZuBruchefallsmoeglichsonstleer(q,alsGemZahl,eps_fuerBruch);
if result = '' then result := FloatToStrF(q,ffGeneral,18,10);
end;
function ReellZuBruch(const q:extended):string; //stets Ergebnis, unechterBruch oder float
begin result:=ReellZuBruch_(q,false) end;
function ReellZuGemZahl(const q:extended):string; //stets Ergebnis, Gem Zahl oder oder float
begin result:=ReellZuBruch_(q,true) end;
function GleichBruchfallsBruchsonstleer(r: extended): string;
var s: string;
begin
s := ReellZuBruch(r);
if pos('/', s) > 0 then result := '=' + s else result := '';
end;
//------------------- Wurzel -------------------------
function AlsVielfachesVonPioderleer(x:extended):string;
var z,n:extended;
begin
result:=''; //Misserfolg
if x > 1E9 then exit;
try
if ErmittleBruche(x/Pi,z,n,1E-15) then Begin
if abs(n)<1000000 then BEgin
if n=1 then BEgin
if z = 1 then result := 'Pi' else
if z = -1 then result := '-Pi' else
result:=RealIsIntegerToStr(z)+'*Pi'
End else
result:=RealIsIntegerToStr(z)+'/'+RealIsIntegerToStr(n)+'*Pi'
ENd;
End;
except End;
end;
function teilweiseRadiziert(n: extended): string;
var NrPZ: Integer;
z,qu: extended;
begin
NrPZ := 0;
z := 1;
repeat
qu:=PrZe(NrPz)*PrZe(NrPz);
while IsInteger(n/qu,1E-15) do Begin
z:=z*PrZe(NrPz);
n:=n/qu;
End;
inc(NrPz);
until (NrPz>1000) or (qu>n);
if z=1 then result := 'sqrt('+floatToStr(n)+')' else
result := FloatToStr(z)+'*sqrt('+floatToStr(n)+')';
end;
function letzterVersuchoderleer(x: extended): string;
//x= (a+wur(b)/c //a,c ganz, b>0 rational => b = (c*x-a)^2
var z,n: extended;
a,c,sgn: integer;
nenner,
sqrt_z_mal_n: string;
begin
result := '';
for c := 1 to 10 do for a := -10 to 10 do if c <> 0 then
//z/n = (cx-a)^2 => cx - a = +- sqrt(z*n)/n => x = (a*n +- sqrt(z*n))/(c*n)
if ErmittleBruche(sqr(c*x-a),z,n,1E-12) then
if abs(z*n) < 1000 then Begin
if abs(x*c*n - a*n - sqrt(z*n)) < abs(x*c*n - a*n + sqrt(z*n))
then sgn := +1 else sgn := -1;
if abs(x*c*n - a*n - sgn*sqrt(z*n)) > 1E-12 then exit;
if alsIntegergleich(c*n,1) then nenner:='' else nenner := '/'+floatToStr(c*n);
if sgn = 1 then result := '+' else result := '-';
//result := '(' + floatToStr(a*n) + result + 'sqrt(' +floatToStr(z*n) +'))' + nenner;
sqrt_z_mal_n := teilweiseRadiziert(z*n);
result := '(' + floatToStr(a*n) + result + sqrt_z_mal_n +')' + nenner;
exit;
End;
end;
function AlsWurzeloderPi(x0:extended; wur:string):string; //evtl. ''
//es wird versucht x=a/b*wur(c)
//-> x^2=z/n Nenner klein genug, dann x=1/n*wur(z*n)
var c,xq,z,n,qu:extended;
NrPZ:integer;
function mitWurzel(x,z,n,c:extended):string;
var wu:string;
begin
kuerzee(z,n);
if abs(c-1)<1E-15 then wu:='' else wu:='*'+wur+'('+RealIsIntegerToStr(c)+')';
if n=1 then Begin
if z=1 then result:=copyab(wu,2) else result:=RealIsIntegerToStr(z)+wu
End else result:=RealIsIntegerToStr(z)+'/'+
RealIsIntegerToStr(n)+wu;
if x<0 then result:='-'+result;
end;
begin
result:='';
try
xq:=x0*x0;
except result := ''; exit End;
try
if ErmittleBruche(xq,z,n,1E-15) then if abs(n)<1000000000 then Begin
if abs(z) < g_eps then Begin
result := '0'; //sonst lautet Primfaktorenzerlegung 0*2*2*2....
exit;
End;
//x^2=z/n => x=1/n*wur(z*n);
//z.B. 123/124*wur(2/19) hoch 2= 15 129*146 072
c:=z*n; //x=1/n*wur(c)
//Teilweise radizieren!
z:=1;
if c>1000000 then exit;
NrPZ:=0;
repeat
qu:=PrZe(NrPz)*PrZe(NrPz);
while IsInteger(c/qu,1E-15) do Begin
z:=z*PrZe(NrPz);
c:=c/qu;
End;
inc(NrPz);
until (NrPz>1000) or (qu>c);
result:=mitWurzel(x0,z,n,c);
End
finally
if result = '' then result := AlsVielfachesVonPioderleer(x0);
if result = '' then result := letzterVersuchoderleer(x0);
if abbrechen <> nil then BEgin
abbrechen.free;
abbrechen := nil;
FRechne.Enabled := true;
frechne.Show;
End;
ENd;
end;
function AlsBruchoderWurzel(r: extended): string;
begin
try
if isinteger(r,g_eps) then Begin
result := formatfloat('0',r);
exit;
End;
result := reellZuBruchefallsmoeglichsonstleer(r,true,eps_fuerBruch);
if pos('/', result) > 0 then exit;
if result = '' then result := AlsWurzeloderPi(r,'sqrt');
except result := entferneSpacesNachMinus(formatfloat('0.
#',r)) End;
if result ='' then result := FloatToStrF(r,ffGeneral,12,10) else
result := result + '=' + FloatToStrF(r,ffGeneral,12,10);
end;
function GleichBruchoderWurzelsonstleer(r: extended): string;
var s: string;
begin
s := AlsWurzeloderPi(r,'sqrt');
if (pos('/', s) > 0) or (pos('sqrt',s) > 0) then result := '=' + s else result := ''
end;
function AlsBruchoderWurzelmitNaeherung(r: extended): string;
begin
result := AlsBruchoderWurzel(r);
if pos(decimalseparator,result) = 0 then
if not isInteger(r,eps_fuerBruch) then result := result + ' = ' + ssd_(r,3);
end;
begin //initialisierung für Primzahlen
setlength(PZe,2);
PZe[0] := 2;
PZe[1] := 3;
nPze := 1; //Zählung ab 0
end.