1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code]. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Вот написал прогу сортировки Хоора с модулем. Вот только она работает с типом real, но почему-то не хочет признавать перечислимый тип. Основная прога
program sorting; uses def24; var c : char; s : stack; t : telem;
procedure Concat(var s1 : stack;s2:stack); var s3:stack; begin init(s3); while not empty(s2) do begin put(s3,top(s2));get(s2); end; while not empty(s3) do begin put(s1,top(s3)); get(s3) end; end; { Concat }
procedure QuickSort(var s : stack); var s1,s2 : stack;V,k:telem; begin if not empty(s) then begin init(s1);init(s2); V:=top(s);get(s); while not empty(s) do begin k:=top(s); if k.key< V.key then put(s1,k) else put(s2,k); get(s); end; QuickSort(s1); QuickSort(s2); put(s1,V); Concat(s1,s2); s:=s1; end; end; { QuickSort }
'6' : if not empty(s) then print(s) else writeln('Stack is empty!');
'7' : writeln('Number of elements: ',kolvo(s):1);
'8' : if empty(s) then writeln('Stack is empty!') else if kolvo(s)>1 then QuickSort(s); end; until c='9'; end.
Модуль
unit def24; interface const l = 30; type colors = (red,yellow,green,black); type telem = record key : integer; data : colors ; end; stack = record m : array[1..l] of telem; hill : integer end; procedure init(var s:stack); function empty(var s:stack):boolean; function top(var s:stack):telem; procedure get(var s:stack); procedure print(var s:stack); function kolvo(var s:stack):integer; procedure put(var s:stack; t:telem);
implementation
procedure init(var s:stack); begin s.hill:=0 end;
function empty(var s:stack):boolean; begin empty:=(s.hill=0) end;
function top(var s:stack):telem; begin top:=s.m[s.hill] end;
procedure get(var s:stack); begin s.hill:=s.hill-1; end;
procedure print(var s:stack); var i:integer; begin for i:=s.hill downto 1 do writeln('Key: ',s.m[i].key:2,'. Data: ',s.m[i].data,'.') end;
function kolvo(var s:stack):integer; begin kolvo:=s.hill end;
procedure put(var s:stack; t:telem); begin if s.hill<l then begin s.hill:=s.hill+1; s.m[s.hill]:=t end else writeln('Stack is full!') end; { put }