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

[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]

Трудно ожидать от программы, вываливающейся по RTE 216 корректной работы...

Извини,с этим разделом я не знаком.Программа работает,просто когда я делал ,то я ожидал,что при записи в стек моя последовательность чисел опять перевернеться,а получилось что она выводит в том же порядке,что и записана в дек,но о этой причине я уже разобрался.

ты только даешь всем советы, как делать правильно, а сам - непонятно что творишь...

Скажм так советы я даю в той области,которую понимаю.Разве мои советы не несут никакого смысла?и не могут помоч в решении.А эту область, по которой я задаю вопросы,я не очень понимаю,поэтому у меня и глупые ошибки.Поэтому и прошу выносить критику.

Как оно ДОЛЖНО работать - это нам предстоит догадаться?

дерево должно заполниться из файла.

P.S.можно как нить помягче,а то такое ощущение,что ты на меня кричиш))))Что я полный дебил,и вообще нихрена не знаю.


А еще у меня вопрос.Почему,если из процедуры CreateStack я удалю reset(fin); То в этой строке мне выдает Division by zero.

Добавлено через 30 минут:

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
    new(curr);
    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;
  new(CurrDeq);
  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;
  dispose(CurrDeq);
 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.

Изменил.После того, как добавил new(CurrDeq); при удалении reset(fin); перестала выдаваться ошибка.Просьба обьяснить взаимосвязь.

И еще по поводу дерева..В приведенном ниже коде я пытаюсь создать деверо из информации,берущейся из текстового файла(Stat-пол мужчина-женщина,name-мня человека,Data-дата рождения данного человека)Сначала считываются пол,затем имя и в конце дата.печать чисто формальна,чтобы просто проверить заполнение дерева.

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 разрядной подсистемы дос, процессор NTVDM обнарушил недопустимую инстукцию

Добавлено через 18 часов:
volvo,а мне тоже надо создавать отдельюную тему для дерева,или ты в этой поможеш.А то я вон смотрю,ты на многих ругаешся,когда по несколько задач в одной теме.И почему хоть и изредка,но я получаю ответ только от тебя,остальным впадлу чтоли читать код:)Или у вас есть какое то разделение по "сферам влияния".В общем жду ответов,вроде все твои коментарии я учел,если правильно их понял.Если что поправлясь.

Добавлено через 3 часа:
В общем я немного пересмотрел программу с деревьями и получилось так.Ошибка про подсистему изчезла,но дерево все еще упорно не заполняется.

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;

Procedure ReadFile(var fin: text; var str: string);
	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=';');
	end;

Procedure CreateNode(temp : PTree;var root:PTree);
  Begin
    root^.head.stat := temp^.head.stat;
    root^.head.name := temp^.head.name;
    root^.head.data := temp^.head.data;
    root^.left := nil;
    root^.right := nil;
  End;

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

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

Begin

  if root = nil then  CreateNode(temp,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 temp^.head.stat='male' then CreateNode(temp,parent^.left)
    else CreateNode(temp,parent^.right);

  end;

End;

Procedure CreateTree(var root: PTree;var fin : text);
 var
 temp : PTree;
 begin
 new(temp);
 new(root);
 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('Нажмите любую клавишу для выхода в главное меню');
end;

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