сортировки

СОРТИРОВКА ПОДСЧЁТОМ------------------------------------------------
var
   i, j, k, N: integer;
   countingArray, answer: array of Integer;
   ArrayOfNumbers : array of Integer;
begin
   WriteLn('N:');
   ReadLn(N);
   SetLength(ArrayOfNumbers, N);
   WriteLn('Massive:');
   for i := 0 to High(ArrayOfNumbers) do
      ReadLn(ArrayOfNumbers[i]);
   Setlength(countingArray, N);
   Setlength(answer, N);
   for j := 0 to (Length(countingArray) - 1) do
      CountingArray[j] := 0;
   for j := 0 to (Length(ArrayOfNumbers) - 2) do
      for k := (j + 1) to (Length(ArrayOfNumbers) - 1) do
         if ArrayOfNumbers[j] > ArrayOfNumbers[k] then
            Inc(CountingArray[j])
         else
            Inc(CountingArray [k]);
   for j := 0 to (Length(CountingArray) - 1) do
      for k := 0 to (Length(CountingArray) - 1) do
         if j = CountingArray[k] then
            Answer[j] := ArrayOfNumbers[k];
   for i := 0 to High(ArrayOfNumbers) do
      ArrayOfNumbers[i] := answer[i];
   OutputArray(ArrayOfNumbers);
   ReadLn;
end.

ПОРАЗРЯДНАЯ СОРТИРОВКА----------------------------------

uses
   SysUtils, Math;

type
   TIntArray = array of Integer;

function GetMaxOrder(DataArray: TIntArray): Integer;
var
   i: Byte;
   MaxEl: Integer;
begin
   MaxEl := DataArray[0];
   for i := 1 to High(DataArray) do
      if DataArray[i] > MaxEl then
         MaxEl := DataArray[i];
   GetMaxOrder := Length(IntToStr(MaxEl));
end;

function RadixSort(DataArr: TIntArray): TIntArray;
var
   i, j, k: Byte;
   PosArr: array [0 .. 9] of array of Integer;
   TempArray: TIntArray;
   Dev: Integer;
   MaxOrder: Integer;
begin
   MaxOrder := GetMaxOrder(DataArr);
   Dev := 1;
   Setlength(TempArray, Length(DataArr));
   repeat
      for i := 0 to High(DataArr) do
      begin
         Setlength(PosArr[(DataArr[i] div Dev) mod 10],
            Length(PosArr[(DataArr[i] div Dev) mod 10]) + 1);
         PosArr[(DataArr[i] div Dev) mod 10]
           [ High(PosArr[(DataArr[i] div Dev) mod 10])] := i;
      end;
      Dev := Dev * 10;
      k := 0;
      for i := 0 to High(PosArr) do
         if Length(PosArr[i]) <> 0 then
         begin
            for j := 0 to High(PosArr[i]) do
            begin
               TempArray[k] := DataArr[PosArr[i][j]];
               Inc(k);
            end;
            Setlength(PosArr[i], 0);
         end;
      for i := 0 to High(DataArr) do
         DataArr[i] := TempArray[i];
   until Dev = Power(10, MaxOrder);
   RadixSort := DataArr;
end;

var
   Arr: TIntArray;
   i, N: Integer;
begin
   WriteLn('N:');
   ReadLn(N);
   SetLength(Arr, N);
   for i := 0 to high(arr) do
      readln(arr[i]);
   RadixSort(Arr);
   for i := 0 to High(Arr) do
      Write(Arr[i], ' ');
   Readln;
end.


ШЕЙКЕРНАЯ СОРТИРОВКА------------------------------------------

Var
   ArrayOfNumbers: array of Integer;
   N, i, step, temp, NumberOfPairs: Integer;

procedure OutputArray(ArrayOfNumbers: array of Integer);
var
   i: Integer;
begin
   for i := 0 to (Length(ArrayOfNumbers) - 1) do
      Write(ArrayOfNumbers[i],' ');
   WriteLn;
end;

begin
   WriteLn('Введите размер массива:');
   ReadLn(N);
   SetLength(ArrayOfNumbers, N);
   WriteLn('Введите массив:');
   for i := 0 to (Length(ArrayOfNumbers) - 1) do
      ReadLn(ArrayOfNumbers[i]);
   i := 0;
   step := 1;
   WriteLn('Пошаговая детализация:');
   OutputArray(ArrayOfNumbers);
   for NumberOfPairs := (Length(ArrayOfNumbers) - 1) downto 0 do
   begin
      i := i + step;
      while (i > 0) and (i < (Length(ArrayOfNumbers) - 1)) do
      begin
         if (ArrayOfNumbers[i + step] - ArrayOfNumbers[i]) * step < 0 then
         begin
            temp := ArrayOfNumbers[i];
            ArrayOfNumbers[i] := ArrayOfNumbers[i + step];
            ArrayOfNumbers[i + step] := temp;
            OutputArray(ArrayOfNumbers);
         end;
         i := i + step;
      end;
      step := -step;
   end;
   ReadLn;
end.

СОРТИРОВКА ЕСТЕСТВЕННЫМ СЛИЯНИЕМ------------------------


procedure MergeArrays(var Arr: TArray;
   leftPoint, midPoint, rightPoint: Integer);
var
   it1, it2: Integer;
   result: TArray;
   i: Integer;
begin
   it1 := 0;
   it2 := 0;
   SetLength(result, rightPoint - leftPoint);
   while (leftPoint + it1 < midPoint) and (midPoint + it2 < rightPoint) do
      if Arr[leftPoint + it1] < Arr[midPoint + it2] then
      begin
         result[it1 + it2] := Arr[leftPoint + it1];
         Inc(it1);
      end
      else
      begin
         result[it1 + it2] := Arr[midPoint + it2];
         Inc(it2);
      end;
   while leftPoint + it1 < midPoint do
   begin
      result[it1 + it2] := Arr[leftPoint + it1];
      Inc(it1);
   end;
   while midPoint + it2 < rightPoint do
   begin
      result[it1 + it2] := Arr[midPoint + it2];
      Inc(it2);
   end;
   for i := 0 to it1 + it2 - 1 do
      Arr[leftPoint + i] := result[i];
end;

procedure OutputArray(arr: TArray);
var
   i, maxIndex: Integer;
begin
   maxIndex := Length(arr) - 1;
   for i := 0 to maxIndex do
      Write(arr[i], ' ');
end;

procedure NaturalMergeSort(var initArray: TArray);
var
   leftPoint, middlePoint, rightPoint, i: Integer;
   isCorrect: Boolean;
begin
   middlePoint := 0;
   isCorrect := True;
   while isCorrect do
   begin
      rightPoint := 0;
      while rightPoint < High(initArray) do
      begin
         i := rightPoint;
         leftPoint := rightPoint;
         while (initArray[i] <= initArray[i + 1]) and
            (i + 1 <= High(initArray)) do
            Inc(i);
         Inc(i);
         middlePoint := i;
         isCorrect := middlePoint < Length(initArray);
         if (leftPoint <> 0) and (i + 1 <= High(initArray)) then
            isCorrect := True;
         rightPoint := middlePoint + 1;
         while (initArray[i] <= initArray[i + 1]) and
            (i + 1 <= High(initArray)) do
         begin
            Inc(rightPoint);
            Inc(i);
         end;
         if middlePoint < Length(initArray) then
            MergeArrays(initArray, leftPoint, middlePoint, rightPoint);
         Write('Intermediate array: ');
         OutputArray(initArray);
         Writeln;
      end;
   end;
end;

СОРТИРОВКА ПРОСТЫМИ ВСТАВКАМИ--------------------------


type
   TIntArray = array of Integer;

procedure InsertionSort(var Arr: TIntArray);
var
   i, j, buf: Integer;
begin
   for i := Low(Arr) + 1 to High(Arr) do
   begin
      buf := Arr[i];
      j := i - 1;
      while (j >= Low(Arr)) and (Arr[j] > buf) do
      begin
         Arr[j + 1] := Arr[j];
         Dec(j);
      end;
      Arr[j + 1] := buf;
   end;
end;

var
   Arr: TIntArray;
   i, N: Integer;
begin
   WriteLn('N:');
   ReadLn(N);
   WriteLn('Massive:');
   SetLEngth(Arr, N);
   for i := 0 to High(Arr) do
      ReadLn(Arr[i]);
   InsertionSort(Arr);
   for i := 0 to High(Arr) do
      Write(Arr[i], ' ');
   Readln;
end.


СОРТИРОВКА ПРОСТЫМ ВЫБОРОМ ------------------------------------

public static void sort(int[] arr) {
    for (int min = 0; min < arr.length - 1; min++) {
        int least = min;
        for (int j = min + 1; j < arr.length; j++) {
            if (arr[j] < arr[least]) {
                least = j;
            }
        }
            int tmp = arr[min];
            arr[min] = arr[least];
            arr[least] = tmp;
    }
}
QUICK_SORT----------------------------------

procedure qSort(var A: TArray; min, max: Integer);
var i, j, supp, tmp: Integer;
begin
supp:=A[max-((max-min) div 2)];
i:=min; j:=max;
while i<j do
  begin
    while A[i]<supp do i:=i+1;
    while A[j]>supp do j:=j-1;
    if i<=j then
      begin
        tmp:=A[i]; A[i]:=A[j]; A[j]:=tmp;
        i:=i+1; j:=j-1;
      end;
  end;
if min<j then qSort(A, min, j);
if i<max then qSort(A, i, max);
end;