Delphi World - Огромные числа

Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...

Огромные числа

Автор: Lloyd

Данный модуль использует массив байт для предоставления БОЛЬШИХ чисел. Бинарно-хранимые числа заключены в массив, где первый элемент является Наименьшим Значимым Байтом (Least Significant Byte - LSB), последний - Наибольшим Значимым Байтом (Most Significant Byte - MSB), подобно всем Intel-целочисленным типам.

Арифметика здесь использует не 10- или 2-тиричную, а 256-тиричную систему исчисления, чтобы каждый байт представлял одну (1) цифру.

Числа HugeInttype - Подписанные Числа (Signed Numbers).

При компиляции с директивой R+, ADD и MUL могут в определенных обстоятельствах генерировать "Arithmetic Overflow Error" (RunError(215)) - ошибка арифметического переполнения. В таком случае пользуйтесь переменной "HugeIntCarry".

Переменная "HugeIntDiv0" используется для проверки деления на ноль.

Используйте {$DEFINE HugeInt_xx } или поле "Conditional defines" (символ условного компилирования) в "Compiler options" (опции компилятора) для задания размерности, где xx должно быть равно 64, 32 или 16, в противном случае HugeIntSize будет равен 8 байтам.

unit HugeInts;
interface

const
{$IFDEF HugeInt_64 }

  HugeIntSize = 64;

{$ELSE}{$IFDEF HugeInt_32 }

  HugeIntSize = 32;
{$ELSE}{$IFDEF HugeInt_16 }

  HugeIntSize = 16;
{$ELSE}

  HugeIntSize = 8;
{$ENDIF}{$ENDIF}{$ENDIF}

  HugeIntMSB = HugeIntSize - 1;

type

  HugeInt = array[0..HugeIntMSB] of Byte;

const

  HugeIntCarry: Boolean = False;
  HugeIntDiv0: Boolean = False;

procedure HugeInt_Min(var a: HugeInt); { a := -a }
procedure HugeInt_Inc(var a: HugeInt); { a := a + 1 }
procedure HugeInt_Dec(var a: HugeInt); { a := a - 1 }

procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt); { R := a + b }
procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt); { R := a - b }
procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt); { R := a * b }
procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt); { R := a div b }
procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt); { R := a mod b }

function HugeInt_IsNeg(a: HugeInt): Boolean;
function HugeInt_Zero(a: HugeInt): Boolean;
function HugeInt_Odd(a: HugeInt): Boolean;

function HugeInt_Comp(a, b: HugeInt): Integer; {-1:a< 0; 1:a>}
procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt); { Dest := Src }

procedure String2HugeInt(AString: string; var a: HugeInt);
procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt);
procedure HugeInt2String(a: HugeInt; var S: string);

implementation

procedure HugeInt_Copy(Src: HugeInt; var Dest: HugeInt);
{ Dest := Src }
begin

  Move(Src, Dest, SizeOf(HugeInt));
end; { HugeInt_Copy }

function HugeInt_IsNeg(a: HugeInt): Boolean;
begin

  HugeInt_IsNeg := a[HugeIntMSB] and $80 > 0;
end; { HugeInt_IsNeg }

function HugeInt_Zero(a: HugeInt): Boolean;
var
  i: Integer;
begin

  HugeInt_Zero := False;
  for i := 0 to HugeIntMSB do
    if a[i] <> 0 then
      Exit;
  HugeInt_Zero := True;
end; { HugeInt_Zero }

function HugeInt_Odd(a: HugeInt): Boolean;
begin

  HugeInt_Odd := a[0] and 1 > 0;
end; { HugeInt_Odd }

function HugeInt_HCD(a: HugeInt): Integer;
var
  i: Integer;
begin

  i := HugeIntMSB;
  while (i > 0) and (a[i] = 0) do
    Dec(i);
  HugeInt_HCD := i;
end; { HugeInt_HCD }

procedure HugeInt_SHL(var a: HugeInt; Digits: Integer);
{ Перемещение байтов переменной "Digits" в левую часть,

байты "Digits" будут 'ослабевать' в MSB-части.
LSB-часть заполняется нулями. }
var
  t: Integer;
  b: HugeInt;
begin

  if Digits > HugeIntMSB then
    FillChar(a, SizeOf(HugeInt), 0)
  else if Digits > 0 then
  begin
    Move(a[0], a[Digits], HugeIntSize - Digits);
    FillChar(a[0], Digits, 0);
  end; { else if }
end; { HugeInt_SHL }

procedure HugeInt_SHR(var a: HugeInt; Digits: Integer);
var
  t: Integer;
begin

  if Digits > HugeIntMSB then
    FillChar(a, SizeOf(HugeInt), 0)
  else if Digits > 0 then
  begin
    Move(a[Digits], a[0], HugeIntSize - Digits);
    FillChar(a[HugeIntSize - Digits], Digits, 0);
  end; { else if }
end; { HugeInt_SHR }

procedure HugeInt_Inc(var a: HugeInt);
{ a := a + 1 }
var

  i: Integer;
  h: Word;
begin

  i := 0;
  h := 1;
  repeat
    h := h + a[i];
    a[i] := Lo(h);
    h := Hi(h);
    Inc(i);
  until (i > HugeIntMSB) or (h = 0);
  HugeIntCarry := h > 0;
{$IFOPT R+ }
  if HugeIntCarry then
    RunError(215);
{$ENDIF}
end; { HugeInt_Inc }

procedure HugeInt_Dec(var a: HugeInt);
{ a := a - 1 }
var
  Minus_1: HugeInt;
begin

  { самый простой способ }
  FillChar(Minus_1, SizeOf(HugeInt), $FF); { -1 }
  HugeInt_Add(a, Minus_1, a);
end; { HugeInt_Dec }

procedure HugeInt_Min(var a: HugeInt);
{ a := -a }
var
  i: Integer;
begin

  for i := 0 to HugeIntMSB do
    a[i] := not a[i];
  HugeInt_Inc(a);
end; { HugeInt_Min }

function HugeInt_Comp(a, b: HugeInt): Integer;
{ a = b: ==0; a > b: ==1; a < b: ==-1 }
var

  A_IsNeg, B_IsNeg: Boolean;
  i: Integer;
begin

  A_IsNeg := HugeInt_IsNeg(a);
  B_IsNeg := HugeInt_IsNeg(b);
  if A_IsNeg xor B_IsNeg then
    if A_IsNeg then
      HugeInt_Comp := -1
    else
      HugeInt_Comp := 1
  else
  begin
    if A_IsNeg then
      HugeInt_Min(a);
    if B_IsNeg then
      HugeInt_Min(b);
    i := HugeIntMSB;
    while (i > 0) and (a[i] = b[i]) do
      Dec(i);
    if A_IsNeg then { оба отрицательные! }
      if a[i] > b[i] then
        HugeInt_Comp := -1
      else if a[i] < b[i] then
        HugeInt_Comp := 1
      else
        HugeInt_Comp := 0
    else { оба положительные } if a[i] > b[i] then
        HugeInt_Comp := 1
      else if a[i] < b[i] then
        HugeInt_Comp := -1
      else
        HugeInt_Comp := 0;
  end; { else }
end; { HugeInt_Comp }

procedure HugeInt_Add(a, b: HugeInt; var R: HugeInt);
{ R := a + b }
var

  i: Integer;
  h: Word;
begin

  h := 0;
  for i := 0 to HugeIntMSB do
  begin
    h := h + a[i] + b[i];
    R[i] := Lo(h);
    h := Hi(h);
  end; { for }
  HugeIntCarry := h > 0;
{$IFOPT R+ }
  if HugeIntCarry then
    RunError(215);
{$ENDIF}
end; { HugeInt_Add }

procedure HugeInt_Sub(a, b: HugeInt; var R: HugeInt);
{ R := a - b }
var

  i: Integer;
  h: Word;
begin

  HugeInt_Min(b);
  HugeInt_Add(a, b, R);
end; { HugeInt_Sub }

procedure HugeInt_Mul(a, b: HugeInt; var R: HugeInt);
{ R := a * b }
var

  i, j, k: Integer;
  A_end, B_end: Integer;
  A_IsNeg, B_IsNeg: Boolean;
  h: Word;
begin

  A_IsNeg := HugeInt_IsNeg(a);
  B_IsNeg := HugeInt_IsNeg(b);
  if A_IsNeg then
    HugeInt_Min(a);
  if B_IsNeg then
    HugeInt_Min(b);
  A_End := HugeInt_HCD(a);
  B_End := HugeInt_HCD(b);
  FillChar(R, SizeOf(R), 0);
  HugeIntCarry := False;
  for i := 0 to A_end do
  begin
    h := 0;
    for j := 0 to B_end do
      if (i + j) < HugeIntSize then
      begin
        h := h + R[i + j] + a[i] * b[j];
        R[i + j] := Lo(h);
        h := Hi(h);
      end; { if }
    k := i + B_End + 1;
    while (k < HugeIntSize) and (h > 0) do
    begin
      h := h + R[k];
      R[k] := Lo(h);
      h := Hi(h);
      Inc(k);
    end; { while }
    HugeIntCarry := h > 0;
{$IFOPT R+}
    if HugeIntCarry then
      RunError(215);
{$ENDIF}
  end; { for }
  { если все хорошо... }
  if A_IsNeg xor B_IsNeg then
    HugeInt_Min(R);
end; { HugeInt_Mul }

procedure HugeInt_DivMod(var a: HugeInt; b: HugeInt; var R: HugeInt);
{ R := a div b  a := a mod b }
var

  MaxShifts, s, q: Integer;
  d, e: HugeInt;
  A_IsNeg, B_IsNeg: Boolean;
begin

  if HugeInt_Zero(b) then
  begin
    HugeIntDiv0 := True;
    Exit;
  end { if }
  else
    HugeIntDiv0 := False;
  A_IsNeg := HugeInt_IsNeg(a);
  B_IsNeg := HugeInt_IsNeg(b);
  if A_IsNeg then
    HugeInt_Min(a);
  if B_IsNeg then
    HugeInt_Min(b);
  if HugeInt_Comp(a, b) < 0 then
    { a<b; нет необходимости деления }
    FillChar(R, SizeOf(R), 0)
  else
  begin
    FillChar(R, SizeOf(R), 0);
    repeat
      Move(b, d, SizeOf(HugeInt));
      { сначала вычисляем количество перемещений (сдвигов) }
      MaxShifts := HugeInt_HCD(a) - HugeInt_HCD(b);
      s := 0;
      while (s <= MaxShifts) and (HugeInt_Comp(a, d) >= 0) do
      begin
        Inc(s);
        HugeInt_SHL(d, 1);
      end; { while }
      Dec(s);
      { Создаем новую копию b }
      Move(b, d, SizeOf(HugeInt));
      { Перемещаем (сдвигаем) d }
      HugeInt_ShL(d, S);
      { Для добавление используем e = -d, это быстрее чем вычитание d }
      Move(d, e, SizeOf(HugeInt));
      HugeInt_Min(e);
      Q := 0;
      { пока a >= d вычисляем a := a+-d и приращиваем Q}
      while HugeInt_Comp(a, d) >= 0 do
      begin
        HugeInt_Add(a, e, a);
        Inc(Q);
      end; { while }
      { Упс!, слишком много вычитаний; коррекция }
      if HugeInt_IsNeg(a) then
      begin
        HugeInt_Add(a, d, a);
        Dec(Q);
      end; { if }
      HugeInt_SHL(R, 1);
      R[0] := Q;
    until HugeInt_Comp(a, b) < 0;
    if A_IsNeg xor B_IsNeg then
      HugeInt_Min(R);
  end; { else }
end; { HugeInt_Div }

procedure HugeInt_DivMod100(var a: HugeInt; var R: Integer);
{ 256-тиричное деление - работает только с

положительными числами: R := a mod 100; a:= a div 100; }
var

  Q: HugeInt;
  S: Integer;
begin

  R := 0;
  FillChar(Q, SizeOf(Q), 0);
  S := HugeInt_HCD(a);
  repeat
    r := 256 * R + a[S];
    HugeInt_SHL(Q, 1);
    Q[0] := R div 100;
    R := R mod 100;
    Dec(S);
  until S < 0;
  Move(Q, a, SizeOf(Q));
end; { HugeInt_DivMod100 }

procedure HugeInt_Div(a, b: HugeInt; var R: HugeInt);
begin

  HugeInt_DivMod(a, b, R);
end; { HugeInt_Div }

procedure HugeInt_Mod(a, b: HugeInt; var R: HugeInt);
begin

  HugeInt_DivMod(a, b, R);
  Move(a, R, SizeOf(HugeInt));
end; { HugeInt_Mod }

procedure HugeInt2String(a: HugeInt; var S: string);

  function Str100(i: Integer): string;
  begin
    Str100 := Chr(i div 10 + Ord('0')) + Chr(i mod 10 + Ord('0'));
  end; { Str100 }
var

  R: Integer;
  Is_Neg: Boolean;
begin

  S := '';
  Is_Neg := HugeInt_IsNeg(a);
  if Is_Neg then
    HugeInt_Min(a);
  repeat
    HugeInt_DivMod100(a, R);
    Insert(Str100(R), S, 1);
  until HugeInt_Zero(a) or (Length(S) = 254);
  while (Length(S) > 1) and (S[1] = '0') do
    Delete(S, 1, 1);
  if Is_Neg then
    Insert('-', S, 1);
end; { HugeInt2String }

procedure String_DivMod256(var S: string; var R: Integer);
{ 10(00)-тиричное деление - работает только с

положительными числами: R := S mod 256; S := S div 256 }
var
  Q: string;
begin

  FillChar(Q, SizeOf(Q), 0);
  R := 0;
  while S <> '' do
  begin
    R := 10 * R + Ord(S[1]) - Ord('0');
    Delete(S, 1, 1);
    Q := Q + Chr(R div 256 + Ord('0'));
    R := R mod 256;
  end; { while }
  while (Q <> '') and (Q[1] = '0') do
    Delete(Q, 1, 1);
  S := Q;
end; { String_DivMod256 }

procedure String2HugeInt(AString: string; var a: HugeInt);
var

  i, h: Integer;
  Is_Neg: Boolean;
begin

  if AString = '' then
    AString := '0';
  Is_Neg := AString[1] = '-';
  if Is_Neg then
    Delete(Astring, 1, 1);
  i := 0;
  while (AString <> '') and (i <= HugeIntMSB) do
  begin
    String_DivMod256(AString, h);
    a[i] := h;
    Inc(i);
  end; { while }
  if Is_Neg then
    HugeInt_Min(a);
end; { String2HugeInt }

procedure Integer2HugeInt(AInteger: Integer; var a: HugeInt);
var
  Is_Neg: Boolean;
begin

  Is_Neg := AInteger < 0;
  if Is_Neg then
    AInteger := -AInteger;
  FillChar(a, SizeOf(HugeInt), 0);
  Move(AInteger, a, SizeOf(Integer));
  if Is_Neg then
    HugeInt_Min(a);
end; { Integer2HugeInt }

end.