Выкладываю готовую программу, вдруг кому нужно будет.
| Код |
unit UnitMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, jpeg, ExtCtrls;
type
TFormMain = class(TForm)
EditSrc: TEdit;
btnSort: TButton;
Label2: TLabel;
cbSortType: TComboBox;
btnInitRnd: TButton;
MemoLog: TMemo;
btnSortAll: TButton;
brnPrint: TButton;
procedure FormCreate(Sender: TObject);
procedure btnInitRndClick(Sender: TObject);
procedure btnSortClick(Sender: TObject);
procedure btnSortAllClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure brnPrintClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
//массив
TArrayOfInteger = array of Integer;
const
//ограничим генерируемые числа
cMaxInt = 10000;
var
FormMain: TFormMain;
//массив
a: TArrayOfInteger;
//инициализация
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
//вспомогательная функция копирования
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
//очистка
procedure ArrayClear(a: TArrayOfInteger);
//сортировки
//Метод обмена (Метод пузырька)
procedure BubbleSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод вставок
procedure InsertSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод выбора
procedure ChooseSort(a: TArrayOfInteger; var Cmp,Sw: Integer; toShow: Boolean = true);
//Метод быстрой сортировки
procedure QuickSort(a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean = true);
//Cmp - число сравнений
//Sw - число перестановок
implementation
{$R *.dfm}
procedure ArrayInitRnd(var a: TArrayOfInteger; N: Integer);
var
i: Integer;
begin
//забиваем массив случайными числами
ArrayClear(a);
SetLength(a,N);
for i:=0 to N-1 do
a[i]:=Random(cMaxInt);
end;
function ArrayCopy(a: TArrayOfInteger): TArrayOfInteger;
var
i,N: Integer;
begin
//копируем массив
N:=Length(a);
SetLength(Result,N);
for i:=0 to N-1 do
Result[i]:=a[i];
end;
procedure ArrayClear(a: TArrayOfInteger);
begin
SetLength(a,0);
end;
procedure BubbleSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
i,j,N,temp: Integer;
begin
Cmp:=0;
Sw:=0;
N:=Length(a);
for i:=1 to N-1 do
for j:=N-1 downto i do
begin
Inc(Cmp);
if a[j-1]>a[j] then
begin
Inc(Sw);
temp:=a[j-1];
a[j-1]:=a[j];
a[j]:=temp;
end;
end;
//если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
if toShow then
for i:=0 to N-1 do
FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
procedure InsertSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
i,j,N,temp: Integer;
begin
Cmp:=0;
Sw:=0;
N:=Length(a);
for i:=1 to N-1 do
begin
temp:=a[i];
j:=i-1;
while (j>=0) and (temp<a[j]) do
begin
Inc(Cmp);
Inc(Sw);
a[j+1]:=a[j];
Dec(j);
end;
Inc(Cmp);
a[j+1]:=temp;
end;
//если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
if toShow then
for i:=0 to N-1 do
FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
procedure ChooseSort(a: TArrayOfInteger; var Cmp, Sw: Integer; toShow: Boolean);
var
i,j,k,N,temp: Integer;
begin
Cmp:=0;
Sw:=0;
N:=Length(a);
for i:=0 to N-2 do
begin
k:=i;
temp:=a[i];
for j:=i+1 to N-1 do
begin
Inc(Cmp);
if a[j]<temp then
begin
k:=j;
temp:=a[j];
Inc(Sw);
end;
end;
a[k]:=a[i];
a[i]:=temp;
end;
//если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
if toShow then
for i:=0 to N-1 do
FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
procedure QuickSort(a: TArrayOfInteger; var Cmp, Sw : Integer; Left, Right: Integer; toShow: Boolean);
var
i,j,sred,temp:integer;
begin
i:=left; j:=right; //установка начальных границ подмассива
sred:=a[(left+right) div 2]; //определение серединного элемента
repeat
while (a[i]<sred) do Begin i:=i+1; Inc(Cmp); End; //поиск слева элемента, большего опорного
while (a[j]>sred) do Begin j:=j-1; Inc(Cmp); End; //поиск справа элемента, меньшего опорного
if i<=j then
begin //обмениваем элементы и изменяем индексы
temp:=a[i]; a[i]:=a[j]; a[j]:=temp;
i:=i+1; j:=j-1;
Inc(Sw);
end;
until i>j;
if left<j then QuickSort(a, Cmp, Sw, left, j, false); //обработка левой половины
if i<right then QuickSort(a, Cmp, Sw, i, right, false); //обработка правой половины
//если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
if toShow then
for i:=0 to High(a) do
FormMain.MemoLog.Lines.Add(IntToStr(a[i]));
end;
procedure TFormMain.FormCreate(Sender: TObject);
begin
ArrayClear(a);
end;
procedure TFormMain.btnInitRndClick(Sender: TObject);
var
i,aCount: Integer;
begin
try
aCount:=StrToInt(EditSrc.Text);
ArrayInitRnd(a,aCount);
MemoLog.Lines.Clear;
for i:=0 to aCount-1 do
MemoLog.Lines.Add(IntToStr(a[i]));
except
ShowMessage('Введите целое число');
end;
end;
procedure TFormMain.btnSortClick(Sender: TObject);
var
Cmp,Sw: Integer;
b: TArrayOfInteger;
begin
MemoLog.Lines.Clear;
//работаем с копией массива, чтобы его не потерять
b:=ArrayCopy(a);
case cbSortType.ItemIndex of
0:
begin
MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
BubbleSort(b,Cmp,Sw);
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
end;
1:
begin
MemoLog.Lines.Add('Метод вставок');
InsertSort(b,Cmp,Sw);
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
end;
2:
begin
MemoLog.Lines.Add('Метод выбора');
ChooseSort(b,Cmp,Sw);
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
end;
3:
begin
MemoLog.Lines.Add('Метод быстрой сортировки');
QuickSort(b,Cmp,Sw,0,High(b),true);
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
end;
end;
SetLength(b,0);
end;
procedure TFormMain.btnSortAllClick(Sender: TObject);
var
Cmp,Sw: Integer;
b: TArrayOfInteger;
begin
MemoLog.Lines.Clear;
//всякий раз работаем с копией массива, чтобы его не потерять
b:=ArrayCopy(a);
BubbleSort(b,Cmp,Sw,false);
MemoLog.Lines.Add('Метод обмена (Метод пузырька)');
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
SetLength(b,0);
b:=ArrayCopy(a);
InsertSort(b,Cmp,Sw,false);
MemoLog.Lines.Add('');
MemoLog.Lines.Add('Метод вставок');
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
SetLength(b,0);
b:=ArrayCopy(a);
ChooseSort(b,Cmp,Sw,false);
MemoLog.Lines.Add('');
MemoLog.Lines.Add('Метод выбора');
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
SetLength(b,0);
b:=ArrayCopy(a);
QuickSort(b,Cmp,Sw,0,High(b),false);
MemoLog.Lines.Add('');
MemoLog.Lines.Add('Метод быстрой сортировки');
MemoLog.Lines.Add('Длина массива: '+IntToStr(Length(a)));
MemoLog.Lines.Add('Сравнений: '+IntToStr(Cmp));
MemoLog.Lines.Add('Перестановок: '+IntToStr(Sw));
SetLength(b,0);
end;
procedure TFormMain.FormDestroy(Sender: TObject);
begin
ArrayClear(a);
end;
procedure TFormMain.brnPrintClick(Sender: TObject);
var
i: Integer;
begin
MemoLog.Lines.Clear;
for i:=0 to Length(a)-1 do
MemoLog.Lines.Add(IntToStr(a[i]));
end;
end.
|
И сам проект также прикладываю во вложении ниже. |
)