Implementierung Langzahlarithmetik

Für Fragen von Einsteigern und Programmieranfängern...
Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Danke für die Antwort. Subtraktion bekommt ja das Ergebnis zurück. Manchmal sieht man den Wald vor lauter Bäumen nicht. Dann mache ich mich mal an die Multiplikation ran. Nochmals ein erleichtertes Danke.
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

siro
Beiträge: 513
Registriert: Di 23. Aug 2016, 14:25
OS, Lazarus, FPC: Windows 10
CPU-Target: 64Bit
Wohnort: Berlin

Re: Implementierung Langzahlarithmetik

Beitrag von siro »

Hallo Neuling,

ich vermute Du hast das mit dem Forward noch nicht richtig gemacht.

Es wird eine ZUSÄTZLICHE Zeile mit dem Programmkopf ganz oben im Code definiert.
Der eigentliche Programmcode für diese Funktion kommt dann erst später, irgendwann.

Daher hier mal dein Code: wobei ich den ausgeklammerten Teil wieder aktiviert habe.
Das lässt sich so einwandfrei compilieren.

Schau Dir das an in der Zeile die ich mit "SIRO" markiert habe.

Code: Alles auswählen

program Lang_Add_Sub_fast_1;

uses
  Crt,Dos,SysUtils;

var
  zahl_1,zahl_2,ergebnis,abbruch,a : String;
  uebergabe : Boolean;

// "SIRO"  der Kopf der Funkction wird vorab definiert
// die eigentliche Funktion kann dann irgendwo dahinter stehen
// so kannst Du von überall aus die Funktion auch aufrufen
function Subtraktion(Zah_1,Zah_2: String): String; forward;

function Gleich(Zah_1,Zah_2: String): Boolean;

var
  i : Integer;
  ziff_zah_1,ziff_zah_2 : String[1];

begin
  if Length(zah_1) < Length(zah_2) then exit(false);
  if Length(zah_2) < Length(zah_1) then exit(false);
  for i := 1 to Length(zah_1) do begin
    ziff_zah_1 := zah_1[i];
    ziff_zah_2 := zah_2[i];
    if ziff_zah_1 <> ziff_zah_2 then exit(false);
  end;
  exit(true);
end;

function Kleiner(Zah_1,Zah_2: String): Boolean;

var
  ziff_1_str,ziff_2_str : String;
  i,j,ziff_1_int,ziff_2_int : Integer;
  klein : Boolean;

begin
  if Gleich(zah_1,Zah_2) = true then exit(false);
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then exit(true);
  end;
  if zah_2[1] = '-' then begin
    if zah_1[1] <> '-' then exit(false);
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Length(zah_1) > Length(zah_2) then exit(true);
      if Length(zah_1) < Length(zah_2) then exit(false);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 2 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int > ziff_2_int then klein := true;
          if ziff_1_int < ziff_2_int then begin
            if klein = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Length(zah_1) < Length(zah_2) then exit(true);
      if Length(zah_1) > Length(zah_2) then exit(false);
      if Length(zah_1) = Length(zah_2) then begin
        for j := 1 to Length(zah_1) do begin
          ziff_1_str := zah_1[j];
          ziff_2_str := zah_2[j];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int < ziff_2_int then klein := true;
          if ziff_1_int > ziff_2_int then begin
            if klein = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  exit(true);
end;

function Groesser(Zah_1,Zah_2: String): Boolean;

var
  ziff_1_str,ziff_2_str : String;
  i,ziff_1_int,ziff_2_int : Integer;
  gross : Boolean;

begin
  if Gleich(zah_1,Zah_2) = true then exit(false);
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then exit(false);
  end;
  if zah_2[1] = '-' then begin
    if zah_1[1] <> '-' then exit(true);
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Length(zah_1) > Length(zah_2) then exit(false);
      if Length(zah_1) < Length(zah_2) then exit(true);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 2 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int < ziff_2_int then gross := true;;
          if ziff_1_int > ziff_2_int then begin
            if gross = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Length(zah_1) < Length(zah_2) then exit(false);
      if Length(zah_1) > Length(zah_2) then exit(true);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 1 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int > ziff_2_int then gross := true;;
          if ziff_1_int < ziff_2_int then begin
            if gross = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  exit(true);
end;

function Addition(zah_1,zah_2: String): String;

var
  ziffer_summe,ziffer_1,ziffer_2,null : String[1];
  summe_1,diff_laenge,summand_1,summand_2,summe : String;
  i,j,k,l,l_s_1,l_s_2,uebertrag,ziff_summ,ziff_summ_1,ziff_1,ziff_2,diff_laen : Integer;
  ergeb_negat,null_str : Boolean;

begin
  uebertrag := 0;
  summe := '';
  summe_1 := '';
  ergeb_negat := false;
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then begin
      Subtraktion(zah_1,zah_2);
      exit(ergebnis);
    end;
  end else                         //   ! Wie ruft man zwei Funktionen gegenseitig auf?
  if zah_1[1] <> '-' then begin
    if zah_2[1] = '-' then begin
      Subtraktion(zah_1,zah_2);
      exit(ergebnis);
    end;
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      delete(zah_1,1,1);
      delete(zah_2,1,1);
      ergeb_negat := true;
    end;
  end;
  summand_1 := zah_1;
  summand_2 := zah_2;
  l_s_1 := Length(summand_1);
  l_s_2 := Length(summand_2);
  if l_s_1 < l_s_2 then begin
    diff_laen := l_s_2 - l_s_1;
    diff_laenge := '';
    null := IntToStr(0);
    for k := 1 to diff_laen do begin
      diff_laenge := diff_laenge + null;
    end;
    summand_1 := diff_laenge + summand_1;
    l_s_1 := Length(summand_1);
  end else
  begin
    diff_laen := l_s_1 - l_s_2;
    diff_laenge := '';
    null := IntToStr(0);
    for k := 1 to diff_laen do begin
      diff_laenge := diff_laenge + null;
    end;
    summand_2 := diff_laenge + summand_2;
    l_s_2 := Length(summand_2);
  end;
  for i := 0 to l_s_1 - 1 do begin
    ziffer_1 := summand_1[l_s_1 - i];
    ziffer_2 := summand_2[l_s_2 - i];
    ziff_1 := StrToInt(ziffer_1);
    ziff_2 := StrToInt(ziffer_2);
    ziff_summ := ziff_1 + ziff_2;
    ziff_summ_1 := 0;
    if ziff_summ > 9 then begin
      ziff_summ_1 := ziff_summ - 10 + uebertrag;
      ziffer_summe := IntToStr(ziff_summ_1);
      summe_1 := summe_1 + ziffer_summe;
      uebertrag := 1;
      if i = l_s_1 - 1 then begin
        summe_1 := summe_1 + '1';
      end;
    end else
    if ziff_summ = 9 then begin
      if uebertrag = 1 then begin
        ziff_summ_1 := ziff_summ - 10 + uebertrag;
        ziffer_summe := IntToStr(ziff_summ_1);
        summe_1 := summe_1 + ziffer_summe;
        uebertrag := 1;
        if i = l_s_1 - 1 then begin
          summe_1 := summe_1 + '1';
        end;
      end else
      if uebertrag = 0 then begin
        ziffer_summe := IntToStr(ziff_summ);
        summe_1 := summe_1 + ziffer_summe;
        uebertrag := 0;
      end;
    end else
    if ziff_summ < 9 then begin
      ziff_summ_1 := ziff_summ + uebertrag;
      ziffer_summe := IntToStr(ziff_summ_1);
      summe_1 := summe_1 + ziffer_summe;
      uebertrag := 0;
    end;
  end;
  for j := 0 to Length(summe_1) - 1 do begin
    summe := summe + summe_1[Length(summe_1) - j];
  end;
  null := IntToStr(0);
  for i := 1 to Length(summe) do begin
    if summe[i] = null then begin
      null_str := true;
    end else
    if summe[i] <> null then begin
      null_str := false;
      break;
    end;
  end;
  if null_str = true then begin
    ergebnis := null;
    exit(ergebnis);
  end;
  for l := 1 to Length(summe) do begin
    while summe[l] = null do begin
      if summe[l] <> null then break else
      delete(summe,l,1);
    end;
    break;
  end;
  if uebergabe = true then summe := '-' + summe;
  if ergeb_negat = true then summe := '-' + summe;
  ergebnis := summe;
  exit(ergebnis);
end;

function Subtraktion(Zah_1,Zah_2: String): String;

var
  ziffer_minuend_str,ziffer_subtrahend_str,ziff_differenz_str,null : String[1];
  diff_laenge,minuend,subtrahend,differenz_1,differenz : String;
  i,j,k,l,l_str,uebertrag,ziff_differenz_int,ziff_minuend_int,ziff_subtrahend_int,diff_laen : Integer;
  ergeb_negat,null_str : Boolean;

begin
  null := IntToStr(0);
  uebertrag := 0;
  differenz := '';
  differenz_1 := '';
  ergeb_negat := false;
  uebergabe := false;
  if zah_1[1] <> '-' then begin
    if zah_2[1] = '-' then begin
      delete(zah_2,1,1);
      Addition(zah_1,zah_2);
      exit(ergebnis);
    end;
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then begin
      uebergabe := true;
      delete(zah_1,1,1);
      Addition(zah_1,zah_2);
      exit(ergebnis);
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Kleiner(zah_1,zah_2) = true then begin
        subtrahend := zah_1;
        minuend := zah_2;
        ergeb_negat := true;
      end;
      if Kleiner(zah_1,zah_2) = false then begin
        subtrahend := zah_2;
        minuend := zah_1;
        ergeb_negat := false;
      end;
    end;
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Kleiner(zah_1,zah_2) = true then begin
        subtrahend := zah_2;
        minuend := zah_1;
        ergeb_negat := true;
      end else
      if Kleiner(zah_1,zah_2) = false then begin
        subtrahend := zah_1;
        minuend := zah_2;
        ergeb_negat := false;
      end;
      if Gleich(zah_1,zah_2) = true then begin
        subtrahend := zah_2;
        minuend := zah_1;
      end;
    end;
    delete(subtrahend,1,1);
    delete(minuend,1,1);
  end;
  diff_laen := Length(minuend) - Length(subtrahend);
  diff_laenge := '';
  for k := 1 to diff_laen do begin
    diff_laenge := diff_laenge + null;
  end;
  subtrahend := diff_laenge + subtrahend;
  l_str := Length(minuend);
  for i := 0 to l_str - 1 do begin
    ziffer_minuend_str := minuend[l_str - i];
    ziffer_subtrahend_str := subtrahend[l_str - i];
    ziff_minuend_int := StrToInt(ziffer_minuend_str);
    ziff_subtrahend_int := StrToInt(ziffer_subtrahend_str);
    if ziff_minuend_int > (ziff_subtrahend_int + uebertrag) then begin
      ziff_differenz_int := ziff_minuend_int - (ziff_subtrahend_int + uebertrag);
      ziff_differenz_str := IntToStr(ziff_differenz_int);
      differenz_1 := differenz_1 + ziff_differenz_str;
      uebertrag := 0;
    end else
    if ziff_minuend_int = (ziff_subtrahend_int + uebertrag) then begin
      ziff_differenz_str := IntToStr(0);
      differenz_1 := differenz_1 + ziff_differenz_str;
      uebertrag := 0;
    end else
    if ziff_minuend_int < (ziff_subtrahend_int + uebertrag) then begin
      ziff_differenz_int := (ziff_minuend_int + 10) - (ziff_subtrahend_int + uebertrag);
      differenz_1 := differenz_1 + IntToStr(ziff_differenz_int);
      uebertrag := 1;
    end;
  end;
  for j := 0 to Length(differenz_1) - 1 do begin
    differenz := differenz + differenz_1[Length(differenz_1) - j];
  end;
  for i := 1 to Length(differenz) do begin
    if differenz[i] = null then begin
      null_str := true;
    end else
    if differenz[i] <> null then begin
      null_str := false;
      break;
    end;
  end;
  if null_str = true then begin
    ergebnis := null;
    exit(ergebnis);
  end;
  for l := 1 to Length(differenz) do begin
    while differenz[l] = null do begin
      if differenz[l] <> null then break else
      delete(differenz,l,1);
    end;
    break;
  end;
  if ergeb_negat = true then differenz := '-' + differenz;
  ergebnis := differenz;
  exit(ergebnis);
end;


begin
  repeat
    uebergabe := false;
    Writeln;
    Write('Zahl 1:');
    Readln(zahl_1);
    WriteLn;
    Write('Zahl 2:');
    ReadLn(zahl_2);
    Writeln;
    Write('Fuer Addieren "a" druecken, sonst wird Subtrahiert:');
    ReadLn(a);
    Writeln;
    if a = 'a' then Addition(zahl_1,zahl_2) else
    Subtraktion(zahl_1,zahl_2);
    WriteLn;
    Write(ergebnis);
    WriteLn;
    WriteLn;
    Write('Programm abbrechen?: ');
    Readln(abbruch);
    ClrScr;
  until abbruch = 'j';
end.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Jetzt werde ich mich erstmal mit Arrays beschäftigen, bevor ich mit der Multiplikation anfange. Die nächste Nuss zu knacken.
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Danke Siro! Wieder etwas gelernt. Ich mache einen Tag Pause. Mit übermüdetem Kopf neige ich zu dummen Fehlern. Wie z. B. den Fehler in den Funktionen Kleiner und Goesser.
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

So läuft es. Geht wohl auch kürzer.

Code: Alles auswählen

program Lang_Add_Sub;

uses
  Crt,Dos,SysUtils;

var
  zahl_1,zahl_2,ergebnis,abbruch,a : String;

function Subtraktion(zah_1,zah_2: String): String; forward;

function Gleich(Zah_1,Zah_2: String): Boolean;

var
  i : Integer;
  ziff_zah_1,ziff_zah_2 : String[1];

begin
  if Length(zah_1) < Length(zah_2) then exit(false);
  if Length(zah_2) < Length(zah_1) then exit(false);
  for i := 1 to Length(zah_1) do begin
    ziff_zah_1 := zah_1[i];
    ziff_zah_2 := zah_2[i];
    if ziff_zah_1 <> ziff_zah_2 then exit(false);
  end;
  exit(true);
end;

function Kleiner(Zah_1,Zah_2: String): Boolean;

var
  ziff_1_str,ziff_2_str : String;
  i,j,ziff_1_int,ziff_2_int : Integer;
  klein : Boolean;

begin
  Kleiner := false;
  klein := false;
  if Gleich(zah_1,Zah_2) = true then exit(false);
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then exit(true);
  end;
  if zah_2[1] = '-' then begin
    if zah_1[1] <> '-' then exit(false);
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Length(zah_1) > Length(zah_2) then exit(true);
      if Length(zah_1) < Length(zah_2) then exit(false);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 2 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int > ziff_2_int then klein := true;
          if ziff_1_int < ziff_2_int then begin
            if klein = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Length(zah_1) < Length(zah_2) then exit(true);
      if Length(zah_1) > Length(zah_2) then exit(false);
      if Length(zah_1) = Length(zah_2) then begin
        for j := 1 to Length(zah_1) do begin
          ziff_1_str := zah_1[j];
          ziff_2_str := zah_2[j];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int < ziff_2_int then klein := true;
          if ziff_1_int > ziff_2_int then begin
            if klein = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  exit(true);
end;

function Groesser(Zah_1,Zah_2: String): Boolean;

var
  ziff_1_str,ziff_2_str : String;
  i,ziff_1_int,ziff_2_int : Integer;
  gross : Boolean;

begin
  Groesser := false;
  gross := false;
  if Gleich(zah_1,Zah_2) = true then exit(false);
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then exit(false);
  end;
  if zah_2[1] = '-' then begin
    if zah_1[1] <> '-' then exit(true);
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Length(zah_1) > Length(zah_2) then exit(false);
      if Length(zah_1) < Length(zah_2) then exit(true);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 2 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int < ziff_2_int then gross := true;;
          if ziff_1_int > ziff_2_int then begin
            if gross = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Length(zah_1) < Length(zah_2) then exit(false);
      if Length(zah_1) > Length(zah_2) then exit(true);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 1 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int > ziff_2_int then gross := true;;
          if ziff_1_int < ziff_2_int then begin
            if gross = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  exit(true);
end;

function Addition(zah_1,zah_2: String): String;

var
  ziffer_summe,ziffer_1,ziffer_2,null : String[1];
  summe_1,diff_laenge,summand_1,summand_2,summe : String;
  i,j,k,l,l_s_1,l_s_2,uebertrag,ziff_summ,ziff_summ_1,ziff_1,ziff_2,diff_laen : Integer;
  null_str,ergeb_negat : Boolean;

begin
  uebertrag := 0;
  summe := '';
  summe_1 := '';
  ergeb_negat := false;
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then begin
      delete(zah_1,1,1);
      if Gleich(zah_1,zah_2) = true then begin
        Subtraktion(zah_1,zah_2);
        exit(ergebnis);
        exit;
      end;
      if groesser(zah_1,zah_2) = true then begin
        Subtraktion(zah_1,zah_2);
        ergebnis := '-' + ergebnis;
        exit(ergebnis);
        exit;
      end;
      if Kleiner(zah_1,zah_2) = true then begin
        Subtraktion(zah_1,zah_2);
        delete(ergebnis,1,1);
        exit(ergebnis);
        exit;
      end;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] = '-' then begin
      delete(zah_2,1,1);
      if Gleich(zah_1,zah_2) = true then begin
        Subtraktion(zah_1,zah_2);
        exit(ergebnis);
        exit;
      end;
      if groesser(zah_1,zah_2) = true then begin
        Subtraktion(zah_1,zah_2);
        exit(ergebnis);
        exit;
      end;
      if Kleiner(zah_1,zah_2) = true then begin
        Subtraktion(zah_1,zah_2);
        exit(ergebnis);
        exit;
      end;
    end;
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      delete(zah_1,1,1);
      delete(zah_2,1,1);
      ergeb_negat := true;
    end;
  end;
  summand_1 := zah_1;
  summand_2 := zah_2;
  l_s_1 := Length(summand_1);
  l_s_2 := Length(summand_2);
  if l_s_1 < l_s_2 then begin
    diff_laen := l_s_2 - l_s_1;
    diff_laenge := '';
    null := IntToStr(0);
    for k := 1 to diff_laen do begin
      diff_laenge := diff_laenge + null;
    end;
    summand_1 := diff_laenge + summand_1;
    l_s_1 := Length(summand_1);
  end else
  begin
    diff_laen := l_s_1 - l_s_2;
    diff_laenge := '';
    null := IntToStr(0);
    for k := 1 to diff_laen do begin
      diff_laenge := diff_laenge + null;
    end;
    summand_2 := diff_laenge + summand_2;
    l_s_2 := Length(summand_2);
  end;
  for i := 0 to l_s_1 - 1 do begin
    ziffer_1 := summand_1[l_s_1 - i];
    ziffer_2 := summand_2[l_s_2 - i];
    ziff_1 := StrToInt(ziffer_1);
    ziff_2 := StrToInt(ziffer_2);
    ziff_summ := ziff_1 + ziff_2;
    ziff_summ_1 := 0;
    if ziff_summ > 9 then begin
      ziff_summ_1 := ziff_summ - 10 + uebertrag;
      ziffer_summe := IntToStr(ziff_summ_1);
      summe_1 := summe_1 + ziffer_summe;
      uebertrag := 1;
      if i = l_s_1 - 1 then begin
        summe_1 := summe_1 + '1';
      end;
    end else
    if ziff_summ = 9 then begin
      if uebertrag = 1 then begin
        ziff_summ_1 := ziff_summ - 10 + uebertrag;
        ziffer_summe := IntToStr(ziff_summ_1);
        summe_1 := summe_1 + ziffer_summe;
        uebertrag := 1;
        if i = l_s_1 - 1 then begin
          summe_1 := summe_1 + '1';
        end;
      end else
      if uebertrag = 0 then begin
        ziffer_summe := IntToStr(ziff_summ);
        summe_1 := summe_1 + ziffer_summe;
        uebertrag := 0;
      end;
    end else
    if ziff_summ < 9 then begin
      ziff_summ_1 := ziff_summ + uebertrag;
      ziffer_summe := IntToStr(ziff_summ_1);
      summe_1 := summe_1 + ziffer_summe;
      uebertrag := 0;
    end;
  end;
  for j := 0 to Length(summe_1) - 1 do begin
    summe := summe + summe_1[Length(summe_1) - j];
  end;
  null := IntToStr(0);
  for i := 1 to Length(summe) do begin
    if summe[i] = null then begin
      null_str := true;
    end else
    if summe[i] <> null then begin
      null_str := false;
      break;
    end;
  end;
  if null_str = true then begin
    ergebnis := null;
    exit(ergebnis);
  end;
  for l := 1 to Length(summe) do begin
    while summe[l] = null do begin
      if summe[l] <> null then break else
      delete(summe,l,1);
    end;
    break;
  end;
  if ergeb_negat = true then summe := '-' + summe;
  ergebnis := summe;
  exit(ergebnis);
end;

function Subtraktion(Zah_1,Zah_2: String): String;

var
  ziffer_minuend_str,ziffer_subtrahend_str,ziff_differenz_str,null : String[1];
  diff_laenge,minuend,subtrahend,differenz_1,differenz : String;
  i,j,k,l,l_str,uebertrag,ziff_differenz_int,ziff_minuend_int,ziff_subtrahend_int,diff_laen : Integer;
  null_str,ergeb_negat : Boolean;

begin
  null := IntToStr(0);
  uebertrag := 0;
  differenz := '';
  differenz_1 := '';
  ergeb_negat := false;
  if zah_1[1] <> '-' then begin
    if zah_2[1] = '-' then begin
      delete(zah_2,1,1);
      Addition(zah_1,zah_2);
      exit(ergebnis);
      exit;
    end;
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then begin
      delete(zah_1,1,1);
      Addition(zah_1,zah_2);
      ergebnis := '-' + ergebnis;
      exit(ergebnis);
      exit;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Kleiner(zah_1,zah_2) = true then begin
        subtrahend := zah_1;
        minuend := zah_2;
        ergeb_negat := true;
      end;
      if Kleiner(zah_1,zah_2) = false then begin
        subtrahend := zah_2;
        minuend := zah_1;
        ergeb_negat := false;
      end;
    end;
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Kleiner(zah_1,zah_2) = true then begin
        subtrahend := zah_2;
        minuend := zah_1;
        ergeb_negat := true;
      end else
      if Kleiner(zah_1,zah_2) = false then begin
        subtrahend := zah_1;
        minuend := zah_2;
        ergeb_negat := false;
      end;
      if Gleich(zah_1,zah_2) = true then begin
        subtrahend := zah_2;
        minuend := zah_1;
      end;
    end;
    delete(subtrahend,1,1);
    delete(minuend,1,1);
  end;
  diff_laen := Length(minuend) - Length(subtrahend);
  diff_laenge := '';
  for k := 1 to diff_laen do begin
    diff_laenge := diff_laenge + null;
  end;
  subtrahend := diff_laenge + subtrahend;
  l_str := Length(minuend);
  for i := 0 to l_str - 1 do begin
    ziffer_minuend_str := minuend[l_str - i];
    ziffer_subtrahend_str := subtrahend[l_str - i];
    ziff_minuend_int := StrToInt(ziffer_minuend_str);
    ziff_subtrahend_int := StrToInt(ziffer_subtrahend_str);
    if ziff_minuend_int > (ziff_subtrahend_int + uebertrag) then begin
      ziff_differenz_int := ziff_minuend_int - (ziff_subtrahend_int + uebertrag);
      ziff_differenz_str := IntToStr(ziff_differenz_int);
      differenz_1 := differenz_1 + ziff_differenz_str;
      uebertrag := 0;
    end else
    if ziff_minuend_int = (ziff_subtrahend_int + uebertrag) then begin
      ziff_differenz_str := IntToStr(0);
      differenz_1 := differenz_1 + ziff_differenz_str;
      uebertrag := 0;
    end else
    if ziff_minuend_int < (ziff_subtrahend_int + uebertrag) then begin
      ziff_differenz_int := (ziff_minuend_int + 10) - (ziff_subtrahend_int + uebertrag);
      differenz_1 := differenz_1 + IntToStr(ziff_differenz_int);
      uebertrag := 1;
    end;
  end;
  for j := 0 to Length(differenz_1) - 1 do begin
    differenz := differenz + differenz_1[Length(differenz_1) - j];
  end;
  for i := 1 to Length(differenz) do begin
    if differenz[i] = null then begin
      null_str := true;
    end else
    if differenz[i] <> null then begin
      null_str := false;
      break;
    end;
  end;
  if null_str = true then begin
    ergebnis := null;
    exit(ergebnis);
  end;
  for l := 1 to Length(differenz) do begin
    while differenz[l] = null do begin
      if differenz[l] <> null then break else
      delete(differenz,l,1);
    end;
    break;
  end;
  if ergeb_negat = true then differenz := '-' + differenz;
  ergebnis := differenz;
  exit(ergebnis);
end;


begin
  repeat
    Writeln;
    Write('Zahl 1:');
    Readln(zahl_1);
    WriteLn;
    Write('Zahl 2:');
    ReadLn(zahl_2);
    Writeln;
    Write('Fuer Addieren "a" druecken, sonst wird Subtrahiert:');
    ReadLn(a);
    Writeln;
    if a = 'a' then Addition(zahl_1,zahl_2) else
    Subtraktion(zahl_1,zahl_2);
    WriteLn;
    Write(ergebnis);
    WriteLn;
    WriteLn;
    Write('Programm abbrechen?: ');
    Readln(abbruch);
    ClrScr;
  until abbruch = 'j';
end.

          
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

siro
Beiträge: 513
Registriert: Di 23. Aug 2016, 14:25
OS, Lazarus, FPC: Windows 10
CPU-Target: 64Bit
Wohnort: Berlin

Re: Implementierung Langzahlarithmetik

Beitrag von siro »

kurze Info:

Code: Alles auswählen

        exit(ergebnis);
        exit;
Code nach dem Exit wird niemals ausgeführt...
Das zweite Exit ist also unnötig.
Hast Du bei der Addition drin.
Grüße von Siro
Bevor ich "C" ertragen muß, nehm ich lieber Lazarus...

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Danke für den Tipp. Brüte gerade über Arrays.
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Multiplikation läuft.

Code: Alles auswählen

program Multi;

uses Crt,Dos,SysUtils;

var
  zahl_1,zahl_2,ergebnis : String;
  abbruch : String[1];

function Gleich(Zah_1,Zah_2: String): Boolean;

var
  i : Integer;
  ziff_zah_1,ziff_zah_2 : String[1];

begin
  if Length(zah_1) < Length(zah_2) then exit(false);
  if Length(zah_2) < Length(zah_1) then exit(false);
  for i := 1 to Length(zah_1) do begin
    ziff_zah_1 := zah_1[i];
    ziff_zah_2 := zah_2[i];
    if ziff_zah_1 <> ziff_zah_2 then exit(false);
  end;
  exit(true);
end;

function Kleiner(Zah_1,Zah_2: String): Boolean;

var
  ziff_1_str,ziff_2_str : String;
  i,j,ziff_1_int,ziff_2_int : Integer;
  klein : Boolean;

begin
  klein := false;
  if Gleich(zah_1,Zah_2) = true then exit(false);
  if zah_1[1] = '-' then begin
    if zah_2[1] <> '-' then exit(true);
  end;
  if zah_2[1] = '-' then begin
    if zah_1[1] <> '-' then exit(false);
  end;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      if Length(zah_1) > Length(zah_2) then exit(true);
      if Length(zah_1) < Length(zah_2) then exit(false);
      if Length(zah_1) = Length(zah_2) then begin
        for i := 2 to Length(zah_1) do begin
          ziff_1_str := zah_1[i];
          ziff_2_str := zah_2[i];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int > ziff_2_int then klein := true;
          if ziff_1_int < ziff_2_int then begin
            if klein = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  if zah_1[1] <> '-' then begin
    if zah_2[1] <> '-' then begin
      if Length(zah_1) < Length(zah_2) then exit(true);
      if Length(zah_1) > Length(zah_2) then exit(false);
      if Length(zah_1) = Length(zah_2) then begin
        for j := 1 to Length(zah_1) do begin
          ziff_1_str := zah_1[j];
          ziff_2_str := zah_2[j];
          ziff_1_int := StrToInt(ziff_1_str);
          ziff_2_int := StrToInt(ziff_2_str);
          if ziff_1_int < ziff_2_int then klein := true;
          if ziff_1_int > ziff_2_int then begin
            if klein = false then exit(false);
          end;
        end;
      end;
    end;
  end;
  exit(true);
end;

function Multiplikation(zah_1,zah_2: String): String;

var
  null : String[1];
  ziff_prod_str : String[2];
  mult_kl,mult_gr,produkt_str,dezi_sum_str : String;
  index_1,index_2,i,j,k,ziff_kl_int,ziff_gr_int,ziff_prod_int,ziff_prod_1,ueber_mult,ueber_add,dezi_sum_int,laenge_arr,index : Integer;
  ergeb_negat,null_str : Boolean;
  arr : array of array[0..1000] of integer;

begin
  ergebnis := '';
  ergeb_negat := false;
  if zah_1[1] = '-' then begin
    if zah_2[1] = '-' then begin
      delete(zah_1,1,1);
      delete(zah_2,1,1);
    end;
  end;
  if zah_1[1] = '-' then begin
    ergeb_negat := true;
    delete(zah_1,1,1);
  end;
  if zah_2[1] = '-' then begin
    ergeb_negat := true;
    delete(zah_2,1,1);
  end;
  if Kleiner(zah_1,zah_2) = true then begin
    mult_kl := zah_1;
    mult_gr := zah_2;
  end else begin
    mult_kl := zah_2;
    mult_gr := zah_1;
  end;
  laenge_arr := Length(mult_kl) + Length(mult_gr);
  SetLength(arr, laenge_arr);
  ueber_mult := 0;
  index := 0;
  index_2 := 0;
  k:= 0;
  for j := Length(mult_kl) downto 1 do begin
    for i := Length(mult_gr) downto 1 do begin
      ziff_kl_int := StrToInt(mult_kl[j]);
      ziff_gr_int := StrToInt(mult_gr[i]);
      ziff_prod_int := ziff_kl_int * ziff_gr_int + ueber_mult;
      ziff_prod_str := IntToStr(ziff_prod_int);
      if Length(ziff_prod_str) > 1 then begin
        ziff_prod_1 := StrToInt(ziff_prod_str[2]);
        ueber_mult := StrToInt(ziff_prod_str[1]);
      end;
      if Length(ziff_prod_str) = 1 then begin
        ziff_prod_1 := StrToInt(ziff_prod_str[1]);
        ueber_mult := 0;
      end;
      if j < Length(mult_kl) then begin
        for index_2 := 0 to  k - 1 do begin
          arr[index_2, k] := 0;
        end;
      end;
      if i = 1 then begin
        if ueber_mult > 0 then begin
          arr[index + k + 1, k] := ueber_mult;
          for index_1 := index + k + 2 to laenge_arr do begin
          arr[index_1, k] := 0;
        end;
      end;
      for index_1 := index + 2 + k to laenge_arr do begin
        arr[index_1, k] := 0;
      end;
      ueber_mult := 0;
    end;
    arr[index + k, k] := ziff_prod_1;
    inc(index);
    end;
    index := 0;
    produkt_str := '';
    inc(k);
  end;
  produkt_str := '';
  dezi_sum_int := 0;
  ueber_add := 0;
  for index := 0 to Length(arr) do begin
    for k := 0 to Length(mult_kl) - 1  do begin
      dezi_sum_int := dezi_sum_int + arr[index, k];
    end;
    dezi_sum_int := dezi_sum_int + ueber_add;
    dezi_sum_str := IntToStr(dezi_sum_int);
    dezi_sum_int := 0;
    if Length(dezi_sum_str) > 1 then begin
      produkt_str := produkt_str + dezi_sum_str[Length(dezi_sum_str)];
      delete(dezi_sum_str,Length(dezi_sum_str),1);
      ueber_add := StrToInt(dezi_sum_str);
      dezi_sum_str := '';
    end;
    if Length(dezi_sum_str) = 1 then begin
      produkt_str := produkt_str + dezi_sum_str;
      ueber_add := 0;
    end;
  end;
  for j := 0 to Length(produkt_str) - 1 do begin
    ergebnis := ergebnis + produkt_str[Length(produkt_str) - j];
  end;
  null := IntToStr(0);
  for i := 1 to Length(ergebnis) do begin
    if ergebnis[i] = null then begin
      null_str := true;
    end else
    if ergebnis[i] <> null then begin
      null_str := false;
      break;
    end;
  end;
  if null_str = true then begin
    ergebnis := null;
    exit(ergebnis);
  end;
  for i := 1 to Length(ergebnis) do begin
    while ergebnis[i] = null do begin
      if ergebnis[i] <> null then break else
      delete(ergebnis,i,1);
    end;
    break;
  end;
  if ergeb_negat = true then ergebnis := '-' + ergebnis;
  exit(ergebnis);
end;

begin
  repeat
    abbruch := '';
    WriteLn;
    Write('Zahl1: ');
    ReadLn(zahl_1);
    WriteLn;
    Write('Zahl2: ');
    ReadLn(zahl_2);
    WriteLn;
    Multiplikation(zahl_1,zahl_2);
    Write(ergebnis);
    WriteLn;
    WriteLn;
    Write('fuer Abbruch "j" eingeben: ');
    ReadLn(abbruch);
    WriteLn;
    WriteLn;
    ClrScr;
  until abbruch = 'j';
end.
Aber ich habe eine Frage zu zweidimensionalen Arrays. Wie kann man zur Laufzeit des Programmes die Länge der "Tochter" Arrays definieren? So wie ich es gemacht habe, so geht es nicht. Und das begrenzt die Länge des kleineren Faktor auf die vordefinierte Länge des Arrays. :( Ich bitte um Rückmeldungen. Danke im Voraus.
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Eventuell muss ich mich - was die Funktionalität für große Zahlen angeht - korrigieren. Ich habe wohl einen Fehler beim Aufsummieren in Bezug auf den Übertrag gemacht, der sich bei großen Zahlen zeigen würde. Vielleicht. Ich bin zu müde, um noch darüber nachzudenken. Wann anders.
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

Benutzeravatar
Winni
Beiträge: 1091
Registriert: Mo 2. Mär 2009, 16:45
OS, Lazarus, FPC: Laz2.0.12, fpc 3.2
CPU-Target: 64Bit
Wohnort: Fast Dänemark

Re: Implementierung Langzahlarithmetik

Beitrag von Winni »

Hi!

Beschäftige Dich mal mit dynamischen Arrays, deren Länge zur Laufzeit zugewiesen werden.

Code: Alles auswählen

var  a,b :  array of whatever;

begin
setlength(a,42);
...
b := copy (a,23,10);
...
end;
Winni

Benutzeravatar
fliegermichl
Lazarusforum e. V.
Beiträge: 1013
Registriert: Do 9. Jun 2011, 09:42
OS, Lazarus, FPC: Winux (L 2.0.11 FPC 3.2)
CPU-Target: 32/64Bit
Wohnort: Echzell

Re: Implementierung Langzahlarithmetik

Beitrag von fliegermichl »

Um auf das zweidimensionale Array zurückzukommen.
In dem Progrämmelchen habe ich ein Memo und einen Button.
Im Button Click Event mache ich folgendes

Code: Alles auswählen

procedure TForm1.Button1Click(Sender: TObject);
var a : array of array of string;
  i, j : integer;
begin
  SetLength(a, 10);
  for i := 1 to 10 do
  begin
    SetLength(a[i], 10);
    for j := 1 to 10 do
    begin
      a[i, j] := IntToStr(i*j);
      Memo1.Lines.Add(a[i, j]);
    end;
  end;
end;

Benutzeravatar
six1
Beiträge: 558
Registriert: Do 1. Jul 2010, 19:01

Re: Implementierung Langzahlarithmetik

Beitrag von six1 »

1 to 10? Sicher?
ich hätte 0 to 9 geschrieben... oder 0 to high(a)
Gruß, Michael

Benutzeravatar
fliegermichl
Lazarusforum e. V.
Beiträge: 1013
Registriert: Do 9. Jun 2011, 09:42
OS, Lazarus, FPC: Winux (L 2.0.11 FPC 3.2)
CPU-Target: 32/64Bit
Wohnort: Echzell

Re: Implementierung Langzahlarithmetik

Beitrag von fliegermichl »

six1 hat geschrieben:
Do 13. Jan 2022, 10:40
1 to 10? Sicher?
ich hätte 0 to 9 geschrieben... oder 0 to high(a)
Richtig, Dynamische Arrays sind immer Nullbasiert.

Neuling
Beiträge: 33
Registriert: Do 30. Dez 2021, 01:08
OS, Lazarus, FPC: Windows 10 (L 2.2.0 FPC 3.2.2)
CPU-Target: 64Bit

Re: Implementierung Langzahlarithmetik

Beitrag von Neuling »

Hallo

Danke für die Antworten. Ich werde darüber nachdenken. Ich habe jetzt auch das zweibändige Lehrbuch von Wilfried Koch. Damit muss ich nicht mehr im Nebel stochern und zeitraubend experimentieren.

Neuling
Ich nehme jede berechtigte Kritik an. Es sei denn, diese fällt von oben herab vor meine Füße.
Programmieren macht Spaß.

Antworten