Падает программа на сортировке массивов и поиске количества операций сравнений

program laba;
 
uses
  crt;
 
type
  MyArr = array[1..10000000]of longint;
 
var
  a: MyArr;
  l, r, n, i, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13, s14, s15, s16, count, start, step, finish: longint;
 
procedure vivod;
 
var
  i: longint;
begin
  for i := 1 to n do
    write(a[i], ' ');
  writeln;
  readln;
end;
 
 
procedure vvod_random(var n: longint; var a: myarr);{задание массива случайно}
 
var
  i, l: longint;
begin
  writeln('введите n');
  readln(n);
  
  randomize;
  for i := 1 to n do
    a[i] := random(100);
end;
 
procedure vvod_hand(var n: longint; var a: myarr);{задание массива вручную}
 
var
  i: longint;
begin
  Writeln('Введите количество элементов массива:');
  readln(n);
  clrscr;
  Writeln('Введите элементы массива:');
  for i := 1 to n do
    Readln(A[i]);
  Readln;
end;
 
procedure vvod_geom_progressive(var n: longint; var a: myarr);{задание массива геометрической прогрессией}
 
var
  i,  p, q: longint;
begin
  Writeln('Введите количество элементов массива:');
  readln(n);
  Writeln('Введите первый элемент:');
  readln(p);
  Writeln('Введите знаменатель прогрессии:');
  readln(q);
  a[1] := p;
  for i := 2 to n do
    a[i] := a[i - 1] * q;
end;
 
procedure vvod_arifm_progressive(var n: longint; var a: myarr);{задание массива арифмитической прогрессией}
 
var
  i, p, d: longint;
begin
  Writeln('Введите количество элементов массива:');
  readln(n);
  Writeln('Введите первый элемент убывающей арифметической прогресии:');
  readln(p);
  Writeln('Введите шаг прогрессии (d<0):');
  readln(d);
  if d > 0 then write('не выполнятеся условие (d<0)');
  if d < 0 then
    a[1] := p;
  for i := 2 to n do
    a[i] := a[i - 1] + d;
end;
 
procedure  sort_podscheta(var n: longint; var a: myarr; var count: longint);{сортировка подсчета(линейная)}
var
  
  b: myarr;
  i, j, k: longint;
begin
  count := 0;
  for i := 1 to 100000 do
    b[i] := 0;
  for i := 1 to n    do
    inc(b[a[i]]);
  k := 1;
  for i := 0 to 100000 do
    for j := 1 to b[i] do    
    begin
      a[k] := i;
      inc(k);
      inc(count);
    end;
end;
 
procedure sort_select(var n: longint; var a: myarr; var count: longint);{сортировка выбора}
var
  i, f: longint;
begin
  count := 0;
  f := 1;
  while f <> 0 do
  begin
    f := 0;
    for i := 1 to n - 1 do
      if a[i] > a[i + 1] then 
      begin
        inc(count);
        swap(a[i], a[i + 1]);
        f := 1;
      end;
  end;
end;
 
procedure sort_swap(var n: longint; var a: myarr; var count: longint);{сортировка сравнением(пузырь)}
var
  i, f: longint;
begin
  count := 0;
  f := 1;
  while f <> 0 do
  begin
    f := 0;
    for i := 1 to n - 1 do
      if a[i] > a[i + 1] then 
      begin
        inc(count);
        swap(a[i], a[i + 1]);
        f := 1;
      end;
  end;  
end;
 
procedure swap(var a, b: longint);
var
  t: longint;
begin
  t := a;
  a := b;
  b := t;
end;
 
procedure sort_vstavki(var n: longint; var a: myarr; var count: longint);{сортировка вставками}
var
  s7: longint; 
  s8: longint;
  i, j, b: longint;
begin
  count := 0;
  for i := 2 to n do
  begin
    b := a[i];
    j := i - 1;
    while (j >= 1) and (a[j] > b) do
    begin
      inc(count);
      a[j + 1] := a[j];
      j := j - 1;
    end;
    a[j + 1] := b;
  end;  
end;
 
procedure sort_shell(var n: longint; var a: myarr; var count: longint);{ сортировка Шелла }
var
  i, j, d, ch: longint;
begin
  count := 0;
  d := n;
  d := d div 2;
  while (d > 0) do
  begin
    for i := 1 to n - d do
    begin
      j := i;
      while ((j > 0) and (a[j] > a[j + d])) do
      begin
        Inc(count);
        ch := a[j];
        a[j] := a[j + d];
        a[j + d] := ch;
        j := j - 1;
      end;
    end;
    d := d div 2;
  end;
end;
 
procedure Quick_Sort(var n: longint;{bysrtaya}
                     var a: myarr;
                     var count: longint;
                     l, r: longint);
var
  i, j, x, y: longint;
begin
  count := 0;
  i := l;
  j := r;
  x := a[(l + r) div 2];
  repeat
    while (a[i] < x) do
      inc(i);
    while (x < a[j]) do
      dec(j);
    if (i <= j) then
    begin
      y := a[i];
      a[i] := a[j];
      a[j] := y;
      inc(i);
      dec(j);
    end;
  until (i > j);
  if (l < j) then
    Quick_Sort(n, a, count, l, j);
  if (i < r) then
    Quick_Sort(n, a, count, i, r);
  count := count + 1;
end;
 
procedure search_binary(var n: longint; {Бинарный поиск}
                        var a: myarr;
                        var count: longint);
var
  i, c, f, b, x: longint;
 
begin
  count := 0;
  writeln('Искомое число');
  readln(c);
  f := 1;
  b := n; 
  while (f < b) do
  begin
    x := f + (b - f) div 2;
    if a[x] = c then
    begin
      inc(count);
      b := x;
      f := x;
    end
    else begin
      inc(count);
      if a[x] < c then
        f := x 
      else b := x - 1
    end;
  end;
  if (b = x) or (f = x) then writeln('искомы элемент находиться на ', f, ' месте')
  else
    write('такого элемента нет'); 
  readln;
end;
 
procedure search_line(var n: longint;
                      var a: myarr;
                      var count: longint);{Линейный поиск}
var
  s, i, c1, k: longint;
begin
  count := 0;
  writeln('Введите искомый элемент');
  readln(s);
  c1 := 0;
  k := 0;
  for i := 1 to n do
  begin
    inc(count);
    if a[i] = s then
    begin
      inc(c1);
      k := i;
      if c1 <> 0 then
        writeln('искомы элемент находиться на ', k, ' месте')
      else writeln('таковых нет');
      readln;
    end;
  end;
end;
 
procedure vvod_exrerementov(var start, finish, step: integer);
var
  f1, f2, f3: boolean;
begin
  clrscr;
  f1 := false;
  while f1 = false do 
  begin
    writeln('Введите начальное значене колличества элементов =');
    readln(Start);
    if (start > 1000000) or (start < 1)  then 
    begin
      f1 := false;
    end
    else
      f1 := true;
  end;
  f2 := false;
  while f2 = false do 
  begin
    writeln('Введите конечное количество элементов =');
    readln(finish);
    if (finish > 1000001) or (finish < 10) or (finish <= start) then
    begin
      f2 := false;
    end
    else
      f2 := true;
  end;
  f3 := false;
  while f3 = false do 
  begin
    writeln('Введите шаг расчета =');
    readln(step);
    if (step > 1000000) or (step < 1) or (step >= (finish - start))  then
    begin
      f3 := false;
    end
    else
      f3 := true;
  end;
end;
 
 
procedure exp_sort_podscheta;
var
  i: longint;
  flag: boolean;
  key: char;
begin
  clrscr;
  vvod_exrerementov(start, finish, step);
  while (start < finish) do 
  begin
    N := start;
    for i := 1 to n do
      a[i] := random(4 * n) - 2 * n;
    s1 := milliseconds;
    sort_podscheta(n, a, count);
    s2 := milliseconds;
    writeln('  N=', start, '   \  количество операций=', count, '   \  время работы=', (s2 - s1) div 3600 div 1000, ':', (s2 - s1) div 60 div 1000, ':', (s2 - s1) div 1000, ':', (s2 - s1) mod 1000);  
    writeln('Продолжить? (+/-)');
    flag := false;
    while flag = false do
    begin
      key := readkey;
      if key = 'n' then
      begin
        clrscr;
        exit;
      end;
      if (key <> '+') and (key <> '-') then
      begin
        flag := false
      end
      else
        flag := true
      
    end;
    start := start + step;
  end;
end;
 
procedure exp_sort_select;
var
  i: longint;
  flag: boolean;
  key: char;
begin
  clrscr;
  vvod_exrerementov(start, finish, step);
  while (start < finish) do 
  begin
    N := start;
    for i := 1 to n do
      a[i] := random(4 * n) - 2 * n;
    s3 := milliseconds;
    sort_select(n, a, count);
    s4 := milliseconds;
    writeln('  N=', start, '  \  количество операций=', count, '  \  время работы=', (s4 - s3) div 3600 div 1000, ':', (s4 - s3) div 60 div 1000, ':', (s4 - s3) div 1000, ':', (s4 - s3) mod 1000);  
    writeln('Продолжить? (+/-)');
    flag := false;
    while flag = false do
    begin
      key := readkey;
      if key = 'n' then
      begin
        clrscr;
        exit;
      end;
      if (key <> '+') and (key <> '-') then
      begin
        flag := false
      end
      else
        flag := true
      
    end;
    start := start + step;
  end;
end;
 
 
procedure exp_sort_swap;
var
  i: longint;
  flag: boolean;
  key: char;
begin
  clrscr;
  vvod_exrerementov(start, finish, step);
  while (start < finish) do 
  begin
    N := start;
    for i := 1 to n do
      a[i] := random(4 * n) - 2 * n;
    s5 := milliseconds;
    sort_swap(n, a, count);
    s6 := milliseconds;
    writeln('  N=', start, '  \  количество операций=', count,  '  \  время работы=', (s6 - s5) div 3600 div 1000, ':', (s6 - s5) div 60 div 1000, ':', (s6 - s5) div 1000, ':', (s6 - s5) mod 1000);  
    writeln('Продолжить? (+/-)');
    flag := false;
    while flag = false do
    begin
      key := readkey;
      if key = 'n' then
      begin
        clrscr;
        exit;
      end;
      if (key <> '+') and (key <> '-') then
      begin
        flag := false
      end
      else
        flag := true
      
    end;
    start := start + step;
  end;
end;
 
procedure exp_sort_vstavki;
var
  i: longint;
  flag: boolean;
  key: char;
begin
  clrscr;
  vvod_exrerementov(start, finish, step);
  while (start < finish) do 
  begin
    N := start;
    for i := 1 to n do
      a[i] := random(4 * n) - 2 * n;
    s7 := milliseconds;
    sort_vstavki(n, a, count);
    s8 := milliseconds;
    writeln('  N=', start, '  \  количество операций=', count, '   \  время работы=', (s8 - s7) div 3600 div 1000, ':', (s8 - s7) div 60 div 1000, ':', (s8 - s7) div 1000, ':', (s8 - s7) mod 1000);  
    writeln('Продолжить? (+/-)');
    flag := false;
    while flag = false do
    begin
      key := readkey;
      if key = 'n' then
      begin
        clrscr;
        exit;
      end;
      if (key <> '+') and (key <> '-') then
      begin
        flag := false
      end
      else
        flag := true
      
    end;
    start := start + step;
  end;
end;
 
 
procedure exp_sort_shell;
var
  i: longint;
  flag: boolean;
  key: char;
begin
  clrscr;
  vvod_exrerementov(start, finish, step);
  while (start < finish) do 
  begin
    N := start;
    for i := 1 to n do
      a[i] := random(4 * n) - 2 * n;
    s9 := milliseconds;
    sort_shell(n, a, count);
    s10 := milliseconds;
    writeln('  N=', start, '  \  количество операций=', count, '   \   время работы=', (s10 - s9) div 3600 div 1000, ':', (s10 - s9) div 60 div 1000, ':', (s10 - s9) div 1000, ':', (s10 - s9) mod 1000);  
    writeln('Продолжить? (+/-)');
    flag := false;
    while flag = false do
    begin
      key := readkey;
      if key = 'n' then
      begin
        clrscr;
        exit;
      end;
      if (key <> '+') and (key <> '-') then
      begin
        flag := false
      end
      else
        flag := true
      
    end;
    start := start + step;
  end;
end;
 
procedure exp_quick_sort;
var
  i: longint;
  flag: boolean;
  key: char;
begin
  clrscr;
  vvod_exrerementov(start, finish, step);
  while (start < finish) do 
  begin
    N := start;
    for i := 1 to n do
      a[i] := random(4 * n) - 2 * n;
    s11 := milliseconds;
    quick_sort(n, a, count, l, r);
    s12 := milliseconds;
    
    writeln('  N=', start, '  \  количество операций=', count, '  \  время работы=', (s12 - s11) div 3600 div 1000, ':', (s12 - s11) div 60 div 1000, ':', (s12 - s11) div 1000, ':', (s12 - s11) mod 1000);  
    
    writeln('Далее? (+/-)');
    flag := false;
    while flag = false do
    begin
      key := readkey;
      if key = 'n' then
      begin
        clrscr;
        exit;
      end;
      if (key <> '+') and (key <> '-') then
      begin
        flag := false
      end
      else
        flag := true
      
    end;
    start := start + step;
  end;
end;
 
procedure make_massiv;
var
  
  op: longint;
  f: boolean;
  c: char;
  i, j: longint;
  mn: array[0..4] of string;
begin
  
  
  op := 0;
  f := true;
  
  mn[0] := '0. Выход';
  mn[1] := '1. Случайным образом';
  mn[2] := '2. Ручной ввод';
  mn[3] := '3. Арифмитическая прогрессия';
  mn[4] := '4. Геометрическая прогрессия';
  
  while f do
  begin
    clrscr;
    
    
    for j := 0 to 4 do
    begin
      if(j = op) then write('*');
      writeln(mn[j]);
    end;
    c := readKey;
    if c = #0 then c := readKey;
    i := ord(c);  
    case i of
      38: 
        begin
          op := (op + 4) mod 5;
        end;
      40: 
        begin
          op := (op + 1) mod 5;
        end;
      13:
        begin
          case op of
            0: 
              begin
                f := false;
              end;
            1: 
              begin
                vvod_random(n, a);
                vivod;
                
              end;
            2: 
              begin
                vvod_hand(n, a);
                vivod;
              end;
            3: 
              begin
                vvod_arifm_progressive(n, a);
                vivod;
              end;
            4: 
              begin
                vvod_geom_progressive(n, a);
                vivod;
              end;
          
          end;
        end;
    end;
  end;
end;
 
procedure sort_massiv;
var
  op: longint;
  f: boolean;
  c: char;
  i, j: longint;
  mn: array[0..6] of string;
begin
  op := 0;
  f := true;
  
  mn[0] := '0. Выход';
  mn[1] := '1. Сортировка выбором';
  mn[2] := '2. Сортировка подсчетом';
  mn[3] := '3. Сортировка пузырьком';
  mn[4] := '4. Сортировка вставками';
  mn[5] := '5. Сортировка Шелла';
  mn[6] := '6. Сортировка быстрая';
  
  while f do
  begin
    clrscr;    
    
    for j := 0 to 6 do
    begin
      if(j = op) then write('*');
      writeln(mn[j]);
    end;
    c := readKey;
    if c = #0 then c := readKey;
    i := ord(c);  
    case i of
      38: 
        begin
          op := (op + 6) mod 7;
        end;
      40: 
        begin
          op := (op + 1) mod 7;
        end;
      13:
        begin
          case op of
            0: 
              begin
                f := false;
              end;
            1: 
              begin
                s1 := Milliseconds;
                sort_select(n, a, count);
                s2 := Milliseconds;
                {vivod;}
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s2 - s1) div 3600 div 1000, ':', (s2 - s1) div 60 div 1000, ':', (s2 - s1) div 1000, ':', (s2 - s1) mod 1000);
                readln;
              end;
            2: 
              begin
                s3 := Milliseconds;
                sort_podscheta(n, a, count);
                s4 := Milliseconds;
                {vivod;}
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s4 - s3) div 3600 div 1000, ':', (s4 - s3) div 60 div 1000, ':', (s4 - s3) div 1000, ':', (s4 - s3) mod 1000);
                readln;
              end;
            3: 
              begin
                s5 := Milliseconds;
                sort_swap(n, a, count);
                s6 := Milliseconds;
                {vivod;}
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s6 - s5) div 3600 div 1000, ':', (s6 - s5) div 60 div 1000, ':', (s6 - s5) div 1000, ':', (s6 - s5) mod 1000);
                readln;
              end;
            4: 
              begin
                s7 := Milliseconds;
                sort_vstavki(n, a, count);
                s8 := Milliseconds;
                {vivod;}
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s8 - s7) div 3600 div 1000, ':', (s8 - s7) div 60 div 1000, ':', (s8 - s7) div 1000, ':', (s8 - s7) mod 1000);
                readln;
              end;
            5: 
              begin
                s9 := Milliseconds;
                sort_shell(n, a, count);
                s10 := Milliseconds;
                vivod;
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s10 - s9) div 3600 div 1000, ':', (s10 - s9) div 60 div 1000, ':', (s10 - s9) div 1000, ':', (s10 - s9) mod 1000);
                readln;
                
              end;
            6: 
              begin
                s11 := Milliseconds;
                Quick_Sort(n, a, count, 1, n);
                s12 := Milliseconds;
                
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s12 - s11) div 3600 div 1000, ':', (s12 - s11) div 60 div 1000, ':', (s12 - s11) div 1000, ':', (s12 - s11) mod 1000);
                readln;
              end;
          end;
        end;
    end;
  end;
end;
 
procedure search_massiv;
var
  
  op: longint;
  f: boolean;
  c: char;
  i, j: longint;
  mn: array[0..5] of string;
begin
  
  
  op := 0;
  f := true;
  
  mn[0] := '0. Выход';
  mn[1] := '1. Линейный поиск';
  mn[2] := '2. Бинарный поиск';
  
  while f do
  begin
    clrscr;
    
    for j := 0 to 2 do
    begin
      if(j = op) then write('*');
      writeln(mn[j]);
    end;
    c := readKey;
    if c = #0 then c := readKey;
    i := ord(c);  
    case i of
      38: 
        begin
          op := (op + 2) mod 3;
        end;
      40: 
        begin
          op := (op + 1) mod 3;
        end;
      13:
        begin
          case op of
            0: 
              begin
                f := false;
              end;
            1: 
              begin
                s13 := Milliseconds;
                search_line(n, a, count);
                s14 := Milliseconds;
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s14 - s13) div 3600 div 1000, ':', (s14 - s13) div 60 div 1000, ':', (s14 - s13) div 1000, ':', (s14 - s13) mod 1000);
                readln;
              end;
            2: 
              begin
                s15 := Milliseconds;
                search_binary(n, a, count);
                s16 := Milliseconds;
                writeln('Количество сравнений ', count);
                writeln('Количество времени затраченное на выполнение сортировки = ', (s16 - s15) div 3600 div 1000, ':', (s16 - s15) div 60 div 1000, ':', (s16 - s15) div 1000, ':', (s16 - s15) mod 1000);
                readln;
              end;
          end;
        end;
    end;
  end;
end;
 
procedure experiments;
 
var
  x: longint;
  Step: longint;
  op: longint;
  f: boolean;
  c: char;
  i, j: longint;
  mn: array[0..6] of string;
begin
  op := 0;
  f := true;
  
  mn[0] := '0. Выход';
  mn[1] := '1. Сортировка выбором';
  mn[2] := '2. Сортировка подсчетом';
  mn[3] := '3. Сортировка пузырьком';
  mn[4] := '4. Сортировка вставками';
  mn[5] := '5. Сортировка Шелла';
  mn[6] := '6. Сортировка быстрая';
  
  while f do
  begin
    clrscr;    
    
    for j := 0 to 6 do
    begin
      if(j = op) then write('*');
      writeln(mn[j]);
    end;
    c := readKey;
    if c = #0 then c := readKey;
    i := ord(c);  
    case i of
      38: 
        begin
          op := (op + 6) mod 7;
        end;
      40: 
        begin
          op := (op + 1) mod 7;
        end;
      13:
        begin
          case op of
            0: 
              begin
                f := false;
              end;
            1: 
              begin
                exp_sort_podscheta;
              end;
            2: 
              begin
                exp_sort_select;
              end;
            3: 
              begin
                exp_sort_swap;
              end;
            4: 
              begin
                exp_sort_vstavki;
              end;
            5: 
              begin
                exp_sort_shell;
              end;
            6: 
              begin
                exp_quick_sort;
              end;
          end;
        end;
    end;
  end;
end;
 
procedure menu;
var
  
  op: longint;
  f: boolean;
  c: char;
  i, j: longint;
  mn: array[0..4] of string;
begin
  
  
  op := 0;
  f := true;
  
  mn[0] := '0. Выход';
  mn[1] := '1. Создать массив';
  mn[2] := '2. Сортировать массив';
  mn[3] := '3. Поиск в массиве';
  mn[4] := '4. Эксперименты';
  
  while f do
  begin
    clrscr;
    
    
    for j := 0 to 4 do
    begin
      if(j = op) then write('*');
      writeln(mn[j]);
    end;
    c := readKey;
    if c = #0 then c := readKey;
    i := ord(c);  
    case i of
      38: 
        begin
          op := (op + 4) mod 5;
        end;
      40: 
        begin
          op := (op + 1) mod 5;
        end;
      13:
        begin
          case op of
            0: 
              begin
                f := false;
              end;
            1: 
              begin
                make_massiv;
              end;
            2: 
              begin
                sort_massiv;
              end;
            3: 
              begin
                search_massiv;
              end;
            4: 
              begin
                experiments;
              end;
          
          end;
        end;
    end;
  end;
end;
 
begin
  menu;
end.

while f do
  begin
    clrscr;    
    
    for j := 0 to 6 do
    begin
      if(j = op) then write('*');
      writeln(mn[j]);
    end;
    c := readKey;
    if c = #0 then c := readKey;
    i := ord(c);  
    case i of
      38: 
        begin
          op := (op + 6) mod 7;
        end;
      40: 
        begin
          op := (op + 1) mod 7;
        end;