Деревья
Упорядоченные списки
Связные списки
Динамические массивы
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.