На главную
ПРАВИЛА FAQ Помощь Участники Календарь Избранное DigiMania RSS
msm.ru
! Правила ЧаВО (FAQ) разделов Паскаля
В этом разделе разрешено создавать только темы, в которых описано РЕШЕНИЕ какой-либо общей проблемы, или описание какого-либо аспекта языка Паскаль.
Обсуждение уже созданных тем разрешено, но только конструктивное, например указание на ошибку или уточнение имеющегося текста.

Стоит почитать Структуры данных
Модераторы: volvo877, Romtek
  
> Как упорядочить данные по возрастанию?, пример для массива записей
    Как упорядочить данные по возрастанию? Пример для массива записей.

    Программа показывает как отсортировать массив записей по возрасту.
    Так можно упорядочить любую структуру данных. Надо только позаботиться о том, по какому критерию надо сортировать.
    По убыванию? Пожалуйста! Поменяйте знак сравнения в процедуре Compare.
    Самая важная часть - сортировка массива записей - осуществляется процедурой Sort. Её можно заменить на любой другой алгоритм сортировки (пузырьком, быстрая сортировка и другие). При замене процедуры сортировки на свою, вы должны внести саму часть сравнения в виде кода
    ExpandedWrap disabled
      if Compare (Data[i], Data[j]) > 0 then

    Процедуры ввода и вывода данных массива (InputData и OuputData) можете заменить на свои.
    ExpandedWrap disabled
      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.


    Вывод на экран такой:
    ExpandedWrap disabled
            Name                           Age
      ========================================
       1    Anton                           23
       2    Denis                           12
       3    Rostik                          19
       4    Vasilij                         27

    Прикреплённый файлПрикреплённый файлSortrec.rar (0.77 Кбайт, скачиваний: 229)
      Рассмотрим более сложный пример, с применением быстрой сортировки. Этот алгоритм рассчитан на большие массивы записей и очень эффективен в большинстве случаев, хотя его реализация и сложнее.
      Вот как будет выглядеть процедура в этом случае:
      ExpandedWrap disabled
        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}

      Сама сортировка в данном случае выглядит так:
      ExpandedWrap disabled
        QuickSort (Data, 1, N); { сортировка массива записей от 1-й до N-й записи }


      Бывают случаи, когда нужно сравнивать текст без учёта регистра. Тогда нужно применять функцию StrICmp вместо StrCmp (смотрите в исходнике программы).

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

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

          Этот способ сортировки имеет преимущество перед описанными ранее тем, что сортирует только указатели на записи, в то время как содержимое записей остаётся на своём месте, нукуда не перемещаясь. Т.е. экономится лишнее время на перемещения данных в памяти.
        3. Вывод данных массива
        ExpandedWrap disabled
          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 -

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

          ExpandedWrap disabled
            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.
          0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
          0 пользователей:


          Рейтинг@Mail.ru
          [ Script Execution time: 0,1282 ]   [ 17 queries used ]   [ Generated: 23.07.19, 17:46 GMT ]