ich habe mal aus reiner Lust am Programmieren einige grundlegende mathematische Funktionen nur mit Hilfe der vier Grundrechnungsarten (nach)programmiert.
Geschafft habe ich es nicht die Funktionen Int() und Trunc() für alle Argumente fehlerfrei zu programmieren.
Bei den Reihenentwicklungen ist es ja wichtig, dass diese Reihen genügend schnell konvergieren.
Also müssen die Argumente als erstes geeignet verkleinert werden.
Augefallen ist mir, dass bei sehr großen Argumenten die Sinus-Funktion ungenau wird. Mir ist nicht klar, wie sich große Argumente schnell und genügend genau reduzieren lassen. (Eigentlich braucht ja nur 2*Pi so lange vom Argument subtrahiert zu werden, dass dies kleiner als 2*Pi ist.)
Auch habe ich keine Lösung gefunden, wie sich das Argument beim IntegralSinus geeignet reduzieren läßt. Wahrscheinlich geht dies auch gar nicht, da keine Periodizität erkennbar ist. Die Funktion nähert sich bei großen Argumenten der Größe Pi/2.
Vielleicht kann mir ja einer weiter helfen.
Ich wünsche viel Spaß beim ausprobieren und verbessern dieser Funktionen.
Viele Grüße
Hier ist nun der Quelltext:
Code: Alles auswählen
Unit Reihen;
interface
function Wurzel(x:Extended):Extended;
function Sinus(x:Extended):Extended;
function ArcusTan(x:Extended):Extended;
function eHochx(x:Extended):Extended;
function Logarithmus(x:Extended):Extended;
function IntegralSinus(x:Extended):Extended;
implementation
Const Max =15000;
Var Pot2 :Array[-Max..Max] Of Extended; // 2^x
Pii, // Pi
Ln2, // Ln(2)
Epsilon,Fehler:Extended;
Function Absolut(x:Extended):Extended; // Abs(x)
Begin
If x<0 Then Absolut:=-x Else Absolut:=x
End;
Function Quadrat(x:Extended):Extended; // Sqr(x)
Begin
If x>Pot2[Max Div 2] Then Quadrat:=Fehler Else Quadrat:=x*x
End;
Function Wurzel(x:Extended):Extended; // Sqrt(x)
Const Alternativ=True;
Var x0,xn,Epsilonn:Extended;
Begin
If x<0 Then Begin Wurzel:=Fehler;Exit End;
If x=0 Then Begin Wurzel:=0;Exit End;
If Alternativ Then
Begin
If x<Epsilon Then Epsilonn:=x/2 Else Epsilonn:=Epsilon;
x0:=0.5*(x+1);xn:=x0;
Repeat x0:=xn;xn:=0.5*(x0+x/x0) Until Absolut(x0-xn)<Epsilonn;
Wurzel:=xn
End
Else Wurzel:=eHochx(0.5*Logarithmus(x))
End;
function Sinus(x:Extended):Extended; // Sin(x)
Var xx,Fak,Teiler,Sinn:Extended;
n :Integer;
vz,Evz :ShortInt;
Begin
If Absolut(x)>Pot2[40] Then Begin Sinus:=Fehler;Exit End;
If x<0 Then Evz:=-1 Else Evz:=1;
x:=Absolut(x);x:=x-Int(x/(2*Pii))*2*Pii;
If x>Pii Then Begin x:=x-Pii;Evz:=-Evz End;
If x>Pii/2 Then x:=Pii-x;
Sinn:=x;xx:=x;x:=Quadrat(x);Fak:=1;n:=1;Teiler:=xx/Fak;vz:=1;
While Teiler>Epsilon Do
Begin
xx:=xx*x;Inc(n,2);Fak:=Fak*n*(n-1);Teiler:=xx/Fak;
vz:=-vz;Sinn:=Sinn+vz*Teiler
End;
Sinus:=Evz*Sinn
End;
function eHochx(x:Extended):Extended; // Exp(x)
Var xx,Fak,Teiler,Exxp:Extended;
n,k :Integer;
vz :Boolean;
begin
If x<-10000 Div 2 Then Begin eHochx:=0;Exit End;
If Absolut(x)>10000 Then Begin eHochx:=Fehler;Exit End;
If x=0 Then Begin eHochx:=1;Exit End;
If x<0 Then vz:=True Else vz:=False;
x:=Absolut(x);k:=Trunc(x/Ln2);x:=x-k*Ln2;Exxp:=1+x;xx:=x;
Fak:=1;n:=1;Teiler:=xx/Fak;
While Teiler>Epsilon Do
Begin xx:=xx*x;Inc(n);Fak:=Fak*n;Teiler:=xx/Fak;Exxp:=Exxp+Teiler end;
Exxp:=Pot2[k]*Exxp;
If vz Then Exxp:=1/Exxp;
eHochx:=Exxp
end;
function Log2:Extended; // Ln(2)
Var Teiler,Logg2:Extended;
n :Integer;
begin
n:=1;Teiler:=0.5;Logg2:=Teiler;
While Teiler>Epsilon Do
Begin n:=n+1;Teiler:=1/(n*Pot2[n]);Logg2:=Logg2+Teiler End;
Log2:=Logg2
end;
function Logarithmus(x:Extended):Extended; //Ln(x)
Var xx,x2,Teiler,Logg:Extended;
n,k,l :Integer;
begin
If (x>Pot2[Max]) Or (x<Pot2[-Max]) Then Begin Logarithmus:=Fehler;Exit End;
If x=1 Then Begin Logarithmus:=0;Exit End;
If x>1 Then For l:=1 To Max Do If Pot2[l]>=x Then Begin k:=l-1;Break End Else
Else For l:=-1 DownTo -Max Do If Pot2[l]<=x Then Begin k:=l;Break End;
x:=x*Pot2[-k];n:=1;xx:=(x-1)/(x+1);x2:=Quadrat(xx);Teiler:=2*xx;Logg:=Teiler;
While Teiler>Epsilon Do
Begin Inc(n,2);xx:=xx*x2;Teiler:=2/n*xx;Logg:=Logg+Teiler End;
Logarithmus:=k*Ln2+Logg
end;
function ArcusTan(x:Extended):Extended; //ArcTan(x)
Var x2,Faktor,Teiler,ATan:Extended;
n :Integer;
vz :ShortInt;
Begin
If x>Pot2[Max Div 2] Then Begin ArcusTan:=Pii/2;Exit End;
If x<-Pot2[Max Div 2] Then Begin ArcusTan:=-Pii/2;Exit End;
Faktor:=1;
While Absolut(x)>0.1 Do Begin
x:=x/(1+Wurzel(1+Quadrat(x)));Faktor:=Faktor*2 End;
ATan:=x;x2:=Quadrat(x);vz:=-1;x:=x*x2;n:=3;
Repeat
Teiler:=x/n;ATan:=ATan+vz*Teiler;vz:=-vz;Inc(n,2);x:=x*x2
Until Absolut(Teiler)<Epsilon;
ArcusTan:=ATan*Faktor
End;
function IntegralSinus(x:Extended):Extended;
Var Ins,Fak,Pot,Teiler:Extended;
vz :ShortInt;
n :Integer;
begin
If Absolut(x)>45 Then Begin IntegralSinus:=Fehler;Exit End;
Ins:=x;n:=1;Fak:=1;Pot:=x;x:=Quadrat(x);vz:=-1;
Repeat
Pot:=Pot*x;Inc(n,2);Fak:=Fak*(n-1)*n;Teiler:=Pot/(Fak*n);
Ins:=Ins+vz*Teiler;vz:=-vz
Until Absolut(Teiler)<Epsilon;
IntegralSinus:=Ins;
end;
Var i:Integer;
Initialization
Pot2[0]:=1;Pot2[1]:=2;
For i:=2 To Max Do Pot2[i]:=Pot2[i-1]*2;
For i:=-1 DownTo -Max Do Pot2[i]:=1/Pot2[-i];
Epsilon:=Pot2[-58];Fehler:=Pot2[Max];
Pii:=16*ArcTan(1/5)-4*ArcTan(1/239);Ln2:=Log2
end.