IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code].
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Сортировка записи с процедурой
ISV
сообщение 9.12.2005 23:05
Сообщение #1


Гость






Есть массив записей - таблица успеваемости.
Код

program tabliza; uses crt;
const n=10;
type
ANk=record
  npp:1..n;
  FIO:string[13];
  Adr:string[15];
  Dr:string[8];
  tel:string[7];
  Ocen:array[1..5] of 2..5;
  SrB:real;
 end;
var
  A12:array[1..n] of Ank;
  nom,i,j,k,h,y:integer;s:integer;min:string;g:ANk

После введения данных необходимо организовать диалог по сортировке(прямой метод сортировки) полей таблицы при помощи процедуры.Т.е. будем вводить название поля(или маркер,указывающий на конкретное поле) по которому нужно сортировать и это станет входящим параметром процедуры.После выводим результат сортировки.Подскажите,пожалуйста, как сделать такую процедуру.
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 3)
volvo
сообщение 9.12.2005 23:30
Сообщение #2


Гость






ISV, сначала посмотри здесь, как организуется сортировка по одному полю... Если, прочитав это, не догадаешься, как сделать нужную тебе процедуру, я подскажу... wink.gif

Как упорядочить данные по возрастанию?
 К началу страницы 
+ Ответить 
ISV
сообщение 10.12.2005 11:41
Сообщение #3


Гость






volvo ,в предложенном примере нет главного,что нужно:не задавать
критерий сортировки в самой программе,а вводить его в диалоге.До этого я и не могу дойти.Помоги,пожалуйста.
 К началу страницы 
+ Ответить 
volvo
сообщение 10.12.2005 12:16
Сообщение #4


Гость






Используем преимущества процедурных типов... Я тут набросал небольшой примерчик, я думаю, разобраться будет несложно...

Что-то в этом роде:
program SortRec;
uses Crt;

const
  N = 4;

type
  SortBy = (_byNpp, _byFio, _byAdr, _byDr, _byTel, _bySrB);

  TInfo=record
    npp: 1..n;
    FIO: string[13];
    Adr: string[15];
    Dr: string[8];
    tel: string[7];
    Ocen: array[1..5] of 2..5;
    SrB:real;
  end;

  List = array [1..N] of TInfo;
  TFunc = Function(T1, T2: TInfo): Integer;


{ *** comparison functions }
function CompareNpp (T1,T2: TInfo): integer; far;
begin
    if T1.Npp > T2.Npp then CompareNpp := 1
    else if T1.Npp = T2.Npp then CompareNpp := 0
    else CompareNpp := -1
end;
function CompareFio (T1,T2: TInfo): integer; far;
begin
    if T1.Fio > T2.Fio then CompareFio := 1
    else if T1.Fio = T2.Fio then CompareFio := 0
    else CompareFio := -1
end;
function CompareAdr (T1,T2: TInfo): integer; far;
begin
    if T1.Adr > T2.Adr then CompareAdr := 1
    else if T1.Adr = T2.Adr then CompareAdr := 0
    else CompareAdr := -1
end;
function CompareDr (T1,T2: TInfo): integer; far;
begin
    if T1.Dr > T2.Dr then CompareDr := 1
    else if T1.Dr = T2.Dr then CompareDr := 0
    else CompareDr := -1
end;
function CompareTel (T1,T2: TInfo): integer; far;
begin
    if T1.Tel > T2.Tel then CompareTel := 1
    else if T1.Tel = T2.Tel then CompareTel := 0
    else CompareTel := -1
end;
function CompareSrB (T1,T2: TInfo): integer; far;
begin
    if T1.SrB > T2.SrB then CompareSrB := 1
    else if T1.SrB = T2.SrB then CompareSrB := 0
    else CompareSrB := -1
end;

Const
  Compare: Array[_byNpp .. _bySrB] Of TFunc =
    (
      CompareNpp, CompareFio, CompareAdr,
      CompareDr, CompareTel, CompareSrB
    );

procedure QuickSort(marker: SortBy;
          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 Compare[marker]( A[i], x ) < 0 do inc(i);
                while Compare[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';
       Adr:'moscow';
       Dr:'january';
       tel:'4587';
       Ocen:(2, 2, 2, 2, 2);
       SrB:2),
      (npp:2;
       FIO:'sidorov';
       Adr:'kiev';
       Dr:'october';
       tel:'2487';
       Ocen:(5, 5, 5, 5, 5);
       SrB:5),
      (npp:3;
       FIO:'ivanov';
       Adr:'piter';
       Dr:'march';
       tel:'5287';
       Ocen:(3, 3, 3, 3, 3);
       SrB:3),
      (npp:4;
       FIO:'kuku';
       Adr:'earth';
       Dr:'december';
       tel:'3411';
       Ocen:(4, 4, 4, 4, 4);
       SrB:4)
    );

Procedure PrintData;
Var i: integer;
Begin
  For i := 1 To n Do
    With data[i] Do
      Writeln(npp:2, ' ', fio:10, ' ', adr:6, ' ',
              dr:8, ' ', tel:6, ' ', srb:5:2);
End;

var
 ix: SortBy;
 Choice: Char;
 _sort: integer;

const
  sb_string: array[SortBy] of string =
    ('by Npp', 'by Fio', 'by Adr', 'by Dr', 'by Tel', 'by SrB');

begin
  WriteLn('before:');
  PrintData;

  Writeln('sort data by:');
  For ix := Low(SortBy) To High(SortBy) Do
    writeln(1 + Ord(ix):2, ' - ', sb_string[ix]);

  Choice := ReadKey;
  _sort := Ord(Choice) - Ord('1');
  If (_sort >= 0) and (_sort <= Ord(High(SortBy)))
  then
    QuickSort ( SortBy(_sort), Data, 1, N)
  Else Writeln('incorrect input');

  WriteLn('after:');
  PrintData;

end.
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 

- Текстовая версия 26.07.2025 9:51
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"