fork download
copy 
  1. // Наработки в области длинной арифметики (даже не пытался оптимизировать)
  2. // Число представляется в виде цифр в 100^n-ричной системе
  3. // Показатель n определяется размером ячейки, отведенной для хранения цифры
  4. // Формат выбран как наиболее удобный для вывода десятичных чисел (не требует деления по модулю 10)
  5. // Реализованы функции сложения и умножения цифр в такой системе счисления
  6. // CopyLeft (c) 2015 Alexey Kuzminov
  7. program VeryLongInteger;
  8.  
  9. type
  10.   // Тип ячейки может быть любым:
  11.   //   Integer, ShortInt, SmallInt, Longint, Byte, Word, LongWord, Cardinal
  12.   // Теоретически возможен QWord и Int64, но не компилится FullTest
  13.   TDigit = type SmallInt; // размер - 2 байта
  14.  
  15. var
  16.   MaxDigit: TDigit;  // максимальное число, кратное степени 100 и не превосходящее High(TDigit)
  17.   HalfDigit: TDigit; // половина MaxDigit
  18.   SqrtDigit: TDigit; // квадратный корень из MaxDigit
  19.   DigitLength: Integer; // длина текста при выводе цифры
  20.  
  21. // Определяет MaxDigit и другие константы
  22. procedure Init;
  23. var
  24.   t: TDigit;
  25. begin
  26.   t := High(TDigit);
  27.   MaxDigit := 1;
  28.   SqrtDigit := 1;
  29.   DigitLength := 0;
  30.   while t > 100 do begin
  31.     t := t div 100;
  32.     MaxDigit := MaxDigit * 100;
  33.     SqrtDigit := SqrtDigit * 10;
  34.     Inc(DigitLength, 2);
  35.   end;
  36.   HalfDigit := MaxDigit div 2;
  37. end;
  38.  
  39. // a := (a + b) mod MaxDigit, результат 1 - есть переполнение, 0 - нет
  40. function Add(var a: TDigit; b: TDigit): TDigit; 
  41. var
  42.   p: Byte;
  43. begin
  44.   // Во избежание переполнения ЗАРАНЕЕ отнимем половину MaxDigit от a и b
  45.   p := 0;
  46.   if (a > HalfDigit) then begin Dec(a, HalfDigit); Inc(p); end;
  47.   if (b > HalfDigit) then begin Dec(b, HalfDigit); Inc(p); end;
  48.  
  49.   // Теперь эта операция переполнения не вызовет
  50.   Inc(a, b);
  51.   if p = 0 then Add := 0       // оба слагаемых маленькие, переполнения нет
  52.   else if p = 2 then Add := 1  // оба слагаемых большие, переполнение гарантировано
  53.   else if a < HalfDigit then begin  // одно слагаемое большое, но переполнения нет
  54.   	Inc(a, HalfDigit);
  55.   	Add := 0
  56.   end
  57.   else begin  // сумма превысила MaxDigit, поэтому переполнеие
  58.   	Dec(a, HalfDigit);
  59.   	Add := 1
  60.   end;
  61. end;
  62.  
  63. // a := (a * b) mod MaxDigit, результат (a * b) div MaxDigit - старшая часть
  64. function Mul(var a: TDigit; b: TDigit): TDigit;
  65. var
  66.   ah, al, bh, bl: TDigit;
  67.   t: TDigit;
  68. begin
  69.   // разложим a = ah*SqrtDigit + al и b = bh*SqrtDigit + bl
  70.   al := a mod SqrtDigit; ah := a div SqrtDigit;
  71.   bl := b mod SqrtDigit; bh := b div SqrtDigit;
  72.  
  73.   // результат: ah*bh*SqrtDigit^2 + (ah*bl+bh*al)*SqrtDigit + al*bl
  74.   // в процессе сложения нужно не допускать переполнения MaxDigit
  75.  
  76.   // крайние слагаемые перепонения не вызовут
  77.   a := al*bl;
  78.   Mul := ah*bh; // SqrtDigit^2 = MaxDigit
  79.  
  80.   // а вот со средним всё интереснее...
  81.   t := ah*bl;
  82.   if Add(t, bh*al) > 0 then Inc(Mul, SqrtDigit); // сложение может вызвать переполнение
  83.   // среднее слагаемое бьется на части: старшая в результат, mладшая в a
  84.   Inc(Mul, t div SqrtDigit);                     
  85.   Inc(Mul, Add(a, (t mod SqrtDigit)*SqrtDigit)); // и тут переполнение
  86.   // Замечание: ни при каком вызове Inc Mul не переполнится (не станет > MaxDigit)
  87. end;
  88.  
  89. // дополняет нужное количество нулей левее числа
  90. function DigitToStr(a: TDigit): String;
  91. begin
  92.   Str(a, DigitToStr);
  93.   while DigitLength > Length(DigitToStr) do
  94.     DigitToStr := '0'+DigitToStr;
  95. end;
  96.  
  97. // значение с коррекцией ошибок
  98. function MakeDigit(Value: Int64): TDigit;
  99. begin
  100.   MakeDigit := Value mod MaxDigit;
  101.   if MakeDigit < 0 then Inc(MakeDigit, MaxDigit); 
  102. end;
  103.  
  104. var
  105.   a, b, c, d: TDigit;
  106.  
  107. // процедура полномасштабного тестирования
  108. procedure FullTest;
  109. var
  110.   r, t: Int64;
  111. begin
  112.   for a := 0 to MaxDigit - 1 do
  113.     for b := 0 to MaxDigit - 1 do begin
  114.       c := a;
  115.       d := Add(c, b);
  116.       t := Int64(d)*MaxDigit + Int64(c);
  117.       r := Int64(a)+Int64(b);
  118.       if (t <> r) or (c < 0) then begin
  119.         WriteLn('Ошибка сложения: ', a, ' + ', b, ' = ', d, '''', DigitToStr(c),
  120.           ' должно быть: ', r);
  121.         Exit;
  122.       end;
  123.  
  124.       c := a;
  125.       d := Mul(c, b);
  126.       t := Int64(d)*MaxDigit + Int64(c);
  127.       r := Int64(a)*Int64(b);
  128.       if (t <> r) or (c < 0) then begin
  129.         WriteLn('Ошибка умножения: ', a, ' * ', b, ' = ', d, '''', DigitToStr(c),
  130.           ' должно быть: ', r);
  131.         Exit;
  132.       end;
  133.     end;
  134.   WriteLn('Проверка сложения и умножения успешна');
  135. end;
  136.  
  137. begin
  138.   Init;
  139.  
  140.   WriteLn('MaxDigit = ', MaxDigit, ' (length = ', DigitLength, ')');
  141.  
  142.   a := MakeDigit(912223443222);
  143.   b := MakeDigit(123223448326);
  144.   Write(DigitToStr(a), ' + ', DigitToStr(b), ' = ');
  145.   Write(DigitToStr(Add(a, b)), ''''); WriteLn(DigitToStr(a));
  146.  
  147.   a := MakeDigit(673993403459);
  148.   b := MakeDigit(381212100238);
  149.   Write(DigitToStr(a), ' * ', DigitToStr(b), ' = ');
  150.   Write(DigitToStr(Mul(a, b)), ''''); WriteLn(DigitToStr(a));
  151.  
  152.   // полная проверка сложения и умножения, только для коротких типов
  153.   if SizeOf(TDigit) <= 1 then
  154.     FullTest;
  155. end.
Success #stdin #stdout 0s 280KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
MaxDigit = 10000 (length = 4)
3222 + 8326 = 0001'1548
3459 * 0238 = 0082'3242
https://ideone.com/JToYl8
Длинная арифметика
language:
Pascal (fpc 3.0.4)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!