1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
| program Laba2;
{Программа сравнения двух бинарных деревьев.
ВНИМАНИЕ: входные данные считаются заведомо корректными,
никакая проверка ошибок не предусмотрена!}
const
TAB = chr(9); {символ табуляции}
type
Element = Integer;
Tree = ^Node; {дерево}
Node = record {вершина дерева}
Data: Element; {данные}
Left: Tree; {левый сын}
Right: Tree; {правый сын}
end;
var
inFile1, inFile2: Text; {файлы двух деревьев}
inTree1, inTree2: Tree; {сцепленные представления двух деревьев}
procedure ReadTree(var F: Text; var T: Tree);
{Читает дерево, представленное иерархическим текстом, из файла F
и строит сцепленное представление дерева T}
var
level: Integer;
currLine: String;
currNumber: String;
dataStr: String;
currPos: Integer;
code: Integer;
function GetWord: String;
{Выделяет из CurrLine очередную последовательность символов,
отличных от пробела и табуляции}
var
result: String;
begin
while (currPos <= Length(currLine)) and ((currLine[currPos] = ' ')
or (currLine[currPos] = TAB)) do
currPos := currPos + 1;
result := '';
while (currPos <= Length(currLine)) and (currLine[currPos] <> ' ')
and (currLine[currPos] <> TAB) do begin
result := result + currLine[currPos];
currPos := currPos + 1;
end;
GetWord := result;
end; {GetWord}
procedure RecurseRT(var T: Tree; level: Integer);
{Читает непустое поддерево T из файла.
Параметр level содержит длину номера корневой вершины поддерева.
В момент вызова этот номер уже считан из текущей введенной строки.
В момент возврата считан номер вершины, не принадлежащей введенному
поддереву}
begin
T := New(Tree);
T^.Left := nil;
T^.Right := nil;
dataStr := GetWord; {данные корневой вершины}
Val(dataStr, T^.Data, Code);
Readln(F, currLine);
currPos := 1;
currNumber := GetWord;
while Length(currNumber) > level do begin {это сыновья}
if currNumber[Length(currNumber)] = '0' then
RecurseRT(T^.Left, level + 1)
else
RecurseRT(T^.Right, level + 1);
end;
end; {RecurseRT}
begin {ReadTree}
if EOF(F) then {пустое дерево}
T := nil
else begin
Readln(F, currLine);
currPos := 1;
currNumber := GetWord;
RecurseRT(T, 1);
end;
end; {ReadTree}
procedure PrintTree(Header: String; var T: Tree);
{Выдает на стандартный вывод текстовое представление дерева T,
предваряя его заголовком Header}
procedure RecursePT(T: Tree; number: String);
{Выдает на стандартный вывод текстовое представление поддерева T.
Параметр number задает номер корневой вершины}
var
i: Integer;
begin {RecursePT}
if T = nil then
Exit;
{Сначала печать корня}
for i := 1 to Length(number) do {Отступ}
Write(' ');
Write(number + ' ');
Writeln(T^.Data);
{Теперь сыновья}
RecursePT(T^.Left, number + '0');
RecursePT(T^.Right, number + '1');
end; {RecursePT}
begin {PrintTree}
Writeln;
Writeln(Header);
RecursePT(T, '0');
end; {PrintTree}
function TreeEquRec(T1, T2: Tree): Boolean;
{Проверяет равенство двух деревьев T1 и T2.
Рекурсивный вариант}
begin
if T1 = nil then
if T2 = nil then
TreeEquRec := true
else
TreeEquRec := false
else
if T2 = nil then
TreeEquRec := false
else
if T1^.Data <> T2^.Data then
TreeEquRec := false
else
TreeEquRec := TreeEquRec(T1^.Left, T2^.Left)
and TreeEquRec(T1^.Right, T2^.Right);
end; {TreeEquRec}
function TreeEquNonRec(T1, T2: Tree): Boolean;
{Проверяет равенство двух деревьев T1 и T2.
Нерекурсивный вариант}
var
Stack: array[1..100, 1..2] of Tree; {Стек для двух деревьев}
Top: Integer; {Указатель вершины стека}
begin
Top := 1;
Stack[Top, 1] := T1;
Stack[Top, 2] := T2;
while Top > 0 do begin {пока в стеке есть нерассмотренные поддеревья}
T1 := Stack[Top, 1];
T2 := Stack[Top, 2];
Top := Top - 1;
if T1 = nil then
if T2 = nil then begin
{В отличие от рекурсивного варианта, здесь еще рано принимать
решение, потому что Exit будет означать завершение всей работы,
без рассмотрения оставшихся поддеревьев!}
{TreeEquNonRec := true;
Exit;}
end
else begin
TreeEquNonRec := false;
{Если хоть одно различие есть, то деревья различны}
Exit;
end
else begin
if T2 = nil then begin
TreeEquNonRec := false;
Exit;
end
else begin
if T1^.Data <> T2^.Data then begin
TreeEquNonRec := false;
Exit;
end
else begin
{Раз не удалось найти различий в корневой вершине,
продолжим на поддеревьях}
Stack[Top+1, 1] := T1^.Left;
Stack[Top+1, 2] := T2^.Left;
Stack[Top+2, 1] := T1^.Right;
Stack[Top+2, 2] := T2^.Right;
Top := Top+2;
end;
end;
end;
end;
{Поддеревья кончились.
Поскольку различий найти не удалось, деревья равны}
TreeEquNonRec := true;
end; {TreeEquNonRec}
begin {Laba2}
Assign(inFile1,'C:\temp\tree1.txt');
Reset(inFile1);
ReadTree(inFile1, inTree1);
PrintTree('Первое дерево:', inTree1);
Assign(inFile2, 'c:\temp\Tree2.txt');
Reset(inFile2);
ReadTree(inFile2, inTree2);
PrintTree('Второе дерево:', inTree2);
Writeln;
if TreeEquRec(inTree1, inTree2) then
Writeln(' Рекурсивное решение: деревья равны')
else
Writeln(' Рекурсивное решение: деревья различны');
if TreeEquNonRec(inTree1, inTree2) then
Writeln('Нерекурсивное решение: деревья равны')
else
Writeln('Нерекурсивное решение: деревья различны');
end. |
(
