Программа показывает как отсортировать массив записей по возрасту.
Так можно упорядочить любую структуру данных. Надо только позаботиться о том, по какому критерию надо сортировать. По убыванию? Пожалуйста! Поменяйте знак сравнения в процедуре 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 (смотрите в исходнике программы). Исходник рабочего примера сортировки по имени, с форматированным выводом записей: [пока нету…]
(с использованием процедурных типов, требует знаний по указателям)
Процедурный тип для вызова функции сравнения даёт возможность выбрать пользователю вид сортировки. Результатом этой функции должно быть:
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.