Große Ganz- und Realzahlen

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:
Kontaktdaten von heizkoerper

Große Ganz- und Realzahlen

Beitrag von heizkoerper »

Hallo fleissige Programmierer,

ich habe schon einmal eine Unit für große Ganzzahlen vorgestellt.

Diese habe ich in der Zwischenzeit überarbeitet und durch Proceduren für große Realzahlen ergänzt.

Ich wünsche viel Spaß beim Ausprobieren und hoffe auf kritische Anmerkungen.

Hier nun die Unit:

Code: Alles auswählen

 
Unit BigMathe; //19.02.2018
 
Interface
 
Function AdditionInteger(Zahl1,Zahl2:String):String;
Function AdditionReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Function SubtraktionInteger(Zahl1,Zahl2:String):String;
Function SubtraktionReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Function MultiplikationInteger(Zahl1,Zahl2:String):String;
Function MultiplikationReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Function DivisionInteger(Zahl1,Zahl2:String):String;
Function DivisionReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Function ModuloInteger(Zahl1,Zahl2:String):String;
Function FakultaetInteger(x:String):String;
Function FakultaetReal(x:String;Nachkommastellen:Integer):String;
Function ggTInteger(x,y:String):String;
Function kgVInteger(x,y:String):String;
Function WurzelReal(x:String;Nachkommastellen:Integer):String;
 
// Die Integer-Zahlen können pascalmäßigig mit oder ohne Vorzeichen eingegeben werden.
// z.B. 5, -5 oder +5.
// Die Real-Zahlen können pascalmäßig mit oder ohne Vorzeichen
// und mit oder ohne Exponenten eingegeben werden.
// z.B. 500.5, -500.5, +500.5, 1.2345e13, -12.3456E-12 etc.
// Die Größe des Exponenten ist beschränkt auf die Extended-Zahlen.
 
Implementation
 
Const ErgebnisFehler    =1E4900;
      LaengeInt64       =16;
      MaximalInt64:Int64=Trunc(1E16);
 
Function IntToStr(n:Int64):String;
Var S:String;
Begin Str(n,S);IntToStr:=S End;
 
Function Value(s:String):Extended;
Var Fehler:Integer;
    Zahl  :Extended;
Begin
 Val(s,Zahl,Fehler);
 If Fehler<>0 Then Value:=ErgebnisFehler Else Value:=Zahl
End;
 
Function VorzeichenErgaenzen(s:String):String;
Begin
 If s[1]='+' Then s[1]:=' ';
 If (s[1]>='0') And (s[1]<='9') Then s:=' '+s;
 VorzeichenErgaenzen:=s
End;
 
Function StringVerkuerzenInteger(s:String):String;
Var i:Integer;
    h:String;
    c:Char;
Begin
 If Int(Value(s))=0 Then Begin StringVerkuerzenInteger:=' 0';Exit End;
 c:=s[1];i:=2;
 While s[i]='0' Do Inc(i);
 h:=c+Copy(s,i,Length(s)-i+1);
 If (h=' ') Or (h='+') Or (h='-') Then h:=' 0';
 If h='-0' Then h:=' 0';
 StringVerkuerzenInteger:=h
End;
 
Function StringVerkuerzenReal(s:String):String;
Var i,Laenge,Expo     :Integer;
    z                 :String;
    GroesserNull,Komma:Boolean;
Begin
 If Value(s)=0 Then Begin StringVerkuerzenReal:=' 0E0';Exit End;
 z:=s[1];GroesserNull:=False;Laenge:=Length(s);
 For i:=2 To Laenge Do
  If (s[i+1]='.') Or (s[i]>'0') Or GroesserNull Then
   Begin z:=z+s[i];GroesserNull:=True End;
 If z=s[1] Then z:=z+'0';
 If z='-0' Then z:=' 0';
 Komma:=False;Expo:=0;Laenge:=Length(z);
 For i:=2 To Laenge Do
  Begin
   If z[i]='.' Then Komma:=True;
   If (z[i]='e') Or (z[i]='E') Then Expo:=i-1
  End;
 If Komma Then
  If Expo=0 Then
   While z[Length(z)]='0' Do z:=Copy(z,1,Length(z)-1)
            Else
   Begin
    While z[Expo]='0' Do Begin Delete(z,Expo,1);Dec(Expo) End;
    If (Copy(z,Expo,2)='.e') Or (Copy(z,Expo,2)='.E') Then Delete(z,Expo,1)
   End;
 StringVerkuerzenReal:=z
End;
 
Function StringVerlaengernInteger(s,Null:String):String;
Var Laenge:Integer;
Begin
 Laenge:=Length(s);
 StringVerlaengernInteger:=s[1]+Copy(Null,1,Length(Null)-Laenge+1)+Copy(s,2,Laenge)
End;
 
Function ExponentBestimmenReal(s:String):Integer;
Var i,Laenge:Integer;
Begin
 Laenge:=Length(s);
 For i:=2 To Laenge Do
  If (s[i]='e') Or (s[i]='E') Then
   Begin ExponentBestimmenReal:=Trunc(Value(Copy(s,i+1,Laenge)));Exit End;
 ExponentBestimmenReal:=0
End;
 
Function RealzahlTeilen(s:String):String;
Var i,Laenge:Integer;
Begin
 Laenge:=Length(s);
 For i:=2 To Laenge Do
  If (s[i]='e') Or (s[i]='E') Then Begin RealzahlTeilen:=Copy(s,1,i-1);Exit End;
 RealzahlTeilen:=s
End;
 
Function GroesserInteger(s1,s2:String):Boolean;
Var Laenge1,Laenge2:Integer;
Begin
 s1:=StringVerkuerzenInteger(s1);s2:=StringVerkuerzenInteger(s2);
 If s1=s2 Then Begin GroesserInteger:=False;Exit End;
 Laenge1:=Length(s1);Laenge2:=Length(s2);
 If (s1[1]=' ') And (s2[1]='-') Then Begin GroesserInteger:=True;Exit End;
 If (s1[1]='-') And (s2[1]=' ') Then Begin GroesserInteger:=False;Exit End;
 If (s1[1]=' ') And (s2[1]=' ') Then
  Begin
   If Laenge1>Laenge2 Then Begin GroesserInteger:=True;Exit End;
   If Laenge1<Laenge2 Then Begin GroesserInteger:=False;Exit End;
   If s1>s2 Then Begin GroesserInteger:=True;Exit End;
   GroesserInteger:=False;Exit
  End;
 If (s1[1]='-') And (s2[1]='-') Then
  Begin
   If Laenge1>Laenge2 Then Begin GroesserInteger:=False;Exit End;
   If Laenge1<Laenge2 Then Begin GroesserInteger:=True;Exit End;
   If s1>s2 Then Begin GroesserInteger:=False;Exit End;
   GroesserInteger:=True;Exit
  End;
 GroesserInteger:=False
End;
 
Function GroesserGleichInteger(s1,s2:String):Boolean;
Begin
 s1:=StringVerkuerzenInteger(s1);s2:=StringVerkuerzenInteger(s2);
 If s1=s2 Then Begin GroesserGleichInteger:=True;Exit End;
 GroesserGleichInteger:=GroesserInteger(s1,s2)
End;
 
Function RealToString(z:Extended;Differenz:Integer):String;
Var e,i,Laenge:Integer;
    s         :String;
Begin
 z:=Int(z);Str(z,s);Laenge:=Length(s);e:=0;
 For i:=Laenge DownTo 1 Do
  If (s[i]='E') Or (s[i]='e') Then
   Begin e:=Trunc(Value(Copy(s,i+1,Laenge)));s:=Copy(s,1,i-1);Break End;
 s:=Copy(s,1,2)+Copy(s,4,Length(s));Laenge:=Length(s);
 If Laenge>e Then Begin RealToString:=Copy(s,1,e+2);Exit End;
 s:=AdditionInteger(s,VorzeichenErgaenzen(IntToStr(Differenz)));
 s:=s+StringOfChar('0',e+2-Laenge);RealToString:=s
End;
 
Function RealzahlNormalisieren(s:String;Var e:Integer):String;
Var i,Komma,Laenge:Integer;
    t             :String;
Begin
 Komma:=0;Laenge:=Length(s);
 For i:=2 To Laenge Do
  If s[i]='.' Then Begin Komma:=i-1;Break End;
 If Komma=0 Then Begin Komma:=Laenge;s:=s+'.' End;
 If Copy(s,2,2)<>'0.' Then e:=e+Komma-2
                      Else
  Begin
   Komma:=1;
   For i:=4 To Laenge Do
    If s[i]<>'0' Then Begin Komma:=i-3;Break End;
   e:=e-Komma
  End;
 t:=s[1];
 For i:=2 To Laenge Do
  If s[i]<>'.' Then t:=t+s[i];
 t:=StringVerkuerzenReal(t);
 If Int(Value(t))=0 Then e:=0;
 RealzahlNormalisieren:=t
End;
 
Function AdditionInteger(Zahl1,Zahl2:String):String;
Var Ergebnis,Null:String;
    i,Laenge  :Integer;
    Vz1,Vz2,Vz:Boolean;
    z         :Int64;
    CF        :Byte;
    Val1,Val2 :Extended;
Begin
 If Zahl1='' Then
  Begin
   AdditionInteger:='? Falsches erstes Argument bei der Integer-Addition!';Exit
  End;
 If Zahl2='' Then
  Begin
   AdditionInteger:='? Falsches zweites Argument bei der Integer-Addition!';Exit
  End;
 If Zahl1[1]='?' Then Begin AdditionInteger:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin AdditionInteger:=Zahl2;Exit End;
 Val1:=Int(Value(Zahl1));Val2:=Int(Value(Zahl2));
 If Not(Abs(Val1)<ErgebnisFehler) Then
  Begin AdditionInteger:='? Falsches erstes Argument bei der Integer-Addition!';Exit End;
 If Not(Abs(Val2)<ErgebnisFehler) Then
  Begin AdditionInteger:='? Falsches zweites Argument bei der Integer-Addition!';Exit End;
 Zahl1:=VorzeichenErgaenzen(Zahl1);Zahl2:=VorzeichenErgaenzen(Zahl2);
 If Zahl1[1]='-' Then Vz1:=True Else Vz1:=False;
 If Zahl2[1]='-' Then Vz2:=True Else Vz2:=False;
 If Length(Zahl1)>=Length(Zahl2) Then Laenge:=Length(Zahl1) Else Laenge:=Length(Zahl2);
 Null:=StringOfChar('0',(Laenge Div LaengeInt64+1)*LaengeInt64);
 Zahl1[1]:=' ';Zahl1:=StringVerlaengernInteger(Zahl1,Null);
 Zahl2[1]:=' ';Zahl2:=StringVerlaengernInteger(Zahl2,Null);Vz:=False;
 If (Vz1 And Not(Vz2)) Or (Vz2 And Not(Vz1)) Then
  Begin
   Ergebnis:=SubtraktionInteger(Zahl1,Zahl2);
   If Ergebnis[1]='-' Then If Vz2 Then Vz:=True Else
                      Else If Vz1 Then Vz:=True
  End
                                             Else
  Begin
   If Vz1 And Vz2 Then Vz:=True;
   Ergebnis:='';i:=Length(Zahl1);CF:=0;
   While i>LaengeInt64 Do
    Begin
     z:=Trunc(Value(Copy(Zahl1,i-LaengeInt64+1,LaengeInt64)))+
        Trunc(Value(Copy(Zahl2,i-LaengeInt64+1,LaengeInt64)))+CF;
     If z>=MaximalInt64 Then Begin Dec(z,MaximalInt64);CF:=1 End Else CF:=0;
     Null:=IntToStr(z);Laenge:=Length(Null);
     If Laenge<LaengeInt64 Then Ergebnis:=StringOfChar('0',LaengeInt64-Laenge)+Null+Ergebnis
                           Else Ergebnis:=Null+Ergebnis;
     Dec(i,LaengeInt64)
    End;
   Ergebnis:=StringVerkuerzenInteger(' '+Ergebnis)
  End;
 If Vz Then Ergebnis[1]:='-' Else Ergebnis[1]:=' ';
 If Ergebnis='-0' Then Ergebnis:=' 0';
 AdditionInteger:=Ergebnis
End;
 
Function AdditionReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Var Ergebnis,s           :String;
    Exp1,Exp2,Expo,Laenge:Integer;
Begin
 If Zahl1='' Then
  Begin AdditionReal:='? Falsches erstes Argument bei der Real-Addition!';Exit End;
 If Zahl2='' Then
  Begin AdditionReal:='? Falsches zweites Argument bei der Real-Addition!';Exit End;
 If Zahl1[1]='?' Then Begin AdditionReal:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin AdditionReal:=Zahl2;Exit End;
 If Not(Abs(Value(Zahl1))<ErgebnisFehler) Then
  Begin AdditionReal:='? Falsches erstes Argument bei der Real-Addition!';Exit End;
 If Not(Abs(Value(Zahl2))<ErgebnisFehler) Then
  Begin AdditionReal:='? Falsches zweites Argument bei der Real-Addition!';Exit End;
 Zahl1:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl1));
 Zahl2:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl2));
 Exp1:=ExponentBestimmenReal(Zahl1);Exp2:=ExponentBestimmenReal(Zahl2);
 Zahl1:=RealzahlNormalisieren(RealzahlTeilen(Zahl1),Exp1);
 Zahl2:=RealzahlNormalisieren(RealzahlTeilen(Zahl2),Exp2);
 If Exp1=Exp2 Then
  Begin
   If Length(Zahl1)>Length(Zahl2) Then Zahl2:=Zahl2+StringOfChar('0',Length(Zahl1)-Length(Zahl2))
                                  Else Zahl1:=Zahl1+StringOfChar('0',Length(Zahl2)-Length(Zahl1));
   Ergebnis:=AdditionInteger(Zahl1,Zahl2);Expo:=Exp1+Length(Ergebnis)-Length(Zahl1)
  End;
 If Exp1>Exp2 Then
  Begin
   If Length(Zahl2)>Length(Zahl1) Then Zahl1:=Zahl1+StringOfChar('0',Length(Zahl2)-Length(Zahl1)+Exp1-Exp2)
                                  Else
    Begin Zahl2:=Zahl2+StringOfChar('0',Length(Zahl1)-Length(Zahl2));Zahl1:=Zahl1+StringOfChar('0',Exp1-Exp2) End;
   If Length(Zahl1)>Length(Zahl2) Then Laenge:=Length(Zahl1) Else Laenge:=Length(Zahl2);
   Ergebnis:=AdditionInteger(Zahl1,Zahl2);Expo:=Exp1+Length(Ergebnis)-Laenge
  End;
 If Exp2>Exp1 Then
  Begin
   If Length(Zahl1)>Length(Zahl2) Then Zahl2:=Zahl2+StringOfChar('0',Length(Zahl1)-Length(Zahl2)+Exp2-Exp1)
                                  Else
    Begin Zahl1:=Zahl1+StringOfChar('0',Length(Zahl2)-Length(Zahl1));Zahl2:=Zahl2+StringOfChar('0',Exp2-Exp1) End;
   If Length(Zahl1)>Length(Zahl2) Then Laenge:=Length(Zahl1) Else Laenge:=Length(Zahl2);
   Ergebnis:=AdditionInteger(Zahl1,Zahl2);Expo:=Exp2+Length(Ergebnis)-Laenge
  End;
 Str(Expo,s);
 Ergebnis:=Ergebnis+StringOfChar('0',Nachkommastellen+5);Ergebnis:=Copy(Ergebnis,1,Nachkommastellen+1);
 AdditionReal:=StringVerkuerzenReal(Copy(Ergebnis,1,2)+'.'+Copy(Ergebnis,3,Length(Ergebnis))+'E'+s)
End;
 
Function SubtraktionInteger(Zahl1,Zahl2:String):String;
Var Ergebnis,Null:String;
    i,Laenge  :Integer;
    Vz1,Vz2,Vz:Boolean;
    z         :Int64;
    BF        :Byte;
    Val1,Val2 :Extended;
Begin
 If Zahl1='' Then
  Begin
   SubtraktionInteger:='? Falsches erstes Argument bei der Integer-Subtraktion!';Exit
  End;
 If Zahl2='' Then
  Begin
   SubtraktionInteger:='? Falsches zweites Argument bei der Integer-Subtraktion!';Exit
  End;
 If Zahl1[1]='?' Then Begin SubtraktionInteger:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin SubtraktionInteger:=Zahl2;Exit End;
 Val1:=Int(Value(Zahl1));Val2:=Int(Value(Zahl2));
 If Not(Abs(Val1)<ErgebnisFehler) Then
  Begin SubtraktionInteger:='? Falsches erstes Argument bei der Integer-Subtraktion!';Exit End;
 If Not(Abs(Val2)<ErgebnisFehler) Then
  Begin SubtraktionInteger:='? Falsches zweites Argument bei der Integer-Subtraktion!';Exit End;
 Zahl1:=VorzeichenErgaenzen(Zahl1);Zahl2:=VorzeichenErgaenzen(Zahl2);
 If Zahl1[1]='-' Then Vz1:=True Else Vz1:=False;
 If Zahl2[1]='-' Then Vz2:=True Else Vz2:=False;
 If Length(Zahl1)>=Length(Zahl2) Then Laenge:=Length(Zahl1)
                                 Else Laenge:=Length(Zahl2);
 Null:=StringOfChar('0',(Laenge Div LaengeInt64+1)*LaengeInt64);
 Zahl1[1]:=' ';Zahl1:=StringVerlaengernInteger(Zahl1,Null);
 Zahl2[1]:=' ';Zahl2:=StringVerlaengernInteger(Zahl2,Null);Vz:=False;
 If (Vz1 And Not(Vz2)) Or (Vz2 And Not(Vz1)) Then
  Begin
   Ergebnis:=AdditionInteger(Zahl1,Zahl2);
   If Vz1 Then Vz:=True
  End
                                             Else
  Begin
   If GroesserInteger(Zahl2,Zahl1) Then
    Begin
     Ergebnis:=Zahl1;Zahl1:=Zahl2;Zahl2:=Ergebnis;
     If Not(Vz1) And Not(Vz2) Then Vz:=True
    End
                                   Else If Vz1 and Vz2 Then Vz:=True;
   Ergebnis:='';i:=Length(Zahl1);BF:=0;
   While i>LaengeInt64 Do
    Begin
     z:=Trunc(Value(Copy(Zahl1,i-LaengeInt64+1,LaengeInt64)))-
        Trunc(Value(Copy(Zahl2,i-LaengeInt64+1,LaengeInt64)))-BF;
     If z<0 Then Begin Inc(z,MaximalInt64);BF:=1 End Else BF:=0;
     Null:=IntToStr(z);Laenge:=Length(Null);
     If Laenge<LaengeInt64 Then Ergebnis:=StringOfChar('0',LaengeInt64-Laenge)+Null+Ergebnis
                           Else Ergebnis:=Null+Ergebnis;
     Dec(i,LaengeInt64)
    End;
    Ergebnis:=StringVerkuerzenInteger(' '+Ergebnis)
  End;
 If Vz Then Ergebnis[1]:='-' Else Ergebnis[1]:=' ';
 If Ergebnis='-0' Then Ergebnis:=' 0';
 SubtraktionInteger:=Ergebnis
End;
 
Function SubtraktionReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Var Ergebnis,s           :String;
    Exp1,Exp2,Expo,Laenge:Integer;
Begin
 If Zahl1='' Then
  Begin SubtraktionReal:='? Falsches erstes Argument bei der Real-Subtraktion!';Exit End;
 If Zahl2='' Then
  Begin SubtraktionReal:='? Falsches zweites Argument bei der Real-Subtraktion!';Exit End;
 If Zahl1[1]='?' Then Begin SubtraktionReal:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin SubtraktionReal:=Zahl2;Exit End;
 If Not(Abs(Value(Zahl1))<ErgebnisFehler) Then
  Begin SubtraktionReal:='? Falsches erstes Argument bei der Real-Subtraktion!';Exit End;
 If Not(Abs(Value(Zahl2))<ErgebnisFehler) Then
  Begin SubtraktionReal:='? Falsches zweites Argument bei der Real-Subtraktion!';Exit End;
 Zahl1:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl1));
 Zahl2:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl2));
 Exp1:=ExponentBestimmenReal(Zahl1);Exp2:=ExponentBestimmenReal(Zahl2);
 Zahl1:=RealzahlNormalisieren(RealzahlTeilen(Zahl1),Exp1);
 Zahl2:=RealzahlNormalisieren(RealzahlTeilen(Zahl2),Exp2);
 If Exp1=Exp2 Then
  Begin
   If Length(Zahl1)>Length(Zahl2) Then Zahl2:=Zahl2+StringOfChar('0',Length(Zahl1)-Length(Zahl2))
                                  Else Zahl1:=Zahl1+StringOfChar('0',Length(Zahl2)-Length(Zahl1));
   Ergebnis:=SubtraktionInteger(Zahl1,Zahl2);Expo:=Exp1+Length(Ergebnis)-Length(Zahl1)
  End;
 If Exp1>Exp2 Then
  Begin
   If Length(Zahl2)>Length(Zahl1) Then Zahl1:=Zahl1+StringOfChar('0',Length(Zahl2)-Length(Zahl1)+Exp1-Exp2)
                                  Else
    Begin Zahl2:=Zahl2+StringOfChar('0',Length(Zahl1)-Length(Zahl2));Zahl1:=Zahl1+StringOfChar('0',Exp1-Exp2) End;
   If Length(Zahl1)>Length(Zahl2) Then Laenge:=Length(Zahl1) Else Laenge:=Length(Zahl2);
   Ergebnis:=SubtraktionInteger(Zahl1,Zahl2);Expo:=Exp1+Length(Ergebnis)-Laenge
  End;
 If Exp2>Exp1 Then
  Begin
   If Length(Zahl1)>Length(Zahl2) Then Zahl2:=Zahl2+StringOfChar('0',Length(Zahl1)-Length(Zahl2)+Exp2-Exp1)
                                  Else
    Begin Zahl1:=Zahl1+StringOfChar('0',Length(Zahl2)-Length(Zahl1));Zahl2:=Zahl2+StringOfChar('0',Exp2-Exp1) End;
   If Length(Zahl1)>Length(Zahl2) Then Laenge:=Length(Zahl1) Else Laenge:=Length(Zahl2);
   Ergebnis:=SubtraktionInteger(Zahl1,Zahl2);Expo:=Exp2+Length(Ergebnis)-Laenge
  End;
 Str(Expo,s);
 Ergebnis:=Ergebnis+StringOfChar('0',Nachkommastellen+5);Ergebnis:=Copy(Ergebnis,1,Nachkommastellen+1);
 SubtraktionReal:=StringVerkuerzenReal(Copy(Ergebnis,1,2)+'.'+Copy(Ergebnis,3,Length(Ergebnis))+'E'+s)
End;
 
Function MultiplikationInteger(Zahl1,Zahl2:String):String;
Var i,l,Laenge2:Integer;
    Ergebnis :String;
    Vz1,Vz2  :Boolean;
    Val1,Val2:Extended;
    Produkt  :Array[1..9] Of String;
Begin
 If Zahl1='' Then
  Begin
   MultiplikationInteger:='? Falsches erstes Argument bei der Integer-Multiplikation!';Exit
  End;
 If Zahl2='' Then
  Begin
   MultiplikationInteger:='? Falsches zweites Argument bei der Integer-Multiplikation!';Exit
  End;
 If Zahl1[1]='?' Then Begin MultiplikationInteger:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin MultiplikationInteger:=Zahl2;Exit End;
 Val1:=Int(Value(Zahl1));Val2:=Int(Value(Zahl2));
 If Not(Abs(Val1)<ErgebnisFehler) Then
  Begin MultiplikationInteger:='? Falsches erstes Argument bei der Integer-Multiplikation!';Exit End;
 If Not(Abs(Val2)<ErgebnisFehler) Then
  Begin MultiplikationInteger:='? Falsches zweites Argument bei der Integer-Multiplikation!';Exit End;
 Zahl1:=VorzeichenErgaenzen(Zahl1);Zahl2:=VorzeichenErgaenzen(Zahl2);
 If (Val1=0) Or (Val2=0) Then Begin MultiplikationInteger:=' 0';Exit End;
 If Zahl1[1]='-' Then Vz1:=True Else Vz1:=False;
 If Zahl2[1]='-' Then Vz2:=True Else Vz2:=False;
 If Length(Zahl2)>Length(Zahl1) Then Begin Ergebnis:=Zahl1;Zahl1:=Zahl2;Zahl2:=Ergebnis End;
 Laenge2:=Length(Zahl2);Ergebnis:=Zahl1;Produkt[1]:=Zahl1;
 For i:=2 To 9 Do
  Begin Ergebnis:=AdditionInteger(Ergebnis,Zahl1);Produkt[i]:=Ergebnis End;
 Ergebnis:='0';
 For i:=2 To Laenge2 Do
  Begin
   l:=Trunc(Value(Zahl2[i]));
   If l>0 Then Ergebnis:=AdditionInteger(Ergebnis,Produkt[l]+StringOfChar('0',Laenge2-i))
  End;
 If ((Vz1 And Not(Vz2)) Or (Not(Vz1) And Vz2)) Then Ergebnis[1]:='-' Else Ergebnis[1]:=' ';
 If Ergebnis='-0' Then Ergebnis:=' 0';
 MultiplikationInteger:=Ergebnis
End;
 
Function MultiplikationReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Var Ergebnis,s    :String;
    Exp1,Exp2,Expo:Integer;
Begin
 If Zahl1='' Then
  Begin
   MultiplikationReal:='? Falsches erstes Argument bei der Real-Multiplikation!';Exit
  End;
 If Zahl2='' Then
  Begin
   MultiplikationReal:='? Falsches zweites Argument bei der Real-Multiplikation!';Exit
  End;
 If Zahl1[1]='?' Then Begin MultiplikationReal:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin MultiplikationReal:=Zahl2;Exit End;
 If Not(Abs(Value(Zahl1))<ErgebnisFehler) Then
  Begin MultiplikationReal:='? Falsches erstes Argument bei der Real-Multiplikation!';Exit End;
 If Not(Abs(Value(Zahl2))<ErgebnisFehler) Then
  Begin MultiplikationReal:='? Falsches zweites Argument bei der Real-Multiplikation!';Exit End;
 Zahl1:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl1));
 Zahl2:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl2));
 Exp1:=ExponentBestimmenReal(Zahl1);Exp2:=ExponentBestimmenReal(Zahl2);
 Zahl1:=RealzahlNormalisieren(RealzahlTeilen(Zahl1),Exp1);
 Zahl2:=RealzahlNormalisieren(RealzahlTeilen(Zahl2),Exp2);
 Ergebnis:=MultiplikationInteger(Zahl1,Zahl2);Expo:=Exp1+Exp2;
 If Value(Ergebnis)=0 Then Begin MultiplikationReal:=' 0E0';Exit End;
 If Length(Ergebnis)>=Length(Zahl1)+Length(Zahl2)-1 Then Inc(Expo);
 Str(Expo,s);Ergebnis:=Ergebnis+StringOfChar('0',Nachkommastellen+5);
 Ergebnis:=Copy(Ergebnis,1,Nachkommastellen+1);
 MultiplikationReal:=StringVerkuerzenReal(Copy(Ergebnis,1,2)+'.'+
  Copy(Ergebnis,3,Length(Ergebnis))+'E'+s)
End;
 
Function DivisionInteger(Zahl1,Zahl2:String):String;
Var Ergebnis,Quotient:String;
    Vz1,Vz2          :Boolean;
    Val1,Val2        :Extended;
Begin
 If Zahl1='' Then
  Begin
   DivisionInteger:='? Falsches erstes Argument bei der Integer-Division!';Exit
  End;
 If Zahl2='' Then
  Begin
   DivisionInteger:='? Falsches zweites Argument bei der Integer-Division!';Exit
  End;
 If Zahl1[1]='?' Then Begin DivisionInteger:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin DivisionInteger:=Zahl2;Exit End;
 Val1:=Int(Value(Zahl1));Val2:=Int(Value(Zahl2));
 If Not(Abs(Val1)<ErgebnisFehler) Then
  Begin DivisionInteger:='? Falsches erstes Argument bei der Integer-Division!';Exit End;
 If Not(Abs(Val2)<ErgebnisFehler) Then
  Begin DivisionInteger:='? Falsches zweites Argument bei der Integer-Division!';Exit End;
 Zahl1:=VorzeichenErgaenzen(Zahl1);Zahl2:=VorzeichenErgaenzen(Zahl2);
 If Val2=0 Then
  Begin DivisionInteger:='? Nicht durch Null teilen bei der Integer-Division!';Exit End;
 If Zahl1[1]='-' Then Vz1:=True Else Vz1:=False;
 If Zahl2[1]='-' Then Vz2:=True Else Vz2:=False;
 Ergebnis:=' 0';Zahl1[1]:=' ';Zahl2[1]:=' ';Val2:=Abs(Val2);
 If (Val1=0) Or GroesserInteger(Zahl2,Zahl1) Then Begin DivisionInteger:=' 0';Exit End;
 While GroesserGleichInteger(Zahl1,Zahl2) Do
  Begin
   Quotient:=RealToString(Value(Zahl1)/Val2,-1);
   Ergebnis:=AdditionInteger(Ergebnis,Quotient);
   Zahl1:=SubtraktionInteger(Zahl1,MultiplikationInteger(Zahl2,Quotient))
  End;
 If ((Vz1 And Not(Vz2)) Or (Not(Vz1) And Vz2)) Then Ergebnis[1]:='-' Else Ergebnis[1]:=' ';
 If Ergebnis='-0' Then Ergebnis:=' 0';
 DivisionInteger:=Ergebnis
End;
 
Function DivisionReal(Zahl1,Zahl2:String;Nachkommastellen:Integer):String;
Var Ergebnis,s    :String;
    Exp1,Exp2,Expo:Integer;
Begin
 If Zahl1='' Then
  Begin DivisionReal:='? Falsches erstes Argument bei der Real-Division!';Exit End;
 If Zahl2='' Then
  Begin DivisionReal:='? Falsches zweites Argument bei der Real-Division!';Exit End;
 If Zahl1[1]='?' Then Begin DivisionReal:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin DivisionReal:=Zahl2;Exit End;
 If Not(Abs(Value(Zahl1))<ErgebnisFehler) Then
  Begin DivisionReal:='? Falsches erstes Argument bei der Real-Division!';Exit End;
 If Not(Abs(Value(Zahl2))<ErgebnisFehler) Then
  Begin DivisionReal:='? Falsches zweites Argument bei der Real-Division!';Exit End;
 If Value(Zahl2)=0 Then
  Begin DivisionReal:='? Nicht durch Null teilen bei der Real-Division!';Exit End;
 Zahl1:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl1));
 Zahl2:=StringVerkuerzenReal(VorzeichenErgaenzen(Zahl2));
 Exp1:=ExponentBestimmenReal(Zahl1);Exp2:=ExponentBestimmenReal(Zahl2);
 Zahl1:=RealzahlNormalisieren(RealzahlTeilen(Zahl1),Exp1);
 Zahl2:=RealzahlNormalisieren(RealzahlTeilen(Zahl2),Exp2);
 Zahl1:=Zahl1+StringOfChar('0',Nachkommastellen+5);
 Ergebnis:=DivisionInteger(Zahl1,Zahl2);Expo:=Exp1-Exp2;
 If Copy(Zahl2,2,Length(Zahl2))>Copy(Zahl1,2,Length(Zahl2)) Then Dec(Expo);
 Str(Expo,s);Ergebnis:=Ergebnis+StringOfChar('0',Nachkommastellen+5);
 Ergebnis:=Copy(Ergebnis,1,Nachkommastellen+1);
 DivisionReal:=StringVerkuerzenReal(Copy(Ergebnis,1,2)+'.'+
  Copy(Ergebnis,3,Length(Ergebnis))+'E'+s)
End; 
 
Function ModuloInteger(Zahl1,Zahl2:String):String;
Var Ergebnis :String;
    Val1,Val2:Extended;
Begin
 If Zahl1='' Then
  Begin ModuloInteger:='? Falsches erstes Argument bei der Modulo-Division!';Exit End;
 If Zahl2='' Then
  Begin ModuloInteger:='? Falsches zweites Argument bei der Modulo-Division!';Exit End;
 If Zahl1[1]='?' Then Begin ModuloInteger:=Zahl1;Exit End;
 If Zahl2[1]='?' Then Begin ModuloInteger:=Zahl2;Exit End;
 Val1:=Int(Value(Zahl1));Val2:=Int(Value(Zahl2));
 If Not(Abs(Val1)<ErgebnisFehler) Then
  Begin ModuloInteger:='? Falsches erstes Argument bei der Modulo-Division!';Exit End;
 If Not(Abs(Val2)<ErgebnisFehler) Then
  Begin ModuloInteger:='? Falsches zweites Argument bei der Modulo-Division!';Exit End;
 If Val2=0 Then
  Begin ModuloInteger:='? Nicht durch Null teilen bei der Modulo-Division!';Exit End;
 ModuloInteger:=SubtraktionInteger(Zahl1,MultiplikationInteger(DivisionInteger(Zahl1,Zahl2),Zahl2))
End;
 
Function FakultaetInteger(x:String):String;
Var i,xx      :Integer;
    j,Ergebnis:String;
    Valx      :Extended;
Begin
 If x='' Then
  Begin FakultaetInteger:='? Falsches Argument bei der Integer-Fakultät!';Exit End;
 If x[1]='?' Then Begin FakultaetInteger:=x;Exit End;
 Valx:=Int(Value(x));
 If Not(Abs(Valx)<ErgebnisFehler) Then
  Begin FakultaetInteger:='? Falsches Argument bei der Integer-Fakultät!';Exit End;
 x:=VorzeichenErgaenzen(x);
 If Valx<0 Then
  Begin
   FakultaetInteger:='? Das Argument bei der Integer-Fakultät muss mindestens Null sein!';Exit
  End;
 If Valx>500 Then
  Begin
   FakultaetInteger:='? Das Argument bei der Integer-Fakultät darf höchstens 500 sein!';Exit
  End;
 If Valx<2 Then Begin FakultaetInteger:=' 1';Exit End;
 Ergebnis:=' 1';j:=Ergebnis;xx:=Trunc(Valx);
 For i:=1 To xx Do
  Begin Ergebnis:=MultiplikationInteger(Ergebnis,j);j:=AdditionInteger(j,' 1') End;
 FakultaetInteger:=Ergebnis
End;
 
Function FakultaetReal(x:String;Nachkommastellen:Integer):String;
Var i,xx      :Integer;
    j,Ergebnis:String;
    Valx      :Extended;
Begin
 If x='' Then
  Begin FakultaetReal:='? Falsches Argument bei der Real-Fakultät!';Exit End;
 If x[1]='?' Then Begin FakultaetReal:=x;Exit End;
 Valx:=Value(x);
 If Not(Abs(Valx)<ErgebnisFehler) Then
  Begin FakultaetReal:='? Falsches Argument bei der Real-Fakultät!';Exit End;
 x:=StringVerkuerzenReal(VorzeichenErgaenzen(x));
 If Valx<0 Then
  Begin
   FakultaetReal:='? Das Argument bei der Real-Fakultät muss mindestens Null sein!';Exit
  End;
 If Valx>500 Then
  Begin
   FakultaetReal:='? Das Argument bei der Real-Fakultät darf höchstens 500 sein!';Exit
  End;
 If Valx<2 Then Begin FakultaetReal:=' 1E0';Exit End;
 Ergebnis:=' 1';j:=Ergebnis;xx:=Trunc(Valx);
 For i:=1 To xx Do
  Begin Ergebnis:=MultiplikationInteger(Ergebnis,j);j:=AdditionInteger(j,' 1') End;
 xx:=Length(Ergebnis)-2;Str(xx,j);
 Ergebnis:=Ergebnis+StringOfChar('0',Nachkommastellen+5);
 Ergebnis:=Copy(Ergebnis,1,Nachkommastellen+1);
 FakultaetReal:=StringVerkuerzenReal(Copy(Ergebnis,1,2)+'.'+
  Copy(Ergebnis,3,Length(Ergebnis))+'E'+j)
End;
 
Function ggTInteger(x,y:String):String;
Var h        :String;
    Valx,Valy:Extended;
Begin
 If x='' Then Begin ggTInteger:='? Falsches erstes Argument beim ggT!';Exit End;
 If y='' Then Begin ggTInteger:='? Falsches zweites Argument beim ggT!';Exit End;
 If x[1]='?' Then Begin ggTInteger:=x;Exit End;
 If y[1]='?' Then Begin ggTInteger:=y;Exit End;
 Valx:=Value(x);Valy:=Value(y);
 If Not(Abs(Valx)<ErgebnisFehler) Then
  Begin ggTInteger:='? Falsches erstes Argument beim ggT!';Exit End;
 If Not(Abs(Valy)<ErgebnisFehler) Then
  Begin ggTInteger:='? Falsches zweites Argument beim ggT!';Exit End;
 If Valx<1 Then
  Begin
   ggTInteger:='? Das erste Argument beim ggT muss mindestens 1 betragen!';Exit
  End;
 If Valy<1 Then
  Begin
   ggTInteger:='? Das zweite Argument beim ggT muss mindestens 1 betragen!';Exit
  End;
 x:=VorzeichenErgaenzen(x);y:=VorzeichenErgaenzen(y);h:=x;
 While GroesserInteger(h,' 0') Do Begin x:=y;y:=h;h:=ModuloInteger(x,y) End;
 ggTInteger:=StringVerkuerzenInteger(y)
End;
 
Function kgVInteger(x,y:String):String;
Var Valx,Valy:Extended;
Begin
 If x='' Then Begin kgVInteger:='? Falsches erstes Argument beim kgV!';Exit End;
 If y='' Then Begin kgVInteger:='? Falsches zweites Argument beim kgV!';Exit End;
 If x[1]='?' Then Begin kgVInteger:=x;Exit End;
 If y[1]='?' Then Begin kgVInteger:=y;Exit End;
 Valx:=Value(x);Valy:=Value(y);
 If Not(Abs(Valx)<ErgebnisFehler) Then
  Begin kgVInteger:='? Falsches erstes Argument beim kgV!';Exit End;
 If Not(Abs(Valy)<ErgebnisFehler) Then
  Begin kgVInteger:='? Falsches zweites Argument beim kgV!';Exit End;
 If Valx<1 Then
  Begin
   kgVInteger:='? Das erste Argument beim kgV muss mindestens 1 betragen!';Exit
  End;
 If Valy<1 Then
  Begin
   kgVInteger:='? Das zweite Argument beim kgV muss mindestens 1 betragen!';Exit
  End;
 x:=VorzeichenErgaenzen(x);y:=VorzeichenErgaenzen(y);
 kgVInteger:=DivisionInteger(MultiplikationInteger(x,y),ggTInteger(x,y))
End;
 
Function WurzelReal(x:String;Nachkommastellen:Integer):String;
Var   ErgebnisAlt,ErgebnisNeu:String;
      Valx,Epsilon           :Extended;
      Exp1,Zaehler           :Integer;
Begin
 If x='' Then
  Begin WurzelReal:='? Falsches Argument bei der Wurzelberechnung!';Exit End;
 If x[1]='?' Then Begin WurzelReal:=x;Exit End;
 Valx:=Value(x);Zaehler:=1;Epsilon:=Exp(-(Nachkommastellen+5)*Ln(10));
 If Not(Abs(Valx)<ErgebnisFehler) Then
  Begin WurzelReal:='? Falsches Argument bei der Wurzelberechnung!';Exit End;
 If Valx<0 Then
  Begin
   WurzelReal:='? Das Argument bei der Wurzel muss mindestens null sein!';Exit
  End;
 If Valx=0 Then Begin WurzelReal:=' 0';Exit End;
 x:=StringVerkuerzenReal(VorzeichenErgaenzen(x));Exp1:=ExponentBestimmenReal(x);
 ErgebnisAlt:=RealzahlNormalisieren(RealzahlTeilen(x),Exp1);
 ErgebnisAlt:=Copy(ErgebnisAlt,1,2)+'.'+Copy(ErgebnisAlt,3,Length(ErgebnisAlt))+
  'E'+IntToStr(Exp1 Div 2);
 Repeat
  ErgebnisNeu:=SubtraktionReal(ErgebnisAlt,DivisionReal(SubtraktionReal(MultiplikationReal(ErgebnisAlt,
                ErgebnisAlt,Nachkommastellen),x,Nachkommastellen),MultiplikationReal(' 2',
                 ErgebnisAlt,Nachkommastellen),Nachkommastellen),Nachkommastellen);
  If Abs(Value(SubtraktionReal(ErgebnisNeu,ErgebnisAlt,Nachkommastellen)))<Epsilon Then
   Begin WurzelReal:=ErgebnisNeu;Exit End;
  ErgebnisAlt:=ErgebnisNeu;Inc(Zaehler)
 Until Zaehler>100;
 WurzelReal:='? Keine Lösung gefunden bei der Wurzelberechnung!'
End;
 
End.
Viele Güße vom Heizkörper.
Zuletzt geändert von m.fuchs am Mo 19. Feb 2018, 18:16, insgesamt 1-mal geändert.
Grund: Highlighter gesetzt
Nach oben
Mathias
Beiträge: 6910
Registriert: Do 2. Jan 2014, 17:21
OS, Lazarus, FPC: Linux (die neusten Trunk)
CPU-Target: 64Bit
Wohnort: Schweiz

Re: Große Ganz- und Realzahlen

Beitrag von Mathias »

Bitte setze deinen Code in Code-Tags, dann wird ihn vielleicht jemand lesen. :wink:
Mit Lazarus sehe ich grün
Mit Java und C/C++ sehe ich rot
Nach oben
mschnell
Beiträge: 3444
Registriert: Mo 11. Sep 2006, 10:24
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ)
CPU-Target: X32 / X64 / ARMv5
Wohnort: Krefeld

Re: Große Ganz- und Realzahlen

Beitrag von mschnell »

heizkoerper hat geschrieben:ich habe schon einmal eine Unit für große Ganzzahlen vorgestellt.
Was ist daran besser als eine der "offiziellen" Implementierungen in C (und möglicherweise / schneller in Assembler) als Bibliotheksfunktionen einzubinden ?

Gut wäre natürlich die über ANSI-C hinausgehenden Möglichkeiten von Object-Pascal wie Operator Overloading, Reference Counting etc auszunutzen, aber der eigentliche Rechen-Code braucht nicht neu "erfunden" zu werden.

-Michael
Nach oben
Benutzeravatar
Niesi
Lazarusforum e. V.
Beiträge: 586
Registriert: So 26. Jun 2016, 19:44
OS, Lazarus, FPC: Linux Mint Cinnamon, Laz 4.1 Fpc 3.2.3 und allerlei mit FpcUpDeLuxe
Kontaktdaten:
Kontaktdaten von Niesi

Re: Große Ganz- und Realzahlen

Beitrag von Niesi »

heizkoerper hat geschrieben:Hallo fleissige Programmierer,

ich habe schon einmal eine Unit für große Ganzzahlen vorgestellt.

Diese habe ich in der Zwischenzeit überarbeitet und durch Proceduren für große Realzahlen ergänzt.

Ich wünsche viel Spaß beim Ausprobieren und hoffe auf kritische Anmerkungen.

...


Viele Güße vom Heizkörper.

Hallo Heizkoerper,

Danke dafür.

Ich finde es einfach große Klasse, wenn Leute ihr Wissen mit vielen teilen.

Denn:

Wissen ist das einzige Gut, welches sich vermehrt, wenn es geteilt wird.

Ich hoffe, ich kann mich mit Deinen Gedanken und Deinem Code in den nächsten Tagen mal etwas beschäftigen ...

Herzlichen Gruß
Niesi
Wissen ist das einzige Gut, das sich vermehrt, wenn es geteilt wird ...
Nach oben
Horst_h
Beiträge: 74
Registriert: Mi 20. Mär 2013, 08:57

Re: Große Ganz- und Realzahlen

Beitrag von Horst_h »

Hallo,

die Nutzung von GMP ist durch die Verwendung der unit gmp leicht möglich.
Vielleicht fehlt in Windows eine neuere Version der gmp.dll oder libgmp.dll ( einfach umbenennen ) davon

Gruß Horst
Nach oben
relocate
Beiträge: 61
Registriert: Di 24. Jan 2012, 11:47
OS, Lazarus, FPC: Win (L- FPC 2.4.4 + 2.6.4)
CPU-Target: 32Bit

Re: Große Ganz- und Realzahlen

Beitrag von relocate »

Ich für meinen Teil bin begeistert von nativen Umsetzungen ohne auf irgendwelche externen DLLs und Co. angewiesen sein zu müssen.
Mehr davon! :!:
Pascal ist eine mächtige Sprache und nur so kann man das auch zeigen!
Würde ich die Dinge so wie alle anderen machen, hätte ich so manche Probleme nicht.

Aber das wäre langweilig.
Nach oben
mschnell
Beiträge: 3444
Registriert: Mo 11. Sep 2006, 10:24
OS, Lazarus, FPC: svn (Window32, Linux x64, Linux ARM (QNAP) (cross+nativ)
CPU-Target: X32 / X64 / ARMv5
Wohnort: Krefeld

Re: Große Ganz- und Realzahlen

Beitrag von mschnell »

relocate hat geschrieben:ohne auf irgendwelche externen DLLs und Co. angewiesen sein zu müssen.
GMP ist (AFAIK) open Source C Code. lässt sich also mit gcc compilieren und dann statisch in das Lazarus Projekt einbinden. Dann muss allergings vermutlich die GPL berücksichtigt werden.

-Michael
Nach oben
Benutzeravatar
af0815
Lazarusforum e. V.
Beiträge: 6770
Registriert: So 7. Jan 2007, 10:20
OS, Lazarus, FPC: FPC fixes Lazarus fixes per fpcupdeluxe (win,linux,raspi)
CPU-Target: 32Bit (64Bit)
Wohnort: Burgenland
Kontaktdaten:
Kontaktdaten von af0815

Re: Große Ganz- und Realzahlen

Beitrag von af0815 »

BTW:

GNURZ gibt es IMHO auch noch. Siehe http://www.lazarusforum.de/viewtopic.php?f=29&t=2015
Nachdem Lazforge tot ist, hier ist der letzte mir bekannte Code https://github.com/afriess/GNURZ

Andreas

PS: Vielleicht hat Euklid oder mschnell noch aktuelleren Code im Archiv :-)
Blöd kann man ruhig sein, nur zu Helfen muss man sich wissen (oder nachsehen in LazInfos/LazSnippets).
Nach oben
indianer-frank
Beiträge: 134
Registriert: So 30. Nov 2008, 21:53

Re: Große Ganz- und Realzahlen

Beitrag von indianer-frank »

Nicht zu vergessen: MPArith mit Pascal-Source kommt ohne GMP und GPL aus. Einführung und Funktionsliste: http://www.wolfgang-ehrhardt.de/mp_intro.html
Nach oben
Horst_h
Beiträge: 74
Registriert: Mi 20. Mär 2013, 08:57

Re: Große Ganz- und Realzahlen

Beitrag von Horst_h »

Hallo,

mparith, natürlich.Wird sehr gut gepflegt und ständig optimiert und kann sogar manche Dinge schneller als gmp, zum Beispiel primorial und hat auch viele interessante Funktionen.
Aber systembedingt manches nicht.Als ich an prime n-Tupel "herumfrickelte" war gmp 7-fach schneller.
Wenn man es gerne in pure pascal haben möchte ist es eine sehr gute Wahl

Gruß Horst
Nach oben
Antworten

Zurück zu „Units/Komponenten“