unit Unit1 mode objfpc interface uses Classes SysUtils FileUtil Forms

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls;
const
MAX = 10000; //максимальный размер массива
type
//тип - массив для сортировки
TArray = array[1..MAX] of integer;
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Edit1: TEdit;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Memo1: TMemo;
Memo2: TMemo;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
size : integer; //размер массива
A : TArray; //массив
implementation
{$R *.lfm}
{ TForm1 }
//генерация массива размером size
procedure GenerateArray(var a : TArray; size : integer);
var
i : integer;
begin
Randomize;
for i := 1 to size do
a[i] := -250 + Random(500); //случайное от -250 до 250
end;
//копирование массива
procedure CopyArray(a : TArray; size : integer; var b : TArray);
var
i : integer;
begin
for i := 1 to size do
b[i] := a[i];
end;
//сортировка обменом (пузырьковая)
//cmp - переменная для кол-ва обменов, swp - перестановок
procedure BubbleSort(var a : TArray; size : integer; var cmp : integer; var swp : integer);
var
i, j, t : integer;
begin
cmp := 0; swp := 0;
for i := 1 to size do
for j := 1 to size - i do
begin
inc(cmp); //+1 сравнение
if a[j] > a[j + 1] then
begin
//перестановка
t := a[j+1];
a[j+1] := a[j];
a[j] := t;
inc(swp); //+1 перестановка
end;
end;
end;
//сортировка вставками
//cmp - переменная для кол-ва обменов, swp - перестановок
procedure InsertionSort(var a : TArray; size : integer; var cmp : integer; var swp : integer);
var
i, j, t : integer;
begin
cmp := 0; swp := 0;
for i := 2 to size do
begin
t := a[i]; //необходимо вставить в нужное место i-тый элемент
j := i - 1; //просматривать начнем с позиции на 1 левее
Inc(cmp); //первое сравнение на данном шаге
while (j >= 1) and (a[j] > t) do //пока не дойдем до начала массива или элемента, меньше текущего
begin
a[j + 1] := a[j];
j := j - 1;
Inc(cmp); //+1 следующее сравнение
end;
a[j + 1] := t; //вставляем элемент в найденное место
inc(swp); //+1 перестановка
end;
end;
//кнопка "Сгенерировать"
procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
begin
size := StrToInt(Edit1.Text);
GenerateArray(A, size);
//вывод на экран
Memo1.Lines.Clear;
for i := 1 to size do
Memo1.Text:= Memo1.Text + IntToStr(A[i]) + ' ';
end;
//кнопка "сортировать"
procedure TForm1.Button2Click(Sender: TObject);
var
B : TArray;
i, c, s : integer;
begin
CopyArray(A, size, B); //копируем исходный массив (чтобы исходный оставался прежним для новой сортировки)
if (RadioButton1.Checked) then //в зависимости от выбранного типа сортировки (выбранного переключателя)
BubbleSort(B, size, c, s) //пузырьковая сортировка
else
InsertionSort(B, size, c, s); //сортировка вставками
//вывод на экран
Memo2.Lines.Clear;
for i := 1 to size do
Memo2.Text:= Memo2.Text + IntToStr(B[i]) + ' ';
//вывод результатов
Label4.Caption := 'Сравнений: ' + IntToStr(c);
Label5.Caption := 'Перестановок: ' + IntToStr(s);
end;
end.