Задача на стек и дек. Опции

[Krjuger]

В общем задача заключается в том что надо из текстового файла заполнить дек и взять последние "Б" элементов и записать их в стек.Суть вопроса заключается в том какую реализацию выбрать.первый скособ это создать процедуру котора берет элемент из дека и пишет в стек,а вторая уже выполняет первую до выполнения условия(достижение Б),либо сделать лиш одну процедуру,которая делает все сразу.

TElem = integer; 
TStack = ^TElement;
 TElement = record
             info:TElem;
             Next:TStack;
        end;
  TData = integer;
  PTDeqItem = ^TDeqItem;
  TDeqItem = record
      Data: TData;
      next, prev: PTDeqItem;
    End;

  TDeq =  Record
      pStart, pFinish: PTDeqItem;
    End;
 

Вот описание стека и дека.Вопрос в том можно ли создать лиш одну буферную переменную или делать через две.каждого типа.

[Krjuger]

Вот полная прога.Теперь, вроде, стек заполняется ,но не печатается.

program laba10;
Uses CRT;
Type

 TElem = integer;

 PTStackItem = ^TStackItem;
 TStackItem = record
   Data: TElem;
   Next: PTStackItem;
end;
TStack = PTStackItem;

 PTDeqItem = ^TDeqItem;
 TDeqItem = record
   Data: TElem;
   next, prev: PTDeqItem;
End;

  TDeque =  Record
      head,tail: PTDeqItem;
    End;

  var
   Deq : TDeque;
   Stack : TStack;
   v : integer; {Љ®«-ў® н«Ґ¬Ґ­в®ў § ЇЁблў Ґ¬лҐ ў б⥪}
   fin : text;


Procedure InitDeq(Var Deq: TDeque);
  Begin
    Deq.head := nil;
    Deq.tail := nil;
  End;

Function IsEmpty(Var Deq: TDeque): Boolean;
  Begin
    isEmpty := (Deq.head = nil);
  End;


Procedure CreateDeq(var Deq : TDeque; var fin:text);
 var
 curr: PTDeqItem;
 ch : TElem;
 begin
  reset(fin);
  while not seekeof(fin) do
  begin
    curr:= new(PTDeqItem);
    read(fin,ch);
    curr^.next := Deq.head;
    curr^.prev := nil;
    curr^.data :=ch;
    If Deq.head <> nil Then
      Deq.head^.prev := curr
    Else
      Deq.tail := curr;

    Deq.head := curr;
   end;
   close(fin);
 end;


Procedure PrintDeq(Var Deq: TDeque);
  Var p: PTDeqItem;
  Begin
    WriteLn( 'Printing Deck...' );
    If isEmpty(Deq) Then
      Begin
        WriteLn('<Џгбв®©>'); Exit
      End;

    p := Deq.head;
    While p <> nil Do
      Begin
        Write( p^.Data, ' ' );
        p := p^.next
      End;
    WriteLn
  End;

Procedure InitStack(var Stack:TStack);
 begin
  Stack:=nil;
 end;


Function StackEmpty(Stack:TStack):Boolean;
 begin
  StackEmpty:=(Stack=NIL);
 end;

Procedure StackPush(var Stack:TStack; E:TElem);
 var
  z:TStack;
 begin
  new(z);
  z^.next:=Stack;
  z^.data:=E;
  Stack:=z;
 end;

 Procedure CreateStack(var Deq : TDeque;var Stack : Tstack; var fin:text;v:integer);
 var
 CurrDeq: PTDeqItem;
 CurrStack:PTStackItem;
 S:integer;
 begin
  reset(fin);
  S:=1;
  while S<=V do
  begin
    CurrDeq^.prev := Deq.tail^.prev;
    CurrDeq^.data :=Deq.tail^.data;
    CurrStack^.next :=Stack;
    CurrStack^.data :=CurrDeq^.data;
    Stack:=CurrStack;
    write(Stack^.data,' ');{Проверка заполнения(ненужная строчка)}
    Deq.tail:=Deq.tail^.prev;
    Stack^.next:=nil;
    S:=S+1;
   end;
 end;

Procedure PrintStack(Var Stack: TStack);
  Var p: PTStackItem;
  Begin
    WriteLn( 'Printing Stack...' );
    If StackEmpty(Stack) Then
      Begin
        WriteLn('<Џгбв®©>'); Exit
      End;

    p := Stack^.next;
    While p <> nil Do
      Begin
        Write( p^.data, ' ' );
        p := p^.next;
      End;
    WriteLn
  End;


 begin
  clrscr;
  chdir('C:\Tpascal');
  assign(fin,'test1.txt');
  InitDeq(Deq);
  InitStack(Stack);
  CreateDeq(Deq,fin);
  PrintDeq(Deq);
  readln(v);
  CreateStack(Deq,Stack,fin,v);
  PrintStack(Stack);
  readln;
 end.

Ну я надеюсь,хоть кто нибудь ответит,или только волво со мной мучаться будет..

Добавлено через 7 часов:
Ауууу желающие помоч отзовитесь,у меня есть еще задачка на деревья,но пока я с этой недомараюсь,ту спрашивать не стану,ибо слишком жирно будет для меня)

Добавлено через 2 часа:
Так же выношу на суд божий еще одно мое творение, которое нефига не рабоатет.В этот раз выдает ошибку 16 разрядной подсистемы дос,типа процессор обнарушил неизвестную инстукцию

program laba11;
Uses CRT;
type
	 DTree = record
	 	Data: integer;
		Name: string;
		stat: String;
   end;

  PTree = ^TTree;
  TTree = record
		head : DTree;
    left,right: PTree;
	end;
 var
 fin:text;
 temp:PTree;
 root:PTree;

Function ReadFile(var fin: text; var str: string): boolean;
	var tmp: char;
	begin
		str:='';
		repeat
			read(fin, tmp);
			if not (tmp = ' ') and not (tmp=';') then
				str:=str+tmp;
		until (tmp=' ') or eoln(fin) or (tmp=';');
		case tmp  of
			' ': readFile:=true;
			else readFile:=false;
		end;
	end;
Procedure CreateNode(n: PTree;var p:PTree);
  Begin
    p^.head.stat := n^.head.stat;
    p^.head.name := n^.head.name;
    p^.head.data := n^.head.data;
    p^.left := nil;
    p^.right := nil;
  End;

Procedure AddItem(Var root: PTree; X: PTree);

  { Функция, создающая новый лист дерева с заданным значением Data }
var
 parent, pwalk: PTree;

Begin

  {
    Если корень дерева - нулевой (только начали заполнять дерево),
    то создаем новый элемент и запоминаем его, как корень
  }
  if root = nil then  CreateNode(X,root)
  else begin

    { Если дерево уже не пустое - тогда начинаем "прогулку" по нему... }

    pWalk := root; { "гулять" начнем с корня }
    while pWalk <> nil do begin { пока не добрались до пустого указателя - делаем следующее }

      { запоминаем текущий элемент, в качестве "родителя" его потомка }
      parent := pWalk;

      {
        переходим в левую лил правую ветвь в зависимости от соотношения величин
        нового элемента и "текущего", которым мы "гуляем" по дереву
      }
      if pWalk^.head.stat='male' then pWalk := pWalk^.left
      else pWalk := pWalk^.right

    end;

    {
      Если мы здесь - значит, добрались до пустого указателя...
      Вот теперь делаем то, для чего запоминали родителя текущего элемента:
      опять же в зависимости от того, больше или меньше добавляемое значение,
      чем значение "родителя", создаем новый элемент и запоминаем его в левой,
      или правой ветке...
    }

    if x^.head.stat='male' then CreateNode(parent^.left,X)
    else CreateNode(parent^.right,X);

  end;

End;

Procedure CreateTree(var root: PTree;var fin : text);
 var
 temp : PTree;
 begin
 readfile(fin,temp^.head.stat);
 readfile(fin,temp^.head.name);
 read(fin,temp^.head.data);
 temp^.Left := nil; temp^.Right := nil;
 root:=temp;
  while not eof(fin) do
    begin
	 readfile(fin,temp^.head.stat);
	 readfile(fin,temp^.head.name);
	 read(fin,temp^.head.data);
	 AddItem(root,temp);
	end;
 end;

procedure printKLP(root:PTree);
begin
	if (root<>NIL) then 
		begin
			write(root^.head.name,' '); (* Распечатать корень дерево *)
			printKLP(root^.left); (* Распечатать левое поддерево *)
			printKLP(root^.right);(* Распечатать правое поддерево *)
		end;
end;

procedure printKLP_wrapper(root:PTree);
begin
	clrscr;
	if (root=NIL) then (* Если дерево пустое *)
		writeln('Дерево пусто!') 
	else  (* Иначе *)
		PrintKLP(root); (* Распечатать дерево *)
	writeln;
	writeln('Нажмите любую клавишу для выхода в главное меню');
	readkey;
end;

begin
  clrscr;
  chdir('C:\TPascal');
  assign(fin,'test.txt');
  reset(fin);
  CreateTree(root,fin);
  printKLP_wrapper(root);
  close(fin);
end.

Добавлено через 16 часов:
В общем по поводу первой задачи я ее сделал своими силами и она работает,только почему то она работает не так,как задумывал.Если кому надо:

program laba10;
Uses CRT;
Type

 TElem = integer;

 PTStackItem = ^TStackItem;
 TStackItem = record
   Data: TElem;
   Next: PTStackItem;
end;
TStack = PTStackItem;

 PTDeqItem = ^TDeqItem;
 TDeqItem = record
   Data: TElem;
   next, prev: PTDeqItem;
End;

  TDeque =  Record
      head,tail: PTDeqItem;
    End;

  var
   Deq : TDeque;
   Stack : TStack;
   v : integer; {Љ®«-ў® н«Ґ¬Ґ­в®ў § ЇЁблў Ґ¬лҐ ў б⥪}
   fin : text;


Procedure InitDeq(Var Deq: TDeque);
  Begin
    Deq.head := nil;
    Deq.tail := nil;
  End;

Function IsEmpty(Var Deq: TDeque): Boolean;
  Begin
    isEmpty := (Deq.head = nil);
  End;


Procedure CreateDeq(var Deq : TDeque; var fin:text);
 var
 curr: PTDeqItem;
 ch : TElem;
 begin
  reset(fin);
  while not seekeof(fin) do
  begin
    curr:= new(PTDeqItem);
    read(fin,ch);
    curr^.next := Deq.head;
    curr^.prev := nil;
    curr^.data :=ch;
    If Deq.head <> nil Then
      Deq.head^.prev := curr
    Else
      Deq.tail := curr;

    Deq.head := curr;
   end;
   close(fin);
 end;


Procedure PrintDeq(Var Deq: TDeque);
  Var p: PTDeqItem;
  Begin
    WriteLn( 'Printing Deck...' );
    If isEmpty(Deq) Then
      Begin
        WriteLn('<Џгбв®©>'); Exit
      End;

    p := Deq.head;
    While p <> nil Do
      Begin
        Write( p^.Data, ' ' );
        p := p^.next
      End;
    WriteLn
  End;

Procedure InitStack(var Stack:TStack);
 begin
  Stack:=nil;
 end;


Function StackEmpty(Stack:TStack):Boolean;
 begin
  StackEmpty:=(Stack=NIL);
 end;

Procedure StackPush(var Stack:TStack; E:TElem);
 var
  tmp:TStack;
 begin
  new(tmp);
  tmp^.next:=Stack;
  tmp^.data:=E;
  Stack:=tmp;
 end;

 Procedure CreateStack(var Deq : TDeque;var Stack : TStack; v : integer);
 var
 CurrDeq: PTDeqItem;
 ch : TElem;
 S : integer;
 begin
  S:=1;
  reset(fin);
  while S<=V do
  begin
    CurrDeq^.prev := Deq.tail^.prev;
    CurrDeq^.data := Deq.tail^.data;
    ch := CurrDeq^.data;
    StackPush(Stack,ch);
    Deq.tail:=Deq.tail^.prev;
    S:=S+1;
   end;
 end;

Procedure PrintStack(Var Stack: TStack);
  Var p: PTStackItem;
  Begin
    WriteLn( 'Printing Stack...' );
    If StackEmpty(Stack) Then
      Begin
        WriteLn('<Џгбв®©>'); Exit
      End;

    p := Stack;
    While p <> nil Do
      Begin
        Write( p^.data, ' ' );
        p := p^.next;
      End;
    WriteLn
  End;


 begin
  clrscr;
  chdir('C:\Tpascal');
  assign(fin,'test1.txt');
  InitDeq(Deq);
  InitStack(Stack);
  CreateDeq(Deq,fin);
  PrintDeq(Deq);
  readln(v);
  CreateStack(Deq,Stack,v);
  PrintStack(Stack);
  readln;
 end.

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