Сортировка массива различными способами

{
  Описание всех алгоритмов можно найти в книге:
      Кнут Д., Искусство программирования для ЭВМ, Т. 3.:
        Сортировка и поиск. М.: Мир, 1978.
  Описание почти всех алгоритмов в книге:
      Кормен Т., Лейзерсон Ч., Ривест Р., Алгоритмы:
        построение и анализ. М.: МЦНМО, 1999.
  Описание некоторых алгоритмов в книге:
      Романовский И., Дискретный анализ,
        СПб.: Невский диалект, 1999.
}
 
program SORT_ARRAY;
 
{ Увеличение размера стека - нужно для рекурсивных алгоритмов
  MergeSort и QuickSort }
{$M 65520, 0, 655360}
 
  { Необязательно, но используется при подсчете времени }
  uses Crt;
 
  const
    { Размер массива }
    max = 16000;
    { Диапазон случайных чисел }
    randmax : Longint = 16000000;
    theword : Longint = 65536;
 
 
  type
    { Тип элемента сортируемого массива }
    itp = Longint;
    { Тип массива }
    mas = array [0..max] of itp;
    { Тип процедуры для сортировки или заполнения массива }
    Func = procedure ( var A : mas );
    { Массивы для цифровой сортировки и сортировки вычерпыванием }
    C8T = array [0..256] of Integer;
    C12T = array [0..4096] of Integer;
 
{ Необходимая директива для использования переменных типа процедуры }
{$F+}
 
  { Заполнение массива числами по возрастанию }
  procedure FillInc( var A : mas );
    var
      i : Integer;
    begin
      for i := 1 to max do
        A[i] := i;
    end;
 
  { Заполнение массива числами по убыванию }
  procedure FillDec( var A : mas );
    var
      i : Integer;
    begin
      for i := 1 to max do
        A[i] := max - i;
    end;
 
  { Заполнение массива равными числами (0) }
  procedure FillZero( var A : mas );
    var
      i : Integer;
    begin
      for i := 1 to max do
        A[i] := 0;
    end;
 
  { Заполнение массива случайными числами }
  procedure FillRand( var A : mas );
    var
      i : Integer;
      t : LongInt;
    begin
      for i := 1 to max do
        begin
          t := Random(32768);
          t := t * 32768;
          t := t + Random(32768);
          A[i] := t mod randmax;
        end;
    end;
 
  { Сортировка вставками }
  procedure InsertSort( var A : mas );
    var
      i, k : Integer;
      x : itp;
    begin
      { Вставляем в уже отсортированную часть элементы со 2 по max }
      for i := 2 to max do
        begin
          k := i;
          x := A[i];
          { Передвигаем на 1 позицию направо элементы,
            большие вставляемого элемента (он записан в x) }
          { Условие k > 1 гарантирует, что мы не выйдем за
            границу массива, если вставляется элемент,
            меньший всех предыдущих.
            В Turbo Pascal условия вычисляются в обратном порядке,
            поэтому условие цикла while нужно заменить на
            (A[k - 1] > x) and (k > 1) }
          while (k > 1) and (A[k - 1] > x) do
            begin
              A[k] := A[k - 1];
              k := k - 1;
            end;
          { Вставляем элемент в нужную позицию }
          A[k] := x;
        end;
    end;
 
  { Сортировка вставками с ограничителем }
  procedure InsertSort2( var A : mas );
    var
      i, k : Integer;
      x : itp;
    begin
      { Вставляем ограничитель, меньший каждого элемента массива }
      A[0] := -1;
      { Вставляем в уже отсортированную часть элементы со 2 по max }
      for i := 2 to max do
        begin
          k := i;
          x := A[i];
          { Передвигаем на 1 позицию направо элементы,
            большие вставляемого элемента (он записан в x) }
          { Здесь не нужно проверять k > 1, так как есть ограничитель
            и всегда будет A[0] < x }
          while A[k - 1] > x do
            begin
              A[k] := A[k - 1];
              k := k - 1;
            end;
          { Вставляем элемент в нужную позицию }
          A[k] := x;
        end;
    end;
 
  { Сортировка выбором без запоминания минимума }
  procedure SelectSort( var A : mas );
    var
      i, j, m : Integer;
      x : itp;
    begin
      { Ищем элементы для позиций с 1 по max - 1 }
      for i := 1 to max - 1 do
        begin
          m := i;
          { Просматриваем все еще не выбранные элементы }
          for j := i + 1 to max do
            { Если встречается элемент, меньший того, что сейчас
              стоит на позиции m, запоминаем в m его позицию  }
            if A[j] < A[m] then
              m := j;
          { Меняем местами i-ый элемент и минимальный из оставшихся -
            m-ый элемент }
          x := A[i];
          A[i] := A[m];
          A[m] := x;
        end;
    end;
 
  { Сортировка выбором }
  procedure SelectSort2(var A : mas);
    var
      i, j, m : Integer;
      x : itp;
    begin
      { Ищем элементы для позиций с 1 по max - 1 }
      for i := 1 to max - 1 do
        begin
          m := i;
          x := A[i];
          { Просматриваем все еще не выбранные элементы }
          for j := i + 1 to max do
            { Если встречается элемент, меньший того, что сейчас
              стоит на позиции m, запоминаем в m его позицию,
              а в x - его значение }
            if x > A[j] then
              begin
                m := j;
                x := A[j];
              end;
            { Меняем местами i-ый элемент, и минимальный из оставшихся -
              m-ый элемент, сохраненный в x }
            A[m] := A[i];
            A[i] := x;
        end;
    end;
 
  { Сортировка "пузырьком" }
  procedure BubbleSort( var A : mas );
    var
      i, j : Integer;
      x : itp;
    begin
      for i := max downto 2 do
        for j := 2 to i do
          if A[j] < A[j - 1] then
            begin
              x := A[j];
              A[j] := A[j - 1];
              A[j - 1] := x;
            end;
    end;
 
  { Сортировка "шейкером" }
  procedure ShakerSort( var A : mas );
    var
      l, r, j : Integer;
      x : itp;
    begin
      l := 2;
      r := max;
      while l <= r do
        begin
          { "Пузырек" слева направо }
          for j := l to r do
          if A[j] < A[j - 1] then
            begin
              x := A[j];
              A[j] := A[j - 1];
              A[j - 1] := x;
            end;
          r := r - 1;
          { "Пузырек" справа налево }
          for j := r downto l do
          if A[j] < A[j - 1] then
            begin
              x := A[j];
              A[j] := A[j - 1];
              A[j - 1] := x;
            end;
          l := l + 1;
        end;
    end;
 
  { Сортировка "пузырьком" с остановкой }
  procedure BubbleSort2( var A : mas );
    var
      i, j, n : Integer;
      x : itp;
    begin
      i := max;
      n := 1;
      { Пока производились обмены элементов }
      while n > 0 do
        begin
          n := 0;
          for j := 2 to i do
            if A[j] < A[j - 1] then
              begin
                x := A[j];
                A[j] := A[j - 1];
                A[j - 1] := x;
                n := 1;
              end;
          i := i - 1;
        end;
    end;
 
  { Сортировка Шелла }
  procedure ShellSort( var A : mas );
    const
      steps = 12;
    var
      i, j, l, k, p, n : Integer;
      x : itp;
      s : array [1..steps] of Integer;
    begin
      k := 1;
      { Формируем последовательность чисел -
        шаги, с которыми выбираем сортируемые подмассивы }
      for i := steps downto 1 do
        begin
          s[i] := k;
          k := k * 2 + 1;
        end;
 
      { Сортировки подмассивов вплоть до шага 1 -
        обычной сортировки пузырьком }
      for k := 1 to steps do
        begin
          l := s[k];
          { Для каждого шага l нужно отсортировать l подмассивов }
          for p := 1 to l do
            begin
              i := max - l;
              n := 1;
              { Сортировка подмассива пузырьком с остановкой }
              { Подмассив - это (A[p], A[p+l], A[p+2*l], ...) }
              while n > 0 do
                begin
                  n := 0;
                  j := p;
                  while j <= i do
                    begin
                      if A[j] > A[j + l] then
                        begin
                          x := A[j];
                          A[j] := A[j + l];
                          A[j + l] := x;
                          n := 1;
                        end;
                      j := j + l;
                    end;
                  i := i - l;
                end;
            end;
        end;
    end;
 
  { Объединение двух массивов для сортировки слиянием }
  procedure Merge( var A, P : mas; l, m, r : Integer );
    var
      i, j, k, z : Integer;
      A2 : mas;
    begin
      z := r - l + 1;
      i := l;
      j := m;
      k := 1;
      { Пока на "слили" все элементы от l до r }
      while k <= z do
        begin
          { Элемент из первого массива меньше или
            во втором массиве закончились элементы }
          if (j > r) or ((i < m) and (A[i] < A[j])) then
            begin
              A2[k] := A[i];
              i := i + 1;
            end
          { Элемент из второго массива меньше или
            в первом массиве закончились элементы }
          else
            begin
              A2[k] := A[j];
              j := j + 1;
            end;
          k := k + 1;
        end;
      i := l;
      { Копируем слитые элементы обратно в массив A }
      for k := 1 to z do
        begin
          A[i] := A2[k];
          i := i + 1;
        end;
    end;
 
  { Процедура рекурсивной сортировки слиянием }
  procedure RecoursiveMerge(var A, P : mas; l, r : Word);
    var
      m : Integer;
    begin
      m := (l + r + 1) div 2;
      { Сортируем первую половину }
      if l < m then
        RecoursiveMerge(A, P, l, m - 1);
      { Сортируем вторую половину }
      if m < r then
        RecoursiveMerge(A, P, m, r);
      { Сливаем два отсортированных массива }
      Merge(A, P, l, m, r);
    end;
 
  { Сортировка слиянием }
  procedure MergeSort( var A : mas );
    var
      p : ^mas;
    begin
      New(p);
      RecoursiveMerge(A, p^, 1, max);
      Dispose(p);
    end;
 
  { Процедура рекурсивной сортировки слиянием с подсортировкой }
  procedure RecoursiveMerge2(var A, P : mas; l, r, b : Word);
    var
      i, k, m : Integer;
      x : itp;
    begin
      { Если количество элементов в сортируемом массиве меньше b,
        сортируем его вставками }
      if r - l < b then
        begin
          for i := l + 1 to r do
            begin
              k := i;
              x := A[i];
              while (k > l) and (A[k - 1] > x) do
                begin
                  A[k] := A[k - 1];
                  k := k - 1;
                end;
              A[k] := x;
            end;
        end
      { Если количество элементов в сортируемом массиве больше b,
        делим его на две половины, сортируем их и затем сливаем }
      else
        begin
          m := (l + r) div 2;
          RecoursiveMerge2(A, P, l, m - 1, b);
          RecoursiveMerge2(A, P, m, r, b);
          Merge(A, P, l, m, r);
        end;
    end;
 
  { Сортировка слиянием с подсортировкой вставками по 10 элементов }
  procedure MergeSort10( var A : mas );
    var
      p : ^mas;
    begin
      New(p);
      RecoursiveMerge2(A, p^, 1, max, 10);
      Dispose(p);
    end;
 
  { Сортировка слиянием с подсортировкой вставками по 100 элементов }
  procedure MergeSort100( var A : mas );
    var
      p : ^mas;
    begin
      New(p);
      RecoursiveMerge2(A, p^, 1, max, 100);
      Dispose(p);
    end;
 
  { Сортировка слиянием с подсортировкой вставками по 1000 элементов }
  procedure MergeSort1000( var A : mas );
    var
      p : ^mas;
    begin
      New(p);
      RecoursiveMerge2(A, p^, 1, max, 1000);
      Dispose(p);
    end;
 
  { Процедура разбиения массива для быстрой сортировки }
  function Partition( var A : mas; l, r : Integer; x : itp ) : Integer;
  { Переставляем элементы массива так, чтобы слева от элемента,
    равного x, были только элементы меньшие или равные x,
    а справа - элементы, большие или равные x }
    var
      i, j : Integer;
      t : itp;
    begin
      i := l - 1;
      j := r + 1;
      repeat
 
        { Пока элементы справа больше среднего }
        repeat
          j := j - 1;
        until x >= A[j];
 
        { Пока элементы слева меньше среднего }
        repeat
          i := i + 1;
        until A[i] >= x;
 
        { Меняем левый и правый элементы и продолжаем дальше }
        if i < j then
          begin
            t := A[i];
            A[i] := A[j];
            A[j] := t;
          end;
        { Иначе - левый и правый встретились -
          разбиение массива завершено }
 
      until i >= j;
      Partition := j;
    end;
 
  { Рекурсивная процедура быстрой сортировки }
  procedure RecoursiveQuick( var A : mas; l, r : Integer );
    var
      m : Integer;
    begin
      if l < r then
        begin
          { В качестве граничного элемента выбирается средний
            элемент массива }
          m := Partition(A, l, r, A[(l + r) div 2]);
          RecoursiveQuick(A, l, m);
          RecoursiveQuick(A, m + 1, r);
        end;
    end;
 
  { Быстрая сортировка }
  procedure QuickSort( var A : mas );
    begin
      RecoursiveQuick(A, 1, max);
    end;
 
  { Рекурсивная процедура рандомизированной быстрой сортировки }
  procedure RecoursiveRandomQuick( var A : mas; l, r : Integer );
    var
      m : Integer;
    begin
      if l < r then
        begin
          { В качестве граничного элемента выбирается элемент
            массива со случайным номером }
          m := Partition(A, l, r, A[Random(r - l + 1) + l]);
          RecoursiveRandomQuick(A, l, m);
          RecoursiveRandomQuick(A, m + 1, r);
        end;
    end;
 
  { Рандомизированная быстрая сортировка }
  procedure RandomQuickSort( var A : mas );
    begin
      RecoursiveRandomQuick(A, 1, max);
    end;
 
  { Рекурсивная процедура быстрой сортировки с выбором медианы }
  procedure RecoursiveMedianQuick( var A : mas; l, r : Integer );
    var
      m : Integer;
      x1, x2, x3 : itp;
    begin
      if l < r then
        begin
          { В качестве граничного элемента выбирается средний
            по величине элемент из трех }
          x1 := A[l + (r - l + 1) div 4];
          x2 := A[(l + r) div 2];
          x3 := A[Integer(l + Longint(r - l + 1) * 3 div 4)];
          if x1 < x2 then
            begin
              if x3 < x2 then
                begin
                  if x1 < x3 then
                    x2 := x3
                  else
                    x2 := x1
                end
            end
          else { x1 > x2 }
            begin
              if x3 > x2 then
                begin
                  if x1 > x3 then
                    x2 := x3
                  else
                    x2 := x1
                end
            end;
 
          m := Partition(A, l, r, x2);
          RecoursiveMedianQuick(A, l, m);
          RecoursiveMedianQuick(A, m + 1, r);
        end;
    end;
 
  { Быстрая сортировка с выбором медианы по 3 элементам }
  procedure MedianQuickSort( var A : mas );
    begin
      RecoursiveMedianQuick(A, 1, max);
    end;
 
  { Исправление кучи с неправильным элементом в вершине }
  procedure HeapCorrect( var A : mas; Bound, n : Integer );
  { Перестановка элементов упорядоченной кучи, на вершине
    которой - единственный неупорядоченный элемент так,
    чтобы куча снова стала упорядоченной }
    var
      l, r, i : Integer;
      x : itp;
    begin
      { n - вершина кучи }
      { l - левый ребенок вершины, r - правый ребенок }
      l := n * 2;
      r := l + 1;
 
      { В i - номер максимального элемента из n, l и r }
      i := n;
      if r <= Bound then
        begin
          if A[l] > A[i] then
            i := l;
          if A[r] > A[i] then
            i := r;
        end
      else if l <= Bound then
        begin
          if A[l] > A[i] then
            i := l;
        end;
 
      { Если максимальный элемент не в вершине,
        меняем максимальный элемент с вершиной и
        вызываем HeapCorrect для подкучи, на вершину которой
        попал элемент из вершины }
      if i <> n then
        begin
          x := A[i];
          A[i] := A[n];
          A[n] := x;
          HeapCorrect(A, Bound, i);
        end;
    end;
 
  { Сортировка при помощи кучи }
  procedure HeapSort( var A : mas );
    var
      i, Bound : Integer;
      x : itp;
    begin
      { Строим упорядоченную кучу }
      for i := (max + 1) div 2 downto 1 do
        HeapCorrect(A, max, i);
 
      Bound := max;
      while Bound > 1 do
        begin
          { Меняем последний элемент кучи с максимальным
            элементом в вершине кучи }
          x := A[1];
          A[1] := A[Bound];
          A[Bound] := x;
          { Уменьшаем размер кучи }
          Bound := Bound - 1;
          { Упорядочиваем кучу }
          HeapCorrect(A, Bound, 1);
        end;
    end;
 
  { Сортировка подсчетом по n-ой 256-ричной цифре }
  procedure Counting8Sort( var A : mas; n: Integer );
    var
      i, j, k, s, index : Integer;
      P : ^mas;
      C : C8T;
    begin
      { Вычисляем сдвиг для n-ой цифры }
      s := 8 * n;
 
      New(P);
 
      { Обнуляем массив частот }
      for i := 0 to 255 do
        C[i] := 0;
 
      { Считаем частоты появления всех цифр в n-ой позиции }
      { Заодно копируем массив A в P^ }
      for i := 1 to max do
        begin
          { index - это значение n-ой цифры }
          index := (A[i] shr s) and 255;
          C[index] := C[index] + 1;
          P^[i] := A[i];
        end;
 
      { Сейчас в каждом C[i] - количество элементов массива A,
        у которых n-ая цифра равна i }
      { После следующего цикла в каждом C[i] будет записано
        количество элементов, с n-ой цифрой, не превосходящей i,
        а это то же самое, что номер последнего элемента
        с n-ой цифрой, равной i }
      for i := 1 to 255 do
        C[i] := C[i] + C[i - 1];
 
      { Переписываем элементы из массива P^ в A, начиная с последнего,
        в соответствии с номерами, записанными в C. Номер последнего
        элемента с n-ой цифрой, равной i, - C[i] - после записи
        элемента в позицию C[i] уменьшаем на 1 }
      for i := max downto 1 do
        begin
          index := (P^[i] shr s) and 255;
          A[C[index]] := P^[i];
          C[index] := C[index] - 1;
        end;
 
      Dispose(P);
    end;
 
  { Цифровая сортировка для 8-разрядных цифр }
  procedure Digital8Sort( var A : mas );
    var
      n : Integer;
      t : itp;
    begin
      t := randmax;
      n := 0;
      { Сортировка по всем цифрам, начиная с последней }
      while t > 0 do
        begin
          Counting8Sort(A, n);
          n := n + 1;
          t := t shr 8;
        end;
    end;
 
  { Сортировка подсчетом по n-ой 4096-ричной цифре }
  procedure Counting12Sort( var A : mas; n: Integer );
    var
      i, j, k, index : Integer;
      P : ^mas;
      C : C12T;
      s : Longint;
      bug : Integer;
    begin
      { Вычисляем сдвиг для n-ой цифры }
      s := 12 * n;
 
      { Переменная bug используется вместо числа 4095 -
        в общем случае это неверно, но таким образом
        обходится ошибка в Borland Pascal, где
        неправильно выполняется операция x shr 24 }
      if s = 24 then
        bug := 255
      else
        bug := 4095;
 
      New(P);
 
      { Обнуляем массив частот }
      for i := 0 to 4095 do
        C[i] := 0;
 
      { Считаем частоты появления всех цифр в n-ой позиции }
      { Заодно копируем массив A в P^ }
      for i := 1 to max do
        begin
          { index - это значение n-ой цифры }
          index := (A[i] shr s) and bug;
          C[index] := C[index] + 1;
          P^[i] := A[i];
        end;
 
      { Сейчас в каждом C[i] - количество элементов массива A,
        у которых n-ая цифра равна i }
      { После следующего цикла в каждом C[i] будет записано
        количество элементов, с n-ой цифрой, не превосходящей i,
        а это то же самое, что номер последнего элемента
        с n-ой цифрой, равной i }
      for i := 1 to 4095 do
        C[i] := C[i] + C[i - 1];
 
      { Переписываем элементы из массива P^ в A, начиная с последнего,
        в соответствии с номерами, записанными в C. Номер последнего
        элемента с n-ой цифрой, равной i, - C[i] - после записи
        элемента в позицию C[i] уменьшаем на 1 }
      for i := max downto 1 do
        begin
          index := (P^[i] shr s) and bug;
          A[C[index]] := P^[i];
          C[index] := C[index] - 1;
        end;
 
      Dispose(P);
    end;
 
  { Цифровая сортировка для 12-разрядных цифр }
  procedure Digital12Sort( var A : mas );
    var
      n : Integer;
      t : itp;
    begin
      t := randmax;
      n := 0;
      { Сортировка по всем цифрам, начиная с последней }
      while t > 0 do
        begin
          Counting12Sort(A, n);
          n := n + 1;
          t := t shr 12;
        end;
    end;
 
  { Сортировка вычерпыванием по 256 частям }
  procedure Bucket8Sort( var A : mas );
    var
      i, index, j, k : Integer;
      d, x : itp;
      P : ^mas;
      C : C8T;
    begin
      { Определяем размер каждой части }
      d := (randmax div 256) + 1;
 
      New(P);
 
      { Определяем количества элементов массива A,
        попадающих в каждую часть -
        так же, как в цифровой сортировке }
      for i := 0 to 256 do
        C[i] := 0;
      for i := 1 to max do
        begin
          index := A[i] div d;
          C[index] := C[index] + 1;
          P^[i] := A[i];
        end;
      for i := 1 to 256 do
        C[i] := C[i] + C[i - 1];
 
      { Переписываем элементы массива так, что сначала идут
        элементы, попавшие в первую часть, затем - элементы
        из второй части }
      for i := max downto 1 do
        begin
          index := P^[i] div d;
          A[C[index]] := P^[i];
          C[index] := C[index] - 1;
        end;
 
      { Остается только отсортировать элементы внутри каждой части -
        используем для этого сортировку вставками }
      for i := 0 to 255 do
        begin
          for j := C[i] + 2 to C[i + 1] do
            begin
              k := j;
              x := A[j];
              while (k > C[i] + 1) and (A[k - 1] > x) do
                begin
                  A[k] := A[k - 1];
                  k := k - 1;
                end;
              A[k] := x;
            end;
        end;
 
      Dispose(P);
  end;
 
  { Сортировка вычерпыванием по 4096 частям }
  procedure Bucket12Sort( var A : mas );
    var
      i, index, j, k : Integer;
      d, x : itp;
      P : ^mas;
      C : C12T;
    begin
      { Определяем размер каждой части }
      d := (randmax div 4096) + 1;
 
      New(P);
 
      { Определяем количества элементов массива A,
        попадающих в каждую часть -
        так же, как в цифровой сортировке }
      for i := 0 to 4096 do
        C[i] := 0;
      for i := 1 to max do
        begin
          index := A[i] div d;
          C[index] := C[index] + 1;
          P^[i] := A[i];
        end;
      for i := 1 to 4096 do
        C[i] := C[i] + C[i - 1];
 
      { Переписываем элементы массива так, что сначала идут
        элементы, попавшие в первую часть, затем - элементы
        из второй части }
      for i := max downto 1 do
        begin
          index := P^[i] div d;
          A[C[index]] := P^[i];
          C[index] := C[index] - 1;
        end;
 
      { Остается только отсортировать элементы внутри каждой части -
        используем для этого сортировку вставками }
      for i := 0 to 4095 do
        begin
          for j := C[i] + 2 to C[i + 1] do
            begin
              k := j;
              x := A[j];
              while (k > C[i] + 1) and (A[k - 1] > x) do
                begin
                  A[k] := A[k - 1];
                  k := k - 1;
                end;
              A[k] := x;
            end;
        end;
 
      Dispose(P);
  end;
 
{$F-}
 
  { Проверка того, что массив отсортирован }
  function CheckArray( var A : mas ) : Boolean;
    var
      i : Integer;
    begin
      CheckArray := TRUE;
      for i := 1 to max - 1 do
        if A[i] > A[i + 1] then
          CheckArray := FALSE;
    end;
 
  { Вывод элементов массива на экран }
  procedure PrintArray( var A : mas );
    var
      i : Integer;
    begin
      WriteLn;
      for i := 1 to max do
        Write(A[i] : 16);
      WriteLn;
    end;
 
  var
    A : mas;
    Fill  : array [1..4] of Func;
    FillS : array [1..4] of string[24];
    Sort  : array [1..20] of Func;
    SortS : array [1..20] of string[24];
    i, j : Integer;
    Time : Longint;
  begin
    FillS[1] := 'Random';
    FillS[2] := 'Increasing';
    FillS[3] := 'Equal';
    FillS[4] := 'Decreasing';
    Fill[1] := FillRand;
    Fill[2] := FillInc;
    Fill[3] := FillZero;
    Fill[4] := FillDec;
    SortS[1] := 'Insertion';
    SortS[2] := 'Insertion with Bound';
    SortS[3] := 'Selection (ver. 1)';
    SortS[4] := 'Selection';
    SortS[5] := 'Bubble';
    SortS[6] := 'Stopping Bubble';
    SortS[7] := 'Shaker';
    SortS[8] := 'Shell';
    SortS[9] := 'Merge';
    SortS[10] := 'Merge + Insertion 10';
    SortS[11] := 'Merge + Insertion 100';
    SortS[12] := 'Merge + Insertion 1000';
    SortS[13] := 'Quick';
    SortS[14] := 'Randomized Quick';
    SortS[15] := 'Median Quick';
    SortS[16] := 'Heap';
    SortS[17] := 'Digital - 8';
    SortS[18] := 'Digital - 12';
    SortS[19] := 'Bucket - 256';
    SortS[20] := 'Bucket - 4096';
    Sort[1] := InsertSort;
    Sort[2] := InsertSort2;
    Sort[3] := SelectSort;
    Sort[4] := SelectSort2;
    Sort[5] := BubbleSort;
    Sort[6] := BubbleSort2;
    Sort[7] := ShakerSort;
    Sort[8] := ShellSort;
    Sort[9] := MergeSort;
    Sort[10] := MergeSort10;
    Sort[11] := MergeSort100;
    Sort[12] := MergeSort1000;
    Sort[13] := QuickSort;
    Sort[14] := RandomQuickSort;
    Sort[15] := MedianQuickSort;
    Sort[16] := HeapSort;
    Sort[17] := Digital8Sort;
    Sort[18] := Digital12Sort;
    Sort[19] := Bucket8Sort;
    Sort[20] := Bucket12Sort;
 
    Write('' : 24);
    for i := 1 to 4 do
      Write(FillS[i] : 12);
    WriteLn;
    for i := 1 to 20 do
      begin
        Write(SortS[i] : 24);
        for j := 1 to 4 do
          begin
            Fill[j](A);
            Time := Meml[$40 : $6C];
            Sort[i](A);
            Time := Meml[$40 : $6C] - Time;
            if CheckArray(A) then
              Write(Time : 12)
            else
              begin
                Write('Failed' : 12);
{                PrintArray(A);}
              end;
          end;
        WriteLn;
      end;
  end.
Теги:
сортировка, массив
Добавлено: 15 Сентября 2013 02:46:53 Добавил: Андрей Ковальчук Нравится 0
Добавить
Комментарии:
Нету комментариев для вывода...