На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное 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 Кбайт, скачиваний: 360)
      Рассмотрим более сложный пример, с применением быстрой сортировки. Этот алгоритм рассчитан на большие массивы записей и очень эффективен в большинстве случаев, хотя его реализация и сложнее.
      Вот как будет выглядеть процедура в этом случае:
      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 Кбайт, скачиваний: 354)
        Эта программа сортирует массив строк или чисел с использованием процедурных типов.
        Требует знаний по указателям.
        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 Кбайт, скачиваний: 336)
          Иногда встречается задача - организовать сортировку массива записей по любому полю, выбирать которое пользователь будет в 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,0401 ]   [ 16 queries used ]   [ Generated: 30.05.24, 21:20 GMT ]