Сортировка пузырьком (bubble sort) — один из самых простых для понимания методов сортировки.
Алгоритм выполняет повторяющиеся проходы по массиву. Во время каждого прохода сортируемые элементы попарно сравниваются, и если порядок в паре неверный, элементы меняются местами (отсюда второе название — сортировка простыми обменами).
Принцип работы метода
program BubbleSort;
const
arrayLength = 10;
var
inputArray : array [1..arrayLength] of integer;
i, j, tempValue: integer;
begin
randomize;
writeln ('Исходный массив: ');
{заполнение массива случайными числами}
for i := 1 to arrayLength do
begin
inputArray[i] := random(100);
write (inputArray[i]:4);
end;
writeln;
{пузырьковая сортировка}
for i := 1 to arrayLength-1 do
for j := 1 to arrayLength-i do
if inputArray[j] > inputArray[j+1] then
begin
{обмен элементов}
tempValue := inputArray[j];
inputArray[j] := inputArray[j+1];
inputArray[j+1] := tempValue;
end;
writeln ('Отсортированный массив: ');
for i := 1 to arrayLength do
write (inputArray[i]:4);
readln;
end.
В приведенной программе производиться сортировка по возрастанию, для сортировки по убыванию достаточно изменить операцию сравнения в строке if inputArray[j] > inputArray[j+1] then, с больше — “>” на меньше — “<“.
Вариант № 2
uses crt;
const n=8;
var
a:array [1..n] of byte;
i,c,q:byte;
begin
clrscr;
a[1]:=25;
randomize; { З|М }
for i:=1 to n do { а|а }
begin { б|с }
a[i]:=random(10); { и|с }
write(a[i],' '); { в|и }
end; { к|в }
writeln; { а|а }
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
repeat {С } ;;
c:=0; {о } ;;
for i:=1 to n-1 do {р } {;;}
begin {т } ;;
q:=a[i]; {и п } ;;
if a[i]>a[i+1] then{р у } {;;}
begin {о з } ;;
a[i]:=a[i+1]; {в ы } ;;
a[i+1]:=q; {к р } ;;
inc(c); {а ь } ;;
end; { к } ;;
end; { о } ;;
until c=0; { м };;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
for i:=1 to n do write(a[i],' ');
readkey;
end.
Вариант 3 Программа сортировки записей в типизированном файле. В файле хранятся записи, состоящие из фамилии и возраста. Производится сортировка пузырьковым методом прямо в файле по обоим полям.
uses CRT;
TYPE
TOne = record
Name: String[20];
Age : Byte;
end;
function FileExists(AFileName: String): Boolean;
var t: File of TOne;
begin
FileExists := False;
Assign(t, AFileName);
{$I-} Reset(t); {$I+}
if IOResult = 0 then begin
Close(t); FileExists:=True
end;
end;
procedure SortByName(AFileName: String);
var
t: File of TOne;
One1, One2: TOne;
pos1, pos2, f_size: Longint;
begin
if NOT FileExists(AFileName) then Exit;
Assign(t, AFileName); Reset(t);
pos1:=0; f_size:=FileSize(t) - 1;
while pos1 < f_size do begin
Seek(t, pos1); Read(t, One1);
pos2 := pos1 + 1;
while pos2 <= f_size do begin
Seek(t, pos2); Read(t, One2);
if One1.Name > One2.Name then begin
Seek(t, pos1); Write(t, One2);
Seek(t, pos2); Write(t, One1);
One1 := One2
end;
inc(pos2);
end;
inc(pos1);
end;
Close(t)
end;
procedure SortByAge(AFileName: String);
var
t: File of TOne;
One1, One2: TOne;
pos1, pos2, f_size: Longint;
begin
if NOT FileExists(AFileName) then Exit;
Assign(t, AFileName); Reset(t);
pos1:=0; f_size:=FileSize(t) - 1;
while pos1 < f_size do begin
Seek(t, pos1); Read(t, One1);
pos2 := pos1 + 1;
while pos2 <= f_size do begin
Seek(t, pos2); Read(t, One2);
if One1.Age > One2.Age then begin
Seek(t, pos1); Write(t, One2);
Seek(t, pos2); Write(t, One1);
One1 := One2
end;
inc(pos2);
end;
inc(pos1);
end;
Close(t)
end;
procedure ShowFile(AFileName: String);
var
One: TOne;
t: File of TOne;
begin
if NOT FileExists(AFileName) then Exit;
Assign(t, AFileName); Reset(t);
while NOT EOF(t) do begin
Read(t, One);
WriteLn(One.Name:25,One.Age:4);
end;
Close(t);
end;
procedure CreateFile(AFileName: String);
{Создание или дополнение}
var t : File of TOne;
One: TOne;
begin
Assign(t, AFileName);
if FileExists(AFileName) then begin
WriteLn('Файл ',AFileName,' существует. Будет открыт для дополнения');
Reset(t); Seek(t, FileSize(t));
end
else begin
WriteLn('Файл ',AFileName,' не существует. Будет создан');
Rewrite(t)
end;
WriteLn('Для окончания ввода введите пустую фамилию или возраст ноль');
repeat
Write('Введите фамилию: '); ReadLn(One.Name);
if One.Name = '' then Break;
Write('Введите возраст: '); {$I-} ReadLn(One.Age); {$I+}
if (IOResult <> 0) or (One.Age = 0) then Break;
Write(t, One);
until (One.Name = '') or (One.Age = 0);
Close(t);
end;
CONST
FileName: String = 'Konst.dat';
BEGIN
ClrScr;
CreateFile(FileName);
ShowFile(FileName);
SortByName(FileName);
WriteLn('После сортировки по имени');
ShowFile(FileName);
SortByAge(FileName);
WriteLn('После сортировки по возрасту');
ShowFile(FileName);
END.
Вариант 4
type
DataItem = char;
DataArray = array [1..80] of char;
var test: DataArray;
t, t2: integer;
testfile: file of char;
{ сортировка пузырьковым методом}
procedure Bubble(var item: DataArray; count:integer);
var
i,j: integer;
x: DataItem;
begin
for i := 2 to count do
begin
for j := count downto i do
if item[j-1]>item[j] then
begin
x := item[j-1];
item[j-1] := item[j];
item[j] := x;
end;
end;
end;
begin
Assign(testfile, 'test.dat');
Reset(testfile);
t := 1;
{ считывание символов,которые будут сортироваться.}
while not Eof(testfile) do begin
read(testfile, test[t]);
t := t+1;
end;
t := t-2; {скорректировать число считанных элементов }
Bubble(test, t); { сортировать массив }
{ выдать отсортированный массив символов }
for t2 := 1 to t do write(test[t2]);
WriteLn;
end.
Для иллюстрации работы сортировки пузырьковым методом ниже даны результаты каждого этапа сортировки массива «dcab»:
- исходное положение: d c a b;
- первый проход: a d c b;
- второй проход: a b d c;
- третий проход: a b c d.