Форум на Исходниках.RU https://forum.sources.ru Форум на Исходниках.RU Форум на Исходниках.RU https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=2228378 Thu, 26 Mar 2009 06:48:45 +0000 Как упорядочить данные по возрастанию? https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=2228378
    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.
]]> volvo877 Pascal: Структуры данных https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=643352 Sun, 13 Mar 2005 19:15:07 +0000 Как упорядочить данные по возрастанию? https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=643352 Эта программа сортирует массив строк или чисел с использованием процедурных типов.
Требует знаний по указателям.
  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 Pascal: Структуры данных https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=445490 Mon, 30 Aug 2004 12:41:08 +0000 Как упорядочить данные по возрастанию? https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=445490 быстрой сортировки. Этот алгоритм рассчитан на большие массивы записей и очень эффективен в большинстве случаев, хотя его реализация и сложнее.
Вот как будет выглядеть процедура в этом случае:
    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 Pascal: Структуры данных https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=399640 Sat, 10 Jul 2004 14:29:30 +0000 Как упорядочить данные по возрастанию? https://forum.sources.ru/index.php?showtopic=59376&view=findpost&p=399640 Как упорядочить данные по возрастанию? Пример для массива записей.

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