fork download
  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
stdin
Standard input is empty
stdout
MaxDigit = 10000 (length = 4)
3222 + 8326 = 0001'1548
3459 * 0238 = 0082'3242