Счетчик операций со стеком - Pascal

Формулировка задачи:

есть код работы сортировки стека и надо сделать счетчик операций со стеком. В принципе смог реализовать счетчик, но есть подозрение что-то не так,потому что при сортировки 100 элементов выходит 469064 операций. Можете подсказать что я упустил или наоборот накосячил.

uses
  SysUtils;
type
  tItem = ^pItem;
  pItem = record
    n : Integer;
    x : tItem;
  end;
 
type
  tStack = record
    Items : tItem;
    Empty : boolean;
  end;
 var
 t,t1,t2: TDateTime;
ch:int64;
function NewStack : tStack;
var
  Stack : tStack;
begin
  Stack.Items := nil;
  Stack.Empty := True;
  NewStack := Stack;
  ch:=ch+5;
end;
 
procedure Push(n : Integer; var Stack : tStack);
var
  tmp : tItem;
begin
  New(tmp);
  tmp^.n := n;
  tmp^.x := Stack.Items;
  Stack.Items := tmp;
  Stack.Empty := False;
  ch:=ch+10;
end;
 
function Pop(var Stack : tStack) : Integer;
var
  res : Integer;
  tmp : tItem;
begin
  if Not Stack.Empty then
    begin
      tmp := Stack.Items;
      Stack.Items := Stack.Items^.x;
      Stack.Empty := Stack.Items = nil;
      res := tmp^.n;
      Dispose(tmp);
      ch:=ch+13;
    end;
  Pop := res;
  ch:=ch+2;
end;
 
function CreateStack(n : Integer) : tStack;
var
  Stack : tStack;
begin
  Stack := NewStack;
  while n > 0 do
    begin
      Push(Random(10), Stack);
      Dec(n);
      ch:=ch+3;
    end;
  CreateStack := Stack;
  ch:=ch+3;
end;
 
procedure PrintStack(Stack : tStack);
var
  tmp : tItem;
begin
  tmp := Stack.Items;
  if Stack.Empty then
    Write('Стек пуст!')
  else
    while tmp <> nil do
      begin
        Write(#32, tmp^.n); tmp := tmp^.x;
        ch:=ch+2;
      end;
      ch:=ch+3;
  WriteLn;
end;
 
procedure ClearStack(var Stack : tStack);
begin
  while Not Stack.Empty do Pop(Stack);
  ch:=ch+2;
end;
 
procedure SortStack(var Stack : tStack);
var
  swap : Boolean;
  tmpStack : tStack;
  n1, n2 : Integer;
begin
  if Stack.Empty then Exit;
  tmpStack := NewStack;
  repeat
    swap := False;
    n1 := Pop(Stack);
    while Not Stack.Empty do
      begin
        n2 := Pop(Stack);
        if n1 > n2 then
          begin
            Push(n2, tmpStack); swap := True;
          end
        else
          begin
            Push(n1, tmpStack); n1 := n2;
          end;
          ch:=ch+2;
      end;
    Push(n1, Stack);
    while Not tmpStack.Empty do
      Push(Pop(tmpStack), Stack);
      ch:=ch+3;
  until Not swap;
  ch:=ch+3;
end;
 
var
  Stack : tStack;
begin
  Stack := CreateStack(100);
  PrintStack(Stack);
  t1:=now;
  SortStack(Stack);
  PrintStack(Stack);
  ClearStack(Stack);
  t2:=now; t:=t2-t1;
  writeln('Время сортировки: ',FormatDateTime('hh:mm:ss.zzz',t));
  write('количество операций со стеком: ',ch);
  readln;
end.

Решение задачи: «Счетчик операций со стеком»

Листинг программы

program Project4;
 
{$APPTYPE CONSOLE}
 
uses
  SysUtils;
 
type ochered=^Rec;
     Rec=record
     info:    integer;
     next:    ochered;
     end;
var
head, head1:  ochered;
n, i, j, z, k,  y, x, x1: integer;
t,t1,t2: TDateTime;
ch: int64;
 
procedure push(var head:ochered; x:integer);  // 6
var a:        ochered;
begin
    new(a);                                //+1
    a^.info:=x;                            //+2
    a^.next:=head;                         //+2
    head:=a;                               //+1
    ch:=ch+6;
end;
 
procedure pop(var head:ochered; var x:integer);  //8+
var a, p:     ochered;
begin
   a:=head;  p:=head; ch:=ch+3;          //+2
       while a^.next<>nil do begin       //+2
         p:=a; a:=a^.next; ch:=ch+4;     //+3
       end;
   x:=a^.info; p^.next:=nil;             //+4
   dispose(a);                           //+1
   ch:=ch+5;
end;
 
function empty(head:ochered): boolean;    //2
begin
   empty:=head=nil;                      //+2
   ch:=ch+2;
end;
 
procedure iniz(var head:ochered; var n:integer);  //1+
var x, i:      integer;
begin
   for i:= 1 to n do begin
      x:=Random(501)+300;             //+3
      push(head,x);                   //+6
      ch:=ch+9;
   end;
end;
 
BEGIN
ch:=0; //счетчик
write('Enter the number of items: ');
   readln(n);
   t1:=now;
   head := nil;
iniz(head,n);
head1:=nil;
ch:=ch+6;
 
For i:= 1 to n-1 do
  For j:= n downto i+1 do begin
    if not empty(head1) then begin  //+3
      head:=head1;                    //+1
      head1:=nil;                     //+1
      ch:=ch+2;
    end;
    ch:=ch+1;
    For z:=1 to j-2 do begin   //1+
       pop(head,y); push(head1,y);//+6+8+
    end;
    ch:=ch+2;
    pop(head,x); pop(head,x1); // 16+2*
    If x>x1 then begin       //+1
      push(head1,x); push(head1,x1);
    end //+12
    else begin
      push(head1,x1); push(head1,x);
    end; //+12
    ch:=ch+1;
    If j<n then begin                    //+1
        For k:= 1 to n-j do begin      //1+
          pop(head,y); push(head1,y);       //+6+8
        end;
        ch:=ch+1;
    end;
    ch:=ch+1;
end;
 
For i:= 1 to n do begin
  pop(head1,x);
  writeln('stack[',i,'] = ',x);
  ch:=ch+1;
end;
ch:=ch+1;
t2:=now; t:=t2-t1;
writeln;
writeln('Your time: ',FormatDateTime('hh:mm:ss.zzz',t));
writeln('Num of operations: ',ch);
readln;
 
  try
    { TODO -oUser -cConsole Main : Insert code here }
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
 
end.

Объяснение кода листинга программы

Объявление переменных и типов данных:
- head, head1: ochered;
- n, i, j, z, k, y, x, x1: integer;
- t,t1,t2: TDateTime;
- ch: int64;
- ochered = ^Rec;
- Rec = record info: integer; next: ochered; end;
Функция push(var head:ochered; x:integer):
- Создание нового элемента в стеке (new(a));
- Присваивание значения и добавление в стек (a^.info:=x; a^.next:=head; head:=a;);
- Увеличение счетчика операций на 6.
Функция pop(var head:ochered; var x:integer):
- Проверка пустоты стека (a^.next<>nil) и удаление всех элементов до последнего (while a^.next<>nil do begin a:=a^.next; disopse(a); end);
- Сохранение значения последнего элемента (x:=a^.info;);
- Удаление ссылки на последний элемент (p^.next:=nil;);
- Увеличение счетчика операций на 8.
Функция empty(head:ochered): boolean:
- Проверка равенства head и nil (empty:=head=nil);
- Увеличение счетчика операций на 2.
Процедура iniz(var head:ochered; var n:integer):
- Создание n случайных чисел и добавление их в стек (for i:= 1 to n do begin x:=Random(501)+300; push(head,x); end);
- Увеличение счетчика операций на 9.
Основной цикл программы:
- Проверка пустоты стека и удаление элементов до указанного индекса (For i:= 1 to n-1 do begin If not empty(head1) then begin head:=head1; head1:=nil; end; For j:= n downto i+1 do begin If not empty(head1) then begin head:=head1; head1:=nil; end; If x>x1 then begin push(head1,x); push(head1,x1); end else begin push(head1,x1); push(head1,x); end; If j<n then begin For k:= 1 to n-j do begin pop(head1,y); push(head1,y); end; end; pop(head1,x); writeln('stack[',i,'] = ',x); end;
- Увеличение счетчика операций на 1.
Вывод результатов:
- Вывод времени выполнения программы (t2-t1);
- Вывод количества операций (ch);
- Чтение строки от пользователя (readln).