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

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

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

> Задача на стек и дек.
сообщение
Сообщение #1


Профи
****

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

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


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

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;


Вот описание стека и дека.Вопрос в том можно ли создать лиш одну буферную переменную или делать через две.каждого типа.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов(1 - 18)
сообщение
Сообщение #2


Гость






Я уже задавал тебе этот вопрос, ты решил, что лучше создать новую тему, что-ли? Авось не заметят? Как ты дек заполняешь? Можно заполнять его с начала, а потом читать с конца (или наоборот, но чтение и запись - с разных сторон), тогда достаточно просто взять первые B элементов из файла и записать в стек, дек напрочь не нужен. Если дек и пишется и потом читается с одно и той же стороны - то никуда не денешься, придется заполнять дек, а потом брать последние B элементов и переносить их в стек. Дублировать ничего не надо, в худшем случае потребуется один TStack, один TDeque, и одна переменная типа TElem...

Кстати, во избежание проблем, которые у тебя обязательно возникнут с твоим стилем программирования, я бы посоветовал тебе сделать так:
TElem = integer; 
PTStackItem = ^TStackItem;
TStackItem = record
info:TElem;
Next: PTStackItem;
end;
TStack = PTStackItem;

PTDeqItem = ^TDeqItem;
TDeqItem = record
Data: TElem;
next, prev: PTDeqItem;
End;
TDeque = Record
Head, Tail: PTDeqItem;
End;
, так ошибиться будет гораздо сложнее, скажем, если понадобится сделать стек/дек не целых, а Char-ов или Real-ов...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Профи
****

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

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


Не, стек и дек обязательно должны быть,это принципи и есть суть задания.а запись у меня с конца.
 
Procedure Create(var Deq : TDeq; var fin:text);
var
curr: PTDeqItem;
ch : TData;
begin
reset(fin);
while not seekeof(fin) do
begin
curr:= new(PTDeqItem);
read(fin,ch);
curr^.next := Deq.pStart;
curr^.prev := nil;
curr^.data :=ch;
If Deq.pStart <> nil Then
Deq.pStart^.prev := curr
Else
Deq.pFinish := curr;

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



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

Добавлено через 19 часов:
Как вам такая реализация?

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 : TDeq;
Stack : TStack;
v : integer; {Љ®«-ў® н«Ґ¬Ґ­в®ў § ЇЁблў Ґ¬лҐ ў б⥪}
fin : text;

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

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

Procedure CreateStack(var Deq : TDeque; var fin:text;v:integer);
var
CurrDeq: PTDeqItem;
CurrStack:PTStackItem;
begin
reset(fin);
while CurrDeq<V do
begin
CurrDeq:= new(PTDeqItem);
CurrStack:= new(PTStackItem);
CurrDeq^.prev := Deq.tail;
CurrDeq^.next := nil;
CurrStack^.next := nil;
СurrStack^.data :=СurrDeq^.data;
If Deq.pStart <> V Then
Stack^.next := curr;
end;
end;


Просьба сильно ботинками не бить)

Добавлено через 6 часов:
Ну так кто нибуть может прокоментировать,прально ли я все делаю??

Добавлено через 30 минут:
процедура создания стека пересмотрена,но все равно не работает.

Procedure CreateStack(var Deq : TDeque; var fin:text;v:integer);
var
CurrDeq: PTDeqItem;
CurrStack:PTStackItem;
begin
reset(fin);
while CurrDeq^.data<V do
begin
CurrDeq:= new(PTDeqItem);
CurrStack:= new(PTStackItem);
CurrDeq^.prev := Deq.tail;
CurrDeq^.next := nil;
CurrStack^.next := nil;
CurrStack^.data :=CurrDeq^.data;
If CurrDeq^.data<>V Then
Stack^.data:= CurrStack^.data;
Deq.tail:=Deq.tail^.prev;
end;

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Нет, конечно... В смысле, неправильно. Сам же сказал, ботинками не бить, вот все и молчат.

НА кой черт ты при создании Стека, когда Дек уже готов, опять создаешь
Цитата
CurrDeq:= new(PTDeqItem);
? Смысл сего действия от меня ускользает. Тебе надо прочесть крайнее значение из Дека, запомнить его, и удалить Item, его хранивший. А ты вместо этого создаешь новый Item. Зачем?

Что за условие
Цитата
while CurrDeq<V do
? Я что-то нигде не заметил, что Дек хранит какие-то порядковые целые числа, тебе надо считать, сколько элементов ты уже перенес в Стек, и это число сравнивать с V. Я уж не говорю о том, что сравнивать теплое с мягким (в твоем исполнении Integer c PTDeqItem - да еще и НЕинициализированным) вообще нельзя, у тебя программа даже компилироваться не должна. Так с какой стати она может быть правильной?

 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Профи
****

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

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


Могу удивить он компилируется в легкую.Так насчет ошибок щас посмотрим,ты далеко не уходи.

Добавлено через 12 мин.
Ну получилось что то в этом духе

Procedure CreateStack(var Deq : TDeque; var fin:text;v:integer);
var
CurrDeq: PTDeqItem;
CurrStack:PTStackItem;
S:integer;
begin
reset(fin);
S:=0;
while S<=V do
begin
CurrDeq^.prev := Deq.tail;
CurrDeq^.next := nil;
CurrStack^.next :=Stack;
CurrStack^.data :=CurrDeq^.data;
Stack:=CurrStack;
Deq.tail:=CurrDeq^.prev;
S:=S+1;
end;
end;

.

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Цитата
Могу удивить он компилируется в легкую.
Ты сказки-то будешь внукам рассказывать... Это компилироваться не может по определению: пост №4 - строка №26, что такое TDeq? Нет такого типа, у тебя есть только TDeque... Дальше продолжать? Влегкую у него компилируется... Ты ПОЛНОСТЬЮ программу выложи, а я тебе скажу, компилируется она или нет.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Профи
****

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

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


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

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.


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


Гость






Цитата
Если кому надо:
Если б работало так, как задумывал, может и пригодилось бы кому. А так кодов на просторах сети - океан, только вот работает правильно очень малая часть...
Цитата
Еще хотелось бы услышать коменрарии к момему способу реализации задачи на стек и дек.
Трудно ожидать от программы, вываливающейся по RTE 216 корректной работы... То, что твой компилятор не отлавливает эту ошибку времени выполнения, не значит, что ее нет:
Прикрепленное изображение
Как ты думаешь, куда указывает CurrDeq, и что произойдет, когда ты попробуешь туда обратиться? А все происходит по той же причине: ты только даешь всем советы, как делать правильно, а сам - непонятно что творишь... Где инициализация переменной CurrDeq? Что в ней хранится при входе в процедуру, с учетом того, что она описана локально?

Цитата
Так же выношу на суд божий еще одно мое творение, которое нефига не рабоатет
Как оно ДОЛЖНО работать - это нам предстоит догадаться? Без задания, без тестового файла данных - это типа квест такой, да?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Профи
****

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

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


Цитата

Трудно ожидать от программы, вываливающейся по 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.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






Цитата
В общем я немного пересмотрел программу с деревьями и получилось так.Ошибка про подсистему изчезла,но дерево все еще упорно не заполняется.
Ты файл test.txt наконец покажешь или нет? Я ж не могу ползать по твоей программе взад и вперед и подбирать файл так, чтобы дерево успешно из файла было создано, правильно? Присоединил бы файл, который должен быть прочитан - все было бы гораздо проще... А так... Сомневаюсь, что найдется время на подбор тестовых данных, да еще потом и ты скажешь: а у меня не такой файл был, программа все равно не работает. Это мы уже проходили, больше я на это не иду.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Профи
****

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

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


Хорошо вот текстовый файл и оновленный вариант программы.
Код

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;
ch: char;

Procedure Trash(var ch:char);
begin
  if (ch =#13) or  (ch =#10) or (ch =' ') or (ch =#0) then
  begin
   read(fin,ch);
   Trash(ch);
end;
end;

Procedure ReadStat(var fin: text; ch : char; var str: string);
    begin
        str:='';
    read(fin, ch);
    Trash(ch);
    str:=str+ch;
        repeat
            read(fin, ch);
            if not (ch = ' ') and not (ch=';') then
                str:=str+ch;
        until (ch=' ') or eoln(fin) or (ch=';');
  end;

Procedure ReadFile(var fin: text; ch : char; var str: string);
    begin
        str:='';
        repeat
            read(fin, ch);
            if not (ch = ' ') and not (ch=';') then
                str:=str+ch;
        until (ch=' ') or eoln(fin) or (ch=';');
  end;

Procedure CreateNode(temp : PTree;var root:PTree);
  Begin
    new(root);
    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,root^.left)
    else CreateNode(temp,root^.right);

  end;

End;

Procedure CreateTree(var root: PTree;var fin : text);
var
temp : PTree;
begin
new(temp);
while not eof(fin) do
  begin
     readstat(fin,ch,temp^.head.stat);
     readfile(fin,ch,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.


Прикрепленные файлы
Прикрепленный файл  test.txt ( 212 байт ) Кол-во скачиваний: 137
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






В результате ты хочешь получить вот такой результат:
boris kor bob bob rita ksenia maria
Нажмите любую клавишу для выхода в главное меню
? Тогда расскажу, что надо делать. Если другой - значит, я еще не разобрался, что именно тебе надо...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Профи
****

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

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


Вообще мне необходимо получить генеагогическое дерево,а уж как выводить его на экран,но тут без разници,потому что это не цель моего задания.А вообще задание звучит,заполнить генеалогическое дерево до 3 поколения данными из файла и вывести на экран,участвовал ли кто нибудь во второй мировой войше,и если такие есть то вывести их на экран. тобиш по суди дожно выводится boris kor bob ksenia rita bob maria

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Цитата
тобиш по суди дожно выводится boris kor bob ksenia rita bob maria
Значит, так. Дерево создается неправильно, пересматривай алгоритм создания. Это минус. Плюс - в том, что оно-таки создается, и все итемы, прочитанные из файла в него попадают и благополучно выводятся на печать. Что я поменял (относительно программы из поста №18):

{ 1 - реализацию CreateNode }
Procedure CreateNode(temp : PTree; var root:PTree);
Begin
new(root); { !!! вот только в этом месте выделяем память под элемент !!! }

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;

{ 2 - процедура печати дерева теперь такая: }
procedure printKLP(root:PTree);

procedure print(level: integer; root:PTree);
begin
if root<>NIL then begin
writeln('':2*level, root^.head.name);
print(level+1, root^.left);
print(level+1, root^.right);
end;
end;

begin
clrscr;
if (root=NIL) then writeln('Дерево пусто!')
else Print(0, root);

writeln;
writeln('Нажмите любую клавишу для выхода в главное меню');
end;

{ 3 - ну, и само создание дерева: }
Procedure CreateTree(var root: PTree; var fin : text);
var
temp : PTree;
begin
while not eof(fin) do begin
new(temp); { <--- Временное хранилище: создали ... }
readfile(fin,temp^.head.stat); { читаем stat }
readfile(fin,temp^.head.name); { читаем имя }
read(fin,temp^.head.data); { читаем дату рождения }
readln(fin); { все остальное - пропускаем !!! }
AddItem(root,temp); { и добавляем прочитанное в дерево }
dispose(temp); { <--- Временное хранилище: удалили}
end;
end;

Хотя я бы процедуру CreateTree и AddItem переписал. Зачем создавать и удалять временный буфер, если можно прочесть данные в строки и число, и передавать их в AddItem... Хотя с другой стороны, тогда придется тянуть все параметры по многим подпрограммам, можешь оставить как есть...

Теперь о твоем многострадальном Деке + Стеке. Оно работает, выдает корректный результат. Все было бы хорошо, если бы не утечки памяти. Ты не чистишь память за собой, это плохо, и преподаватели (хорошие преподаватели) знают, как это проверяется. А для себя - это еще хуже. Привыкаешь работать, "не убирая мусор" за собой - потом при программировании под Win получаешь на пустом, казалось бы, месте ошибки типа "не хватает памяти для ресурсов", или что-нибудь в таком роде. А памяти-то гигабайты. И все равно, все очень быстро забрасывается мусором. Привыкай прямо сейчас: память выделил - значит надо вернуть.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Профи
****

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

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


В общем я почитал пяток другой факов и немного пересмотрел концепцию.пришел я к такому варианту.

program laba11;
Uses Crt;

Type TInf=Record
pol: String;
name: String;
BirthB,BirthD: Integer;
end;
TTree=^Tree;
Tree=Record
Inf:TInf;
Left,Right: TTree;
end;

var
fin : text;
root : TTree;
list : Tinf;
walk : TTree;
{-------------------------------------------------------------------------}
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 Show(List: TInf);{Отображение данных записи}
Begin
Write(List.pol,' ',List.name,' ',list.BirthB,' ',list.BirthD);
WriteLn; {Перевод строки}
End;

Procedure Input(Var list: TInf);{Заполнение записи путём ввода данных из файла}
Begin
Readfile(fin,list.pol);
Readfile(fin,list.name);
Read(fin,list.BirthB);
Read(fin,list.BirthD);
readln(fin);
End;

{-------------------------------------------------------------------------}

Function SignKey(B: TInf): Boolean;
Begin SignKey:=False;
If B.pol='male' then SignKey:=True;
End;

Function FindKey(A: TInf): Boolean;
Begin FindKey:=False;
If (A.BirthB<1942) and (A.BirthD>1942) then FindKey:=True;
End;

Function NewSheet(X:TInf): TTree; {размещение в куче нового элемента}
Var Temp: TTree;
Begin
New (Temp);
Temp^.Inf:=X;
Temp^.Right:=Nil;
Temp^.Left:=Nil;
NewSheet:=Temp;
End;

Procedure AddSheet(Var Root: TTree; tmp: TInf);{размещение нового элемента (листа) в структуре}
Begin
If Root<>Nil then begin
If SignKey(tmp) then begin
If Root^.Left=Nil then Root^.Left:=NewSheet(tmp) else AddSheet(Root^.Left,tmp);
end else begin
If Root^.Right=Nil then Root^.Right:=NewSheet(tmp) else AddSheet(Root^.Right,tmp);
end;
end else begin {дерево не создано, создаем его}
Root:=NewSheet(tmp);
end;
End;

Procedure AddTree(Var Root: TTree; New: TTree);{размещение нового в структуре}
Begin
If Root<>Nil then begin
If New<>Nil then begin
If SignKey(New^.Inf) then begin
If Root^.Left=Nil then Root^.Left:=New else AddTree(Root^.Left,New);
end else begin
If Root^.Right=Nil then Root^.Right:=New else AddTree(Root^.Right,New);
end;
end;
end else begin {дерево не создано, пытаемся создать его}
Root:=New;
end;
End;

Function Find(Root: TTree): TTree;{Поиск элемента}
Var temp: Ttree;
Begin temp:=Nil;
If Root<>Nil then begin {Если дерево не пустое}
If FindKey(Root^.Inf) then begin {Проверяем значение ключевого поля}
temp:=Root; {Если нашли нужный элемент, запоминаем его значение}
end else begin {если не нашли}
temp:=Find(Root^.Left); {пытаемся найти в других ветвях дерева (сначала слева)}
If temp=Nil then temp:=Find(Root^.Right); {Потом справа, если слева ничего не нашли}
end;
end;
Find:=temp; {Результат функции - значение временной переменной temp}
End;

Procedure ShowTree(R: TTree); {Вывод дерева на экран}
Begin
If R<>Nil then begin {Если ветвь не пуста}
Show(R^.Inf); {выводим информацию}
If R^.Left <> nil then ShowTree(R^.Left); {если слева имеется сук, выводим и его}
If R^.Right <> nil then ShowTree(R^.Right);{тоже самое справа...}
end;
End;


Procedure Print(T: TTree; g: integer); {Печать дерева. G-глубина (по лекции)}
Begin
If T=nil then Writeln ('Дерево пустое') else begin
g:=g+1;
If T^.Right <> nil then
Print (T^.Right, g);

Writeln (T^.Inf.pol,' ', T^.Inf.name);
If T^.Left <> nil then
Print (T^.Left,g);

g:=g-1;
End;
End;

{-------------------------------------------------------------------------}


begin
ClrScr; {Основная программа}
assign(fin,'C:\Tpascal\test.txt');
reset(fin);
Root:=Nil; {Начальные условия - пустое дерево}
while not eof(fin) do begin {В цикле вводим записи }
Input(list);
AddSheet(Root,list);{Добовляем данные}
end;
WriteLn;
WriteLn('Введённые данные: ');
ShowTree(Root); WriteLn;
ReadLn;

WriteLn('Отображение в виде дерева:');
Print(Root,0);
ReadLn;

Walk:=Find(Root);
If Walk=Nil Then WriteLn('Элемент не найден.');

WriteLn('Найден элемент:');
Show(Walk^.Inf); WriteLn;

close(fin);
END.

Но дерево все равно заполняется в виде пирамиды какой то.(текстовый файл все тот же)

Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Гость






Если
Цитата
текстовый файл все тот же
, то дерево в принципе не будет заполняться, ибо уже при чтении первой записи у тебя будет вылет: { не является целым числом. Точка, все дальнейшее - неправда.

Если чуть-чуть изменить входной файл (продублировать целое число, находящееся в каждой строке), то дерево будет построено, и даже выведено на экран:
Введённые данные:
male boris 1995 1995
male kor 1955 1955
male bob 1912 1912
male bob 1912 1912
fomale maria 1965 1965
fomale ksenia 1915 1915
fomale rita 1915 1915

Отображение в виде дерева:
fomale rita
fomale ksenia
fomale maria
male boris
male kor
male bob
male bob
Где "пирамида"? Ты что, где-то форматируешь вывод (а я ведь показывал тебе, КАК это делается, второй раз я повторять не буду)? Опять ложь.

Следующий баг:
Цитата
 Walk:=Find(Root);
If Walk=Nil Then WriteLn('Элемент не найден.');
WriteLn('Найден элемент:');
Show(Walk^.Inf); WriteLn;

Что это? То есть, ты сообщаешь, что элемент не найден, и тут же разыменовываешь nil? Интересная концепция...

В общем, пока я не вижу ничего измененного. Ты по-прежнему как партизан молчишь, ЧТО ты за дерево такое особенное хочешь получить (говоришь, что главное - создать дерево, но как только оно у тебя НЕ ТАКОЕ, как ты хочешь - ты тут же говоришь, что оно неправильное). Как правильно - ведомо только тебе, вот и делай сам. Здесь телепатов нет. Что ты хотел, чтоб Паскаль по твоему хотению проник тебе в мысли, узнал вот из этого бреда:
male boris 1995 {корень}
fomale maria 1965 {мать}
male kor 1955 {отец}
fomale ksenia 1915 {бабушка по отцу}
male bob 1912 {дед по отцу}
fomale rita 1915 {бабушка по матери}
male bob 1912 {дед по матери}
, что Ксения - мать Кора, а Боб - отец Марии, и добавил эти итемы в нужные тебе места? Не бывать этому. Ты должен сообщить программе, кто есть кто, и кого куда добавлять. Иначе она всегда будет создавать просто какое-то дерево, которое нельзя назвать генеалогическим.

Извини, я не вижу прогресса у тебя в теме, посему.... Мне надоело переливать из пустого в порожнее. Ты не хочешь видеть того, что тебе говорят. А я не хочу говорить то, чего потом не видят.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Профи
****

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

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


Цитата

Если Цитата
текстовый файл все тот же, то дерево в принципе не будет заполняться, ибо уже при чтении первой записи у тебя будет вылет: { не является целым числом. Точка, все дальнейшее - неправда.

Если чуть-чуть изменить входной файл (продублировать целое число, находящееся в каждой строке), то дерево будет построено, и даже выведено на экран:

Введённые данные:male boris 1995 1995male kor 1955 1955male bob 1912 1912male bob 1912 1912fomale maria 1965 1965fomale ksenia 1915 1915fomale rita 1915 1915Отображение в виде дерева:fomale ritafomale kseniafomale mariamale borismale kormale bobmale bob

Да это мой косяк,добавить добавил а упомянуть об этом забыл.
Цитата

Walk:=Find(Root);
If Walk=Nil Then WriteLn('Элемент не найден.');
WriteLn('Найден элемент:');
Show(Walk^.Inf); WriteLn;

Что это? То есть, ты сообщаешь, что элемент не найден, и тут же разыменовываешь nil? Интересная концепция...

если я правильно понял,то должно быть так
Код

Walk:=Find(Root);
If Walk=Nil Then WriteLn('Элемент не найден.')
else
  begin
    WriteLn('Найден элемент:');
    Show(Walk^.Inf); WriteLn;
  end;


Сообщение отредактировано: Krjuger -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Профи
****

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

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


Вроде я понял о чем ты так усердно пытался мне сказать и в общем добавил указатель на ветку,но тут такая проблема Root^.inf.stat не обновляется и продолжает висеть на значении первого(root) и поэтому все элементы улетают в правую ветвь.

program laba11;
Uses Crt;

Type TInf=Record
stat : string;
pol: String;
name: String;
BirthB,BirthD: Integer;
end;
TTree=^Tree;
Tree=Record
Inf:TInf;
Left,Right: TTree;
end;

var
fin : text;
root : TTree;
walk : TTree;
tmp : Tinf;
{-------------------------------------------------------------------------}
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 Show(List: TInf);{Отображение данных записи}
Begin
Write(List.pol,' ',List.name,' ',list.BirthB,' ',list.BirthD);
WriteLn; {Перевод строки}
End;

Procedure Input(Var list: TInf);{Заполнение записи путём ввода данных из файла}
Begin
Readfile(fin,list.stat);
Readfile(fin,list.pol);
Readfile(fin,list.name);
Read(fin,list.BirthB);
Read(fin,list.BirthD);
readln(fin);
End;

{-------------------------------------------------------------------------}

Function SignKey(B: TInf): Boolean;
Begin SignKey:=False;
If B.pol='male' then SignKey:=True;
End;

Function FindKey(A: TInf): Boolean;
Begin FindKey:=False;
If (A.BirthB<1942) and (A.BirthD>1942) and (A.pol='male') then FindKey:=True;
End;

Function NewSheet(X:TInf): TTree; {размещение в куче нового элемента}
Var Temp: TTree;
Begin
New (Temp);
Temp^.Inf:=X;
temp^.inf.stat:=X.stat;
Temp^.Right:=Nil;
Temp^.Left:=Nil;
NewSheet:=Temp;
End;

Procedure AddSheet(Var Root: TTree; tmp: TInf);{размещение нового элемента (листа) в структуре}
Begin
If Root<>Nil then
begin
if tmp.stat='father' then
begin
If Root^.Left=Nil then
Root^.Left:=NewSheet(tmp)
else
begin
If SignKey(tmp) then
AddSheet(Root^.Left,tmp)
else
AddSheet(Root^.right,tmp);
end;
end
else
begin
If Root^.Right=Nil then
Root^.Right:=NewSheet(tmp)
else
begin
If SignKey(tmp) then
AddSheet(Root^.Left,tmp)
else
AddSheet(Root^.Right,tmp);
end;
end;
end
else
begin {дерево не создано, создаем его}
Root:=NewSheet(tmp);
end;
End;


Function Find(Root: TTree): TTree;{Поиск элемента}
Var temp: Ttree;
Begin temp:=Nil;
If Root<>Nil then begin {Если дерево не пустое}
If FindKey(Root^.Inf) then begin {Проверяем значение ключевого поля}
temp:=Root; {Если нашли нужный элемент, запоминаем его значение}
end else begin {если не нашли}
temp:=Find(Root^.Left); {пытаемся найти в других ветвях дерева (сначала слева)}
If temp=Nil then temp:=Find(Root^.Right); {Потом справа, если слева ничего не нашли}
end;
end;
Find:=temp; {Результат функции - значение временной переменной temp}
End;

procedure printKLP(root:TTree);

procedure print(level: integer; root:TTree);
begin
if root<>NIL then begin
writeln('':2*level, root^.inf.name);
print(level+1, root^.left);
print(level+1, root^.right);
end;
end;

begin
if (root=NIL) then writeln('Дерево пусто!')
else Print(0, root);

writeln;
writeln('Нажмите любую клавишу для выхода в главное меню');
end;

{-------------------------------------------------------------------------}


begin
ClrScr; {Основная программа}
assign(fin,'C:\Tpascal\test.txt');
reset(fin);
Root:=Nil; {Начальные условия - пустое дерево}
while not eof(fin) do begin {В цикле вводим записи }
Input(tmp);
AddSheet(Root,tmp);{Добовляем данные}
end;
WriteLn;
WriteLn('Введённые данные: ');
ShowTree(Root); WriteLn;
ReadLn;

WriteLn('Отображение в виде дерева:');
printKLP(root);
readln;
Walk:=Find(Root);
If Walk=Nil Then WriteLn('Элемент не найден.')
else
begin
WriteLn('Найден элемент:');
Show(Walk^.Inf); WriteLn;
end;
readln;

close(fin);
END.


Тьфу извиняюсь эту оплошность я исправил,то вот по тому,как дерево выводится я все эще не мгу понять правильно ли оно собирается,а выглядеть оно должно так.
Код

                                    boris
          kor                   maria
      bob            ksenia       bob              rita  


А выходит с использованием твоей печати
Код

boris
  kor
      bob
      bob
  maria
      ksenia
      rita


Сообщение отредактировано: Krjuger -


Прикрепленные файлы
Прикрепленный файл  test.txt ( 290 байт ) Кол-во скачиваний: 120
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Профи
****

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

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


При этом,если сделать в процедуре

Procedure AddSheet(Var Root: TTree; tmp: TInf);{размещение нового элемента (листа) в структуре}
Begin
If Root<>Nil then
begin
if Root^.inf.stat='father' then
begin
If Root^.Left=Nil then
Root^.Left:=NewSheet(tmp)
else
begin
If SignKey(tmp) then
AddSheet(Root^.right,tmp){я поменял право и лево тут}
else
AddSheet(Root^.left,tmp);{и тут}
end;
end
else
begin
If Root^.Right=Nil then
Root^.Right:=NewSheet(tmp)
else
begin
If SignKey(tmp) then
AddSheet(Root^.Left,tmp)
else
AddSheet(Root^.Right,tmp);
end;
end;
end
else
begin {дерево не создано, создаем его}
Root:=NewSheet(tmp);
end;
End;


и стало выводиться
Код

boris
  kor
      bob
      rita
  maria
      ksenia
      bob

Что уже больше похоже на правду.поэтому либо я не совсем понимаю вывод дерева.либо я хз как эту ошибку исправить.
Код

boris
  kor
      bob
      rita
  maria
      bob
      ksenia

Вот на мой взгляд правильный вывод,каким должен быть,либо Volvo поясти,может я чтото не понимаю.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





- Текстовая версия 2.12.2020 12:34
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name