Деревья

Упорядоченные списки

Связные списки

Динамические массивы

Type vector = array[1..1]of integer;

Var a1,a2=^vector;

P:pointer;

N,j,s:integer;

Begin

Writeln(‘Введите число элементв’);

Readln(n);

Mark(p); {Указатель на текущий участок}

Getmem(a1,n*sizeof(integer));

For i:=1 to n do readln(a^[i]);

S:=0;

For i:=1 to n do begin s:=s+a1^[i];

End;

Связный список – это последовательность из n узлов, причем в каждом из них есть поле для связи со следующим (ссылка \ указатель)

Достоинства:

1) Не требует непрерывного участка памяти для размещения

2) Операция вставки и удаления происходят гораздо быстрее, чем в массивах

3) Помогают для реализации графов, деревьев

Недостатки:

1) Последовательный доступ

В паскале единственным исключением из правила опережающего описания является описание связного списка.

Type sp=^el

El=record

Data:integer;

Next:sp;

End;

Соглашения:

1) Список без головы (первый узел – первое значение)

2) Список с головой(первый узел не содержит значимых данных. Только ссылку)

3) Список с хвостом(последний узел списка не имеет данных, ссылается или на nil или на самого себя)

Function seatch(l:sp; M:integer):sp; {Поиск элементов}

Var [:sp;

B:Boolean;

Begin

P:=l;

B:=true;

While p<>nil and b do

If p^.a=m then b=false

Else p:=p^.n;

Search:=p;

End;

Function tolast(l:sp):sp;

Var p:sp;

Begin

P:=l;

While p^.n<>nil do p:=p^.n;

Tolast:=p;

End;

С клавиатуры вводятся элементы. Нужно занести из в список в порядке возрастания, указав количество их повторений.

Числа целые, положительные из не большие тысячи.

Program p1;

Const

N=1000;

Var m:word;

A,k:array [1..n] of word; {Массив а – для храненяи самих чисел, к-количество повторений ахI] элемента}

I,j,x:word;

Begin

M:=0;

Repeat

Read(x);

i:=0;

for j:=1 to m do {Тут кажется какой то косяк. Не могу разобратся в лекции}

if a[j]=x then i:=j;

if i=0 then begin

inc(m);

a[m]:=x;

k[m]:=1;

end;

else inc(k[i]);

until x=0;

dec(m);

for 1 to m-1 do

for j:=i+1 to m do

if a[i]>a[j] then begin

x:=a[i];

a[i]:=a[j];

a[j]:=x;

x:=k[i];

k[i]:=k[j];

k[j]:=x;

{А теперь та же самая задач, только со списками}

Type sp=^el;

El=record

A,k:word;

N:sp;

End;

Var q,p,l:sp;

Begin

L:=nil;

New(l);

L^.a:=0;

L^.k:=1;

L^.n:=nil;

{Эта магия вверху - голова}

Repeat

Read(x);

P:=l;

While (p^.a<x) and (p^.n<>nil) do

P:=p^.n;

If p^.a=x then inc(p^.k);

Else p^.a<x then begin

New(q);

Q^.a:=x;

Q^.k:=1;

Q^.n:=nil;

P^.n:=q;

P^.a:=x;

P^.k:=1;

End;

Until x=0;

L:=l^.n;

Деревья это совокупность элементов называемых узлами и отношений образующих иерархическую структуру узлов.

Дерево может быть либо пустым, либо в нем имеется один специально обозначенный узел называемый корнем дерева, а все остальные узлы содержатся в непересекающихся множествах, каждое из которых в свою очередь является деревом.

Деревья называют поддеревьями данного корня

Type der=^user

Usel = record

Data:Tdata;

L,r:der;

End;

Var T:der;

begin

For i:=to n do write(x[i]);

P:=l;

While p<>nil do begin

Writeln(p^.d);

P:=p^n;

{Это не в той программе}

End;

Procedure prefix(t:der) {Сначала корень, потом левая ветка, а потом правая ветка }

Begin

If t<>nil then begin

Writeln(t^.data);

Prefix(t^.l);

Prefix(t^.r);

End;

Procedure infix(t:der); {Левая ветка, корень, правая - инфиксная}

Begin

If t<>nil then begin

Infix(t^.l);

Writeln(t^.Data);

Infix(t^.t);

End;

End;

Procedure postfix (t:der);{Сначала левая ветка, правая, а потом корень}

Begin

If t<>nil then begin

Postfix(t^.l);

Postfix(t^.r);

Writeln(t^.data);

End;

End;

Procedure create(var t:der; h:integer);

Begin

If h=0 then t:=nil

Else begin

New(t);

T^.elem:=h;

Create(t^.l,h-1);

Create(t^.r,h-1);

End;

End;

Procedure printTree(t:der; space:integer);

Var I:integer;

Begin

If t<>nil then

Begin

printTree(t^.right, space +1);

for i:=to space do write(‘ ‘);

writeln(t^.elem);

printtree(t^.left, space+1);

end;

end;

function count(t:der):word; {Число вершин}

begin

if t = nil then count:=0

else count:=1+count(t^.l) +count(t^.r);

end;

function count(t:der):word; {Тоже счет}

var k:word;

procedure work(l:der);

begin

if L<> nil then begin

k:=k+1;

work(l^.1); work(l^.r);

end;

end;

begin

k:=0;

work(t);

count:=k;

function levels(t:der):word;{Счет уровней}

var lev,maxlev:word;

procedure work(l:der);

begin

if l<>nil then begin

inc(lev);

if lev >maxlev then maxlev:=lev;

work(l^.l); work(l^.r);

dec(lev);

end;

end;

begin

lev:=0;

maxlev:=0;

work(l);

levels:=maxlev;

function sumpos(t:der):real;{Сумма положительных}

begin

if t=nil then sumpos:=0;

else begin

sumpos:=sumpos(t^.l)+sumpos(t^.r)+t^.data*ord(t.data>0);

end;

end;

type der=^usel;

usel= record

word=string;

count:word;

left,right:der;

end;

var

t:der;

p,q:der;

w:string;

found:Boolean;

procedure outder(t:der);

begin

if t<.nil then begin

outder(t^.left);

wrieln(t^.word,’-‘,T^.count);

outder(t^.right);

end;

end;

readln(w);

new(t);

witht^ do begin

word:=w;

count:=1;

left:=nil;

right:=nil;

end;

readln(w);

whie w<>’’ do begin

found:=false;

p:=t;

while p<>nile and found = false do begin

q:=p;if w<p^.word

then p:=p^.left;

else if w>p^.word

then p:=p^right;

else found:= true;

end;

if found then inc(p^.count);

else begin

new(p);

whit p^ do begin

word:=w; count:=1;

left:=nil; right:=nil;

end;

if w<q^.word

then q^.left:=p;

else q^.right:=p;

end;

readln(w);

end;

outDer(t);

end.

Дата добавления: 2014-01-07