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

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

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

> Изменить тип, работа с модулями
Clon
сообщение 30.05.2006 14:44
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 37
Пол: Мужской

Репутация: -  0  +


Вот написал прогу сортировки Хоора с модулем. Вот только она работает с типом 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 }
   
Begin
   init(s);
   repeat
    writeln('1=Init 2=Empty 3=Get 4=Top 5=Put 6=Print 7=Kolvo 8=Sort 9=Exit');
      readln(c); case c of
	
	'1' : init(s); 
	
	'2' : writeln(empty(s));
	
	'3' : if not empty(s) then get(s)
	        else writeln('Stack is empty!');
	   
        '4' : if not empty(s) then begin
	           t:=top(s);
	           writeln('Key: ',t.key:1,'. Data: ',t.data,'.');
	      end
	        else writeln('Stack is empty!');
		
        '5' : begin
	        writeln('Input key:'); readln(t.key);
	        writeln('Input data:'); readln(t.data);
	        put(s,t);
	      end;

	'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 }

end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 

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