- •Обращение к полям записи
- •Оператор with
- •Записи с вариантами
- •Рекурсия
- •Вычислить n!
- •Вычисления чисел Фибоначчи
- •Вычисления значений формул
- •Быстрая сортировка
- •Процедуры и функции общие для всех типов файлов
- •Режимы работы файла
- •Опция компиляции
- •Процедуры и функции модуля system
- •Процедуры и функции для типизированных файлов
- •Как добиться прямого доступа??
- •Стандартная конструкция редактирования файла
- •Тектовые файлы
- •Процедуры и функции для текстовых файлов
- •Способы считывания
- •Бинарные файлы
- •Работа с динамической памятью
- •Pointer
- •Дерево Absolute
- •Типизированные ( переменные ) указатели
- •Процедуры работы с кучей
- •Динамические массивы
- •Связные списки
- •Упорядоченные списки
- •Деревья
Упорядоченные списки
С клавиатуры вводятся элементы. Нужно занести из в список в порядке возрастания, указав количество их повторений.
Числа целые, положительные из не большие тысячи.
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.