Сам я не пользовался им, но так просмотрел, вроде неплохой: тем много, каждая тема описывается кратко, но понятно, присутствуют примеры и доказательства, ну вообщем советую посмотреть....
Название: работа с деревьями Паскаль Категория:лабы на Паскале Формат файла: *.pas Размер: 3.5Kb Просмотров: 4744 Загрузок: 1170 Комментариев:1 Дата добавления: 01 Июня 2009, 12:27 Теги:
Внимание! Если ссылка не работает, файл не найден или просто возникают какие-либо вопросы, напишите об этом, пожалуйста, мне на почту: xdypx@yandex.ru. В письме достаточно указать ссылку на эту страницу и описание проблемы или свой вопрос.
Описание: Задание: Дан текстовый файл с изображением целых чисел, которые переписать в стек 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;
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);
24 Сентября 2017, Воскресенье
11:30
>Г Л А В Н А Я
>Ф А Й Л Ы
>С Т А Т Ь И
>Р Е Ф Е Р А Т Ы
>Ф О Р У М
>О Т З Ы В Ы
>Т Е С Т Ы
>F l a s h И Г Р Ы
>Ф О Т О Ш О П
