лабы на Паскале

работа с деревьями Паскаль СКАЧАТЬ

Описание:
Задание:
Дан текстовый файл с изображением целых чисел, которые переписать в стек St1. Используя стек St2, выбрать только нечетные положительные числа и построить из них сбалансированное  дерево.

Исходный код:
Program Lab12;
uses crt;
type Ptr=^Node;
Node=record
Dn:Integer;
Ln,Rn:Ptr;
end;

Type
TElement=^element;
Element=record
a:integer;
next:TElement;
End;

procedure proverka(filename:string);
var f:text;
Begin
{$I-}
Assign(f,filename);
reset(f);
{$I+}
if ioresult<>0 then Begin textcolor(204); writeln(‘ERROR FILE!!!’); readln; halt; End
else writeln(‘fail “‘,filename,’” otkrit’);
End;

procedure printfile(filename:string);
var f:text;
a:string; b:integer;
Begin
Assign(f,filename);
reset(f);
while not eof(f) do
Begin
readln(f,a);
writeln(a);
End;
close(f);
End;

procedure CreateStack(var First:TElement; x:integer);
var Q:TElement;
Begin
new(Q);
Q^.a:=x;
Q^.next:=First;
First:=q;
End;

function PrintStack(var First:TElement; var x:integer):boolean;
var q:TElement;
begin
if First=nil then PrintStack:=false else
Begin
x:=First^.a;
Q:=First;
First:=First^.next;
dispose(q);
PrintStack:=true;
End;
end;

function KolEl(var T:ptr):integer;
begin
if T=nil then  kolel:=0
else kolEL:=kolel(T^.Ln)+1+kolel(T^.Rn);
end;

procedure AddTree(var t:Ptr; D:integer);
begin
if t=nil then
begin
new(t);
t^.Dn:=D;
t^.Ln:=nil;
t^.Rn:=nil;
end
else if kolEL(t^.Ln)<kolEL(t^.Rn) then AddTree(t^.Ln,D)
else AddTree(t^.Rn,D);
end;

procedure PrintTree(t:Ptr; H:integer);
const M=6;
var i:integer;
begin
if T<>nil then
begin
PrintTree(t^.Ln,H+M);
for i:=1 to H do write(‘ ‘);
Writeln(t^.Dn);
PrintTree(t^.Rn,H+M);
end;
end;

procedure DoneTree(t:Ptr);
begin
if t<>nil then
if (t^.Ln=nil) and (t^.Rn=nil) then Dispose(t)
else
begin
DoneTree(t^.Ln);  t^.Ln:=nil;
DoneTree(t^.Rn);  t^.Rn:=nil;
Dispose(t);
end;
end;

procedure transfer(var First:TElement; filename:string);
var F:text; st,sl:string; l,code,x:integer;
Begin
Assign(f,filename);
reset(f);
st:=”;
sl:=”;
while not eof(f) do
Begin
readln(f,st);
for l:=1 to length(st) do
Begin
if st[l]<>’ ‘ then sl:=sl+st[l] else
Begin
val(sl,x,code);
CreateStack(First,x);
sl:=”;
End;
End;
End;
close(F);
End;

{===========================MAIN===============================}

var  i,z,U:integer;
t:Ptr;
First, First2:TElement;

BEGIN
ClrScr;
first:=nil;
first2:=nil;
t:=nil;
i:=0;

writeln(‘1: BBOD 4uceJl Bpy4HyIO’);
writeln(‘2: B39Tb 4ucJlA u3 qpauJla’);
write(‘–>’);
readln(u);
writeln;

if u=1 then
Begin
writeln(‘vvedite 4isla: ‘);
readln(z);
CreateStack(First,z);
while z<>0 do
Begin
readln(z);
CreateStack(First,z);
End;
End;

if u=2 then
Begin
proverka(‘g:in.txt’);
printfile(‘g:in.txt’);
transfer(First,’g:in.txt’);
End;
writeln(’sodergimoe pervogo steka: ‘);
while PrintStack(First,z)<>false do
Begin
write(z,’ ‘);
if ((i mod 2<>0) and (z>0)) then CreateStack(First2,z);
inc(i);
End;
writeln;
writeln(’sodergimoe vtorogo steka: ‘);
while PrintStack(First2,z)<>false do Begin write(z,’ ‘); AddTree(t,z); End;
writeln;
writeln(‘vivod dereva: ‘);
writeln;
PrintTree(t,4);
DoneTree(t);

readln;
End.