Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
- Cmp:=0;
- Sw:=0;
- 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, toShow); //обработка левой половины
- if i<right then QuickSort(a, Cmp, Sw, i, right, toShow); //обработка правой половины
- //если надо, выводим полученный массив, чтобы убедиться, что все работает как надо
- 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); //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.
Advertisement
Add Comment
Please, Sign In to add comment