Как упорядочить данные по возрастанию? , пример для массива записей

[Romtek]

Как упорядочить данные по возрастанию? Пример для массива записей.

Программа показывает как отсортировать массив записей по возрасту.
Так можно упорядочить любую структуру данных. Надо только позаботиться о том, по какому критерию надо сортировать.
По убыванию? Пожалуйста! Поменяйте знак сравнения в процедуре 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

Прикреплённый файлSortrec.rar (0.77 Кбайт, скачиваний: 378)

[Romtek]

Рассмотрим более сложный пример, с применением быстрой сортировки. Этот алгоритм рассчитан на большие массивы записей и очень эффективен в большинстве случаев, хотя его реализация и сложнее.
Вот как будет выглядеть процедура в этом случае:

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 (смотрите в исходнике программы).

---

Исходник рабочего примера сортировки по имени, с форматированным выводом записей:

Сообщение отредактировано: Romtek - 28.03.05, 11:48

Прикреплённый файлSortRec2.zip (1.38 Кбайт, скачиваний: 370)

[Romtek]

Эта программа сортирует массив строк или чисел с использованием процедурных типов.
Требует знаний по указателям.

1. Ввод данных массива
2. Сортировка массива:
   для массива чисел нужно выбрать функцию сравнения чисел CompareNumbers
   для массива строк - функцию сравнения строк CompareStrings.
   Процедурный тип для вызова функции сравнения даёт возможность выбрать пользователю вид сортировки. Результатом этой функции должно быть:
   1, если A > B
   0, если A = B
   -1, если A < B
   Можно также менять порядок сортировки по возрастанию или убыванию. Для этого надо поменять знаки на противоположные в функции сравнения.
   
   Этот способ сортировки имеет преимущество перед описанными ранее тем, что сортирует только указатели на записи, в то время как содержимое записей остаётся на своём месте, нукуда не перемещаясь. Т.е. экономится лишнее время на перемещения данных в памяти.
   
3. Вывод данных массива

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.

Сообщение отредактировано: Romtek - 29.03.05, 09:37

Прикреплённый файлsortarr.rar (1.61 Кбайт, скачиваний: 356)

[volvo877]

Иногда встречается задача - организовать сортировку массива записей по любому полю, выбирать которое пользователь будет в RunTime. Ниже представлен пример реализации (опять же, с помощью процедурных типов):

program SortRec;
uses crt;
const
  n = 4;
type
  { Массив вот таких записей и надо будет отсортировать }
  TInfo=record
    npp   : 1 .. n;
    Fio   : string[13];
    Addr  : string[15];
    Month : string[8];
    Tel   : string[7];
    Grades: array[1 .. 5] of 2 .. 5;
    Aver  : real;
  end;
  List = array[1 .. n] of TInfo;
  TFunc = Function(T1, T2: TInfo): Integer;
 
{
  Вспомогательные функции сравнения чисел и строк.
  Можно было бы обойтись и без них, но тогда в функциях
  сравнения полей записи осуществлялись бы одинаковые
  действия
}
function compareVals(A, B: real): integer;
begin
  if A > B then compareVals := 1
  else
    if A < B then compareVals := -1
    else compareVals := 0;
end;
function compareStrs(sA, sB: string): integer;
begin
  if sA > sB then compareStrs := 1
  else
    if sA = sB then compareStrs := 0
    else compareStrs := -1
end;
 
{ *** Функции сравнения полей двух записей *** }
function cfNpp (T1,T2: TInfo): integer; far;
begin
  cfNpp := compareVals(T1.npp, T2.npp);
end;
function cfFio (T1,T2: TInfo): integer; far;
begin
  cfFio := compareStrs(T1.Fio, T2.Fio)
end;
function cfAddr (T1,T2: TInfo): integer; far;
begin
  cfAddr := compareStrs(T1.Addr, T2.Addr);
end;
function cfMonth (T1,T2: TInfo): integer; far;
begin
  cfMonth := compareStrs(T1.Month, T2.Month);
end;
function cfTel (T1,T2: TInfo): integer; far;
begin
  cfTel := compareStrs(T1.Tel, T2.Tel);
end;
function cfAver (T1,T2: TInfo): integer; far;
begin
  cfAver := compareVals(T1.Aver, T2.Aver);
end;
 
{
  Вводим тип - перечисление всех полей,
  по которым может происходить сортировка ...
}
type
  TSortBy = (
    _byNpp, _byFio, _byAddr, _byMonth, _byTel, _byAver
  );
{
  ... и описываем названия этих полей
  (для удобства пользователя)
}
const
  Titles : array[TSortBy] of string =
    ('by Npp', 'by Fio', 'by Addr', 'by Month', 'by Tel', 'by Aver');
 
{
  А также - ставим в соответствие каждому полю
  "свою" функцию сравнения
}
  CompareFuncs: Array[TSortBy] Of TFunc =
    (cfNpp, cfFio, cfAddr, cfMonth, cfTel, cfAver);
 
{
  Собственно, процедура сортировки.
  В нее достаточно передать нужный элемент из
  перечисления полей, и массив записей будет
  отсортирован по соответствующему полю
}
procedure QuickSort(marker: TSortBy;
          var A: List; Lo, Hi: Integer);
var
 i,j: integer;
 x, y: TInfo;
procedure Sort (l, r: Integer);
begin
    repeat
          x := A[(l+r) shr 1];
          i := l; j := r;
          repeat
                while CompareFuncs[marker]( A[i], x ) < 0 do inc(i);
                while CompareFuncs[marker]( 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; { QuickSort }
 
{
  Для простоты зададим несколько записей в виде константы
  (но в принципе массив может заполняться и в процессе
  выполнения программы)
}
const
  Data: List = (
    (npp: 1; Fio:  'petrov'; Addr: 'moscow'; Month: 'january';
     Tel:'4587'; Grades:(2, 2, 2, 2, 2); Aver:2.0),
    (npp: 2; Fio: 'sidorov'; Addr:   'kiev'; Month: 'october';
     Tel:'2487'; Grades:(5, 5, 5, 5, 5); Aver:5.0),
    (npp: 3; Fio:  'ivanov'; Addr:  'piter'; Month:   'march';
     Tel:'5287'; Grades:(3, 3, 3, 3, 3); Aver:3.0),
    (npp: 4; Fio:  'kuzmin'; Addr: 'e-burg'; Month:'december';
     Tel:'3411'; Grades:(4, 4, 4, 4, 4); Aver:4.0)
  );
 
procedure PrintData;
var i: integer;
begin
  for i := 1 To n do
    with Data[i] do
      WriteLn(npp:2, ' ', Fio:10, ' ', Addr:6, ' ',
              Month:8, ' ', Tel:6, ' ', Aver:5:2);
end;
 
var
  ix: TSortBy;
  Choice: Char;
  _sort: integer;
begin
  WriteLn('before:');
  PrintData;
 
  {
    А теперь - самое главное: выводим все возможные
    варианты сортировки, и запрашиваем у пользователя
    (во время выполнения программы), по какому из
    вариантов сортировать (в данном случае число
    вариантов ограничено 9, но ничего не мешает
    обойти это ограничение чуть-чуть по другому
    организовав получение ответа от пользователя)
  }
  Writeln('sort data by:');
  For ix := Low(TSortBy) To High(TSortBy) Do
    writeln(1 + Ord(ix):2, ' - ', Titles[ix]);
  Choice := ReadKey;
  _sort := Ord(Choice) - Ord('1');
 
  { Проверяем корректность полученного ответа,
    и если все в порядке - сортируем массив,
    иначе выдаем сообщение об ошибке }
  if (_sort >= 0) and (_sort <= Ord(High(TSortBy))) then
  begin
    QuickSort (TSortBy(_sort), Data, 1, n);
    WriteLn('after:');
    PrintData;
  end
  else
    Writeln('incorrect input');
 
  ReadLn;
end.