uses crt type ptr record data string count integer left right ptr end

  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
uses crt;
type ptr=^t;
t = record
data:string;
count:integer;
left,right:ptr;
end;
ptr1 = ^item;
item = record
data:string;
next:ptr1;
end;
var n,k:integer;
root,rootTr:ptr;
current,last,head:ptr1;
function tree(countNodes:integer):ptr;
var leftNodes,rightNodes,k:integer;
str:string;
newnode:ptr;
begin
if countNodes = 0 then tree:=nil
else
begin
leftNodes:=countNodes div 2;
rightNodes:=countNodes - leftNodes - 1;
write('Enter node data: ');
readln(str);
new(newnode);
newnode^.data:=str;
newnode^.left:=tree(leftNodes);
newnode^.right:=tree(rightNodes);
tree:=newnode;
end;
end;
procedure printTree(rootTree:ptr; l:integer; amountNode:integer);
var i:integer;
begin
amountNode:=amountNode div 2;
if rootTree <> nil then
begin
if (rootTree^.left = nil) and
(rootTree^.right = nil) and
(amountNode = 0) then
begin
inc(k);
new(current);
current^.data:=rootTree^.data;
current^.next:=nil;
if last = nil then head:=current
else last^.next:=current;
last:=current;
end;
printTree(rootTree^.left,l+1,amountNode);
for i:=1 to l do write(' ');
writeln(rootTree^.data);
printTree(rootTree^.right,l+1,amountNode);
end;
end;
procedure search(x:string;var t:ptr);
begin
if t = nil then
begin
new(t);
t^.data:=x;
t^.count:=1;
t^.left:=nil;
t^.ri)ght:=nil;
end
else if x < t^.data then search(x,t^.left)
else if x > t^.data then search(x,t^.right)
else t^.count:=t^.count+1;
end;
procedure printList;
begin
current:=head;
rootTr:=nil;
while current <> nil do
begin
write(current^.data,' ');
search(current^.data,rootTr);
current:=current^.next;
end;
end;
Begin
clrscr;
k:=0;
writeln('Create tree');
write('Enter number of nodes: ');
readln(n);
root:=tree(n);
writeln('Created tree');
printTree(root,0,n);
writeln('k = ',k);
writeln('List');
printList;
writeln;
writeln;
writeln('New Tree');
printTree(rootTr,0,k);
readkey;
End.