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

program Project1;
 
type
  {Тип основных данных (значения десятичных разрядов).}
  TData = 0..9;
  {Тип указателя на элемент списка.}
  TPElem = ^TElem;
  {Тип элемента списка.}
  TElem = record
    Data : TData; {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент списка.}
  end;
  {Тип, описывающий однонаправленный список.}
  TDList = record
    Cnt, Sign : Integer; {Количество разрядов и знак числа.}
    PFirst, PLast : TPElem; {Указатели на первый и на последний элементы списка.}
  end;
 
{
--------------------------------------------------
Подпрограммы для работы со списком.
--------------------------------------------------
}
 
{Начальная инициализация списка. Внимание! Эту процедуру можно выполнять
только в отношении пустого списка! Иначе - будут утечки памяти.}
procedure Init(var aList : TDList);
begin
  with aList do begin
    Cnt := 0;
    Sign := 1;
    PFirst := nil;
    PLast := nil;
  end;
end;
 
{Добавление элемента в конец однонаправленного списка. Функция возвращает
указатель на добавленный элемент.}
function Add(var aList : TDList; const aData : TData) : TPElem;
var
  Res : TPElem;
begin
  Inc(aList.Cnt);
  New(Res);
  Res^.Data := aData;
  Res^.PNext := nil;
  if aList.PFirst = nil then
    aList.PFirst := Res
  else
    aList.PLast^.PNext := Res;
  aList.PLast := Res;
  Add := Res;
end;
 
{Удаление однонаправленного списка из памяти и инициализация.}
procedure Free(var aList : TDList);
var
  PNext, PDel : TPElem;
begin
  PNext := aList.PFirst;
  while PNext <> nil do begin
    PDel := PNext;
    PNext := PNext^.PNext;
    Dispose(PDel);
  end;
  Init(aList);
end;
 
{Составление списка из строки.
Цифры числа хранятся в списке так: вначале - младшие разряды, в конце - старшие.
Т. е., если у нас, например, имеется число: 12345, то в списке оно будет
храниться так: 5 - 4 - 3 - 2 - 1.}
function StrToList(const aStr : String; var aList : TDList) : Boolean;
const
  D = ['0'..'9'];
var
  i, Len, z : Integer;
begin
  Free(aList);
  Len := Length(aStr);
  z := Ord('0');
  for i := Len downto 1 do
    if aStr[i] in D then
      Add(aList, Ord(aStr[i]) - z)
    else if i = 1 then begin
      if aStr[i] = '-' then
        aList.Sign := -1
      else if aStr[i] <> '+' then
        Free(aList);
    end else begin
      Free(aList);
      Break;
    end;
 
  StrToList := aList.PFirst <> nil;
end;
 
{Список - в строку.
Цифры числа хранятся в списке так: вначале - младшие разряды, в конце - старшие.
Т. е., если у нас, например, имеется число: 12345, то в списке оно будет
храниться так: 5 - 4 - 3 - 2 - 1.}
function ListToStr(const aList : TDList) : String;
var
  PElem : TPElem;
  S, Res : String;
begin
  if aList.PFirst = nil then begin
    ListToStr := 'Число не задано';
    Exit;
  end;
 
  Res := '';
  PElem := aList.PFirst;
  while PElem <> nil do begin
    Str(PElem^.Data, S);
    Res := S + Res;
    PElem := PElem^.PNext;
  end;
  if aList.Sign < 0 then Res := '-' + Res;
  ListToStr := Res;
end;
 
{
--------------------------------------------------
Подпрограммы для работы с длинной арифметикой.
--------------------------------------------------
}
 
{Сложение чисел, которые имеют одинаковые знаки.}
procedure Plus(const aL1, aL2 : TDList; var aRes : TDList);
const
  Base = 10;
var
  Res : TDList;
  P1, P2 : TPElem;
  Carry, Num : Integer;
begin
  Free(aRes);
  {Знак результирующего числа.}
  aRes.Sign := aL1.Sign;
  P1 := aL1.PFirst;
  P2 := aL2.PFirst;
  {Величина переноса в следующий старший разряд.}
  Carry := 0;
  {Вычисление продолжаем пока имеются разряды слагаемых чисел или имеется
  НЕнулевое значение переноса.}
  while (P1 <> nil) or (P2 <> nil) or (Carry <> 0) do begin
    {Учитываем значение переноса.}
    Num := Carry;
    {Если имеется разряд числа aL1.}
    if P1 <> nil then begin
      {Добавляем значение разряда числа aL1.}
      Num := Num + P1^.Data;
      {Переход к следующему старшему разряду числа aL1.}
      P1 := P1^.PNext;
    end;
    if P2 <> nil then begin
      {Добавляем значение разряда числа aL2.}
      Num := Num + P2^.Data;
      {Переход к следующему старшему разряду числа aL2.}
      P2 := P2^.PNext;
    end;
    {Вычислем величину переноса в следующий старший разряд.}
    Carry := Num div Base;
    {Вычисленный разряд добавляем в результирующее число.}
    Add(aRes, Num mod Base);
  end;
end;
 
{Вычитание. Знаки чисел aL1 и aL2 должны быть разными. Из числа aL1 вычитается
число aL2. При этом модуль числа aL1 должен быть не меньше модуля числа aL2.
Т. е., в отношении модулей должно выполняться уловие: |aL1| >= |aL2|.
aL1 - "уменьшаемое".
aL2 - "вычитаемое".
aRes - разность.}
procedure Minus(const aL1, aL2 : TDList; var aRes : TDList);
const
  Base = 10;
var
  P, P1, P2 : TPElem;
  Carry, Num : Integer;
begin
  Free(aRes);
  {Результирующее число будет иметь тот же знак, что и знак уменьшаемого.}
  aRes.Sign := aL1.Sign;
  P1 := aL1.PFirst;
  P2 := aL2.PFirst;
  P := nil;
  {Величина заёма из следующего старшего разряда.}
  Carry := 0;
  {Перебор всех разрядов aL1 и aL2.}
  while P1 <> nil do begin
    {Величина текущего разряда aL1 с учётом заёма.}
    Num := Carry + P1^.Data;
    {Переход к следующему старшему разряду aL1.}
    P1 := P1^.PNext;
    {Если в aL2 есть соответствующий разряд.}
    if P2 <> nil then begin
      {Выполняем вычитание значения разряда aL2.}
      Num := Num - P2^.Data;
      {Переход к следующему старшему разряду aL2.}
      P2 := P2^.PNext;
    end;
    {Заём из следующего старшего разряда.}
    Carry := 0;
    {Если разность разрядов получилась отрицательной, то требуется заём из
    следующего старшего разряда.}
    if Num < 0 then begin
      Num := Base + Num;
      Carry := -1;
    end;
    {Добавляем вычисленный разряд в результирующее число.
    При этом, если значение разряда не равно нулю, то запоминаем
    указатель на него. Таким образом, после вычисления всех разрядов
    результирующего числа мы будем иметь указатель на элемент, который
    содержит самый старший значащий разряд. Это нам позволит в дальнейшем
    удалить старшие нулевые незначащие разряды. Т. е., если в результате
    вычислений мы получили число: "0000123", то указатель P будет указывать
    на элемент, который содержит цифру "1". Зная этот указатель,
    мы сможем удалить старшие незначащие разряды - т. е. мы удалим
    ведущие нули "0000".}
    if Num <> 0 then
      P := Add(aRes, Num mod Base)
    else
      Add(aRes, Num mod Base);
  end;
 
  {Здесь мы удаляем из числа старшие незначащие разряды. Т. е., если мы получили
  число "0000123", то незначащими старшими разрядами являются ведущие нули: "0000".
  Вот их мы здесь и будем удалять (если они есть).}
  if P <> aRes.PLast then begin
    {Устанавливаем указатель на младший незначащий ноль.
    Если P = nil, то число имеет вид: "00000". В этом случае нам понадобится
    сохранить один ноль в записи числа. Поэтому, в этом случае, устанавливаем
    указатель на первый элемент списка (это младший ноль).}
    if P = nil then
      P := aRes.PFirst;
    {Исключаем из списка элементы, содержащие незначащие нули.}
    aRes.PLast := P;
    P := P^.PNext;
    aRes.PLast^.PNext := nil;
    {Удаляем из памяти элементы, содержащие незначащие нули.}
    while P <> nil do begin
      P1 := P;
      P := P^.PNext;
      Dispose(P1);
    end;
  end;
end;
 
{Сложение с учётом знаков.}
procedure Calc(const aL1, aL2 : TDList; var aRes : TDList);
var
  P1, P2 : TPElem;
  F : Boolean;
begin
  {Если знаки чисел одинаковые, то выполняем процедуру сложения.}
  if aL1.Sign = aL2.Sign then begin
    Plus(aL1, aL2, aRes);
    Exit;
  end;
 
  {Здесь мы оказываемся, если знаки чисел разные. В этом случае мы должны
  применить процедуру вычитания. В процедуре вычитания модуль первого аргумента
  должен быть не меньше модуля второго аргумента. Поэтому сначала
  определим выполняется ли условие: |aL1| >= |aL2|.
  Если F = True - значит, |aL1| >= |aL2|.
  Если F = False - значит, |aL1| < |aL2|.}
  if aL1.Cnt > aL2.Cnt then
    {Если количество разрядов в aL1 больше, чем в aL2, то |aL1| > |aL2|.}
    F := True
  else if aL1.Cnt < aL2.Cnt then
    {Если количество разрядов в aL1 меньше, чем в aL2, то |aL1| < |aL2|.}
    F := False
  else begin
    {Если в aL1 и aL2 равное количество разрядов, то для выяснения соотношения
    модулей требуется сравнить соответствующие разряды этих чисел.}
    F := True;
    P1 := aL1.PFirst;
    P2 := aL2.PFirst;
    {Сравниваем разряды чисел.}
    while P1 <> nil do begin
      if P1^.Data > P2^.Data then
        F := True
      else if P1^.Data < P2^.Data then
        F := False;
      {Переход к следующему старшему разряду.}
      P1 := P1^.PNext;
      P2 := P2^.PNext;
    end;
  end;
 
  if F then
    Minus(aL1, aL2, aRes)
  else
    Minus(aL2, aL1, aRes);
end;
 
var
  L1, L2, L3 : TDList;
  S : String;
  F : Boolean;
begin
  {Начальная инициализация списков.}
  Init(L1);
  Init(L2);
  Init(L3);
 
  repeat
    repeat
      Writeln('Задайте первое число:');
      Readln(S);
      F := StrToList(S, L1);
      if not F then
        Writeln('Неверный ввод. Повторите.');
    until F;
    repeat
      Writeln('Задайте второе число:');
      Readln(S);
      F := StrToList(S, L2);
      if not F then
        Writeln('Неверный ввод. Повторите.');
    until F;
 
    Calc(L1, L2, L3);
    Writeln('Сумма: ', ListToStr(L3));
 
    {Удаление списков из памяти.}
    Free(L1);
    Free(L2);
    Free(L3);
    Writeln('Списки удалены из памяти.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.