daily pastebin goal
51%
SHARE
TWEET

Spiski

sidorova-math May 23rd, 2012 77 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Program spisok;
  2. Type
  3.   ptr=^student;
  4.   student=record
  5.    fam:string;
  6.    year:integer;
  7.    groop:string[9];
  8.    time:real;
  9.    next:ptr;
  10.   end;
  11.  
  12. var
  13.   headptr:ptr;
  14.  
  15. procedure vvod(var stud:student); {чтение значений полей записи}
  16. begin
  17.   with stud do
  18.    begin
  19.     write('введите- фамилию '); readln(fam);
  20.     write('год рождения ') ; readln(year);
  21.     write ('номер группы '); readln(groop);
  22.     write('время забега '); readln(time);
  23.    end;
  24. end;{vvod}
  25.  
  26. procedure formspisok; {построение списка}
  27. var
  28.   p:ptr;
  29.   let:char;
  30. begin
  31.   headptr:=nil;
  32.   repeat
  33.     write(' Продолжить? (у-да, n-нет) ');readln(let) ;
  34.     if let='n' then exit;
  35.     if headptr=nil then
  36.       {формирование первого элемента списка}
  37.       begin new(headptr);
  38.           p:=headptr;
  39.       end
  40.     else
  41.     {формирование очередного элемента списка}
  42.       begin
  43.         new(p^.next);
  44.         p:=p^.next;
  45.       end;
  46.     vvod(p^);
  47.     p^.next:=nil;
  48.   until let='n';
  49. end; {formspisok}
  50.  
  51. procedure pech (stud: student); {печать значений полей записи}
  52. begin
  53.   with stud do
  54.     writeln(fam:14,year:6,groop:11,time:9:2);
  55. end;{pech}
  56.  
  57. procedure pechspisok; {печать списка}
  58. var p:ptr;
  59. begin
  60.   p:=headptr;
  61.   while p<>nil do
  62.     begin
  63.       pech(p^);
  64.       p:=p^.next;
  65.     end;
  66. end;{pechspisok}
  67.  
  68. procedure sort; {сортировка списка}
  69. var p1,p2,q1,q2,temp{Bcпомогат. указатель}:ptr;
  70. begin
  71.   if headptr=nil then exit {если списка нет}
  72.                  else if headptr^.next=nil then exit
  73.                  {если список из одного элемента}
  74.                  else
  75.                    begin
  76.                      p1:=headptr;{поиск с начала}
  77.                      p2:=nil;
  78.                        while p1^.next<>nil do
  79.                          begin
  80.                            q1:=p1^.next;{адрес очередного эл.}
  81.                            q2:=p1;
  82.                            while q1<>nil do {пока не конец}
  83.                             begin
  84.                              if p1^.fam>q1^.fam then
  85.                                                   begin
  86.                                                   if p1=q2 then
  87.                                                   {выбираем следующий элемент списка}
  88.                                                   begin
  89.                                                     p1^.next:=q1^.next;
  90.                                                     q1^.next:=p1; p1:=q1;
  91.                                                     q1:=q2; q2:=q1;
  92.                                                   end
  93.                                                   else{изменяем связи в списке}
  94.                                                     begin
  95.                                                       temp:=p1^.next;
  96.                                                       p1^.next:=q1^.next ;
  97.                                                       q1^.next:=temp;
  98.                                                       temp:=p1; p1:=q1;
  99.                                                       q1:=temp; q2^.next:=q1;
  100.                                                     end;
  101.                              if p2=nil then headptr:=p1
  102.                                else p2^.next:=p1;
  103.                             end;
  104.                             q2:=q1; q1:=q1^.next;
  105.                             end;
  106.                             p2:=p1; p1:=p1^.next;
  107.                          end;
  108.                    end;
  109. end;{sort}
  110.  
  111. begin
  112.   formspisok;
  113.   writeln('Исходный список: ');
  114.   pechspisok;
  115.   sort;
  116.   writeln;
  117.   writeln('Список после сортировки: ');
  118.   pechspisok;
  119. end.
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top