====== Как упорядочить данные по возрастанию? ======
==== Простой пример ====
Программа показывает как отсортировать массив записей по возрасту.
Так можно упорядочить //любую// структуру данных. Надо только позаботиться о том, по какому критерию надо сортировать.
По убыванию? Пожалуйста! Поменяйте знак сравнения в процедуре //Compare//.
Самая важная часть - сортировка массива записей - осуществляется процедурой //Sort//. Её можно заменить на любой другой алгоритм сортировки (пузырьком, быстрая сортировка и другие). При замене процедуры сортировки на свою, вы должны внести саму часть сравнения в виде кода
if Compare (Data[i], Data[j]) > 0 then
Процедуры ввода и вывода данных массива (//InputData// и //OuputData//) можете заменить на свои.
program SortRec;
const N = 4;
type
TInfo = record
Age: integer; { возраст }
Name: string [20];
end;
List = array [1..N] of TInfo; { массив записей содержит возраст и имя }
var
Data: List;
{ сравнивать по именам }
function Compare (T1,T2: TInfo): integer;
begin
if T1.Name > T2.Name then
Compare := 1
else
if T1.Name = T2.Name then
Compare := 0
else
Compare := -1
end;
(* или:
{ сравнивать по возрасту }
function Compare (T1,T2: TInfo): integer;
begin
if T1.Age > T2.Age then
Compare := 1
else
if T1.Age = T2.Age then
Compare := 0
else
Compare := -1
end;
*)
procedure Sort;
var
i, j: integer;
temp: TInfo;
begin
For I := 1 To Pred (N) Do
For J := Succ (I) To N Do
if Compare (Data[i], Data[j]) > 0 then
Begin
temp := Data[i];
Data[i] := Data[j];
Data[j] := temp;
End;
end;
procedure InputData;
var
I: Integer;
begin
for I := 1 to N do
with Data[I] do
begin
writeln;
write ('Enter name: '); readln (Name);
write ('Enter age: '); readln (Age);
end;
end;
procedure OuputData;
var
I: Integer;
begin
writeln;
writeln ('Name' : 10, 'Age' : 30);
for I := 1 to 40 do write ('=');
writeln;
for I := 1 to N do
with Data[I] do
begin
write ( I : 2 );
write ( ' ' : 4, Name);
writeln ( Age : 34 - Length (Name));
end;
readln;
end;
begin { Main }
{ заполнение массива записей }
InputData;
{ сортировка массива записей }
Sort;
{ форматированный вывод на экран массива записей }
OuputData;
end.
Вывод на экран будет таким:
Name Age
========================================
1 Anton 23
2 Denis 12
3 Rostik 19
4 Vasilij 27
==== Усложнённый пример ====
Рассмотрим более сложный пример, с применением быстрой сортировки. Этот алгоритм рассчитан на большие массивы записей и очень эффективен в большинстве случаев, хотя его реализация и сложнее.\\ Вот как будет выглядеть процедура в этом случае:
procedure QuickSort (var A: List; Lo, Hi: Integer);
var
x, y: TInfo;
procedure Sort (l, r: Integer);
var
i, j: integer;
begin
repeat
x := A[(l + r) div 2];
i := l; j := r;
repeat
while Compare( A[i], x ) < 0 do
inc (i);
while Compare( A[j], x ) > 0 do
dec (j);
if i <= j then
begin
y := A[i]; A[i] := A[j]; A[j] := y; { поменять A[i] и A[j] значения местами }
inc(i);
dec(j);
end;
until i > j;
if l < j then Sort (l, j);
l := i;
until l >= r;
end;
begin
Sort (Lo,Hi);
end; {QuickSort}
Сама сортировка в данном случае выглядит так:
QuickSort (Data, 1, N); { сортировка массива записей от 1-й до N-й записи }
----
Бывают случаи, когда нужно сравнивать текст без учёта регистра. Тогда нужно применять функцию //StrICmp// вместо //StrCmp// (смотрите в исходнике программы).
Исходник рабочего примера сортировки по имени, с форматированным выводом записей: [пока нету...]
==== Сортировка массива строк или чисел ====
(с использованием процедурных типов, требует знаний по указателям)
- Ввод данных массива
- Сортировка массива
- Вывод данных массива
== Сортировка массива ==
* для массива чисел нужно выбрать функцию сравнения чисел //CompareNumbers//
* для массива строк - функцию сравнения строк //CompareStrings//.
Процедурный тип для вызова функции сравнения даёт возможность выбрать пользователю вид сортировки. Результатом этой функции должно быть:
1, если A > B
0, если A = B
-1, если A < B
Можно также менять порядок сортировки по возрастанию или убыванию. Для этого надо поменять знаки на противоположные в функции сравнения.
Этот способ сортировки имеет преимущество перед описанными ранее тем, что сортирует только указатели на записи, в то время как содержимое записей остаётся на своём месте, нукуда не перемещаясь. Т.е. экономится лишнее время на перемещения данных в памяти.
Program SortArray;
Uses Objects;
const
N = 4; { кол-во элементов в массиве }
SORT_STR: boolean = true;
type
PInteger = ^Integer;
List = array[1..N] of Pointer; { список указателей на ячейки данных }
{ процедурный тип для вызова функции сравнения }
TSortFunc = function (a,b: pointer): integer;
var
Data: List;
{$I sortfunc.inc} { подключаем дополнительный код - функция StrCmp }
{ Здесь указываем как будем сортировать данные.
Данные для сравнения переда„м в качестве указателей, будь то строки,
числа, или даже структуры данных типа Запись }
function CompareNumbers (a,b: pointer): integer; FAR; { дальний тип связи }
begin
if PInteger (a)^ > PInteger (b)^ then
CompareNumbers := 1
else
if PInteger (a)^ = PInteger (b)^ then
CompareNumbers := 0
else
CompareNumbers := -1
end;
function CompareStrings (a,b: pointer): integer; FAR;
begin
CompareStrings := strcmp (PString (a)^, PString (b)^)
end;
procedure QuickSort (var A: List; SortFunc: TSortFunc; Lo, Hi: Integer);
{ "Быстрая сортировка". Можно применить любой другой вид сортировки }
var
i,j: integer;
x, y: pointer;
procedure Sort (l, r: Integer);
begin
repeat
x := A[(l+r) div 2];
i := l; j := r;
repeat
while SortFunc (A[i], x) < 0 do inc (i);
while SortFunc (A[j], x) > 0 do dec (j);
if i <= j then
begin
y := A[i]; A[i] := A[j]; A[j] := y; { поменять указатели местами }
inc (i);
dec (j);
end;
until i > j;
if l < j then Sort (l, j);
l := i;
until l >= r;
end;
begin
Sort (Lo,Hi);
end;
procedure Input_Array;
var
i: Integer;
S: string;
Num: PInteger;
begin
Randomize; { Инициализация генератора случайных чисел }
writeln (#13#10'*** Data input ***'#13#10);
if SORT_STR then
for i := 1 to N do
begin
write ('Enter string: ');
readln (s);
Data[i] := pointer (NewStr (s)); { резервируем память для строки }
end
else
for i := 1 to N do
begin
New (Num); { резервируем память для числа }
Num^ := random (100); { случайные числа }
Data[i] := Num;
end;
end;
procedure View_Array;
var
i: Integer;
begin
writeln (#13#10'*** Data output ***'#13#10);
if SORT_STR then
for i := 1 to N do
begin
writeln (PString (Data[i])^); { вывод строки }
DisposeStr (PString (Data[i]));
{ освобождаем память, взятую для числа }
end
else
for i := 1 to N do
begin
write (PInteger (Data[i])^ : 4); { вывод числа }
Dispose (Data[i]);
{ освобождаем память, взятую для строки }
end;
readln;
end;
begin
Input_Array; { ввод данных }
{ вызов процедуры сортировки }
if SORT_STR then
QuickSort (Data, CompareStrings, 1, N)
{ сортируем массив строк }
else
QuickSort (Data, CompareNumbers, 1, N);
{ сортируем массив чисел }
View_Array; { вывод данных }
end.