В рассмотренных методах сортировки берутся массивы, начинающиеся с индекса 0 !
Если исходный массив начинается с 1, нужно изменять коэффициенты в самой процедуре.
Это наиболее естественный алгоритм упорядочивания. Допустим, что элементы a0 , …, ai-1 уже упорядочены, тогда среди оставшихся ai , …, an-1 находим минимальный элемент и меняем его местами с i-тым элементом. И так далее, пока массив не будет полностью упорядочен.
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure SelectionSort(var arr : array of Real; const N : Integer); var I : Integer; J : Integer; K : Integer; M : Real; begin for i:=1 to N do begin m:=Arr[i-1]; k:=i; for j:=i to n do begin if m>Arr[j-1] then begin m:=Arr[j-1]; k:=j; end; end; Arr[k-1]:=Arr[i-1]; Arr[i-1]:=m; end; end;
Последовательно просматриваем числа a0 , …, an-1 находим наименьшее i такое, что ai > ai+1 . Поменять ai и ai+1 местами, возобновить просмотр с элемента ai+1 и т.д. Тем самым наибольшее число передвиниться на последнее место. Следующие просмотры начинать опять сначала, уменьшая на единицу количество просматриваемых элементов. Массив будет упорядочен после просмотра, в котором участвовали только первый и второй элементы.
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure BubbleSort(var Arr : array of Real; const N : Integer); var I : Integer; J : Integer; Tmp : Real; begin for i:=0 to N-1 do for j:=0 to N-1-i do if Arr[j]>=Arr[j+1] then begin Tmp:=Arr[j]; Arr[j]:=Arr[j+1]; Arr[j+1]:=Tmp; end; end;
Этот метод похож на метод пузырька.
procedure InversionSort (var a: array of integer; n:integer); var t,i,j:integer; begin for i := 0 to n-2 do for j := i+1 to n-1 do if a[i]>a[j] then begin t := a[i]; a[i] := a[j]; a[j] := t end; end;
Последовательно просматриваем a1 , …, an-1 и каждый новый элемент ai вставляем на подходящее место в уже упорядоченную совокупность ai-1 , …, a1 . Это место определяется последовательным сравнением ai с упорядоченными элементами a0 , …, ai-1 .
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure InsertionSort(var Arr : array of Real; N : Integer); var I : Integer; J : Integer; K : Integer; Tmp : Real; begin dec(N); i:=1; repeat j:=0; repeat if Arr[i]<=Arr[j] then begin k:=i; Tmp:=Arr[i]; repeat Arr[k]:=Arr[k-1]; dec(k); until not(k>j); Arr[j]:=Tmp; j:=i; end else inc(j); until not(j<i); inc(i); until not(i<=n); end;
Этот алгоритм представляет из себя оптимизированную версию предыдущего, отличие заключается в том, что при поиске место, на которое надо вставить элемент ai в уже упорядоченную совокупность a0 , …, ai-1 , определяется алгоритмом деления пополам (отсюда и название алгоритма «бинарные вставки» здесь понимаем как «вставка делением пополам»).
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure BinaryInsertionSort(var Arr : array of Real; N : Integer); var B,C,E,I,J,K : Integer; Tmp : Real; begin i:=2; repeat b:=1; e:=i-1; c:=((b+e) div 2); while b<>c do begin if Arr[c-1]>Arr[i-1] then e:=c else b:=c; c:=((b+e) div 2); end; if Arr[b-1]<Arr[i-1] then begin if Arr[i-1]>Arr[e-1] then b:=e+1 else b:=e; end; k:=i; Tmp:=Arr[i-1]; while k>b do begin Arr[k-1]:=Arr[k-1-1]; dec(k) end; Arr[b-1]:=Tmp; inc(i); until not(i<=n); end;
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure ShellSort(var Arr : array of Real; N : Integer); var C : Boolean; E : Integer; G : Integer; I : Integer; J : Integer; Tmp : Real; begin N:=N-1; g:=((n+1) div 2); repeat i:=g; repeat j:=i-g; c:=True; repeat if Arr[j]<=Arr[j+g] then c:=False else begin Tmp:=Arr[j]; Arr[j]:=Arr[j+g]; Arr[j+g]:=Tmp; end; dec(j) until not((j>=0)and(C)); inc(i) until not(i<=n); g:=g div 2; until not(g>0); end;
Алгоритм основан на представлении массива в виде бинарного дерева, обладающего особыми свойствами. В памяти компьютера все элементы массива расположены последовательно, структура же дерева определяется следующим образом: будем считать, что i-ый элемент массива («предок») имеет два элемента потомка с номерами 2i+1 и 2i+2. Дерево имеет нормальную форму, если любой элемент предок больше своих потомков.
Из свойств алгоритма стоит заметить, что он дает стабильно хорошую скорость упорядочивания (порядка n*log(n)), вне зависимости от того с каким массивом работает, и поэтому используется в случаях когда необходимо гарантировано упорядочить массив за короткое время.
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure HeapSort(var Arr : array of Real; N : Integer); var I,J,K,T : Integer; Tmp : Real; begin i:=2; repeat t:=i; while t<>1 do begin k:=t div 2; if Arr[k-1]>=Arr[t-1] then t:=1 else begin Tmp:=Arr[k-1]; Arr[k-1]:=Arr[t-1]; Arr[t-1]:=Tmp; t:=k; end; end; inc(i) until not(i<=n); i:=n-1; repeat Tmp:=Arr[i]; Arr[i]:=Arr[0]; Arr[0]:=Tmp; t:=1; while t<>0 do begin k:=2*t; if k>i then t:=0 else begin if k<i then if Arr[k]>Arr[k-1] then inc(k); if Arr[t-1]>=Arr[k-1] then t:=0 else begin Tmp:=Arr[k-1]; Arr[k-1]:=Arr[t-1]; Arr[t-1]:=Tmp; t:=k; end; end; end; dec(i) until not(i>=1); end;
Алгоритм фон Неймана упорядочивания массива (алгоритм сортировки слияниями) основан на многократных слияниях уже упорядоченных групп элементов массива. Вначале весь массив рассматривается как совокупность упорядоченных групп по одному элементу в каждой. Слиянием соседних групп получаем упорядоченные группы, каждая из которых содержит два элемента (кроме, возможно, последней группы которой не нашлось парной). Далее, упорядоченные группы укрупняются тем же способом и т.д.
Алгоритм дает хорошие показатели по скорости работы, даже в сравнении с сортировкой методом бинарных деревьев. Единственный недостаток - необходимость использовать дополнительный массив того же размера.
(******************************************************* Процедура для сортировки массива. Принимает: *массив значений a с индексами элементов от 0 до N-1 *число элементов N *******************************************************) procedure NeumanSort(var Arr : array of Real; N : Integer); var C : Boolean; I,I1,I2, N1,N2,J,K : Integer; Tmp : Real; BArr : array of Real; MergeLen : Integer; begin SetBounds(BArr, [0,N-1]); MergeLen:=1; c:=True; while MergeLen<n do begin if C then begin i:=0; while i+MergeLen<=n do begin i1:=i+1; i2:=i+MergeLen+1; n1:=i+MergeLen; n2:=i+2*MergeLen; if n2>n then n2:=n; while (i1<=n1)or (i2<=n2) do begin if i1>n1 then begin while i2<=n2 do begin inc(i); BArr[i-1]:=Arr[i2-1]; i2:=i2+1 end; end else begin if i2>n2 then begin while i1<=n1 do begin inc(i); BArr[i-1]:=Arr[i1-1]; i1:=i1+1 end; end else begin if Arr[i1-1]>Arr[i2-1] then begin inc(i); BArr[i-1]:=Arr[i2-1]; i2:=i2+1 end else begin inc(i); BArr[i-1]:=Arr[i1-1]; i1:=i1+1 end; end; end; end; end; i:=i+1; while i<=n do begin BArr[i-1]:=Arr[i-1]; inc(i); end; end else begin i:=0; while i+MergeLen<=n do begin i1:=i+1; i2:=i+MergeLen+1; n1:=i+MergeLen; n2:=i+2*MergeLen; if n2>n then n2:=n; while (i1<=n1)or (i2<=n2) do begin if i1>n1 then begin while i2<=n2 do begin inc(i); Arr[i-1]:=BArr[i2-1]; i2:=i2+1 end; end else begin if i2>n2 then while i1<=n1 do begin inc(i); Arr[i-1]:=BArr[i1-1]; i1:=i1+1 end else begin if BArr[i1-1]>BArr[i2-1] then begin inc(i); Arr[i-1]:=BArr[i2-1]; i2:=i2+1 end else begin inc(i); Arr[i-1]:=BArr[i1-1]; i1:=i1+1 end; end; end; end; end; inc(i); while i<=n do begin Arr[i-1]:=BArr[i-1]; inc(i); end; end; MergeLen:=2*MergeLen; c:=not(C); end; if not(C) then begin i:=1; repeat Arr[i-1]:=BArr[i-1]; inc(i); until not(i<=n); end; end;
procedure QuickSort(var A: Array of word; L, R: Integer); var I, J: Integer; P, T: Word; begin repeat I := L; J := R; P := A[(L + R) shr 1]; repeat while A[I]< P do Inc(I); while A[J]> P do Dec(J); if I <= J then begin T := A[I]; A[I] := A[J]; A[J] := T; Inc(I); Dec(J); end; until I > J; if L < J then QuickSort(A, L, J); L := I; until I >= R; end;