Длинная арифметика.

[Leshii]

Доброго времени суток, нужна помощь в одном вопросе, в программе при сложении не переноситься разряд. То есть оно пишет просто сложение двух чисел. Чесно говоря уже сам разобраться не могу =) Может кто на свежую голову чего подскажет ( код рабочий ).

Program Prak_1;
Uses crt;
const MaxDig = 10;
type
      Tlong = array [0..MaxDig] of byte;
var
      A, B: Tlong;
      i, la, lb, ch, cod: integer;
      s1, s2: string;
      k: word;

Procedure dodavannya (var k:word; A, B: Tlong; la, lb: integer);
var i, j, c: word;
    st: string;
begin
  if la>lb then k:=la else k:=lb;
     c:=0;
   for i:=1 to k do begin
       c:=A[i]+B[i]+c;
       a[i]:=c mod 10000;
       c:=c div 10000;
   end;
  if c<>0 then begin
     inc(k);
     a[k]:=c;
  end;
  write(A[k]);
  for i:=k-1 downto 1 do begin
      str(a[i], st);
      {for j:=1 to 4 - length(st) do
      write('0'); }
      write(A[i]);
 end;
end;

begin
clrscr;
Write('----Programa dodavannya, vidnimannya, mnogennya ta dilennya dvox 4usel----');
writeln;
write('Vvedit 4uslo A:=');readln(s1);la:=length(s1);
write('Vvedit 4uslo B:=');readln(s2);lb:=length(s2);
for i:=1 to la do begin
    val(s1[i],ch,cod);
    A[i]:=ch;
end;
for i:=1 to lb do begin
    val(s2[i],ch,cod);
    B[i]:=ch;
end;
writeln;
dodavannya(k, A, B, la, lb);
readln;
end.

[Serge_Bliznykov]

извините, но всё очень плохо!

первое. Вы числа в столбик складывать умеете?
Вы это делаете слева направо или справа налево?
В начальной школе нас учили складывать именно справа налево (от младших разрядов к старшим).
И в длинной арифметике реализуется именно этот подход.
У Вас же этого я не увидел.

второе. что за таинственный параметер var k:word ?
Если Вы думаете, что это длина полученной суммы двух длинных чисел, то Вы заблуждаетесь!

третье. Вам нужно разделять процедуры(функции) выполнения операций над длинными числами и процедуру вывода полученной результата. Это, конечно, дело хозяйское.
Но с точки зрения практической полезности и гибкости - крайне рекомендую делать именно раздельные процедуры(функции) тем более, что, судя по заголовку, который выдаёт программа, планируется ещё делать вычитание, умножение и деление длинных чисел....

в качестве иллюстрации к моим словам прошу рассмотреть
пример кода:

Program Prak_1;
Uses crt;
const MaxDig = 10;
type
    Tlong = array [0..MaxDig] of byte;

{процедура вывода длинного числа на экран}
procedure PrintLong(A : Tlong; la : integer);
var i : integer;
begin
  for i:=1 to la do
    Write(A[i]);
  WriteLn;
end;


Procedure dodavannya (A, B: Tlong; la, lb: integer; var Rez : TLong; var lRez : integer);
var i, iSmall : integer;
 Perenos : byte;
begin
  if la>lb then begin 
    lRez:=la;

    Perenos := 0;
    iSmall := lb;
    for i:=lRez downto 1 do begin
      if iSmall>0 
        then Rez[i] := A[i] + B[iSmall] + perenos
        else Rez[i] := A[i] + perenos;

      if Rez[i]>9 then begin
        Perenos := Rez[i] div 10;
        Rez[i] := Rez[i] mod 10;
      end
      else 
        perenos := 0; 
      dec(iSmall);

    end;

  end
  else begin
    lRez:=lb;

    Perenos := 0;
    iSmall := la;
    for i:=lRez downto 1 do begin
      if iSmall>0
        then Rez[i] := B[i] + A[iSmall] + perenos
        else Rez[i] := B[i] + perenos;

      if Rez[i]>9 then begin
        Perenos := Rez[i] div 10;
        Rez[i] := Rez[i] mod 10;
      end
      else
        perenos := 0;
      dec(iSmall);

    end;
  end;

  if Perenos>0 then {полученное число нужно сдвинуть} begin
    for i:=lRez downto 1 do Rez[i+1] := Rez[i];
    Rez[1] := Perenos;
    inc(lRez);
  end;
end;

var
      A, B, C : Tlong;
      i, la, lb, lc, ch, cod: integer;
      s1, s2: string;
      k: word;

begin
clrscr;
Write('----Programa dodavannya, vidnimannya, mnogennya ta dilennya dvox 4usel----');
writeln;
write('Vvedit 4uslo A:=');readln(s1);la:=length(s1);
write('Vvedit 4uslo B:=');readln(s2);lb:=length(s2);
for i:=1 to la do begin
    val(s1[i],ch,cod);
    A[i]:=ch;
end;
for i:=1 to lb do begin
    val(s2[i],ch,cod);
    B[i]:=ch;
end;
writeln;
dodavannya( A, B, la, lb, C, lc);
Write('A='); PrintLong( A, la);
Write('B='); PrintLong( B, lb);
Write('C='); PrintLong( C, lc);
readln;
end.

NB.
кстати, я бы рекомендовал длину числа включить в структуру типа. Это реально удобнее:

type
  Tlong = record
    LenLong: integer;
    Data: array[0..MaxDig] of byte;
  end;

{процедура вывода длинного числа на экран}
procedure PrintLong(A: Tlong);
var i: integer;
begin
  for i := 1 to A.LenLong do
    Write(A.Data[i]);
  WriteLn;
end;

{процедура сложения длинных чисел C := A + B}
procedure dodavannya(A, B: Tlong; var Rez: TLong);
var i, iSmall: integer;
  Perenos: byte;
begin
  if A.LenLong > B.LenLong then begin
    Rez.LenLong := A.LenLong;

    Perenos := 0;
    iSmall := B.LenLong;
    for i := Rez.LenLong downto 1 do begin
      if iSmall > 0
        then Rez.Data[i] := A.Data[i] + B.Data[iSmall] + perenos
      else Rez.Data[i] := A.Data[i] + perenos;

      if Rez.Data[i] > 9 then begin
        Perenos := Rez.Data[i] div 10;
        Rez.Data[i] := Rez.Data[i] mod 10;
      end
      else
        perenos := 0;
      dec(iSmall);

    end;

  end
  else begin
    Rez.LenLong := B.LenLong;

    Perenos := 0;
    iSmall := A.LenLong;
    for i := Rez.LenLong downto 1 do begin
      if iSmall > 0
        then Rez.Data[i] := B.Data[i] + A.Data[iSmall] + perenos
      else Rez.Data[i] := B.Data[i] + perenos;

      if Rez.Data[i] > 9 then begin
        Perenos := Rez.Data[i] div 10;
        Rez.Data[i] := Rez.Data[i] mod 10;
      end
      else
        perenos := 0;
      dec(iSmall);

    end;
  end;

  if Perenos > 0 then {полученное число нужно сдвинуть}  begin
    for i := Rez.LenLong downto 1 do Rez.Data[i + 1] := Rez.Data[i];
    Rez.Data[1] := Perenos;
    inc(Rez.LenLong);
  end;
end;

[Leshii]

Вообщем родил... кому надо, пользуйтесь.

Program Prak_1;
Uses crt;
var
ch: integer;
row: array[1..20000] of byte;
col: array[1..10000] of byte;
nr, nc, dp: integer;
c: char;



Procedure dodavannya;
var
   s1, s2: string;
   a, b:array [1..10] of byte;
   len,i,c:integer;
begin
clrscr;
write('Enter first number:');readln(s1);
write('Enter second number:');readln(s2);
c:=0;
len:=length(s1);
for i:=1 to len do
a[len-i+1]:=Ord(s1[i])-48;
len:=length(s2);
for i:=1 to len do
b[len-i+1]:=Ord(s2[i])-48;

if length(s1)>length(s2) then len:=length(s1)
else len:=length(s2);
for i:=1 to len do
begin
c:=c+a[i]+b[i];
a[i]:=c mod 10;
c:=c div 10;
end;
if c>0 then begin
len:=len+1;
a[len]:=c;
end;
writeln(s1);
writeln('+');
writeln(s2);
writeln('--------');
for i:=len downto 1 do
Write(a[i]);
writeln;
writeln('Press Enter to proceed...');
readkey;
clrscr;
end;

Function CompLong(s1,s2:string):integer;
var
a,len1,len2,i:integer;
b:boolean;
begin
a:=0;
b:=true;
len1:=length(s1);
len2:=length(s2);
if len1>len2 then begin a:= 1; b:=false; end;
if len1<len2 then begin a:=-1; b:=false; end;
if b then
for i:=1 to len1 do
begin
if Ord(s1[i])-48>Ord(s2[i])-48 then begin a:= 1; break; end;
if s1[i]<s2[i] then begin a:=-1; break; end;
end;
CompLong:=a;
end;
 
Procedure vidnimannya;
var
s1,s2:string;
i,len,c,x:integer;
a,b:array[1..10] of byte;

begin
write('Enter first number:');readln(s1);
write('Enter second number:');readln(s2);
len:=length(s2);
for i:=1 to len do
b[len-i+1]:=Ord(s2[i])-48;
len:=length(s1);
 
for i:=1 to len do
a[len-i+1]:=Ord(s1[i])-48;
if Complong(s1,s2)<0 then begin
len:=length(s2);
for i:=1 to len do begin
x:=a[i];
a[i]:=b[i];
b[i]:=x;
end;
end;
for i:=1 to len do
begin
c:=c+a[i]-b[i]+10;
a[i]:= c mod 10;                       
if c < 10 then c:=-1 else c:=0;
end;
writeln(s1);
writeln('-');
writeln(s2);
writeln('---------');
while (a[len]=0) and (len>1) do len:=len-1;
for i:=len downto 1 do 
Write(a[i]);
writeln;
writeln('Press Enter to proceed...');
readkey;
clrscr;
end;

procedure PrintResult;
begin
     write('Rezult= ');
     while (dp<=high(row)) do begin
        write(char(row[dp]+ord('0')));
        inc(dp);
     end;
     writeln;
     writeln('Press Enter to proceed...');
     readkey;
     clrscr;
end;
 
procedure Multiplying;
var i,j,cr,cc:integer;
    carry,sum:longint;
begin
    dp:=high(row); cr:=nr; cc:=nc;
    carry := 0;
    while (cc>0) do begin
        i:=cr; j:=cc; sum:=carry;
        while (i<=nr) and (j>=1) do begin
           sum:=sum+row[i]*col[j];
           inc(i); dec(j);
        end;
        row[dp]:=sum mod 10; dec(dp);
        carry:=sum div 10;
        if cr>1 then dec(cr) else dec(cc);
    end;
    while (carry<>0) do begin
        row[dp]:=carry mod 10;
        carry:=carry div 10;
        dec(dp);
    end;
    inc(dp);
end;


begin
clrscr;
repeat
writeln('menu');
writeln('-------------');
writeln('1:dodavannya');
writeln('2:vidnimannya');
writeln('3:mnogennya');
writeln('4:exit');
writeln('-------------');
write('Your choice:');readln(ch);
case ch of
1:dodavannya;
2:vidnimannya;
3:begin
     fillchar(row,sizeof(row),0); fillchar(col,sizeof(col),0);
     writeln('Enter first number:');
     c:=#0;
     while NOT(c in ['0'..'9']) do c:=readkey;
     nr:=0;
     while (c in ['0'..'9']) do begin
        write(c);
        inc(nr); row[nr]:=ord(c)-ord('0');
        c:=readkey;
     end;
     writeln;
     writeln('Enter second number:');
     while NOT(c in ['0'..'9']) do c:=readkey;
     nc:=0;
     while (c in ['0'..'9']) do begin
        write(c);
        inc(nc); col[nc]:=ord(c)-ord('0');
        c:=readkey;
     end;
     writeln;
     Multiplying; PrintResult;
end;
end;
until (ch=4);
end.

[Serge_Bliznykov]

Вообщем родил... кому надо, пользуйтесь.

ну да... пользуйтесь, если неважно, что код ошибно считает.

например.
сложение двух чисел:

Enter first number:99
Enter second number:1
99
+
1
--------
190
Press Enter to proceed...

Это, мягко говоря, не совсем верный ответ...

p.s. остальной код не проверял

p.p.s. риторический вопрос: а что, мой пример кода Вас чем-то не устроил?..

[Leshii]

Ну вот, есть что исправлять. Но работу уже проверили, проверяли на длинных числах.