Добавлено (21.12.2011, 07:29)
---------------------------------------------
есть вот начало, но она не работает
[code]
PROGRAM QueueS;

Type Sptr = ^Stack;
Stack = Record
Key: integer;
Next: Sptr;
End;
Qptr = ^List;
List = Record
Key: Sptr;
Next: Qptr;
End;
Var p,q,r, TopQ, Temp : Qptr; { r - указатель на конечный элемент }
s, tops: Sptr;
Knew, k, tmp, CouElem: integer;
ch: char;
Flag: Boolean;

Procedure AddS(VAR TopS: Sptr);
Var
k: integer;
els: Sptr;
Procedure Add(Var CureEl: Sptr; Var k: integer);
Begin
if CureEl^.next <> NIL
then
Add(CureEl^.next, k)
else
begin
NEW(els);
els^.key := k;
els^.next := NIL;
CureEl^.next := els
end
end;
begin
writeln('введите элемент стека');
readln(k);
Add(TopS, k);
END;

Procedure AddQ(elq: Qptr);
Var
q: Qptr;
k: integer;
Begin
if elq^.next <> NIL
then
AddQ(elq^.next)
else
begin
new(q);
new(q^.key);
q^.key^.next := NIL;
write('введите элемент очереди ');
readln(k);
q^.key^.key := k;
elq^.next := q
end
End;

Procedure ShowQ(VAR TopQ: Qptr);
Procedure ShowS(S: Sptr);
Begin
if S <> NIL
then
Begin
write(S^.key);
if s <> NIL
then
if S^.next <> NIL
then
ShowS(S^.next);
end
else
writeln('Element is empty');
end;
Begin
if TopQ <> NIL
then
begin
if TopQ <> NIL
then
begin
if TopQ^.Next <> NIL
then
ShowQ(TopQ^.Next);
ShowS(TopQ^.Key)
end
end
else
writeln('Stack is empty')
end;

Procedure ShowStack(Var TopS: Sptr);
begin
write(TopS^.key);
if TopS^.next <> NIL
then
begin
if TopS^.next <> NIL
then
ShowStack(TopS^.next)
end
end;

Procedure StackInQ(Var TopS: Sptr);
Var
flag: boolean;
p, q: Sptr;
number: CHAR;
k: integer;
Begin
flag := true;
While flag
Do
begin
Writeln('1. Добавить элемент в стек');
Writeln('2. Показать содержимое стека');
Writeln('3. Вернуться');
Read(number);
CASE number Of
'1': if TopQ <> NIL
then
AddS(TopS)
else
begin
NEW(TopS);
writeln('введите символ для стека');
readln(k);
TopS^.key := k;
TopS^.next := NIL;
end;
'2': begin
if TopS <> NIL
then
begin
ShowStack(TopS);
writeln;
readln
end
else
begin
writeln('Добавьте элемент в стек, т.к. он пуст');
readln
end;
writeln
end;
'3':Flag := false
end
end
end;

Begin
New(TopQ);
Flag := True;
While Flag
Do
Begin
Writeln;
WriteLn('1.Добавить в очередь');
WriteLn('2.Показать очередь');
WriteLn('3.Введение стека из начала очереди');
// WriteLn('4.Удалить элемент');
// WriteLn('5.Показать всю очередь');
WriteLn('6.Выход');
Write('Выбираем : ');
ReadLn(Ch); { номер пункта меню }
Case Ch Of
'1' : if TopQ <> NIL
then
AddQ(TopQ)
else
begin
NEW(TopQ);
writeln('Enter first element of queue for first element of stack; press "Enter"');
readln(k);
New(TopQ^.Key);
TopQ^.Key^.key := k;
TopQ^.Key^.next := NIL;
TopQ^.Next := NIL;
end;
'2' : Begin
ShowQ(TopQ);
Writeln;
Readln
End;
'3' : Begin
if TopQ <> NIL
then
begin
if TopQ^.Next <> NIL
then
begin
temp := TopQ^.Next;
while temp^.Next <> NIL
do
temp := temp^.Next;
StackInQ(temp^.Key)
end
else
StackInQ(TopQ^.Key)
end
else
begin
writeln('Stack is empty, add new element');
writeln('Press "Enter" to continue');
readln
end
end;
// 4 : DelFromList
// 5 : OutList
'6' : Flag := False
End
End
End.

Добавлено (21.12.2011, 16:42)
---------------------------------------------
Организовать в основной памяти стек из очередей.
Обеспечить операции ведения очереди из вершины стека,
расширения и сокращения стека, выдачи содержимого стека

полностью рабочая

PROGRAM StackQ(INPUT, OUTPUT);

USES crt;
TYPE
QPtr = ^Queue;
Queue = RECORD
key: CHAR;
next: QPtr
END;
StackPtr = ^Stack;
Stack = RECORD
Key: QPtr;
Next: StackPtr
END;
VAR
TopSt, temp, q: StackPtr;
a, Ch: CHAR;
EndProg: BOOLEAN;

PROCEDURE AddSt(CureEl: StackPtr);
VAR
NewStEl: StackPtr;
Ch: CHAR;
BEGIN
IF CureEl^.Next <> NIL
THEN
AddSt(CureEl^.Next)
ELSE
BEGIN
New(NewStEl);
New(NewStEl^.Key);
NewStEl^.Key^.next := NIL;
WRITELN('Enter first element for queue and press "Enter"');
READ(Ch);
READLN;
NewStEl^.Key^.key := Ch;
CureEl^.Next := NewStEl
END
END;

PROCEDURE ShowSt(VAR TopSt: StackPtr);
PROCEDURE ShowContentEl(Que: QPtr);
BEGIN
IF Que <> NIL
THEN
BEGIN
WRITE(Que^.key);
IF Que^.next <> NIL
THEN
ShowContentEl(Que^.next);
END
ELSE
WRITELN('Element is empty');
END;
BEGIN
IF TopSt <> NIL
THEN
BEGIN
IF TopSt^.Next <> NIL
THEN
ShowSt(TopSt^.Next);
ShowContentEl(TopSt^.Key);
WRITELN
END
ELSE
WRITELN('Stack is empty')
END;

PROCEDURE DelSt(VAR TopSt:StackPtr);
VAR
DelEl: StackPtr;
BEGIN
IF TopSt <> NIL
THEN
BEGIN
IF TopSt^.Next <> NIL
THEN
DelSt(TopSt^.Next)
ELSE
BEGIN
DelEl := TopSt^.Next;
TopSt := NIL;
DISPOSE(DelEl)
END
END
ELSE
WRITELN('Stack is empty')
END;

PROCEDURE WriteStackMenu;
BEGIN
WRITELN(' ':5, '1 - add element to stack');
WRITELN(' ':5, '2 - delete element from stack');
WRITELN(' ':5, '3 - show content of stack');
WRITELN(' ':5, '4 - work with queue');
WRITELN(' ':5, '5 - end of program')
END;

PROCEDURE WriteQueueMenu;
BEGIN
clrscr;
WRITELN(' ':5, '1 - add element to queue');
WRITELN(' ':5, '2 - free element from queue');
WRITELN(' ':5, '3 - show content of queue');
WRITELN(' ':5, '4 - return to stack')
END;

PROCEDURE AddQ(VAR TopQ: Qptr);
VAR
Ch: CHAR;
NewElQ: QPtr;
PROCEDURE Add(VAR CureEl: QPtr; VAR NewEl: CHAR);
BEGIN
IF CureEl^.next <> NIL
THEN
Add(CureEl^.next, NewEl)
ELSE
BEGIN
NEW(NewElQ);
NewElQ^.key := NewEl;
NewElQ^.next := NIL;
CureEl^.next := NewElQ;
END
END;
BEGIN
WRITELN('Enter symbol, press "ENTER"');
READ(CH);
READLN;
Add(TopQ, Ch);
END;

PROCEDURE DelQ(VAR TopQ: Qptr);
VAR
DelEl: QPtr;
BEGIN
DelEl := TopQ;
TopQ := TopQ^.next;
DISPOSE(DelEl);
END;

PROCEDURE ShowQ(VAR TopQ: QPtr);
BEGIN
WRITE(TopQ^.key);
IF TopQ^.next <> NIL
THEN
BEGIN
IF TopQ^.next <> NIL
THEN
ShowQ(TopQ^.next)
END
END;

PROCEDURE WorkWithQueue(VAR TopQ: QPtr);
VAR
EndProc: BOOLEAN;
p, q: QPtr;
a, Ch: CHAR;
BEGIN
EndProc := TRUE;
WHILE EndProc
DO
BEGIN
WriteQueueMenu;
a := READKEY;
CASE a OF
'1': IF TopQ <> NIL
THEN
AddQ(TopQ)
ELSE
BEGIN
NEW(TopQ);
WRITELN('Enter symbol, press "ENTER"');
READ(CH);
READLN;
TopQ^.key := Ch;
TopQ^.next := NIL;
END;
'2': IF TopQ <> NIL
THEN
DelQ(TopQ)
ELSE
BEGIN
WRITELN('Queue is empty, add new element');
WRITELN('Press "Enter" to continue');
READLN
END;
'3': BEGIN
IF TopQ <> NIL
THEN
BEGIN
ShowQ(TopQ);
WRITELN;
WRITELN('Press "Enter"');
READLN
END
ELSE
BEGIN
WRITELN('Queue is empty, add new element');
WRITELN('Press "Enter" to continue');
READLN
END;
WRITELN
END;
'4':EndProc := FALSE
END
END
END;

BEGIN
clrscr;
NEW(TopSt);
EndProg := TRUE;
WHILE EndProg
DO
BEGIN
WriteStackMenu;
a := READKEY;
CASE a OF
'1': IF TopSt <> NIL
THEN
AddSt(TopSt)
ELSE
BEGIN
NEW(TopSt);
WRITELN('Enter first element of queue for first element of stack; press "Enter"');
READ(Ch);
READLN;
New(TopSt^.Key);
TopSt^.Key^.key := Ch;
TopSt^.Key^.next := NIL;
TopSt^.Next := NIL;

'2': IF END; TopSt <> NIL
THEN
DelSt(TopSt)
ELSE
BEGIN
WRITELN('Stack is empty, add new element');
WRITELN('Press "Enter" to continue');
READLN
END;
'3': BEGIN
ShowSt(TopSt);
WRITELN;
WRITELN('Press "ENTER" to continue');
READLN
END;
'4': BEGIN
IF TopSt <> NIL
THEN
BEGIN
IF TopSt^.Next <> NIL
THEN
BEGIN
temp := TopSt^.Next;
WHILE temp^.Next <> NIL
DO
temp := temp^.Next;
WorkWithQueue(temp^.Key)
END
ELSE
WorkWithQueue(TopSt^.Key)
END
ELSE
BEGIN
WRITELN('Stack is empty, add new element');
WRITELN('Press "Enter" to continue');
READLN
END
END;
'5':EndProg := FALSE
END;
clrscr
END
END.