Описание и реализация алгоритмов:
Пузырьковая сортировка (простым выбором, простым обменом, линейная)
Последовательно просматривая числа a1 , ... , an находим наименьшее i такое, что ai > ai+1 . Меняем ai и ai+1 местами, продолжаем просмотр с элемента ai+1 и т.д. Тем самым наибольшее число передвинется на последнее место. Следующие просмотры начинать со второго элемента, при этом количество просматриваемых элементов уменьшится на единицу. Массив будет упорядочен после просмотра, в котором участвовали только элементы an-1 и an.
Скачать: [attachmentid=4349]
Type
arrType = Array[1 .. n] Of Integer;
Procedure Bubble(Var ar: arrType; n: integer);
Var i, j, T: Integer;
Begin
For i := 1 To n Do
For j := n DownTo i+1 Do
If ar[Pred(j)] > ar[j] Then Begin { < }
T := ar[Pred(j)]; ar[Pred(j)] := ar[j]; ar[j] := T
End
End;
Const
n = 10;
Type
TType = Integer;
arrType = Array[1 .. n] Of TType;
Const
a: arrType =
(7, 1, 9, 8, 5, 6, 2, 4, 3, 10);
Procedure Bubble(Var source, sorted: arrType);
Procedure SwapIndex(i, j: Integer);
Var
T: TType;
Begin
move(sorted[i], T, SizeOf(TType));
move(sorted[j], sorted[i], SizeOf(TType));
move(T, sorted[j], SizeOf(TType));
End;
Var
i, j: Integer;
Begin
move(source, sorted, SizeOf(arrType));
For i := 1 To n Do
For j := n DownTo i + 1 Do
If sorted[Pred(j)] < sorted[j] { change here }
Then SwapIndex(Pred(j), j);
End;
Var
b: arrType;
i: Integer;
Begin
Bubble(a, b);
for i := 1 to n do writeln(b[i]);
End.
procedure BubbleSort(Mas: Pointer; Len: LongWord);
asm
dec Len
@CycleExt:
xor ebx,ebx
mov ecx,Len
mov esi,0
@CycleIn:
mov edi,Mas[esi]
cmp edi,Mas[esi+4]
jg @Exchange
add esi,4
loop @CycleIn
jmp @Check
@Exchange:
mov ebx,Mas[esi+4]
mov Mas[esi+4],edi
mov Mas[esi],ebx
add esi,4
loop @CycleIn
@Check:
cmp ebx,0
je @Exit
jmp @CycleExt
@Exit:
end;
Сортировка простой вставкой
Скачать:
INS_SORT.PAS ( 601 байт )
Кол-во скачиваний: 2008
Type
arrType = Array[1 .. n] Of Integer;
Procedure Insert(Var ar: arrType; n: Integer);
Var i, j, T: Integer;
Begin
For i := 1 To n Do Begin
T := ar[i];
j := Pred(i);
While (j > 0) and (T < ar[j]) Do Begin { !!! }
ar[Succ(j)] := ar[j]; Dec(j);
End;
ar[Succ(j)] := T;
End;
End;
Сортировка слияниями
Type
arrType = Array[1 .. n] Of Integer;
Procedure merge(Var ar: arrType; n: Integer);
Procedure Slit( k, q: Integer );
Var
m: Integer;
i, j, T: Integer;
d: arrType;
Begin
m := k + (q-k) div 2;
i := k; j := Succ(m); t := 1;
While (i <= m) and (j <= q) Do Begin
If ar[i] <= ar[j] Then Begin
d[T] := ar[i]; Inc(i)
End
Else Begin
d[T] := ar[j]; Inc(j)
End;
Inc(T)
End;
While i <= m Do Begin
d[T] := ar[i]; Inc(i); Inc(T)
End;
While j <= q Do Begin
d[T] := ar[j]; Inc(j); Inc(T)
End;
For i := 1 to Pred(T) Do
ar[Pred(k+i)] := d[i]
End;
Procedure Sort(i, j: Integer);
Var T: integer;
Begin
If i >= j Then Exit;
If j-i = 1 Then Begin
If ar[j] < ar[i] Then Begin
T := ar[i]; ar[i] := ar[j]; ar[j] := T
End
End
Else Begin
Sort(i, i + (j-i) div 2);
Sort(i + (j-i) div 2 + 1, j);
Slit(i, j)
End;
End;
Begin
Sort(1, n);
End;
Быстрая сортировка Хоара
Это улучшенный метод, основанный на обмене. При "пузырьковой" сортировке производятся обмены элементов в соседних позициях. При пирамидальной сортировке такой обмен совершается между элементами в позициях, жестко связанных друг с другом бинарным деревом. Ниже будет рассмотрен алгоритм сортировки К. Хоара, использующий несколько иной механизм выбора значений для обменов. Этот алгоритм называется сортировкой с разделением или быстрой сортировкой. Она основана на том факте, что для достижения наибольшей эффективности желательно производить обмены элементов на больших расстояниях.
Предположим, что даны N элементов массива, расположенные в обратном порядке. Их можно рассортировать, выполнив всего N/2 обменов, если сначала поменять местами самый левый и самый правый элементы и так далее, постепенно продвигаясь с двух сторон к середине. Это возможно только, если мы знаем, что элементы расположены строго в обратном порядке.
Рассмотрим следующий алгоритм: выберем случайным образом какой-то элемент массива (назовем его X). Просмотрим массив, двигаясь слева направо, пока не найдем элемент a[ i ]>X (сортируем по возрастанию), а затем просмотрим массив справа налево, пока не найдем элемент a[ j ]<X. Далее, поменяем местами эти два элемента a[ i ] и a[ j ] и продолжим этот процесс "просмотра с обменом", пока два просмотра не встретятся где-то в середине массива.
После такого просмотра массив разделится на две части: левую с элементами меньшими (или равными) X, и правую с элементами большими (или равными) X. Итак, пусть a[k] (k=1,...,N) - одномерный массив, и X - какой-либо элемент из a. Надо разбить "a" на две непустые непересекающиеся части а1 и а2 так, чтобы в a1 оказались элементы, не превосходящие X, а в а2 - не меньшие X.
Рассмотрим пример. Пусть в массиве a: <6, 23, 17, 8, 14, 25, 6, 3, 30, 7> зафиксирован элемент x=14. Просматриваем массив a слева направо, пока не найдем a[ i ]>x. Получаем a[2]=23. Далее, просматриваем a справа налево, пока не найдем a[ j ]<x. Получаем a[10]=7. Меняем местами a[2] и a[10]. Продолжая этот процесс, придем к массиву <6, 7, 3, 8, 6> <25, 14, 17, 30, 23>, разделенному на две требуемые части a1, a2. Последние значения индексов таковы: i=6, j=5. Элементы a[1],....,a[i-1] меньше или равны x=14, а элементы a[j+1],...,a[n] больше или равны x. Следовательно, разделение массива произошло.
Описанный алгоритм прост и эффективен, так как сравниваемые переменные i, j и x можно хранить во время просмотра в быстрых регистрах процессора. Наша конечная цель - не только провести разделение на указанные части исходного массива элементов, но и отсортировать его. Для этого нужно применить процесс разделения к получившимся двум частям, затем к частям частей, и так далее до тех пор, пока каждая из частей не будет состоять из одного единственного элемента. Эти действия описываются следующей программой. Процедура Sort реализует разделение массива на две части, и рекурсивно обращается сама к себе...
Type
arrType = Array[1 .. n] Of Integer;
{ первый вариант : }
Procedure HoarFirst(Var ar: arrType; n: integer);
Procedure sort(m, l: Integer);
Var i, j, x, w: Integer;
Begin
i := m; j := l;
x := ar[(m+l) div 2];
Repeat
While ar[i] < x Do Inc(i);
While ar[j] > x Do Dec(j);
If i <= j Then Begin
w := ar[i]; ar[i] := ar[j]; ar[j] := w;
Inc(i); Dec(j)
End
Until i > j;
If m < j Then Sort(m, j);
If i < l Then Sort(i, l)
End;
Begin
sort(1, n)
End;
Type
arrType = Array[1 .. n] Of Integer;
{ второй вариант : }
Procedure HoarSecond(Var ar: arrType; n: Integer);
Procedure Sort(m, l: Integer);
Var i, j, x, w: Integer;
Begin
If m >= l Then Exit;
i := m; j := l;
x := ar[(m+l) div 2];
While i < j Do
If ar[i] < x Then Inc(i)
Else If ar[j] > x Then Dec(j)
Else Begin
w := ar[i]; ar[i] := ar[j]; ar[j] := w;
End;
Sort(m, Pred(j));
Sort(Succ(i),l);
End;
Begin
Sort(1, n)
End;
Пирамидальная - турнирная - HeapSort сортировка
Скачать:
HIP_SORT.PAS ( 1.27 килобайт )
Кол-во скачиваний: 1832
Type
arrType = Array[1 .. n] Of Integer;
Procedure HeapSort(Var ar: arrType; n: Integer);
Var
i, Left, Right: integer;
x: Integer;
Procedure sift;
Var i, j: Integer;
Begin
i := Left; j := 2*i; x := ar[i];
While j <= Right Do Begin
If j < Right Then
If ar[j] < ar[Succ(j)] Then Inc(j);
If x >= ar[j] Then Break;
ar[i] := ar[j];
i := j; j := 2 * i
End;
ar[i] := x
End;
Var T: Integer;
Begin
Left := Succ(n div 2); Right := n;
While Left > 1 Do Begin
Dec(Left); sift
End;
While Right > 1 Do Begin
T := ar[ Left ]; ar[ Left ] := ar[ Right ]; ar[ Right ] := T;
Dec(Right); sift
End
End;
Распределяющая сортировка - RadixSort - цифровая - поразрядная
Пусть имеем максимум по k байт в каждом ключе (хотя за элемент сортировки вполне можно принять и что-либо другое, например слово - двойной байт, или буквы, если сортируются строки). k должно быть известно заранее, до сортировки.
Разрядность данных (количество возможных значений элементов) - m - также должна быть известна заранее и постоянна. Если мы сортируем слова, то элемент сортировки - буква, m = 33. Если в самом длинном слове 10 букв, k = 10. Обычно мы будем сортировать данные по ключам из k байт, m=256.
Пусть у нас есть массив source из n элементов по одному байту в каждом.
Для примера можете выписать на листочек массив source = <7, 9, 8, 5, 4, 7, 7>, и проделать с ним все операции, имея в виду m=9.
for i := 0 to Pred(255) Do distr[i]:=0;
for i := 0 to Pred(n) Do distr[source[i]] := distr[[i]] + 1;
index: array[0 .. 255] of integer;
index[0]:=0;
for i := 1 to Pred(255) Do index[i]=index[i-1]+distr[i-1];
for i := 0 to Pred(n) Do Begin
sorted[ index[ source[i] ] ]:=source[i];
{
попутно изменяем index уже вставленных символов, чтобы
одинаковые ключи шли один за другим:
}
index[ source[i] ] := index[ source[i] ] +1;
End;
Const
n = 8;
Type
arrType = Array[0 .. Pred(n)] Of Byte;
Const
m = 256;
a: arrType =
(44, 55, 12, 42, 94, 18, 6, 67);
Procedure RadixSort(Var source, sorted: arrType);
Type
indexType = Array[0 .. Pred(m)] Of Byte;
Var
distr, index: indexType;
i: integer;
begin
fillchar(distr, sizeof(distr), 0);
for i := 0 to Pred(n) do
inc(distr[source[i]]);
index[0] := 0;
for i := 1 to Pred(m) do
index[i] := index[Pred(i)] + distr[Pred(i)];
for i := 0 to Pred(n) do
begin
sorted[ index[source[i]] ] := source[i];
index[source[i]] := index[source[i]]+1;
end;
end;
var
b: arrType;
begin
RadixSort(a, b);
end.
Пузырьковая сортировка с просеиванием
Аналогичен методу пузырьковой сортировки, но после перестановки пары соседних элементов выполняется просеивание: наименьший левый элемент продвигается к началу массива насколько это возможно, пока не выполняется условие упорядоченности.
Преимущество: простой метод пузырька работает крайне медленно, когда мин/макс (в зависимости от направления сортировки) элемент массива стоит в конце, этот алгоритм - намного быстрее.
const n = 10;
var
x: array[1 .. n] of integer;
i, j, t: integer;
flagsort: boolean;
procedure bubble_P;
begin
repeat
flagsort:=true;
for i:=1 to n-1 do
if not(x[i]<=x[i+1]) then begin
t:=x[i];
x[i]:=x[i+1];
x[i+1]:=t;
j:=i;
while (j>1)and not(x[j-1]<=x[j]) do begin
t:=x[j];
x[j]:=x[j-1];
x[j-1]:=t;
dec(j);
end;
flagsort:=false;
end;
until flagsort;
end;
Древесная сортировка (TreeSort)
Использует http://forum.pascalnet.ru/index.php?showtopic=2706&view=findpost&p=28334, в которых для каждого предшественника выполнено следующее правило: левый преемник всегда меньше, а правый преемник всегда больше или равен предшественнику.
При добавлении в дерево нового элемента его последовательно сравнивают с нижестоящими узлами, таким образом вставляя на место: если элемент >= корня - он идет в правое поддерево, сравниваем его уже с правым сыном, иначе - он идет в левое поддерево, сравниваем с левым, и так далее, пока есть сыновья, с которыми можно сравнить.
Если мы будем рекурсивно обходить дерево по правилу "левый сын -> родитель -> правый сын", то, записывая все встречающиеся элементы в массив, мы получим упорядоченное в порядке возрастания множество. Hа этом и основана идея сортировки деревом.
Более подробно правило обхода можно сформулировать так: обойти левое поддерево -> вывести корень -> обойти правое поддерево, где рекурсивная процедура 'обойти' вызывает себя еще раз, если сталкивается с узлом-родителем и выдает очередной элемент, если у узла нет сыновей.
Const n = 8;
Type
TType = Integer;
arrType = Array[1 .. n] Of TType;
Const
a: arrType =
(44, 55, 12, 42, 94, 18, 6, 67);
(* Сортировка с помощью бинарного дерева *)
Type
PTTree = ^TTree;
TTree = Record
a: TType;
left, right: PTTree;
End;
{ Добавление очередного элемента в дерево }
Function AddToTree(root: PTTree; nValue: TType): PTTree;
Begin
(* При отсутствии преемника создать новый элемент *)
If root = nil Then Begin
root := New(PTTree);
root^.a := nValue;
root^.left := nil;
root^.right := nil;
AddToTree := root; Exit
End;
If root^.a < nValue Then
root^.right := AddToTree(root^.right, nValue)
Else
root^.left := AddToTree(root^.left, nValue);
AddToTree := root
End;
(* Заполнение массива *)
Procedure TreeToArray(root: PTTree; Var a: arrType);
Const maxTwo: Integer = 1;
Begin
(* При отсутствии преемников рекурсия остановится *)
If root = nil Then Exit;
(* Левое поддерево *)
TreeToArray(root^.left, a);
a[maxTwo] := root^.a; Inc(maxTwo);
(* Правое поддерево *)
TreeToArray(root^.right, a);
Dispose(root)
End;
(* Собственно процедура сортировки *)
Procedure SortTree(Var a: arrType; n: Integer);
Var
root: PTTree;
i: Integer;
Begin
root := nil;
For i := 1 To n Do
root := AddToTree(root, a[i]);
TreeToArray(root, a)
End;
Var i: Integer;
Begin
WriteLn('До сортировки:')
For i := 1 To n Do Write(a[i]:4);
WriteLn;
SortTree(a, n);
WriteLn('После сортировки:')
For i := 1 To n Do Write(a[i]:4);
WriteLn
End.
Сортировка методом поиска нового номера (в новый массив)
Краткая теория: Последовательно для каждого элемента массива вычисляется его новая позиция в отсортированном массиве, рассчитывается кол-во элементов, значения которых
type
TArr = array[1..100] of integer;
var
mass1,NewMass : TArr;
n : integer;
{
n-размерность массива, mass1 - исходный массив,
NewMass - удет состоять из отсотртированных элементов массива mass1
}
procedure NewNSort(var mass, Nmass: TArr; size: integer);
var i, j, NewN: integer;
begin
for i:=1 to size do begin
NewN:=0;
for j:=1 to size do
if (mass[j]<mass[i]) or ((mass[j]=mass[i]) and (j<=i)) then inc(NewN);
Nmass[NewN]:=mass[i];
end;
end;
NewNSort(mass1, NewMass, n);
Метод последовательного поиска минимумов
Теория: Просматривается весь массив, ищется минимальный элемент и ставится на место первого, "старый" первый элемент ставится на место найденного
type
TArr = array[1..100] of integer;
var
mass1 : TArr;
n : integer;
procedure NextMinSearchSort(var mass:TArr; size:integer);
var i, j, Nmin, temp: integer;
begin
for i:=1 to size-1 do begin
nmin:=i;
for j:=i+1 to size do
if mass[j]<mass[Nmin] then Nmin:=j;
temp:=mass[i];
mass[i]:=mass[Nmin];
mass[Nmin]:=temp;
end;
end;
NextMinSearchSort(mass1, n);