(Nach)Programmieren von Funktionen

Zur Vorstellung von Komponenten und Units für Lazarus
Antworten
heizkoerper
Beiträge: 24
Registriert: Mo 1. Aug 2011, 14:39
OS, Lazarus, FPC: Windows XP und 7, L 0.9.31, FPC 2.4.4
CPU-Target: 32 und 64 Bit
Wohnort: Hannover
Kontaktdaten:

(Nach)Programmieren von Funktionen

Beitrag von heizkoerper »

Hallo Lazarusfreunde,

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.

Warf
Beiträge: 1908
Registriert: Di 23. Sep 2014, 17:46
OS, Lazarus, FPC: Win10 | Linux
CPU-Target: x86_64

Re: (Nach)Programmieren von Funktionen

Beitrag von Warf »

function Sinus(x:Extended):Extended;


Warum der Sinus bei großen eingaben ungenau ist liegt daran dass Extended bei großen eingaben ungenau ist. Extended ist ein IEEE 754 formatiertes Binärwort, und hat die form 1,Matisse Hoch Exponent bei 80, du kannst also nur 2er Potenzen darstellen was bei hohen werten zu Ungenauigkeit führt

Antworten