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

Простой пример

Программа показывает как отсортировать массив записей по возрасту.

Так можно упорядочить любую структуру данных. Надо только позаботиться о том, по какому критерию надо сортировать. По убыванию? Пожалуйста! Поменяйте знак сравнения в процедуре 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. Ввод данных массива
  2. Сортировка массива
  3. Вывод данных массива
Сортировка массива
  • для массива чисел нужно выбрать функцию сравнения чисел 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.
 
pascal/data_sorting.txt · Последние изменения: 2006/05/10 14:05 (внешнее изменение)
 
Recent changes RSS feed Donate Powered by PHP Valid XHTML 1.0 Valid CSS Driven by DokuWiki