Графы

Оглавление:
Некоторые определения
Способы задания графов
Деревья
Сформировать бинарное дерево из N узлов
Дерево поиска
Сильноветвящиеся деревья
Черно-белые деревья
Генеалогическое древо
Преобразование дерева в строку
Цепочки ДНК
Хранение деревьев в массиве
Корневые деревья (root tree)
Расчет уровней вершин
Нахождение корня и сжатие путей
Упаковка двоичного дерева в массив
Наибольший общий предок
Обход вершин графа
Построение каркаса или остова
Эйлеровы пути
Гамильтонов цикл
Нахождение кратчайших путей
Нахождение кратчайших путей от фиксированной вершины. Алгоритм Дейкстры
Кратчайшие пути между всеми парами вершин. Алгоритм Флойда
Топологическая сортировка
Очередь с приоритетом
Волновой алгоритм. Закраска замкнутых областей
Волновой алгоритм. Поиск пути в лабиринте
Lines (20 баллов)
Lines-2 (30 баллов)
Задача С. «Камелот»
Задача B. «Гонки в лабиринте»
Задача C. Шахматная партия Алисы
Задача B. Верхом на шахматной фигуре
Спам
Задача В. Путешествие на хамелеоне
Задача D. 38 попугаев
Задача А. Волшебная Змейка
Задача В. Компьютерный вирус
Задача D. Темный лабиринт

Некоторые определения
Граф G представляет собой совокупность трех множеств: G={V,E,А}. V-множество вершин, E- множество ребер графа, А - отношение инцидентности, оно ставит в соответствие каждому ребру две вершины
Если ребра графа имеют направление, то граф называется ориентированным.
Если ребрам приписаны числа, то граф называется взвешенным.
e2,e4 кратные ребра,
e1 e4 е5 петля,
V5 изолированная
вершина
.V5

Способы задания графов
Задание графа списком ребер.
Недостаток: сложно работать
в программе
Задание графа матрицей смежности. Матрица содержит количество
ребер инцидентных
вершинам с номерами
i и j.
1
4
2
3

Способы задания графов
Список инцидентности. Номер вершины графа используется, как номер строки в матрице. Элемент с номером 0 хранит количество элементов в строке. Каждый элемент строки хранит номер второй вершины, с которой их соединяет ребро. В ориентированном графе номер вершины, в которой начинается ребро - это номер строки матрицы, а в этой строке хранятся номера вершин, в которых заканчиваются ребра
1
4
2
3

Деревья
Деревом называется конечное множество точек (узлов), соединенных между собой дугами, на которые накладываются следующие ограничения:
1) между узлами устанавливается отношение "исходный⇒порожденный" или "отец⇒сын". Есть только один узел, не имеющий исходного, он называется корень;
2) все узлы, кроме корня, имеют только один исходный (порожденных может быть несколько);
3) Отношение "исходный⇒порожденный" действует только в одном направлении.

Способы задания деревьев
задание дерева графом. Наиболее информативный способ задания дерева. Кружки обозначают вершину, а дуги – в виде стрелок.
задание дерева множествами.
задание дерева скобочной структурой.
a(b(d(),e(g())),c(f()) )

Некоторые определения
Степенью узла – называется количество его потомков.
Степенью дерева – называется максимальная степень его узлов.
Высотой узла – называется длина пути в дугах от корня до данного узла +1.
Высотой дерева – называется максимальная высота его узлов.
Бинарным деревом – называется дерево степени 2.
Лист- узел без потомков.

Сформировать бинарное дерево из N узлов
В бинарном дереве у каждого узла возможно два потомка: левый и правый. Разработаем динамическую структуру данных для представления такого дерева.
Type Ref=^Node;
Node=Record
Left, Right:Ref;
Key:тип_элемента
End;
Var root:Ref;{корень дерева}
Всего в дереве N узлов, один уйдет на корень, останется N-1 узел. Слева разместится половина оставшихся узлов – nl=(N-1) div 2, справа – nr=N-1-nl.
Алгоритм построения дерева:
построить корень
вычислить количество узлов слева и справа
построить поддерево из nl узлов и прицепить его к корню слева
построить поддерево из nr узлов и прицепить его к корню справа
Причем алгоритм построения поддерева абсолютно совпадает с исходным алгоритмом, что позволяет использовать рекурсию.

Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Построим бинарное дерево из 8 узлов. N=8
N=8
1
nl=3
nr=4
N=3
2
nl=1
nr=1
N=1
3
nl=0
nr=0
nil
nil
N=1
4
nl=0
nr=0
nil
nil
N=4
5
nl=1
nr=2
N=3
6
nr=0
nl=0
7
nr=1
nl=0
8
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;
Function BuildT(n:integer):ref;
Var R:Ref;
Begin
If n=0 then BuildT:=nil
Else begin
New(R);
{Создать корень поддерева}
Write(‘введите значение звена’);
readln(R^.key);
{сосчитать узлы слева и справа}
nl:=(n-1)div 2;nr:=n-1-nl;
R^.Left:=BuildT(nl);
{построить левое поддерево}
R^.Right:=BuildT(nr);
{построить правое поддерево}
BuildT:=R;
{прицепить дерево к имени функции}
End;
End;

Для вывода дерева на экран, повернем его на 90 градусов против часовой стрелки.
Для каждого узла будем хранить его высоту (h), при выводе его на экран будем использовать h в качестве смещения вправо: чем глубже, тем правее.
Вывод дерева на экран
h
0
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
1
2
Следующий рекурсивный вызов подпрограммы завершится ничем, так как указатель R=nil. Подпрограмма вернется в точку вызова
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
21
1
13
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
Попытаемся напечатать левое поддерево, но оно пустое. Вернемся на шаг назад.
0
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
10
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
Теперь пойдем в левое поддерево.
1
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
2
8
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;
1
2
5
1
Procedure PrintT(R:ref;h:integer);
Var i:integer;
Begin
If r<>nil
then begin
PrintT(R^.Right, h+1);
for i:=1 to h do
write(‘ ‘);
writeln(R^.Key);
PrintT(R^.Left, h+1);
End;
End;

Дерево поиска
Деревом поиска называется бинарное дерево, организованное по следующим принципам:
элементы большие корня хранятся в правом поддереве;
элементы меньшие корня хранятся в левом поддереве;
Такое дерево предназначено для организации очень быстрого поиска информации.
Поиск в таком «дереве» организовать несложно.
1. «Встаем» на корень дерева;
2. Пока (не дошли до «пустого дерева») и (не нашли искомый узел)
2.1 Если искомый узел меньше текущего, то сдвигаемся в левое поддерево, иначе сдвигаемся в правое поддерево

Итерационный алгоритм поиска
Readln(x);
{ввели искомое значение}
P:=Root; {встали на корень}
While (p<>nil)and(p^.key<>x) do {пока не дошли до конца и не нашли}
If p^.key>x
Then p:=p^.left
Else p:=p^.right
Пусть мы ищем число 17.
Встаем на корень дерева и сравниваем значение текущего звена с ключом поиска
10>17?
Нет
13>17?
Нет
21>17?
Да
17=17?
Да
Нашли!

Рекурсивный алгоритм поиска
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
X
6
10
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
5
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
8
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
Function Seek(p:ref;x:integer):Ref;
Begin
If (p=nil) or (p^.key=x)
Then Seek:=p
Else If p^.key>x
Then Seek:=Seek(p^.left,x)
Else Seek:=Seek(p^.right,x)
End;
6

Рекурсивный алгоритм вставки
Procedure Insert(Var p:ref; y:integer):Ref;
Begin
If (p=nil)
{если дерево закончилось,
то пора создавать узел}
Then begin
New(p); p^.Key:=y;
P^.Left:=nil; p^.Right:=nil
End
Else If p^.key>Y
Then Insert(p^.left,y)
Else If p^.key
Then Insert(p^.Right,y)
End;
Пусть мы хотим вставить число 7.
Встаем на корень дерева и сравниваем значение текущего звена с ключом поиска
7
10>7?
Да
5>7?
Нет
8>7?
Да
6>7?
Нет

Сильноветвящиеся деревья
Деревья
Бинарные
Фиксированной степени
Неизвестной степени

Черно-белые деревья
Очень часто в информатике для хранения видеоизображения используют специальные способы кодирования информации. Для простоты рассмотрим черно-белое изображение, имеющее форму квадрата c длиной стороны равной степени числа 2. Изображение последовательно делится на 4 равных квадрата. Если все точки внутри одного квадрата имеют одинаковый цвет (черный или белый), то процесс деления этого квадрата заканчивается, в противном случае он снова делится на 4 части. Процесс деления продолжается, пока все квадраты не будут содержать точки одного цвета. Преобразование изображения в дерево выполняется следующим образом. Корень дерева представляет все изображение. Каждая вершина описывает некоторый квадрат. Она может иметь либо 4 исходящих ребра к другим вершинам, либо быть листом и не иметь потомков. В дереве вершины пронумерованы в соответствии с нумерацией квадратов на рисунке. Квадраты обходятся слева направо сверху вниз, начиная с верхнего левого угла. Задание:
разработайте структуру данных для представления такого дерева;
опишите алгоритм, который по имеющемуся дереву и размерам картинки (NxN) восстановит изображение.

Так как количество потомков каждого узла фиксировано: либо 4, либо 0, то для хранения связей воспользуемся массивом на 4 элемента.
Type Ref=^Node;
Node=Record
P:array[0..3] of ref; {4 ссылки на квадраты}
Col:byte; {цвет текущего квадрата}
End;
Var Root:ref;
Каждый квадрат либо монолитен, имеет собственный цвет, либо разбит на 4 квадрата, каждый из которых имеет такую же структуру: либо монолитен, либо разбит. Это позволяет использовать рекурсивный подход к рисованию квадрата. В начале проверяем цвет текущего квадрата: если он серый, то делим длину стороны квадрата пополам и рекурсивно пытаемся нарисовать 4 квадрата, на рисунке показаны координаты каждого из мини-квадратов:S/2S x,y+s/2x,yx+s/2,yx+s/2,
y+s/2
Procedure Rec(x,y:integer; S:integer; R:ref;);
Const dx: array[0..3] of integer =(0,1,0, 1);
dy: array[0..3] of integer =(0,0, 1,1);
Var i, c:integer;
Begin
If R^.Col<>серый
Then Квадрат(x, y, x+s, y+s, R^.Col)
Else begin
c:=s div 2;
for i:=0 to 3 do
Rec(x+dx[i]*c+1, y+dy[i]*c+1, c, R^.[i])
end
End;

6
7
8
9
11
17
Procedure Rec(x,y:integer; S:integer; R:ref;);
Const dx: array[0..3] of integer =(0,1,0, 1);
dy: array[0..3] of integer =(0,0, 1,1);
Var i, c:integer;
Begin
If R^.Col<>серый
Then Квадрат(x, y, x+s, y+s, R^.Col)
Else begin
c:=s div 2;
for i:=0 to 3 do
Rec(x+dx[i]*c+1, y+dy[i]*c+1, c, R^.[i])
end
End;
Встаем на корень дерева, он имеет серый цвет, то есть имеет 4-е потомка, поэтому начинается цикл, выполняющийся 4 раза, первая итерация пойдет по левой ветке и нарисует 1-ый белый квадрат
Достигли листа – он белый, рисуем белый квадрат
Снова серое звено, начинается цикл. Обратите внимание на то, что размеры S и координаты верхнего левого угла меняются
Далее аналогично

Генеалогическое древо
Король «Квадрандии» решил составить свою родословную, начиная с Адама, и описать ее генеалогическим древом. В него должны быть включены все предки по мужской линии. Причем если у мужчины А было три сына В, С и D, то это изображалось так:
Древо получилось очень «ветвистым», и работать с ним стало крайне неудобно. Помогите королю «Квадрандии» справиться с возникшими проблемами. Задание:
разработайте структуру данных на языке Паскаль для представления генеалогического древа;
опишите алгоритм поиска человека Х в генеалогическом древе;
опишите алгоритм, позволяющий определить, является ли человек А отцом В;
опишите алгоритм, позволяющий определить, является ли человек А предком В.

Так как количество потомков у человека Х заранее неизвестно, то использовать массив для хранения родственных связей нельзя (всегда есть предел количества потомков). Воспользуемся динамическими структурами данных.
а) Type Ref=^tNode; {Указатель на звено дерева}
tNode=record {Звено дерева}
Name: string; {Имя человека}
Son:Ref;{Указатель на звено потомка}
Next: Ref;{Указатель на следующее звено этого уровня-брата}
Owner:Ref {Указатель на предка}
End;
Указатель Son ссылается на звено первого сына, Next ссылается на следующего брата. Например, у А два сына (В и С), указатель Son ссылается на звено сына В, а его указатель Next – на звено сына С. При такой структуре данных – количество сыновей у А неограниченно.

Function SeekX(p: Ref):ref;
Var f: Ref;
Begin
If (p=Nil) or (p^.Name=x)
{Если дошли до конца дерева или нашли }
Then SeekX:=p
{ нужного человека, то возвращаем указатель на него}
Else begin
{Поищем среди сыновей и братьев}
f:= SeekX(p^.Son); {перебираем сыновей}
if f=nil then f:= SeekX(p^.Next);
{перебираем братьев}
SeekX:=f
End
End;
Рассмотрим функцию поиска человека Х в таком дереве. Так как ее удобнее реализовать рекурсивно, то будем считать, что искомое имя Х является глобальной переменной. Функции необходимо передается указатель на вход в дерево.
Пусть мы хотим найти человека F. Встаем на корень дерева.
F
‘A’=‘F’?Нет!
Ищем среди сыновей
‘B’=‘F’?Нет!
Ищем среди сыновей
‘D’=‘F’?Нет!
Сыновей нет, ищем среди братьев
Затем сравниваем ‘F’ с ‘G’ и ‘E’
Нашли!

Преобразование дерева в строку
Как известно, в информатике широкое распространение получили древовидные структуры данных. Они служат для описания иерархических конструкций, в которых последующий уровень узлов подчинен предыдущему. Деревом называется совокупность узлов (вершин) и дуг, на которые накладываются следующие ограничения:
узлы соединяются ориентированными дугами, то есть между ними устанавливаются родственные отношения (отец->сын);
все узлы (кроме корня) имеют только одного отца, сыновей может быть сколько угодно, в том числе и ноль;
существует единственный узел, который не имеет отца – корень дерева.
Существует несколько способов описания дерева, наиболее распространенный – в виде графа. «Графовым» представлением назовем такое представление графа, которое организуется в виде связного динамического списка вершин. Такой способ представления удобен для обхода графа, но не всегда удобен для хранения дерева, например, в файле. В этих случаях применяют описание дерева с использованием скобок (скобочное). Для нашего примера скобочное описание дерева будет выглядеть так: A(B(E(),F(),D()),C()). Сначала следует название узла, являющегося корнем некоторого поддерева, затем в скобках, через запятую, перечисляются структуры, описывающие узлы-потомки данной вершины. Эти структуры имеют аналогичное строение. Если у вершины нет потомков, то после ее имени стоят пустые скобки.
Задание:
а) опишите структуры данных на языке Паскаль, позволяющие представить дерево в «графовом» и «скобочном» виде; (2 балла)
б) опишите подпрограмму, которая по имеющемуся дереву в виде графа (связного списка) построит его «скобочное» представление (5 баллов);
в) опишите подпрограмму, которая по имеющемуся скобочному представлению дерева построит его «графовое» представление (в виде списка) (7 баллов);

Переведем дерево в строковое представление:
Procedure TreeToStr(R:ref);
Var i:integer;
t:Ref;
begin
if R=nil {если поддерево пустое}
then s:=s+'()' {то добавим пустые скобки}
else begin {если поддерево не пустое}
s:=s+r^.key+'('; {вначале добавим ‘(’}
t:=r^.S; {встаем на сына}
While t<>nil do
begin {бежим по «братьям»пока они есть}
TreeToStr(t); {каждого «брата» преобразуем}
t:=t^.N; {в строковый вид и переходим}
if t<> nil {к следующему}
then s:=s+','; {не забудем поставить ‘,’}
end;
s:=s+')'; {а также скобку}
end;
end;
S=
S=A(
Рекурсивный вызов!
S=A(B(
Рекурсивный вызов!
S=A(B(E,
S=A(B(E,F,
S=A(B(E,F,D
S=A(B(E,F,D)
Рекурсивный возврат!
S=A(B(E,F,D),С())

Procedure StrToTree(Var R:ref;Var k:integer);
Var i:integer; t:Ref;
begin
if k then begin
New(r);r^.n:=nil; {создаем новый узел - корень}
r^.key:=s[k]; {запоминаем его значение}
k:=k+2; {смещаемся на 2: название и скобку}
if s[k]=')' {если скобки пустые, то поддерева нет}
then r^.S:=nil {сыновей нет}
else begin {поддерево все же есть}
StrToTree(r^.s,k); {разбираем его на части}
t:=r^.s; {встаем на первого «сына»}
While s[k+1]=',' do{пока «сыновья не закончились»}
begin
k:=k+2; {вырезаем их из строки и прицепляем}
StrToTree(t^.N,k); {к дереву}
t:=t^.n;
end;
inc(k)
end
end;
end;
S=‘A(B(E,F,D),С())’
К
Рекурсивный вызов!
Рекурсивный вызов!
Рекурсивный возврат!

Цепочки ДНК
Как известно каждому первоклашке, ДНК – это дезоксирибонуклеиновая кислота – носитель генетического кода. Именно она определяет, кем мы будем – Белым кроликом, Болванщиком или Алисой. ДНК представляет собой очень длинную цепочку, состоящую из 4 повторяющихся кирпичиков - аминокислот А, Г, Т, Ц (аденин, гуанин, тимин и цитозин). У близких родственников эти цепочки частично совпадают. По приказу ЧК в Зазеркалье проводится всеобщее медицинское обследование. У каждого жителя будет взята ДНК и сохранена в памяти ноутбука Черной Королевы. Это необходимо для быстрого определения нелегальных эмигрантов, работающих на восстановлении катакомб. Так как места на диске ноутбука очень мало, то необходимо минимизировать размер, хранимых структур.
Задание:
разработайте структуру данных для эффективного хранения цепочек ДНК;
опишите эффективный по времени алгоритм, позволяющий определить, есть ли в базе данная цепочка ДНК.

Данная задача требует от школьника знаний сложных структур данных, а именно – нагруженных деревьев или дерева 4-ой степени. Каждый узел такого дерева будет хранить четыре указателя, каждый – будет представлять собой одну из 4-х аминокислот (А, Г, Т, Ц).
Данное дерево представило следующие цепочки ДНК: АЦА, АЦЦ, ЦТТ, ЦЦТ. Каждая из них – это путь в дереве. Если пути нет, то в узле хранится пустая ссылка nil.
Теперь рассмотрим подпрограмму, которая определит, принадлежит ли цепочка ДНК нашему дереву. Цепочку ДНК будем хранить в строке. Воспользуемся функцией Conv, которая будет преобразовывать букву ‘A’ в код 1, букву ‘Г’ в код 2 и так далее..
Структура данных:
Const A=1;G=2;T=3;C=4;
Type Ref=^Node;
mass=array[A..C]of Ref;
Node=record
Next:mass
End;
Var Root:Ref;

Function Conv(c:char):integer;
Begin
Case c of
‘A’: Conv:=1;
‘Г’: Conv:=2;
‘Т’: Conv:=3;
‘Ц’: Conv:=4;
End;
End;
Function Seek(Root:Ref;s:string):boolean;
Var i:integer; p:ref;
Begin
{встаем на начало дерева и строки}
P:=Root;i:=1;
While (p<>nil)and(i
begin;{двигаемся по дереву, используя коды ДНК,как индексы массива}
P:=p^.Next[Conv(s[i])];
{сдвигаемся к следующему звену}
Inc(i) ;{и следующему коду ДНК}
End;
Seek:=p<>nil
End;
S=‘ЦТТ’
Встаем на корень дерева и начало строки S.
Выделяем первый символ цепочки ДНК – это символ Ц, если P^.Next[Ц]<>nil, то сдвигаемся к следующему звену
S=‘ЦТТ’
Выделяем второй символ цепочки ДНК – это символ Т, если P^.Next[Т]<>nil, то сдвигаемся к следующему звену
S=‘ЦТТ’
Аналогично действуем с третьим символом цепочки ДНК –Т, если P^.Next[Т]<>nil, то сдвигаемся к следующему звену, если следующего звена нет, то цепочка ДНК не принадлежит базе
Если строка S закончилась и мы не столкнулись с пустой ссылкой nil, то цепочка принадлежит базе.
S=‘ЦТТ’

Хранение деревьев в массиве
Можно было бы сопоставить вершины полного двоичного дерева с числами 1, 2, 3,... (считая, что левый сын вершины (n) = 2n, правый сын вершины (n) = 2n + 1) и хранить значения вершин в массиве val [1...]. Однако этот способ неэффективен, поскольку тратится место на хранение пустых вакансий в полном двоичном дереве.

Дерево поиска в массиве
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
Function Seek(r:ref;key:integer):ref;
Begin
if (r=nil)or(r^.key=key)
then Seek:=r
else If key
then Seek:=Seek(r^.Left,key)
else Seek:=Seek(r^.Left,key)
End;
key
5
i
1
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
2
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
4
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
9
Function Seek( i, key:integer):integer;
Begin
if (val[i]=0)or(Val[i]=key)
then Seek:=i
else If key
then Seek:=Seek(i*2,key)
else Seek:=Seek(i*2+1,key)
End;
Недостатки:
Неэффективно по памяти для несбалансированных деревьев;
Нельзя хранить в дереве число 0

Хранение дерева в массиве с указанием индексов вершин
Type Node=Record
val: тип вершин; left, right: 0..n;
end;
Mass=Array[0..N] of Node;
Var m:Mass;
(n - максимальное возможное число вершин дерева) и переменную root: 0..n. Каждая вершина хранимого дерева будет иметь номер - число от 1 до n, значение i-ой вершины равно m[i].val. Корень имеет номер root. Если вершина с номером i имеет сыновей, то их номера равны m[i].left и m[i].right. Отсутствующим сыновьям соответствует число 0. Аналогичным образом значение root = 0 соответствует пустому дереву.

Хранение дерева в массиве с указанием индексов вершин
Для хранения дерева используется лишь часть массива; для тех i, которые свободны - т.е. не являются номерами вершин - значения m[i].val безразличны. Нам будет удобно, чтобы все свободные числа были "связаны в список". Первое хранится в специальное переменной free: 0..n, а следующее за i свободное число хранится в m[i].right, так что свободны числа free, m[Free]. right, m[m[free]. right]. right,... Для последнего свободного числа i значение m[i]. right = 0. Равенство free = 0 означает, что свободных чисел больше нет. Вместо значения 0 (обозначающего отсутствие вершины) можно было бы воспользоваться любым другим числом вне 1..n, например, будем вместо 0 использовать константу null = 0.

Дерево поиска в массиве
Function Seek( root, key:integer):integer;
begin
If root= Null then Seek:=Null
else Begin
x:= root; f:=false;
repeat
If key = m[x].Val then f:=true
else If key
then x:=m[x].Left
else x:=m[x].Right
until f or (x=null)
Seek:=x
End;
End;
Определить, содержится ли элемент t в дереве поиска
Left
Right
Root
1
Free
8
Можно ли ускорить решение?

Дерево поиска в массиве
Function Seek( root, key:integer):integer;
begin
m[null].val := key; While key <> m[root].val do
If key < m[root]. val then root:=m[root].left
else x:=m[root].right;
if (root <> null) then Seek:=root else Seek:=Null
End;
Определить, содержится ли элемент t в дереве поиска
Left
Right
Root
1
Key
5
Function Seek( root, key:integer):integer;
begin
m[null].val := key;
While key <> m[root].val do
If key < m[root]. val then root:=m[root].left
else x:=m[root].right;
if (root <> null) then Seek:=root else Seek:=Null
End;
Function Seek( root, key:integer):integer;
begin
m[null].val := key;
While key <> m[root].val do
If key < m[root]. val then root:=m[root].left
else x:=m[root].right;
if (root <> null) then Seek:=root else Seek:=Null
End;
Free
8
2
4
Function Seek( root, key:integer):integer;
begin
m[null].val := key;
While key <> m[root].val do
If key < m[root]. val then root:=m[root].left
else x:=m[root].right;
if (root <> null) then Seek:=root else Seek:=Null
End;
7

Рассмотрим программу добавления элемента t во множество, представленное упорядоченным деревом (если элемент t уже есть, ничего делать не надо). Определим функцию get_free (var i: integer), дающую номер свободной ячейки i (не являющееся узлом дерева) и соответствующим образом корректирующую список свободных ячеек.
function get_free : integer;
Begin get_free:= free; free := m[free].right;
End;
Procedure Add(var root:integer; t:тип);
Begin
If root = null {Дерево пустое?}
then Begin
root:=get_free ; m[root].left:=null;
m[root].right := null; m[root]. val := t;
End
else If t< m[root]. Val then Add(m[root]. left, t)
else If t > m[root].Val then Add(m[root]. right, t)
End;
Left
Right
Free
8

Корневые деревья (root tree)
Дерево – это структура, отображающая иерархический порядок, заданный на множестве узлов (или вершин). У каждого узла может быть не более одного предка.
Как и списки, мы будем формировать деревья используя обычные массивы. Данные мы будем хранить в массиве Items[], остальные массивы будут разниться в зависимости от видов деревьев.
Как известно, основными компонентами дерева являются узлы (Node). Пронумеруем эти узлы последовательными положительными числами от 1 до n. Корневое дерево сопоставляет каждому (кроме корневого), узлу предка. Иначе говоря, у каждого узла есть ссылка на предка. Ссылка показывает, какому узлу данный узел подчинен. Единственным узлом, который предка не имеет является корень дерева – у него ссылка на предка будет иметь значение NIL. На рисунке ниже ссылки показаны стрелками.

Для представления корневого дерева достаточно каждому узлу сопоставить одно число – номер его предка. Этот номер и будет ссылкой. Ссылку будем помещать в массив Parent[].
Для корневого дерева опишем следующие операции и свойства:
Перед началом работы предполагается, что Count = 0. Инициализация дерева очень проста – создается пустое дерево, то есть корень дерева объявляется как NIL.
RTree.Init()
begin
Root ← NIL;
end

Добавление наследника для указанного узла P сводится к назначению узла P предком нового узла. Отдельно нужно отслеживать попытки добавления корня (в этом случае в качестве узла P указывается NIL).
RTree.AddChild(P, Item)
begin {Проверим не вышли ли за границы}
if (P < 0) or (P > Count)
then ◊ Не сущесвует указанного предка;
{Проверим, не идет ли добавление корня}
if (P = NIL) and (Root ≠ NIL)
then ◊ Один корень уже есть;
{Добавляем элемент}
New ← Count ← Count + 1;
Items[New] ← Item;
Parent[New] ← P;
{Проверим, не корень ли}
if P = NIL
then Root ← P;
return (New);
end
Оценка алгоритма O(1).

Расчет уровней вершин
Это один из алгоритмов, основанных на раскрашивании. Расстояние от корня до вершины также называется уровнем вершины. Когда две вершины лежат на одинаковом расстоянии от корня, говорят, что они лежат на одном уровне. Уровень вершины с номером i обозначим как level(i). Если вершина p является предком для вершины i, то выполняется соотношение Разделим узлы на два типа – белые, для которых расстояние от корня точно определено, и серые – расстояния до которых находится в процессе уточнения. Первоначально окрасим все вершины в серый цвет. Корень окрасим в белый цвет и присвоим ему расстояние 0. Возьмем произвольную вершину. Если ее предок имеет белый цвет, то расстояние определяется как расстояние до предка плюс 1. Если предок имеет серый цвет, то рекурсивно применим эти рассуждения к нему, и получим расстояние до него. Процесс на рисунке.

Оформим это в виде алгоритма. Уровни вершин будем хранить в массиве Level[].
RTree.ForceLevel(I)
begin {Предполагаем, что I – узел, и у него есть предок P}
P ← Parent[I];
{Проверим цвет предка}
if Color[P] = GRAY
then Result ← RTree.ForceLevel(P) + 1
else Result ← Level[P] + 1;
{Окрасим вершину в белый цвет}
Color[I] ← WHITE; Level[I] ← Result;
{Вернем уровень текущей вершины}
return (Result);
end
Этот алгоритм перебирает каждую вершину не более 1 раза – и сразу ее перекрашивает. Теперь построим алгоритм целиком. Для удобства напишем алгоритм окрашивания всех вершин в одинаковый цвет, так как эта операция будет встречаться очень часто. Так как операция будет производиться не только над корневыми деревьями, то опишем ее наиболее обще.
PaintAll(Struc, NewColor)
begin
for I ← 1 to Struc.Count do
Struc.Color[I] ← NewColor;
end
Этот алгоритм работает за O(n), где n = Struc.Count.

Вспомогательные алгоритмы готовы, теперь построим сам алгоритм.
RTree.BuildLevel();
begin
{Красим все вершины в серый цвет}
PaintAll(RTree, GRAY);
Level[Root] ← 0;
Color[Root] ← WHITE;
{Запускаем алгоритм}
for I ← 1 to Count do
if (I ≠ Root) and (Color[I] = GRAY)
then ForceLevel(I);
end
Если вызвать этот алгоритм для каждой вершины, то он обработает все вершины за время O(n), где n – количество вершин в дереве. Это заключение основывается на том, что каждая вершина ровно один раз перекрашивается из серого цвета в белый.
В алгоритме, в принципе, можно обойтись вообще без раскраски, используя в качестве признака «серой» вершины i специальное значение Level[i], например –1, но мы оставим алгоритм в таком виде для сохранения большей общности используемых методов.

Нахождение корня и сжатие путей
Весьма часто работа производится не с одним корневым деревом, а с несколькими. В этом случае говорят о лесе корневых деревьев. Такие леса возникают при использовании корневых деревьев для представления непересекающихся множеств или при использовании алгоритмов обхода графов. В таких лесах часто ставится задача нахождения корня дерева, которому принадлежит данный узел. Алгоритм нахождения предка для указанного узла прост:
RTree.RootOfNode(I)
begin
{Предполагаем, что I – номер узла, для которого ищем корень}
while Parent[I] ≠ NIL do
I ← Parent[I];
return (I);
end
Очевидно, что в худшем случае (дерево «вытянуто» в одну сторону) алгоритм работает за O(n), где n – число узлов в дереве. При вызове данного алгоритма m раз имеет сложность O(m * n). Допустим, что исходное дерево нам можно модифицировать по своему усмотрению. Можно ли оптимизировать алгоритм, чтобы улучшить оценку нескольких (m) поисков? Можно, если использовать специальную эвристику, называемую сжатием путей. Суть эвристики в том, что каждый узел, для которого ищется корень, делается потомком самого корня. При этом, конечно, изменяется структура дерева, но если мы только ищем корни, то она нам и не важна. В крайнем случае, можно сделать копию дерева.

RTree.RootOfNodeComp(I)
begin
{Предполагаем, что I – номер узла, для которого ищем корень}
if Parent[I] ≠ NIL
then begin
{Находим корень предка}
I ← RootOfNodeComp(Parent[I]);
{сжимаем путь до корня}
Parent[I] ← I;
end;
return (I);
end
В худшем случае, процедура со сжатием также работает за O(n). Для оценки m запросов с использованием сжатия используем раскраску. Будем оценивать алгоритм количеством рекурсивных вызовов RTree.RootOfNodeComp().

Покрасим все вершины, у которых предок не корень, в серый цвет, остальные – в белый. Серых вершин будет не больше n. На каждом шаге рекурсивного поиска для серой вершины, она будет превращаться в белую, следовательно, для перекраски всех серых вершин понадобиться не более n рекурсивных вызовов. Обработка любой белой вершины займет не более 2-х рекурсивных вызовов (на втором шаге находим предка). Таким образом, m определений корня потребует не более 2m + n рекурсивных вызовов. Оценка
алгоритма также будет O(n+m).

Упаковка двоичного дерева в массив
Двоичное дерево можно упаковать в массив. Для этого используется следующий прием. Пусть текущий узел помещен в ячейку массива с индексом i, тогда его левый потомок помещается в ячейку с номером 2i (Left(i) = 2i), а правый потомок в ячейку с номером 2i+1 (Right(i) = 2i+1). Предок может быть определен как i div 2 (Parent(i) = i div 2). Корнем дерева будет элемент с индексом 1. Такое размещение является плотным, т.е. не пропускает ни одной ячейки массива. Более наглядно это можно продемонстрировать с помощью таблицы
При таком представлении дерева требуется специальный символ, который будет обозначать пустой элемент. Обозначим пустой элемент как λ. Пример упаковки дерева в массив показан на рисунке.

Счетчик Count поддерживать не обязательно, но бывает весьма удобно. Инициализация заключается в простом заполнении всех элементов массива пустым значением λ и обнулением счетчика элементов.
ArrTree.Init()
begin
Count ← 0; {Заполняем весь массив пустыми элементами}
for I ← 1 to … do
Items[I] ← λ;
end
Добавление левого потомка выполняется простым вычислением индекса нового узла и заполнением вычисленной ячейки добавляемым значением:
ArrTree.AddLeft(Item, P)
begin
{Item–элемент, P–предок узла, если P = 0 – добавляем корень. Проверяем не корень ли}
if P = 0 then L ← 1
else L ← 2 * P; {Левый потомок}
Items[L] ← Item;
{Поддерживаем Count в актуальном состоянии}
Count ← max(Count, L);
{Обнуляем потомки узла, если нужно}
Items[L * 2] ← Items[L * 2 + 1] ← λ;
end

Добавление правого потомка абсолютно симметрично:
ArrTree.AddRight(Item, P)
begin
{Item–элемент, P–предок узла, если P = 0 – добавляем корень}
{Проверяем не корень ли}
if P = 0 then R ← 1
else R ← 2 * P + 1;
Items[R] ← Item;
{Поддерживаем Count в актуальном состоянии}
Count ← max(Count, R);
{Обнуляем потомки узла, если нужно}
Items[R * 2] ← Items[R * 2 + 1] ← λ;
end
Удаление узла производится простой заменой значения на пустое (λ).
ArrTree.Delete(I)
begin
{I – удаляемый узел}
Items[I] ← λ;
{Модифицируем счетчик Count, если нужно}
while (Count > 0) and (Items[Count] = λ) do
Count ← Count – 1;
end

Счетчик Count поддерживается только для удобства.
Переходы к предку, левому и правому потомкам выглядят как простые математические операции (с проверкой ячеек на пустоту):
ArrTree.Left(I)
{I – текущий узел}
L ← I * 2; {Левый потомок}
{Проверяем, существует ли узел}
if (L > Count) or (Items[L] = λ)
then return (NIL)
else return (L);
end
ArrTree.Right(I)
R ← I * 2 + 1; {Правый потомок}
{Проверяем, существует ли узел}
if (R > Count) or (Items[R] = λ)
then return (NIL)
else return (R);
end

ArrTree.Parent(I)
{Предок получается для всех кроме корня}
if I > 1
then begin
P ← I div 2; {Есть предок}
{Существует ли предок?}
if Items[P] = λ
then return (NIL) {Нет предка}
else return (P);
end else return (NIL);{Нет предка}
end
При такой реализации возможны ситуации, когда предок оказывается пустым λ – этот случай учитывается в алгоритме.
Если не поддерживать счетчик Count, то все алгоритмы будут работать за O(1). Если счетчик Count поддерживать, то за O(n) будет работать операция удаления, остальные – также за O(1).
Такие деревья просты в реализации, но очень расточительны по памяти – для того, чтобы реализовать любое по количеству элементов дерево с высотой h потребуется массив с 2h–1 ячейками. Если мы гарантируем, что дерево компактное, т.е. количество узлов в дереве не намного меньше значения 2h–1, то такое дерево имеет смысл реализовывать на массиве, в противном случае – нет.

Вычисление уровня (расстояния до корня)
Обозначим уровень вершины i как Level[i]. Как уже описывалось в разделе про корневые деревья, уровень потомка на единицу больше уровня предка, т.е. Level[i] = Level[Parent[i]]. Так как функция зависит только от предка, то можно использовать либо pred-нумерацию, либо «широкую» нумерацию. Будем использовать pred-нумерацию. Естественно, что нумеровать вершины, а затем сортировать их в порядке номеров не эффективно. Обычно, использование какой-либо нумерации сводится к тому, что обработка вершины помещается в то место алгоритма, где стояла бы нумерация вершины. В нашем случае – перед обработкой потомков.
TreeLevel(Node)
begin
{При первом вызове Node = Tree.Root}
if Node = NIL {У пустой вершины нет уровня}
then return ();
{Уровень корня определяем как 0}
if Parent[Node] = NIL
then Level[Node] ← 0
else Level[Node] ← Level[Parent[Node]] + 1;
{Обрабатываем детей}
TreeLevel(Left[Node]);
TreeLevel(Right[Node]);
end
Алгоритм можно значительно упростить, если в массив Level[] добавить дополнительную ячейку для индекса NIL и положить Level[NIL] = –1

Поиск элемента в дереве
Алгоритм поиска в дереве может быть реализован с помощью обхода в глубину. Единственная модификация которая потребуется – возможность остановки поиска после того, как элемент был найден.
TreeSearch(Node, X)
begin
{При первом вызове Node = Tree.Root}
if Node = NIL {Проверяем существование}
then return (NIL);
{Сравниваем зачение вершины с искомым элементом}
if Items[Node] = X
then return (Node);
{Ищем в левом поддереве}
Temp ← TreeSearch(Left[Node], X);
{Если не нашли в левом поддереве, то нужно искать в правом}
if Temp = NIL then Temp ← TreeSearch(Right[Node], X);
return (Temp); {Возвращаем результат}
end
Этот алгоритм в худшем случае (искомого элемента в дереве нет) обходит все вершины, и имеет сложность O(n). В случае успеха алгоритм вернет нам вершину с искомым значением, в противном случае – вернет NIL.

Если нам потребуется отыскать самую близкую к корню (с минимальным уровнем) вершину равную данной, то логичнее всего использовать обход дерева в ширину. Конечно никто не запрещает проставить уровни у всех вершин, а затем обойти их обходом в глубину и выбрать среди найденных вершину с минимальным уровнем. Полученный алгоритм будет работоспособным, но излишне сложным – лучше использовать тот метод обхода у которого разбиение на уровни является естественным свойством.
TreeBreadthSearchMin(Tree, X)
begin {Подготавливаем очередь, и заносим в нее корень дерева}
Queue.Init;
if Tree.Root ≠ NIL then Queue.Insert(Tree.Root);
{Обработка идет пока в очереди есть элементы и не нашли}
Result ← NIL;
while (not Queue.Empty)) and (Result = NIL) do begin
{Извлекаем элемент} I ← Queue.Extract;
{Сравниваем с искомым}
if Items[I] = X then Result ← I;
{Помещаем в очередь потомков}
if Left[I] ≠ NIL then Queue.Insert(Left[I]);
if Right[I] ≠ NIL then Queue.Insert(Right[I]);
end;
return (Result);
end
Сложность алгоритма остается O(n).

Высота дерева
Высотой дерева называется расстояние от корня дерева до самой удаленной вершины. Иначе говоря, высота дерева есть максимальный уровень вершины этого дерева. Составим алгоритм определения высоты дерева. Во-первых, заметим, что высота вершины h(i) есть максимум из высот его потомков, плюс единица (сама вершина). На этой основе можно записать функцию высоты: h(i) = h(Left[i]) + h(Right[i]) + 1. Высота листа определяется как нуль. Так как функция зависит от параметров потомков, то вычислять ее нужно в порядке post-нумерации. Высоты вершин будем хранить в массиве H[]. Как и в предыдущем разделе определим H[NIL] = –1 – это позволит упростить алгоритм.
TreeH(Node)
begin
{При первом вызове Node = Tree.Root}
if Node = NIL {Несуществующая вершина}
then return ();
{Обрабатываем потомков}
TreeH(Left[Node]);
TreeH(Right[Node]);
{Вычисляем высоту}
H[Node] ← max(H[Left[Node]], H[Right[Node]]) + 1;
end
Естественно, что сложность алгоритма O(n).

Наибольший общий предок
Нахождение наибольшего общего предка достаточно часто встречается на практике и для нее разработан ряд эффективных алгоритмов. В зарубежной литературе эта задача известна под названием Least Common Ancestor (LCA). Так как к задаче существует несколько подходов, мы будем рассматривать все из них.
В этом разделе будет использоваться несколько отличные понятия предка и потомка. Предком вершины i в дереве называется вершина k, пройдя через которую, можно от корня дерева достигнуть вершины i, переходя только по связям дерева. Будем обозначать то факт, что k является предком i как k → i. Для простоты будем считать, что вершина является своим собственным предком: i → i.
Если посмотреть на свойства отношения «является предком» (→), то можно заметить, что оно:
1. Рефлексивно: a → a.
2. Транзитивно: если a → b и b → c, то a → c.
3. Антисимметрично: если верно, что a → b, то не верно, что b → a.
4. Определено не для все пар a, b.
Из этого следует, что отношение «является предком» есть отношение частичного порядка, определенное на множестве вершин дерева. Вершина i является потомком k, если k – предок i: k → i. Пусть нам дано произвольное дерево. Наибольшим общим предком двух вершин i и j называется такая вершина k, которая является предком и i и j: k → i, k → j; и не существует вершины, которая являлась бы одновременно предком i и j и потомком k.

Простой алгоритм
Алгоритм использует простую предобработку – вычисление уровней дерева. Идея заключается в синхронном подъеме по дереву двух индексов, до тех пор, пока он не достигнут одной и той же вершины. Если изначально индексы указывают на вершины разных уровней, то тот который находится дальше от корня, подтягивается до уровня второго индекса. Этот процесс заключается на том простом умозаключении, что общий предок не может лежать на уровне, большем, чем уровень любого из потомков. Рассмотрим пример, приведенный на рисунке.
Нам нужно найти общего предка для вершин 12 и 6. Так как вершина 6 лежит на уровне 2, то общий предок не может иметь уровень больший двух. В связи с этим, из вершины 12 мы поднимаемся в вершину 5 (пунктирные стрелки), также имеющую уровень 2. Получаем пару вершин (5, 6) Далее, мы совершаем два синхронных подъема вверх: сначала получаем пару (2, 3), затем (1, 1). Так как в последней паре вершины совпадают, то вершина 1 является наибольшим общим предком для вершин 12 и 6 (а также и для всех промежуточных пар).

LCATreeSimple(I, J)
begin {Поднимаем более низкий до уровня более высокого}
{Предполагаем, что Level[NIL] = -1}
while Level[I] > Level[J] do
I ← Parent[I];
while Level[I] < Level[J] do
J ← Parent[J];
{Синхронные шаги}
while I ≠ J do begin
I ← Parent[I];
J ← Parent[J];
end;
return (I);
end
Заметим, что даже в случае, если вершины i и j не имеют общего предка, то алгоритм будет работать правильно: i и j дойдут до значения NIL, совпадут, и значение NIL будет выдано в качестве индикатора того, что у вершин вообще нет общих предков.
Число шагов алгоритма не превысит максимального значения уровня вершины, а максимальный уровень равен высоте дерева h. Сложность алгоритма будет
. Первая оценка указывается для предварительной обработки – в нашем случае построения массива уровней, вторая оценка – собственно оценка операции.

Алгоритм для двоичных деревьев
Этот алгоритм требует времени обработки O(n), и позволяет вычислять общих предков за O(1).
Этот алгоритм основан на специальной нумерации вершин. Пусть у нас есть двоичное дерево высоты h (высоту дерева можно вычислить за O(n)). Будем нумеровать вершины двоичными числами из h+1 бита. Номер вершины определяется путем, который пройден от корня до вершины. Строим номер следующим образом:
1. Начинаем с пустого номера
2. Если идем влево, то приписываем справа к номеру нуль
3. Если идем вправо, то приписываем слева к номеру единицу
После того, как мы пронумеровали таким образом все вершины, нужно дополнить до h+1 бита (по биту на каждый уровень дерева). Дополнение производится так: дописывается одна единица, а остаток дополняется нулями. Пример такой нумерации показан на рисунке. Подчеркнуты дополнительные биты.

Заметим, что такая нумерация позволяет для двух вершин i и j и вычислить их набольшего общего предка исходя только из полученных номеров. Пусть нам нужно найти общего предка вершин 9 и 14. Эти вершины имеют двоичные коды 1001 и 1110.
Возьмем общий префикс этих кодов (он подчеркнут). Таким префиксом будет 1. Далее, используем наше правило дополнения, и получим код вершины 1100. Это вершина 12 – она и будет общим предком для вершин 9 и 14.
Для вершин 5 и 7 (0101 и 0111) общий префикс будет 01. После дополнения получаем код 0110, что соответствует вершине 6.
Заметим, что для полного двоичного дерева такая нумерация является просто in-нумерацией. Если же дерево не является полным, то приводимая нумерация не будет сплошной.
Фактически, мы «подогнали» под наши нужды некоторую нумерацию, и используя конструкцию такой нумерации составили алгоритм. Нам даже не нужно доказывать что алгоритм верный, так как мы заранее строили нумерацию, которая обладает нужными нам свойствами.

Для начала нам потребуется алгоритм дополнения номера.
PaddTreeNum(CurNum, NumSize, H)
begin
{CurNum – текущий номер, NumSize – число битов в номере}
{H+1 – число необходимых битов}
{Добавляем единицу и дополняем нужным числом нулей}
return ((CurNum * 2 + 1) shl (H - NumSize));
end
Алгоритм нумерации дерева приводится ниже.
LCANumTreeRec(Node, CurNum, NumSize, H)
begin
{При первом вызове: Node – корень дерева, CurNum, NumSize = 0}
{H – высота дерева}
if Node ≠ NIL
then return ();
{Нумеруем вершину}
LCANum[Node] ← PaddTreeNum(CurNum, NumSize, H);
{Обрабатываем детей}
LCANumTreeRec(Node, CurNum * 2, NumSize + 1, H);
LCANumTreeRec(Node, CurNum * 2 + 1, NumSize + 1, H);
end
Алгоритм имеет очевидную сложность O(n).

Теперь нужно сформировать код предка, для этого воспользуемся двоичными операциями, в частности операцией xor. Это позволит нам превратить одинаковые биты префикса в нули, а первый отличающийся бит в единицу.
LCAByNum(I, J)
begin
{Получаем номера}
INum ← LCANum[I];
JNum ← LCANum[J];
{Формируем битовую маску}
Mask ← INum xor JNum;
{Сбрасываем биты правее первого отличающегося}
while (Mask and (Mask - 1) ≠ 0) do
Mask ← Mask and (Mask - 1);
{Теперь Mask – дополняющий код вида 0…010…0}
NotMask ← not (Mask – 1); {Маска 0…001…1}
{Теперь фомриуем код}
return ((INum and NotMask) or Mask);
end
Алгоритм имеет сложность O(1).

Обход вершин графа
Существует много алгоритмов, в которых необходимо последовательно перебрать все вершины графа, побывав в каждой только один раз. Существует два способа обхода вершин графа: поиск в ширину и поиск в глубину.
1) Поиск в глубину
Просматриваем некоторую вершину V0, от нее переходим к смежной вершине V1. Затем рассматриваем смежные с V1 вершины. У некоторой вершины Vn уже нет смежных не просмотренных вершин, тогда возвращаемся к вершине, из которой мы попали в Vn и рассматриваем другие смежные с ней вершины.
Для организации обхода графа нам потребуются два массива:
New:array[1..N] of boolean; элемент массива равен true, если вершина еще не просмотрена, False в противном случае.
Point:массив, хранящий список инцидентности вершин.
Point[i,0]-количество вершин, соединенных дугами с вершиной с номером i. Существуют следующие дуги:
,
,...

procedure PG(V:integer);
var i:integer;
Begin
обработать вершину V;
New[V]:=False;
For i:=1 to Point[V,0]do
Begin U:=Point[V,i]
If New[U]
then PG(U)
End
End;
Begin {Main}
FillChar(New,SizeOf(New),true)
{данный цикл необходим, если граф не связный}
For V:=1 to N do
If New[V] then PG(V)
End.
Данный пример показывает, как можно реализовать рекурсивный перебор вершин графа. Он имеет сложность порядка O(n+m).

2) Поиск в ширину.
При поиске в ширину, чем раньше посещается вершина, тем раньше она используется.
procedure PS(V:integer);
Begin
Очередь:=0; Очередь<=V; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;
New[u]:=false;
End
End
End
End;
Оба вида поиска в графе могут быть использованы для нахождения пути между фиксированными вершинами v и u. Преимуществом поиска в глубину является тот факт, что к моменту посещения вершины u в стеке будет содержаться последовательность вершин, определяющая путь из v в u, однако этот путь не будет кратчайшим. Поиск в ширину дает минимальный путь, если стоимость каждой дуги одинакова!

procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
1
2
3
4
5
6
7
8
9
10
11
12
13
0 1 2 3 4 5
P
1
Очередь
1
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
2
2 4
2 4 12
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
2
4 12
4
12
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
12 6
12 6 7
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
12
6 7
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
6 7 10
6 7 10 11
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
6
7 10 11
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
7 10 11 5
7 10 11 5 9
7 10 11 5 9 13
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;
7
10 11 5 9 13
10 11 5 9 13 3
procedure PS(p:integer);
Begin
Очередь:=0; Очередь<=p; New[V]:=False;
While Очередь не пуста do
Begin
P<=Очередь;
Обработать р;
For i:=1 to Point[P,0]do
Begin
u:=Point[p,i];
If New[u]
then Begin
Очередь<=u;New[u]:=false;
End
End
End
End;

Построение каркаса или остова
Деревом называется произвольный неориентированный связный граф без циклов. Для произвольного графа G=
, где V-множество вершин, Е-множество ребер, каркасом будем называть подграф
, Т является частью E. Все ребра, входящие в Т будем называть ветвями, а все не входящие хордами. Алгоритм нахождения каркаса связного графа методом поиска в глубину.
procedure WGD(v:integer);
Var i, u: integer;
Begin
New[v]:=false;
For i:=1 to Point[v,0] do Begin
u:=Point[v,i];
If New[u] then Begin
T:=T U {v,u}; {добавить в список Т новую ветвь {v,u}}
WGD(u)
End
End {for}
End;
Begin {main}
For i:=1 to N do
New[i]:=true;
T:=0; WGD(r); {r-произвольная вершина}
End.

Построение каркаса или остова
procedure WGD(v:integer);
Var i, u: integer;
Begin
New[v]:=false;
For i:=1 to Point[v,0] do Begin
u:=Point[v,i];
If New[u]
then Begin
inc(T[v,0]);T[v, T[v,0]]:=u;
inc(T[u,0]);T[u, T[u,0]]:=v;
WGD(u)
End
End {for}
End;
1
2
3
4
5
6
7
8
9
0 1 2 3 4 5

Алгоритм построения «минимального каркаса»:
For i:=1 to N do Begin
флаг[i]:=0; БЛИЖ[i]:=1
End;
флаг[1]:=1;
For k:=1 to N-1 do Begin
минрас:=∞;
For i:=2 to N do
If (флаг[i]=0) and (минрас > C[БЛИЖ[i],i])
Then Begin минрас:=C[БЛИЖ[i],i];
j:=i;
End;
Вывод ребра (БЛИЖ[j],j)
флаг[j]:=1;
For i:=2 to N do
If (флаг[i]=0) and (C[БЛИЖ[i],i]>C[i,j]) then БЛИЖ[i]:=j;
End; {For}

Производство
В некотором тридесятом государстве было N заводов, которые занимались производством ЕГО. Для работы заводы должны быть обеспечены компонентами двух типов: кислотой (тип А) и щелочью (тип В). Вначале для доставки компонентов производства на каждый из заводов использовались два типа труб: красные – для транспортировки кислоты и синие – для щелочи. Передача компонентов не по своему типу труб не допустима. Некоторое время спустя ученые тридесятого государства изобрели новый тип труб – зеленые, которые одновременно позволяли транспортировать компоненты обоих типов (возможно в противоположных направлениях). Между заводами трубы разветвлений не имеют, а компоненты производства могут передаваться по ним в любом направлении. Считается, что завод обеспечен компонентом данного типа, если он соединен, по крайне мере, с одним заводом, который уже обеспечен компонентом этого типа. Завод №1 имеет склад с неограниченным запасом компонентов обоих типов. Строительство системы трубопроводов велось хаотично, что привело к созданию сложной многократно дублированной системы (например, один завод мог получать кислоту сразу по нескольким красным и зеленым трубам). Премьер министр решил упростить систему снабжения заводов, сократив максимальное количество сегментов труб, не нарушая, при этом, снабжение каждого завода компонентами обоих типов. (Сегментом называется непрерывный участок трубы, соединяющей два завода)
Задание:
разработайте структуру данных для представления системы трубопроводов; (2 балла)
используя разработанную структуру данных, опишите алгоритм, который позволит удалить максимальное количество сегментов труб, не нарушая снабжение каждого завода.(8 баллов)

Для удаления лишних труб, не нарушая связи с источником, нужно построить каркас графа или его остов.
А) структура данных:
Type Node=record
Start,Finish:integer;1213456
End;
TDug=array[1..n] of Node;1213456
Var Green, Blue, Red: tDug;
Докажем, что данное решение оставляет минимальное количество труб. Возможно 3 варианта расположения труб:
К каждому заводу подходит как минимум одна зеленая труба. Использование зеленых труб предпочтительнее, так как требуется только одна труба, вместо двух. Тогда построив зеленый остов, мы получим минимальный набор труб, необходимый для снабжения заводов. Наличие любого зеленого цикла говорит о том, что существует два пути к некоторому заводу и один из них можно сократить.
Не к каждому заводу подходит зеленая труба. Это означает, что невозможно обеспечит снабжение заводов только по зеленым трубам, то есть придется использовать синие и красные. Очевидно, что использование зеленых эффективней, так как по одной зеленой можно передать то, что передают две: синяя и красная. Построим остов по зеленым дугам. Это приведет к появлению леса (набора «кустов»). Внутри каждого зеленого куста действует эффективная система передачи компонентов, то есть, если куст подключить к источнику, то все его заводы будут полностью обеспечены компонентами обоих типов. Рассмотрим отдельно подключение кислоты и щелочи. Для этого достраиваем остов по красным, а затем по синим трубам. Отсутствие цикла в каждом случае гарантирует отсутствие «лишних» труб. Причем для доказательства каждый «куст» можно рассматривать как одну вершину графа, в которую входят все дуги, входившие в вершины куста.
Нельзя построить остов. Но это невозможно, так как не понятно, как тогда ранее работали заводы.

Строим остовное дерево по зеленым трубам.
Алгоритм1:
1) Сделать остовное дерево пустым.
2) берем очередную зеленую дугу и включаем ее в дерево1213456
3) если образовался цикл, то исключаем ее из дерева
4) повторять с п. 2 пока не закончатся зеленые дуги или количество включенных в дерево дуг не станет равным N-1
5) Если количество дуг равно N-1,
6) то вывод решения
7) иначе begin
Запоминаем остовное зеленое дерево.
Выполняем Алгоритм2 и Алгоритм31213456
end;
Алгоритм2:
1) Достраиваем остовное дерево по красным трубам:
2) Берем очередную красную дугу, включаем ее в остовное дерево.
3) Если дуга образовала цикл с красными или зелеными дугами, то исключаем из остова.
4) Повторять с п. 2 пока количество дуг не будет N-1 или не закончатся красные дуги.
Алгоритм3:
1) Восстанавливаем дерево.
2) Повторяем предыдущий алгоритм для синих труб
3) Если остались необеспеченные вершины, то задача не имеет решения. (Смотри пункт 3 доказательства)

Исходный вариант трубопроводов между заводами.
Рассмотрим пока только зеленые трубы
Строим каркас по зеленым трубам. Вершины 1-2-3 образуют цикл – одна труба лишняя, удалим ее, например, 1-3
Достраиваем зеленый каркас синими трубами, добавляя их по очереди. Если образовался цикл, то удаляем данную трубу.
Цикл!
Цикл!
Цикл!
Цикл!
Цикл!
Достраиваем зеленый каркас красными трубами, добавляя их по очереди. Если образовался цикл с красными или зелеными, то удаляем данную трубу.
Цикл!
Цикл!
Результат готов!

Эйлеровы пути
Эйлеровым путем в графе называется путь, проходящий через каждое ребро графа только один раз. Замкнутый Эйлеров путь называется Эйлеров цикл.
ТЕОРЕМА Эйлеров путь в графе существует тогда и только тогда, когда граф связный и содержит не более чем две вершины нечетной степени.
Begin
стек:=0;СЕ:=0; {3}V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
End. Скорость работы алгоритма порядка O(m).
Эйлеров путь в графе (1,2,3,4,5,6,7,2,8,6,9,7,8,5,3,1).

стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
1
2
3
4
5
6
7
8
9
0 1 2 3 4 5
Стек
СЕ
V
1
1
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
U
2
1
2
2
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
3
3
2
1
3
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
4
4
4
3
2
1
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
стек:=0;СЕ:=0;
V:= произвольная вершина графа нечетной степени, если она есть;
Push(V);
While стек не пуст do Begin
V:=стек[top];{элемент остается в стеке}
If Point[V,0]<>0 {есть ребра в вершине V}
then Begin
U:=Point[V,1];{1-ая вершина в списке}
Push(U); {удалить U и V из списка}
Point[V]:=Point[V]/{U};
Point[U]:=Point[U]/{V};
V:=U
End
else Begin
V:=pop; CE<=V {поместить V в стек СЕ}
End
End;
5
5
4
3
2
1
5

Гамильтонов цикл
Гамильтоновым путем называется путь, проходящий через каждую вершину графа только один раз. Замкнутый Гамильтонов путь называется Гамильтоновым циклом. В отличие от Эйлеровых путей не известно ни одного необходимого или достаточного условия существования гамильтоновых путей. Не известен также алгоритм, который бы строил этот путь, используя число шагов O(n). Наш алгоритм основан на полном переборе всех вариантов и имеет скорость O(n!).
procedure Gamilt(k:integer);
Var i: integer;
Begin
For i:=1 to Point [x[k-1],0] do
Begin
y:=Point[x[k-1],i];
If (k=n+1)and(y=V0)
then обработать список <х[1],x[2],...,x[n], V0>
else If New[y]
then Begin
x[k]:=y; New[y]:=false; Gamilt(k+1); New[y]:=true
End
End {For}
End;
Begin {Main}
For i:=1 to N do New[i]:=true;
x[1]:=V0;{V0 произвольная вершина графа} New[V0]:=false;
Gamilt(2);
End.

Задача о коммивояжере
Имеется N городов, расстояния между которыми заданы. Коммивояжеру необходимо выйти из какого-то города, посетить остальные N-1 городов точно по одному разу и вернуться в исходный город. При этом маршрут коммивояжера должен быть минимальной длины (стоимости). Задача коммивояжера относится к классу NP-полных, то есть, не известны алгоритмы, скорость которых пропорциональна N. В задаче с N городами требуется рассмотреть (N-1)! вариантов маршрутов, а это не позволит решить задачу при больших значениях N.
Для ускорения работы необходимо как можно больше ограничить число вариантов.
Const Max=100;
Var a:array[1..Max,1..Max] of integer;{Матрица расстояний между городами}
Way,BestWay:array[1..Max] of byte; {текущий и лучший маршрут}
nNew:array[1..Max] of boolean; {значение элемента false говорит о том, что коммивояжер уже побывал в этом городе}
BestCost:longint;{стоимость лучшего маршрута}

Идея решения: Пусть мы находимся в городе с номером v. Наши действия: 1) Если расстояние (стоимость), пройденное коммивояжером до города v, больше либо равна стоимости найденного ранее наилучшего решения (BestCost), то следует выйти из данной ветви дерева перебора.
2) Если рассматривается последний город маршрута (осталось вернуться только в первый город), то следует сравнить стоимость нового решения со стоимостью лучшего решения. Если результат сравнения положительный, то новое решение следует запомнить в переменных BestCost и BestWay, выйти из ветви перебора.
3) Пометить город с номером v как рассмотренный, записать этот номер по индексу Count в массив Way.
4) Рассмотреть пути коммивояжера из города v в другие города, в которых еще не бывали. Если такие города еще есть, то рекурсивно вызваться с другим значением v, Count+1, Cost+стоимость от v до выбранного города, иначе на следующий шаг.
5) Пометить город v как не рассмотренный и выйти из данной ветви перебора.

procedure Rec(v,Count:byte;Cost:longint);
{v-номер текущего города, Count - счетчик количества пройденных
городов, Cost- стоимость текущего решения}
var i:integer;
Begin
If Cost<=BestCost {Стоимость текущего решения не больше лучшего}
then Begin
If Count=N {если город последний, то…}
then Begin
Cost:=Cost+A[v,1];Way[N]:=v;{Последний город пути}
If Cost
then Begin
BestCost:=Cost; BestWay:=Way
End
End
else Begin ;{Город v пройден, запомним его номер}
nNew[v]:=false;Way[Count]:=v {пометить и запомнить город}
For i:=1 to N do {перебираем все соседние непросмотренные города}
If nNew[i] then Rec(i,Count+1,Cost+A[v,i]);
nNew[v]:=true {возвращаем город v в число непройденных}
End
End
End;

procedure Rec(v,Count:byte;Cost:longint);
var i:integer;
Begin
If Cost<=BestCost then Begin
If Count=N
then Begin
Cost:=Cost+A[v,1];Way[N]:=v; If Cost
End
else Begin
nNew[v]:=false;Way[Count]:=v
For i:=1 to N do If nNew[i] then Rec(i,Count+1,Cost+A[v,i]);
nNew[v]:=true
End
End
End;
V=1,Cost=0
V=2,Cost=4
V=3,Cost=4
V=4,Cost=5
V=1,Cost=5
Вторая оценка
V=4,Cost=9
Второе отсечение
V=3,Cost=0
V=2,Cost=4
V=4,Cost=9
Первое отсечение
V=4,Cost=1
V=2,Cost=3
V=1,Cost=8
Первая оценка
V=4,Cost=9
Третье отсечение

Нахождение кратчайших путей в графе
Здесь мы будем рассматривать ориентированные графы G=
, дугам которых приписаны веса, то есть некоторое вещественное число a(u,v). Оно равно бесконечности (очень большому числу), если нет дуги, соединяющей вершины u и v. Длина пути из вершины v0 в vp (v0,v1,...vp) определяется как сумма весов всех ребер. Длину кратчайшего пути мы будем обозначать d(s,t) и называть расстоянием от s до t. Если не существует ни одного пути из s в t, то d(s,t)=бесконечности (∞).
Можно дать много практических интерпретаций задачи о кратчайших путях. Например, вершины могут соответствовать городам, а каждая дуга некоторому пути или стоимости пути. Достаточно отметить, что если для произвольных вершин s и t, известна минимальная стоимость пути, достаточно найти такую вершину v, что d(s,t)=d(s,v)+a(v,t) где v предпоследняя вершина произвольного кратчайшего пути из s в t. Далее мы можем найти вершину u, для которой d(s,v)=d(s,u)+a(u,v) и т.д.

Нахождение кратчайших путей от фиксированной вершины. Алгоритм Дейкстры
В данном алгоритме формируется множество вершин Т, для которых еще не вычислена оценка расстояния и минимальное значение в D. Как только мы попали в некоторую вершину v, это означает, что найден путь минимальной длины, так как любой другой путь содержит большее число ребер положительного веса и, следовательно, больше.
В списке D выбирается наименьшее значение, но только из числа еще не рассмотренных вершин (номер соответствующей вершины должен быть в списке Т) и пытаемся пересчитать стоимости путей до оставшихся в Т вершин, может через найденную вершину дешевле?
Вход: s- источник, А - матрица весов дуг.
Выход: D[v]=d(s,v) кратчайшие расстояния от вершины s до v.

Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s]; While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
1 2 3 4 5 6
D
D[v]:=min(D[v],D[u]+A[u,v])
1 2 3 4 5 6
1
2
3
4
5
6
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
D[i]=стоимость прямого пути из 1 вершины в i-ую (без заезда в другие города).
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Заведем множество Т, оно включает в себя все города, в которых мы еще не бывали.
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Пока еще есть города, в которых мы не были, просматриваем их и ищем такой город, до которого дешевле всего добраться
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Исключим этот город из рассмотрения
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Рассмотрим оставшиеся города, проверим, вдруг поездка через найденный город (2) дешевле, чем прямой путь?
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Снова ищем такой город (в котором не были), стоимость до которого самая маленькая. Так как стоимость не отрицательная, попасть в этот город дешевле нельзя
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Исключаем 4 город из рассмотрения (в нем мы уже побывали), пересчитываем стоимость пути до других городов, если дешевле, то запоминаем.
Begin {main}
For i:=1 to N do
D[i]:=A[s,i];
D[s]:=0;
T:=[1..N]-[s];
While T<>[ ] do
Begin
Min:=32000;
For i:=1 to N do
If (i in T) and (D[i]
Then begin
u:=i; Min:=D[i]
end;
T:=T-[u]
For v:=1 to N do
If v in T then
D[v]:=min(D[v],D[u]+A[u,v])
End; {While}
End.
Далее действуем аналогично, пока все нерассмотренные города не закончатся

Алгоритм восстановления кратчайшего пути по известным кратчайшим расстояниям
Вход: D массив минимальных расстояний от фиксированной вершины s до всех остальных вершин V.
t-фиксированная вершина,
А- матрица весов ребер.
Выход: Stack содержит последовательность вершин - кратчайший путь из s в t.
Begin {main}
Stack:=0; Push(t); v:=t;
While v<>s do
Begin
u:=вершина, для которой D[v]=D[u]+A[u,v];
Push(u); v:=u
End;
End.
Сложность нашего алгоритма O(n2). В случае неориентированного графа необходимо каждое ребро заменить двумя ребрами {u,v} и {v,u}, вес которых одинаков.

Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
1 2 3 4 5 6
D
1 2 3 4 5 6
1
2
3
4
5
6
Stack
V
5
U
Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
5
S
1
Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
Перебираем вершины, пока не дойдем до вершины старта S=1
Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
Определим, откуда мы пришли в вершину V, для этого переберем соседей, для нужного соседа должно выполняться равенство:
стоимость пути до вершины V равна стоимость до соседа U + стоимость прямого пути между U и V.
6
Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
Запоминаем найденную вершину в стек ответа, и перемещаемся в нее. Повторяем алгоритм для найденной вершины.
6
5 6
Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
Сейчас мы находимся в вершине 6, стоимость пути до нее = 5, ищем, откуда мы пришли:
D[u]+A[u,v]=D[v]
Это вершина 3
D[3]=4, 4+1=5=D[6]
Begin {main}
top:=0; Push(t); v:=t;
While v<>s do
Begin
for i:=1 to N do
if D[v]=D[i]+A[i,v]
then begin
u:=I; Push(u);
v:=u; break
end
End;
End.
Запоминаем ответ, смещаемся в найденную вершину.
3
3
5 6 3
Далее действуем аналогично
4
4
5 6 3 4
2
2
5 6 3 4 2
1
1
5 6 3 4 2 1

Кратчайшие пути между всеми парами вершин. Алгоритм Флойда
Для произвольных графов без контуров отрицательной длины и O(n3).
Вход: А - матрица весов дуг ориентированного графа.
Выход: D[i,j]=d(vi,vj)- расстояние между всеми парами вершин.
Begin
For i:=1 to N do
For j:=1 to n do
D[i,j]:=A[i,j];
For i:=1 to N do
D[i,i]:=0;
For m:=1 to N do
For i:=1 to N do
For j:=1 to N do
D[i,j]:= min(D[i,j],D[i,m]+D[m,j]);
End.
Сложность данного алгоритма O(n3).
Переберем все пары вершин (i,j), для каждой пары выберем такую вершину m, путь через которую дешевле, чем прямой путь между I и j без захода в m. В отличие от Дейкстры, алгоритм Флойда позволяет использовать отрицательную стоимость дуг, но должен отсутствовать цикл отрицательной суммарной стоимости

Топологическая сортировка
Топологическая сортировка. Представим себе n чиновников, каждый из которых выдает справки определенного вида. Мы хотим получить все эти справки, соблюдая ограничения, установленные чиновниками. Ограничения состоят в том, что у каждого чиновника есть список справок, которые нужно собрать перед обращением к нему. Дело безнадежно, если схема зависимостей имеет цикл (справку A нельзя получить без B, B без C,..., Y без Z и Z без A). Предполагая, что такого цикла нет, требуется составить план, указывающий один из возможных порядков получения справок.
Изображая чиновников точками, а зависимости - стрелками, приходим к такой формулировке. Имеется n вершин, пронумерованных от 1 до n. Из каждой вершины ведет несколько (возможно, 0) дуг в другие вершины. Циклов нет. Требуется перечислить вершины графа в таком порядке, чтобы конец любой стрелки предшествовал ее началу. Эта задача называется топологической сортировкой.
Из условия отсутствия циклов вытекает, что есть вершина, из которой вообще не выходит стрелок (иначе можно двигаться по стрелкам, пока не зациклимся). Ее будем считать первой. Выкидывая все стрелки, в нее ведущие, мы сводим задачу к графу с меньшим числом вершин и продолжаем рассуждение по индукции.
Наша программа будет печатать номера вершин. В массиве printed: array[1..n] of boolean мы будем хранить сведения о том, какие вершины напечатаны. Будем говорить, что напечатанная последовательность вершин корректна, если никакая вершина не напечатана дважды и для любого номера i, входящего в эту последовательность, все вершины, в которые ведут стрелки из i, напечатаны, и притом до i.

procedure add (i: integer);
Var j :integer;
Begin {вершина i еще не напечатана}
If not printed[i]
Then For j:=1 to Point[i,0] do
add(Point[i,j]);
{идем до конца ветки, т.е. до листа}
{все вершины, в которые из i ведут стрелки,
уже напечатаны - так что можно печатать i,
не нарушая корректности}
If not printed[i]
then Begin
writeln(i); printed [i]:= TRUE;
End;
End;
Основная программа:
For i:=1 to n do
printed[i]:= FALSE;
For i:=1 to n do
add(i)
Второй цикл необходим только в том случае, если существуют изолированные вершины или граф несвязный.
1
2
3
4
5
6
7
8
9
10
11
Результат
7
7 6
7 6 4
7 6 4 3
7 6 4 3 8
7 6 4 3 8 5
7 6 4 3 8 5 2
7 6 4 3 8 5 2 1
7 6 4 3 8 5 2 1 11
7 6 4 3 8 5 2 1 11 10
7 6 4 3 8 5 2 1 11 10 9

Очередь с приоритетом
Иногда необходимо работать с динамически изменяющимся множеством объектов, среди которых часто нужно находить объект с минимальным ключом. В этом случае может пригодиться структура данных, называемая “приоритетной очередью”. Более точно, приоритетная очередь – это структура, хранящая набор объектов и поддерживающая следующие операции:
INSERT (x) – добавляет в очередь новый объект x;
MINIMUM – возвращает объект с минимальным значением ключа;
EXTRACT-MIN – удаляет из очереди объект с минимальным значением ключа.
Бинарная куча
Будем считать, что объекты хранятся в вершинах полного двоичного дерева (самый нижний уровень дерева заполнен, возможно, не полностью).
Пронумеруем вершины этого дерева слева направо сверху вниз. Пусть N – количество вершин в дереве. Нетрудно видеть, что справедливы следующие свойства

Свойство 1. Высота полного двоичного дерева из N вершин (то есть максимальное количество ребер на пути от корня к листьям) - O(log2 N).
Свойство 2. Рассмотрим вершину полного двоичного дерева из N вершин, имеющую номер i. Если i = 1, то у вершины i нет отца. Если i > 1, то ее отец имеет номер i div 2. Если 2i < N, то у вершины i есть два сына с номерами 2i и 2i+1. Если 2i = N, то единственный сын вершины i имеет номер 2i. Если 2i > N, то у вершины i нет сыновей. Будем говорить что объекты, хранящиеся в дереве, образуют бинарную кучу, если ключ объекта, находящегося в любой вершине, всегда не превосходит ключей объектов в сыновьях этой вершины. Будем хранить бинарную кучу в массиве H. Элемент этого массива H[i] будет содержать объект, находящийся в вершине дерева с номером i.
Свойство 3. В бинарной куче объект H[1] (или объект, хранящийся в корне дерева) имеет минимальное значение ключа из всех объектов.
Реализация операции MINIMUM, работающая за O(1).

Добавление нового элемента в кучу
Сначала мы помещаем добавляемый объект x=2 на самый нижний уровень дерева на первое свободное место
Если окажется, что ключ этого объекта больше (или равен) ключа его отца, то свойство кучи нигде не нарушено, и мы корректно добавили вершину в кучу. В противном случае, поменяем местами объект с его отцом. В результате вершина с добавляемым объектом «всплывает» на одну позицию вверх.
Это «всплытие» продолжается до тех пор, пока ключ объекта не станет больше (или равен) ключа его отца или пока объект не «всплывет» до самого корня дерева. Время работы операции INSERT прямо пропорционально высоте дерева - O(log N).
Что при этом может произойти?

Реализация операции MINIMUM, работающая за O(1).
function MINIMUM:тип;
begin
MINIMUM:=H[1];
End;
Рассмотрим операцию INSERT. Сначала мы помещаем добавляемый объект x на самый нижний уровень дерева на первое свободное место. Если окажется, что ключ этого объекта больше (или равен) ключа его отца, то свойство кучи нигде не нарушено, и мы корректно добавили вершину в кучу. В противном случае, поменяем местами объект с его отцом. В результате вершина с добавляемым объектом «всплывает» на одну позицию вверх. Это «всплытие» продолжается до тех пор, пока ключ объекта не станет больше (или равен) ключа его отца или пока объект не «всплывет» до самого корня дерева. Время работы операции INSERT прямо пропорционально высоте дерева - O(log N).
Procedure INSERT (x:тип);
begin
N:= N+1; H[N]:= x; i:= N;
While (i > 1) and (H[i].Key < H[i div 2].Key) Do
Begin
S:= H[i]; H[i]:=H[i div 2]; H[i div 2]:= S;i:= i div 2;
End;
End;

Удаление минимального элемента из кучи
Сначала перемещаем объект из листа с номером N в корень (при этом объект в корне затирается, так как его и нужно удалить).
Ставший свободным при этом лист удаляется.
Если теперь окажется, что ключ объекта в корне меньше (или равен) ключей объектов в его сыновьях (что очень маловероятно), то свойство кучи нигде не нарушено и удаление было проведено корректно. В противном случае, выберем сына корня с минимальным значением ключа и поменяем объект в корне с объектом в этом сыне. В результате объект, находившийся в корне, «спускается» на одну позицию вниз.

Теперь рассмотрим операцию EXTRACT-MIN. Для ее реализации мы сначала перемещаем объект из листа с номером N в корень (при этом объект в корне затирается, так как его и нужно удалить). Ставший свободным при этом лист удаляется. Если теперь окажется, что ключ объекта в корне меньше (или равен) ключей объектов в его сыновьях (что очень маловероятно), то свойство кучи нигде не нарушено и удаление было проведено корректно. В противном случае, выберем сына корня с минимальным значением ключа и поменяем объект в корне с объектом в этом сыне. В результате объект, находившийся в корне, «спускается» на одну позицию вниз. Этот «спуск» продолжается до тех пор, пока объект не окажется в листе или его ключ не станет меньше (или равен) ключей объектов в его сыновьях. Операция выполняется за O(log N), так как время ее работы пропорционально высоте дерева.
Procedure EXTRACT-MIN;
begin
H[1]:= H[N]; N:= N-1; i:= 1;
While 2*i <= N Do Begin
If (2*i = N) or (H[2*i].Key < H[2*i+1].Key)
Then Min:= 2*i Else Min:= 2*i+1;
If H[i].Key <= H [Min].Key Then Break;
S:= H[i]; H [i]:= H [Min]; H [Min]:= S; i:= Min;
End;
End;

Волновой алгоритм. Закраска замкнутых областей
Пусть имеется некоторая замкнутая область, граница которой имеет не 0 цвет, а внутренняя часть – 0 цвет. Пусть (x, y) – координаты любой внутренней точки области. Покрасим данную точку в нужный цвет и рассмотрим четырех ее соседей: сверху, снизу, слева, справа. Если соседняя точка имеет черный цвет, то есть, не покрашена, то покрасим ее и запомним ее координаты, чтобы повторить этот процесс для ее соседей. В результате цветная волна начнет разливаться по экрану. Наткнувшись на точку границы или уже покрашенную, процесс в данном месте прервется. Для хранения положения соседей воспользуемся очередью – массивом записей.
Type El=record
i,j:integer;
End;
tQueue=array[1..20000] of El;
Var Q: tQueue;
G,Xv,L:integer;{голова, хвост, длина}

Нарисуем замкнутую фигуру любой формы и зададим внутри нее любую точку, покрасим ее и поместим ее координаты в кольцевую очередь.
Для каждой покрашенной точки выполняем следующее: рассматриваем 4-х ее соседей (сверху, снизу, слева, справа), если соседняя точка не покрашена, то красим ее и помещаем ее координаты в очередь.
4
7
Пока очередь не пуста:
1. Извлекаем из очереди очередную точку.
2.Рассматриваем 4-е соседние точки с координатами: (i+1,j), (i-1,j), (i,j+1), (i,j-1), если точка не покрашена, то красим ее и помещаем ее координаты в очередь:
4
8
5
7
4
6
3
7
Процесс продолжается аналогично для всех точек, находящихся в очереди. «Наткнувшись» на границу или уже покрашенную область, цветная волна останавливается, так как координаты точки не попадут в очередь
4
9
5
8
3
8

Нарисовать фигуру; задать координаты внутренней точки
putPixel(x,y,цвет);{закрасить точку} PutQ(x,y); {поместим ее в очередь}
While L>0 do Begin{пока очередь не пуста}
GetQ(x,y);{извлекаем из очереди очередную точку}
If (x>1)and(GetPixel(x-1,y)=0) {если сосед слева существует}
Then begin {и не покрашен, то}
PutPixel(x-1,y,цвет);{покрасить его}
PutQ(x-1,y){поместить его координаты в очередь}
End;
If (x<639)and(GetPixel(x+1,y)=0){если сосед справа существует}
Then begin {и не покрашен, то}
PutPixel(x+1,y,цвет);{покрасить его}
PutQ(x+1,y){поместить его координаты в очередь}
End;
If (y>1)and(GetPixel(x,y-1)=0) {если сосед сверху существует}
Then begin {и не покрашен, то}
PutPixel(x,y-1,цвет);{покрасить его}
PutQ(x,y-1){поместить его координаты в очередь}
End;
If (y<479)and(GetPixel(x,y+1)=0){если сосед снизу существует}
Then begin {и не покрашен, то}
PutPixel(x,y+1,цвет);{покрасить его}
PutQ(x,y+1){поместить его координаты в очередь}
End;
End;
End.

Волновой алгоритм. Поиск пути в лабиринте
Пусть имеется лабиринт, представленный матрицей поля. А[i,j]=0, если клетка свободна и А[i,j]=255, если клетка содержит непроходимое препятствие. Пусть объект хочет найти путь из точки с координатами Si, Sj в точку с координатами Fi, Fj.
1. Поместить в очередь координаты выхода PutQ(Fi,Fj), пометить эту точку в матрице числом 1 (A[Fi, Fj]:=1).
2. Пока очередь не пуста делать
2.1 извлечь координаты очередной точки (x,y);
2.2 рассматриваем все соседние точки (сверху, снизу, слева, справа);
2.3 Если сосед существует, и еще не помечен, то
Пометить его числом на 1 больше (С[y,x]+1);
поместить его координаты в очередь;
Для восстановления пути по заполненной матрице, объект «смотрит» вокруг себя и смещается в клетку с наименьшим числовым значением.

Нарисуем замкнутую фигуру любой формы и зададим внутри нее точку финиша, пометим ее 1 (зеленая окружность) и поместим ее координаты в кольцевую очередь.
Для каждой точки из очереди выполняем следующее: рассматриваем 4-х ее соседей (сверху, снизу, слева, справа), если соседняя точка не помечена числом (равна 0), то помечаем ее числом на 1 большим и помещаем ее координаты в очередь.
5
8
Пока очередь не пуста:
1. Извлекаем из очереди очередную точку.
2.Рассматриваем 4-е соседние точки с координатами: (i+1,j), (i-1,j), (i,j+1), (i,j-1), если точка не помечена, то помечаем ее числом на 1 большим и помещаем ее координаты в очередь:
Процесс продолжается аналогично для всех точек, находящихся в очереди. «Наткнувшись» на границу или уже помеченную точку, цифровая волна останавливается, так как координаты точки не попадут в очередь
1
2
5
9
5
7
2
3
4
9
4
3
9
5
3
8
6
3
7
7
8
9
9
10
10
10
11
11
12
13
14
15
16
После заполнения матрицы А, путь восстанавливается элементарно: встаем в точку с координатами старта Si, Sj (голубая окружность). Рассматриваем соседние точки и ищем минимум. (Красные стены имеют код 255). Минимум=14, смещаемся в эту клетку и повторяем процесс пока не дойдем до точки финиша.

Нарисовать фигуру; задать координаты внутренней точки
A[Fi,Fj]:=1;{пометим точку} PutQ(Fi,Fj); {поместим ее в очередь}
While L>0 do Begin{пока очередь не пуста}
GetQ(y,x);{извлекаем из очереди очередную точку}
If (x>1)and(A[y,x-1]=0) {если сосед слева существует}
Then begin {и не помечен, то}
A[y,x-1]= A[y,x]+1;{пометим его}
PutQ(y,x-1){поместить его координаты в очередь}
End;
If (x
Then begin {и не помечен, то}
A[y,x+1]= A[y,x]+1;{пометим его}
PutQ(y,x+1){поместить его координаты в очередь}
End;
If (y>1)and(A[y-1,x]=0) {если сосед сверху существует}
Then begin {и не помечен, то}
A[y-1,x]= A[y,x]+1;{пометим его}
PutQ(y-1,x){поместить его координаты в очередь}
End;
If (y
Then begin {и не помечен, то}
A[y+1,x]= A[y,x]+1;{пометим его}
PutQ(y+1,x){поместить его координаты в очередь}
End;
End;
End.

Lines (20 баллов)
Мрак сгустился над Зазеркальем, солнце уже давно не появлялось над горизонтом. Казалось, что вся радость и счастье исчезли из этого мира, как будто их высосал огромный черный пылесос… «Дементоры», - подумала Алиса и, размахивая над головой подобранной с земли кривой палкой, произнесла – «Экспекто патронус». Но мрак не рассеялся, а белый олень не проскакал… «Жаль, - подумала Алиса, - теперь придется читать, а это страшно утомительное занятие…» Алиса открыла древнюю книгу на странице заклятия, разгоняющего мрак, и углубилась в чтение. Древняя магия оказалась простой, как колумбово яйцо: надо всего лишь за 1 секунду угадать состояние поля древней зазеркальной игрушки ЛИНЕС после очередного хода, и мрак рассеется, будто его и не было. Правила игры в нее аналогичны нашей игре Lines. Имеется квадратное поле размера NxN клеток, каждая клетка либо пуста, либо содержит шарик одного из 9 цветов (для удобства цвета задаются цифрами от 1 до 9). Если в результате перемещения шарика в заданную позицию образуется вертикальная, горизонтальная или диагональная линия (линии) из К или более шариков одного цвета, то они удаляются. Шарик может перемещаться только в свободную соседнюю клетку либо по горизонтали, либо по вертикали.
Задание: напишите программу, которая по заданному состоянию игрового поля, начальным и конечным координатам шарика, определит состояние игрового поля после перемещения шарика и возможного удаления образовавшихся одноцветных «линий».

Формат входного файла input.txt:
В первой строке через пробел указываются два числа: N (2<=N<=100) – размеры игрового поля и К (2<=K<=N) – минимальное количество одноцветных шариков, расположение которых в одну линию приводит ее к удалению.
Далее располагается N строк – каждая содержит по N цифр: 0 – клетка пуста, 1..9 – клетка содержит шарик указанного цвета.
В следующей строке даются начальные координаты клетки перемещаемого шарика SI, SJ (номер строки, столбца, 1<= SI, SJ <=N).
В следующей строке даются координаты клетки, куда необходимо переместить указанный шарик FI, FJ (номер строки, столбца,
1<= FI, FJ <=N).
Формат выходного файла output.txt:
Выведите NO SOLUTION, если невозможно переместить указанный шарик в заданную клетку, в противном случае выведите итоговое состояние игрового поля в виде N строк, каждая строка – N цифр, соответствующих цветам расположенных в них шариков.
Замечания:
стартовая позиция гарантировано содержит шарик;
финишная позиция гарантировано пуста;
начальная позиция шарика не совпадает с конечной;
на игровом поле до перемещения шарика не присутствуют одноцветные линии длиной К или более клеток.

Решение: тема «Моделирование, графы, поиск пути в лабиринте». Задача имеет две части решения:
поиск пути шарика из начальной позиции в конечную. Для этого используется стандартный волновой алгоритм с использованием очереди или рекурсивный перебор.
удаление возможных одноцветных линий. Бежим вверх и вниз, считаем, сколько шариков совпало по цвету. Если их больше или равно К, то удаляем эту линию. Аналогично повторяем процесс для горизонтальной и диагональных линий.
Игровое поле представлено матрицей р, p[i,j]=0, если клетка пуста и p[i,j]=номеру цвета шарика в противном случае. Матрица m используется для поиска пути шариком: в ней все клетки, занятые шариком обозначены числом 255, а свободные клетки – числом 0. Точка, куда выбранный шарик должен переместиться помечается числом 1, затем его координаты помещаются в очередь.

Пока очередь не пуста повторять:
извлечь из очереди очередную клетку поля;
рассмотреть ее 4-х соседей: сверху, снизу, слева, справа;
если сосед в границах поля, не содержит шарик (не 255) и еще не помечен, то пометим его числом на 1 большим и поместим его координаты в очередь.
Если «цифровая волна» добежала до клетки поля с выбранным шариком, то путь существует. Его, кстати, легко восстановить, двигаясь в сторону уменьшения чисел.

Const Max=100; {максимальный размер поля}
Type matr=array[0..max+1,0..max+1] of shortint;
matr2=array[0..max+1,0..max+1] of word;
Var p:matr; {игровое поле}
m:matr2; {матрица для поиска пути}
si,sj,fi,fj,N,K,col:integer; poss,Fl:boolean;
procedure Load(Nf:string; Var p:matr; {ввод данных}
Var N,Si,Sj,Fi,Fj:integer);
Var f:text; i,j:integer; c:char;
begin
fillchar(p,SizeOF(p),255); {заполним препятствиями}
assign(f,NF); reset(f);
readln(f,N,K);
for i:=1 to n do begin
for j:=1 to n do
begin{считаем цвет шарика и заполним матрицы}
read(f,c); p[i,j]:=ord(c)-ord('0');
if p[i,j]=0 then m[i,j]:=0 else m[i,j]:=65535
end;{число 65535, а не 255, используется из-за больших размеров поля}
readln(f);
end;
readln(f,si,sj); readln(f,fi,fj); close(f);
end;

procedure Save(Nf:string; Var p:matr);
{сохраняем результаты}
Var f:text; i,j:integer;
begin
assign(f,NF); rewrite(f); {создадим файл}
if Poss{если путь перемещения существует, то выведем результат}
then begin
for i:=1 to n do begin
for j:=1 to n do
write(f,p[i,j]);
writeln(f);
end;
end
else Writeln(f, 'NO SOLUTION');
close(f);
end;

procedure Solve(Var p:matr;n,si,sj,fi,fj:integer);
Type Vect=array[1..4] of shortint;
Const dj:vect=(+1, 0,+1,+1); {вектор направлений движения}
di:vect=( 0,+1,+1,-1); {шарика}
Var z,col,i,j,cn:integer;
function Possible:boolean;
Type hod=array[1..4] of integer;
tQUEUE=array[1..10000] of record{очередь}
i, j:integer;
end;
Var g,h,l:integer; q:tQUEUE;
Const hodi:hod=(-1, 0, 0,+1); hodj:hod=(-0,+1,-1,0);
procedure putQ(i,j:integer); {поместить в очередь}
begin
if l>1000 then writeln('QUEUE is full')
else begin
inc(l); h:=(h mod 1000)+1; q[h].j:=j; q[h].i:=i;
end
end;
procedure GetQ(Var i,j:integer); {извлечь из очереди}
begin
if l=0 then writeln('QUEUE is empty')
else begin
dec(l); j:=q[g].j; i:=q[g].i; g:=(g mod 1000)+1;
end
end;
function InR(x:integer):boolean; {проверка на попадание в поле}
begin InR:=(x>=1)and(x<=N)
end;

procedure FillBall(n,si,sj:integer;Const hodi,hodj:hod);
Var k,ki,kj:integer; {поиск пути шариком}
begin{инициализация очереди}
g:=1;h:=0;l:=0; putQ(si,sj);m[si,sj]:=1;
While l<>0 do{пока очередь не пуста}
begin
GetQ(ki,kj); {извлечем из очереди координаты очередной клетки}
for k:=1 to 4 do{переберем 4-х соседей, для каждого проверим что он существует и не содержит шарика}
if (InR(ki+hodi[k]))and(InR(kj+hodj[k]))and
(m[ki+hodi[k],kj+hodj[k]]=0)
then begin{в этом случае пометим его и запомним в очереди}
m[ki+hodi[k],kj+hodj[k]]:=m[ki,kj]+1;
putQ(ki+hodi[k],kj+hodj[k]);
end;
end;
end;
Var i,j:integer;
begin
fillBall(n,si,sj,hodi,hodj);{построим путь}
possible:=m[fi,fj]<>0; {если добрались до конечной точки}
end;

procedure fill(dj,di,ti,tj,col:shortint);
Var i,j:integer; {процедура удаляет одноцветные линии}
begin{ ti,tj-начальное положение, dj,di-вектор смещения}
i:=ti+di;j:=tj+dj; While p[i,j]=col do begin
p[i,j]:=0; i:=i+di; j:=j+dj
end;
i:=ti-di;j:=tj-dj;
While p[i,j]=col do begin
p[i,j]:=0; i:=i-di; j:=j-dj
end;
end;
function Calc(dj,di,ti,tj,col:shortint):integer;
Var cn,i,j:integer;{считает длину одноцветной линии}
begin
cn:=0; i:=ti;j:=tj; {встали в начало}
While p[i,j]=col do{пока цвет совпадает – бежим «вправо»}
begin{«вправо» - условно, т.к. все зависит от значений di, dj}
inc(cn); i:=i+di; j:=j+dj
end;
i:=ti-di;j:=tj-dj;
While p[i,j]=col do{теперь – «влево»}
begin
inc(cn); i:=i-di; j:=j-dj
end;
Calc:=cn
end;

begin
col:=p[si,sj]; Poss:=Possible; {поищем путь}
if Poss{если нашли, то}
then begin{переберем 4 возможные линии}
p[si,sj]:=0;p[fi,fj]:=col;
fl:=false;
for z:=1 to 4 do{если линия существует}
if Calc(dj[z],di[z],fi,fj,col)>=k
then begin{то удалим ее}
Fill(dj[z],di[z],fi,fj,col);
Fl:=true
end;
if Fl then p[fi,fj]:=0;
{удалим шарик, если линии были}
end;
end;

Lines-2 (30 баллов)
«Господи, что за страна такая?», - подумала Алиса про Зазеркалье, - «Что за странные игры в демократию в то время, когда поля не засеяны, а урожай не собран?» Такие мысли промелькнули в голове Алисы, когда она стояла в толпе на Озерной площади, а Черная Королева объявляла правила очередной, мягко говоря, «странной» игры. Пусть игра – полный бред, но побеждать-то надо! Ведь победитель получит карту к пещере, в которой заточена Белая Королева, а ее надо спасти! Правила игры:
Имеется квадратное игровое поле размера NxN на котором размещены цветные шарики К цветов. ЧК выбирает главный шарик, который можно переместить в любую свободную клетку игрового поля, куда он сможет добраться, перемещаясь в пустые клетки, расположенные непосредственно слева, справа, сверху или снизу текущей клетки. Задача состоит в перемещении выбранного шарика в такую позицию, чтобы набрать максимальное количество очков. Очки начисляются за построение одноцветной фигуры из шариков по следующему принципу:
одноцветная горизонтальная, вертикальная или диагональная линия из М подряд расположенных шариков – М очков, кроме вырожденного случая – единственный шарик;
одноцветный крест, образованный пересечением (имеют общую клетку) горизонтальной и вертикальной линиями, кроме вырожденного случая (точка) – 2*min(длина горизонтальной линии, длина вертикальной линии). Крест может быть не симметричным, в виде буквы Т или Г;
одноцветный диагональный крест, образованный пересечением (имеют общую клетку) двух диагональных линий, кроме вырожденного случая (точка) – 2*min(длина главной диагонали, длина побочной диагонали).
Перемещаемый шарик обязательно должен быть элементом образовавшейся фигуры, а не располагаться рядом, касаясь ее! Если в результате перемещения шарика в некоторую позицию, образовалось несколько фигур, то начисляется максимальное количество очков из возможных. Алисе очень важно победить в этом соревновании Белого Кролика – известного хвастуна и проныру. Для этой цели она попросила Вас написать программу, решающую поставленную задачу.

Формат входного файла input.txt:
Первая строка: размер игрового поля N (2<=N<=100) и количество цветов шариков К (1<=K<=9).
Вторая строка: Si,Sj (1<=Si, Sj<=N) координаты шарика (через пробел), выбранного Черной Королевой.
Далее располагается N строк, каждая по N цифр (0…К), где 0 – клетка свободна, иначе в ней располагается шарик, указанного цвета.
Формат выходного файла output.txt:
Выведите в первой строке координаты клетки, куда необходимо переместить заданный шарик для максимизации выигрыша (номер строки, пробел, номер столбца). Если таких позиций несколько, то укажите любую. Замечание: координаты целевой клетки не могут совпадать с координатами стартовой.
Во второй строке укажите количество очков, которые сможет набрать Алиса, если переместит шарик в данную клетку.
Выведите NO SOLUTION, если невозможно переместить шарик для образования одноцветной фигуры – он заперт.

Не смотря на то, что условие этой задачи достаточно простое, а что и как делать – понятно, задача, на мой взгляд, является самой сложной на олимпиаде. В чем ее сложность? – в большом количестве частных случаев, которые надо учесть, тонкостях условия, которые надо увидеть. Задачу сложно отлаживать обычными методами, поэтому в процессе отладки рекомендуется выводить на экран состояние поля.
Идея решения проста:
возьмем активный шарик и определим все достижимые свободные поля;
переберем все возможные допустимые варианты;
для каждого варианта посчитаем очки и запомним максимум.

function Can(i,j:integer):boolean;{проверяет допустимость хода}
Var ii,jj,z:integer;
begin
z:=0; {ход возможен, если целевая клетка пуста, а рядом с ней}
for ii:=-1 to 1 do {есть шарики «нашего» цвета}
for jj:=-1 to 1 do
if p[ii+i,j+jj]=col then inc(z);
Can:=(p[i,j]=0)and(z>=1);
end;
procedure putQ(i,j:integer); {поместить координаты в очередь}
begin
if l>1000 then writeln('QUEUE is full')
else begin
inc(l); h:=(h mod 1000)+1; q[h].j:=j; q[h].i:=i;
end
end;
procedure GetQ(Var i,j:integer);{извлечь координаты из очереди}
begin
if l=0 then writeln('QUEUE is empty')
else begin
dec(l); j:=q[g].j; i:=q[g].i; g:=(g mod 1000)+1;
end
end;
function InR(x:integer):boolean;{координаты в игровом поле}
begin
InR:=(x>=1)and(x<=N)
end;

procedure FillBall(n,si,sj:integer;Const hodi,hodj:hod);
Var k,ki,kj:integer;
begin{ищет достижимые клетки от активного шарика}
g:=1;h:=0;l:=0; putQ(si,sj);m[si,sj]:=1;
While l<>0 do{пока очередь не пуста}
begin
GetQ(ki,kj); {извлечем из очереди очередную клетку}
for k:=1 to 4 do{переберем ее соседей}
if (InR(ki+hodi[k]))and(InR(kj+hodj[k]))and
(m[ki+hodi[k],kj+hodj[k]]=0)
then begin{если сосед на поле и там нет шарика, то}
m[ki+hodi[k],kj+hodj[k]]:=m[ki,kj]+1;
putQ(ki+hodi[k],kj+hodj[k]);
end;{пометим его как рассмотренного и запомним в очереди}
end;
end;
function Possible(fi,fj:integer):boolean;{ищет все допустимые для хода клетки, использует волновой алгоритм}
Type hod=array[1..4] of integer;
tQUEUE=array[1..10000] of record i,j:integer; end;
Var g,h,l:integer; q:tQUEUE;
Const hodi:hod=(-1, 0, 0,+1); {вектор возможного перемещения}
hodj:hod=(-0,+1,-1,0);
Begin {possible}
fillBall(n,si,sj,hodi,hodj);
possible:=m[fi,fj]<>0;
end;

procedure fill(dj,di,ti,tj,col:shortint);
Var i,j:integer;
Begin {удаляет одноцветные линии в заданном направлении}
i:=ti+di;j:=tj+dj;
While p[i,j]=col do
begin
p[i,j]:=0; i:=i+di; j:=j+dj
end;
i:=ti-di;j:=tj-dj;
While p[i,j]=col do
begin
p[i,j]:=0; i:=i-di; j:=j-dj
end;
end;
function Calc(dj,di,ti,tj,col:shortint):integer;
Var cn,i,j:integer; {считает количество одноцветных шариков}
Begin {в заданной линии}
cn:=0; i:=ti;j:=tj;
While p[i,j]=col do
begin
inc(cn); i:=i+di; j:=j+dj
end;
i:=ti-di;j:=tj-dj;
While p[i,j]=col do
begin
inc(cn); i:=i-di; j:=j-dj
end;
Calc:=cn
end;

Function MaxCalc(fi,fj:integer):integer;{лучший вариант}
Var maxT,t,i,j,z:integer; fl:boolean;
function Min2(a,b:integer):integer; {находит минимум из 2-х}
begin
if a then Min2:=a else Min2:=b
end;
function Krest(fi,fj,col:integer):integer;
Var MaxT,Ht,cn,i,j:integer; {поиск обычного креста}
Begin cn:=0;ht:=0;MaxT:=0; i:=fi;j:=fj;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[1],di[1],i,j,col);
if t>Ht then Ht:=t; i:=i+1;
end;
i:=fi-1;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[1],di[1],i,j,col);
if t>Ht then Ht:=t; i:=i-1;
end;
t:=min2(cn,Ht); if t>MaxT then MaxT:=t; i:=fi;j:=fj; cn:=0;ht:=0;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[2],di[2],i,j,col);
if t>Ht then Ht:=t; j:=j+1;
end;
j:=fj-1;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[2],di[2],i,j,col); if t>Ht then Ht:=t; j:=j-1;
end;
t:=min2(cn,Ht); if t>MaxT then MaxT:=t;
if MaxT>1 then Krest:=2*Maxt else Krest:=Maxt
end;

function KrestD(fi,fj,col:integer):integer;
Var Ht,cn,i,j,MaxT:integer; {поиск креста из диагоналей}
begin
cn:=0;ht:=0; MaxT:=0; i:=fi;j:=fj;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[4],di[4],i,j,col);
if t>Ht then Ht:=t; i:=i+1;j:=j+1
end;
i:=fi-1;j:=fj-1;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[4],di[4],i,j,col);
if t>Ht then Ht:=t; i:=i-1;j:=j-1
end;
t:=min2(cn,Ht);
if t>MaxT then MaxT:=t;
cn:=0;ht:=0; i:=fi;j:=fj;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[3],di[3],i,j,col);
if t>Ht then Ht:=t; i:=i-1;j:=j+1
end;
i:=fi+1;j:=fj-1;
While p[i,j]=col do
begin
inc(cn); t:=Calc(dj[3],di[3],i,j,col);
if t>Ht then Ht:=t; i:=i+1;j:=j-1
end;
t:=min2(cn,Ht);
if t>MaxT then MaxT:=t;
if Maxt>1 then KrestD:=2*MaxT
else KrestD:=MaxT
end;

Begin {MaxCalc}
fl:=false; Maxt:=0;
for z:=1 to 4 do
begin
t:= Calc(dj[z],di[z],fi,fj,col); if t>maxT then MaxT:= t;
end;
t:=Krest(fi,fj,col); if t>maxT then MaxT:= t;
t:=KrestD(fi,fj,col); if t>maxT then MaxT:= t;
MaxCalc:=MaxT
end;
Begin {Solve}
col:=p[si,sj];
for i:=1 to n do
for j:=1 to n do
begin
p[si,sj]:=0; {уберем активный шарик со стартовой позиции}
if Can(i,j) {если можем попасть в клетку с координатами (i,j)}
then begin
m:=m1; {вспомним состояние поля – его будем портить}
if Possible(i,j){если имеет смысл туда прыгать, то}
then begin
p[i,j]:=col; {перемещаем туда шарик}
t:=MaxCalc(i,j); {считаем «прибыль»}
if t>maxR{если лучше, чем раньше, то запомним это}
then begin
MaxR:=t; Ri:=i;Rj:=j
end;
p[si,sj]:=col;p[i,j]:=0; {восстановим поле}
end
end
end;
end;

Задача С. «Камелот»
Настольная игра "Камелот" придумана для одного игрока и играется она двумя фигурами - Королем и Конем. Доска имеет размер n×n (2<=n<=100), Король может перемещаться в любую смежную клетку. Конь, как известно, ходит буквой "Г". В начале игры обе фигуры выставляются по одной на любые две не совпадающие клетки. Игроку необходимо так перемещать фигуры, чтобы привести их в одну (любую) клетку за минимальное суммарное число ходов. Первый ход в партии может делать как Король, так и Конь. Одной фигурой можно делать несколько ходов подряд.
Задание: определите минимальное суммарное количество ходов обеих фигур для их встречи в одной клетке.

В начале заполним матрицу поля нулями и пометим клетку, где стоит конь 1.
Все соседние «нулевые» клетки, на которые может переместиться конь, пометим числом 1. Конь ходит буквой «Г», для удобства его перемещения мы завели два массива – смещение координат по оси Х и У.
Затем процесс повторяется для каждой клетки, помеченной 1, ее соседи – помечаются 2 и так далее. Процесс завершается, когда не удастся пометить ни одной клетки. Для хранения «соседей» будем использовать классическую очередь.
Аналогичный процесс повторяем для второй матрицы. Отличие состоит в том, что ходы короля имеют другое смещение – соседние клетки по горизонтали и диагонали.
Числа в матрицах показывают за сколько ходов (+1) фигура сможет добраться до данной клетки. Найдем сумму элементов матрицы, а среди этих сумм – минимум. Эта клетка и будет точкой встречи.

Идея – ищем путь от короля до всех клеток, то есть, считаем, за сколько ходов король сможет добраться до этой клетки, затем делаем это же для коня. Складываем две матрицы ходов и ищем наименьшее значение – это и будет точка встречи.
Const hodKni:hod=(-2,-2,-1,+1,+2,+2,+1,-1); {ходы коня}
hodKnj:hod=(-1,+1,+2,+2,+1,-1,-2,-2);
hodKri:hod=(-1,-1,-0,+1,+1,+1,-0,-1); {ходы короля}
hodKrj:hod=(-0,+1,+1,+1,+0,-1,-1,-1);
Procedure Fill(Var m:tMatr;n,ki,kj:integer;const hodKni,hodKnj:hod);
Var k:integer;
Begin
g:=1;h:=0;l:=0;
putQ(ki,kj); m[ki,kj]:=1;{пометить и поместить в очередь стартовую точку}
While l<>0 do {пока очередь не пуста}
begin
GetQ(ki,kj); {извлечь из очереди очередную точку}
for k:=1 to 8 do {проверяем 8 соседей}
if (InR(ki+hodKni[k]))and(InR(kj+hodKnj[k]))and
(m[ki+hodKni[k],kj+hodKnj[k]]=0)
then begin {если ход в пределах доски и клетка не помечена}
m[ki+hodKni[k],kj+hodKnj[k]]:=m[ki,kj]+1; {помечаем большим числом}
putQ(ki+hodKni[k],kj+hodKnj[k]); {помещаем ее координаты в очередь}
end;
end;
end;

Function CalcMin(Kn,Kr:tMatr):integer;
{ищем минимум среди суммы матриц}
Var i,j,min:integer;
Begin min:=32000;
for i:=1 to n do
for j:=1 to n do
if (kn[i,j]+kr[i,j]
0)
then min :=kn[i,j]+kr[i,j];
CalcMin:=min-2 {-2, так как начинали заполнять матрицы с 1}
end;
begin
… {ввод из файла условий}
Fill(Kn,n,Kni,knj,hodKni,hodKnj); {считаем для коня}
Fill(Kr,n,Kri,Krj,hodKri,hodKrj); {считаем для короля}
z:=CalcMin(Kn,Kr); {находим расстояние}
if z<=0 then z:=Kr[Kni,Knj]-1; {проверяем случай, когда конь не ходит - конь и король стоят рядом}

Задача B. «Гонки в лабиринте»
В честь великого праздника – Дня рождения Черной Королевы в Зазеркалье были устроены соревнования – забег в лабиринте. Победитель забега получал главный приз – месячный бесплатный абонемент на чаепитие у Болванщика. Вот уже много лет никто не мог обогнать в этом соревновании Белого Кролика. Лабиринт представляет собой матрицу NxM клеток, часть из них проходима, часть – нет. Перемещаться в лабиринте можно только по свободным клеткам, имеющим общую сторону, это занимает 1 единицу времени. Кроме того, в некоторых клетках лабиринта стоят телепорты, которые позволяют за 1 единицу времени перемещаться между двумя клетками, связанными телепортом. Каждый телепорт имеет свой порядковый номер и связывает только свой вход со своим выходом, причем вам всем еще с детства известно, что нельзя из входа телепорта №1 попасть в выход телепорта №2, попасть можно только в выход №1, и телепорты работают в обоих направлениях.
Естественно, что без плана заходить в лабиринт было чистой воды безрассудством. Однако Алисе повезло – Белая Королева подарила ей план лабиринта. Помогите Алисе найти самый короткий путь в лабиринте, или выяснить, что такого пути не существует.
Задание: Напишите программу, которая по карте лабиринта, полученной из файла input.txt найдет и выведет в файл output.txt:
Только длину кратчайшего пути от входа в лабиринт до выхода из него. Телепорты при этом не используются (15 баллов);
Длину кратчайшего пути от входа в лабиринт до выхода из него, а также любой кратчайший путь. Телепорты при этом не используются (20 баллов);
Длину кратчайшего пути от входа в лабиринт до выхода из него, любой кратчайший путь. Телепорты при этом можно использовать (25 баллов).

Описание входного файла input.txt:
Первая строка содержит размеры лабиринта – два числа N и М, разделенных пробелом. (2<=N, M<=150).
Вторая строка содержит координаты входа в лабиринт (Si, Sj): номер строки, номер столбца; (1<=Si<=N, 1<=Sj<=M)
Третья строка содержит координаты выхода из лабиринта (Fi, Fj): номер строки, номер столбца; (1<=Fi<=N, 1<=Fj<=M)
Далее следует N строк, содержащих по М чисел, разделенных пробелами:
0 – клетка свободна;
255 – клетка занята (непроходима);
1, 2, 3,..., К – пары чисел – номера телепортов. Каждое число (1..К) встречается в матрице ровно два раза, одно из них обозначает вход, а второе – выход из телепорта. Телепорт может работать в обоих направлениях. (1<=K<=20).
Описание выходного файла output.txt:
Первая строка должна содержать натуральное число R – длину кратчайшего пути от входа в лабиринт до выхода из него или NO SOLUTION (заглавные буквы, один пробел), если указанного пути не существует.
Вторая строка (варианты b и с) должна содержать любой путь минимальной длины, состоящий из символов: D – переместиться на одну клетку вниз, U – переместиться на одну клетку верх, L – переместиться на одну клетку влево, R – переместиться на одну клетку вправо, Т – воспользоваться телепортом, если он расположен в текущей клетке. Клетка лабиринта с координатами (1, 1) считается верхней левой.
Замечания:
телепортом можно не пользоваться, в этом случае клетка считается проходимой;
суммарная длина пути не более 255 ходов.
Вы получите +5 баллов, если длина пути может быть более 255 ходов.

Предположим, что Алиса не умеет пользоваться телепортами, тогда решение задачи сводится к поиску оптимального пули в лабиринте, а эту задачу мы уже умеем решать волновым алгоритмом. Что дает появление телепорта? - возможность мгновенного (за 1) перемещения в другую точку лабиринта. Но телепортом можно и не пользоваться – заранее мы этого не знаем. Это приводит к идее модифицировать волновой алгоритм – наткнувшись на вход в телепорт, цифровая волна продолжит распространяться и со второй его стороны (выхода).

1
1
2
2
3
3
При загрузке файла закодируем игровое поле: 0 клетка свободна, 65535 –препятствие (длина пути может быть больше 255 шагов). Все телепорты сохраним в особую структуру – двумерный массив.
1 2 3 MaxT
T
1
2
3
4
5
6
7
8
9
1 2 3 4 5 6 7 8 9 10
(4,3)
1
(3,9)
2
(7,5)
1
(8,3)
2
(8,9)
3
(9,5)
3
От точки финиша запустим волновой алгоритм, пометим точку финиша 1, ее соседей – 2 и т.д. Если очередной сосед содержит вход в телепорт, то пометив его противоположный конец числом на 1 большим.
Матрица заполнена, теперь надо восстановить путь Алисы. Встаем на точку старта, смотрим 4-х соседей, ищем среди них минимум. Пусть старт (1,1), тогда минимум (10, 10)=10. Res=‘D’
Смещаемся вниз (2,1) - (9, 9)=9. Res=‘DD’ и так далее
В точке (4,3) расположен вход в телепорт. На его противоположном конце – число 5, а вокруг – 7, следовательно, Алисе выгоднее воспользоваться телепортом. Res=‘DDDRRT’
Дошли до точки старта. Ответ: Res=‘DDDRRTDDLL’

Структура данных
Const MaxT=20; {максимальное количество телепортов}
Type Matr=array[0..151,0..151] of word; {игровое поле}
XY=record{описание одного входа в телепорт}
i,j:byte;
end;
Tel=array[1..MaxT,0..1] of XY; {описание телепортов}
QUEUE=array[1..1000] of XY; {очередь}
tString=array[1..30000] of char; {массив для результата}
pString=^tString; {он еще и динамический}
Var a:Matr; {игровое поле}
Path:pString; {результирующий путь}
LPath,Si,Sj,Fi,Fj,n,m,Z:integer;
t:Tel;
Q:^QUEUE;
Len,G,H:integer;
i:integer; {варианты смещений Алисы}
Const DX:array[0..3] of integer=(-1,0,0,1);
DY:array[0..3] of integer=(0,-1,1,0);
D :array[0..3] of char =('L','U','D','R');

Волновой алгоритм поиска
procedure Fill(x,y:integer); {}
var k,i,j,p,e,W:integer; {стоимости кратчайшего пути}
Begin
Len:=0;g:=0;h:=1;w:=1; {инициализируем очередь} PutQ(x,y); {поместим точку куда надо попасть в матрицу и очередь}
A[y,x]:=w;
While Len>0 do {пока очередь не пуста}
Begin
GetQ(x,y);w:=a[y,x]+1;{извлечем координаты очередной точки}
For k:=0 to 3 do {перебираем 4 направления движения}
begin
i:=y+dy[k];j:=x+dx[k];
If (a[i,j]=0) {если там не были}
then Begin
a[i,j]:=w; {пометим, что можем туда попасть}
PutQ(j,i); {за w ходов, поместим в очередь}
for p:=1 to Z do{переберем телепорты}
for e:=0 to 1 do {если нашли, то попробуем}
if (t[p,e].i=i)and(t[p,e].j=j)
then begin {воспользуемся телепортом}
a[t[p,1-e].i,t[p,1-e].j]:=w;
PutQ(t[p,1-e].j,t[p,1-e].i);
break {дальше нет смысла искать}
end;
End;
end;
end;
End;

Загрузка матрицы поля
procedure Load(Name:string;var a:matr; var t:tel; Var N,M,Z,Si,Sj,Fi,Fj:Integer);
var f:text; x,i,j:integer;
begin
FillChar(a,SizeOf(a),255); {заполним массив а числами 65535!}
assign(f,Name); reset(f); {откроем файл} Readln(f,N,M); {считаем размер поля}
Readln(f,Si,Sj); {считаем координаты точки старта}
Readln(f,Fi,Fj); {считаем координаты точки финиша} z:=0;
for i:=1 to N do{считаем поле}
begin
for j:=1 to M do
begin Read(f,x);
if (x<>0)and(x<>255) {если не пусто и не препятствие,}
then begin {то - телепорт}
inc(z);a[i,j]:=0; {сохраним его}
if t[x,0].i=0 {0 строка -вход}
then begin {1 строка - выход}
t[x,0].i:=i;t[x,0].j:=j;
end
else begin
t[x,1].i:=i;t[x,1].j:=j;
end
end
else if x=255 {если препятствие, то пометим его 65535}
then a[i,j]:=65535 else a[i,j]:=x
end; readln(f)
end;
Close(f);
z:=z div 2{количество телепортов}
end;

Восстановим путь
procedure Path_(Si,Sj,Fi,Fj:integer;s:pString); {восстанавливает путь в матрице}
var ss:string; min,i,j,k,x,y,p,e:integer; Quit:boolean; c:char;
begin
if a[si,sj]=0 {если до точки старта «волна» не дошла, то}
then begin {решения нет} LPath:=-1; exit end;
Quit:=false;lPath:=0;
while not Quit do{пока не дошли до финиша}
begin
y:=si;x:=sj; Min:=a[y,x];c:='T'; {ищем вокруг себя наименьшее число}
for k:=0 to 3 do
begin
i:=si+dy[k];j:=sj+dx[k];
If (a[i,j]
then Begin Min:=a[i,j];c:=D[k]; x:=j;y:=I end
end;
if (y=si)and(x=sj) {если меньшего нет, значит был использован телепорт}
then begin
for p:=1 to Z do {найдем его номер}
for e:=0 to 1 do
if (t[p,e].i=si)and(t[p,e].j=sj)
then begin {теперь координаты выхода}
y:=t[p,1-e].i; x:=t[p,1-e].j;break; end;
end;
inc(lPath); {увеличим длину пути на 1}
s^[lPath]:=c; {запомним ход} Si:=y;sj:=x; {сместимся в эту клетку матрицы}
if (si=fi)and(sj=fj) {если это финиш, то выход} then Quit:=true;
end;
end;

Задача C. Шахматная партия Алисы
Темные тучи сгустились над Зазеркальем – власть Черной Королевы с каждым днем усиливалась. Что смогут противопоставить этому светлые силы? Их королева заперта в норе Кролика, и еще не известно, освободят ли ее.. Однако даже в самые тяжелые и мрачные дни всегда есть слабый луч надежды.. Алиса узнала про белую пешку, которая сможет стать королевой, если ее проводить до 8 параллели шахматной доски, и тогда в Зазеркалье восстановится баланс сил. Кроме пешки на доске стоят другие белые и черные фигуры. Правда на них наложено заклятье сна – они дремлют, то есть остаются неподвижно. Однако при этом, фигуры продолжают бить часть полей (в соответствии с шахматными правилами). Ваша задача определить, возможно ли Алисе добраться со своей точки старта до белой пешки, при этом миновать все поля, битые черными фигурами, а также разбудить белую пешку, обеспечив ей возможность добраться до 8 параллели шахматной доски.
Формат входного файла input.txt:
В первой строке содержатся координаты Алисы (заглавная латинская буква, цифра, например, А7)
Во второй строке содержатся координаты единственной белой пешки (заглавная латинская буква, цифра, например, Н5).
В третей строке дается число N – количество фигур на доске. (0<=N<=20)
Далее следует N строк, в каждой через один пробел располагается название фигуры (заглавные латинские буквы) и ее координаты:
BKN (WKN) – черный или белый конь (бьет поля «буквой Г»),
BSN (WSN) – черный или белый слон (бьет поля по диагонали),
BLD (WLD) – черная или белая ладья (бьет поля по вертикали, горизонтали),
BFZ (WFZ) – черный или белый ферзь (королева) (бьет поля по вертикали, горизонтали, диагонали)

Замечания:
фигуры могут загораживать друг друга;
битые поля посещать нельзя, есть черные фигуры нельзя;
ходы фигур и нумерация клеток соответствуют правилам шахмат;
белая пешка ходит только вперед НА ОДНУ КЛЕТКУ, не может пересекать битые поля и «есть» черные фигуры;
в начале игры белая пешка не может находиться под боем или на 8 параллели;
Алиса ходит в любую сторону, в том числе и по диагонали, на одну клетку;
в начале игры Алиса не может находиться под боем или в клетке, соседней с белой пешкой;
Алиса не является препятствием для движения вперед белой пешке.

Решение:
задачу можно разделить на несколько частей:
пометить «битые поля»;
найти кратчайший путь от Алисы до пешки;
Найти путь от пешки до 8 параллели.
Для решения первой части задачи заведем матрицу поля. Для каждой черной фигуры будем «трассировать» ее битые поля (например, для ладьи – двигаться вверх, вниз, влево, вправо) до тех пор, пока не дойдем до края доски или не наткнемся на препятствие – любую фигуру. Конь – особый случай.
Поиск пути к пешке будем решать «волновым методом». Он уже рассматривался ранее.
Поиск пути пешкой решается просто – просмотрим клетки впереди пешки: если нет битых полей и препятствий, значит, все хорошо.

Приступим к первому этапу, для этого:
Закодируем каждую фигуру (заменим числом)
Const BKN=240; BSN=241; BLD=242; BFZ=243; WKN=244; WSN=245; WLD=246; WFZ=247; WP =248;
Заполним матрицу поля: 0 – клетка свободна, 240..248 – фигура, при этом запомним положения каждой фигуры в специальном массиве.
tFig=record{фигура}
typ:byte; {тип}
i:byte;{координаты}
j:char;
end;
tFigs=array[1..100] of tFig;
Затем берем по очереди каждую черную фигуру и трассируем ее битые клетки до края доски или до препятствия (другой фигуры)
Черный конь
Черная ладья
Черный слон
Теперь матрица готова к использованию, все битые поля помечены числом 255, фигуры – 240..248. Запустим волну от белой пешки
1
2
2
2
2
3
3
3
3
4
4
4
5
5
5
5
6
6
6
6
6
7
7
7
7
7
7
7
7
8
8
8
Если после волнового заполнения матрицы клетка с Алисой осталась с 0, то решения нет (Алисе не добраться до пешки). Если 8-ая параллель в столбце белой пешки осталась равной 0, то решения нет (пешке не пройти). В противном случае восстанавливаем путь Алисы, двигаясь в минимальном направлении

загрузим данные
procedure LoadFile(Name:string); {}
var ff:text; c,s:string; i:integer;
begin
assign(ff,Name); reset(ff); {откроем файл}
Readln(ff,s); {считаем координаты Алисы}
ai:=ord(s[2])-ord('0'); aj:= s[1];
Readln(ff,s); {считаем координаты пешки}
pi:=ord(s[2])-ord('0'); pj:= s[1];
readln(ff,n); {считаем количество фигур}
for i:=1 to n do
begin {загрузим очередную фигуру}
readln(ff,s); c:=copy(s,1,3);
for k:=BKN to WFZ do{определим, какая она}
if c=fig[k]
then begin{ запомним ее координаты}
f[i].typ:=k;f[i].i:=ord(s[6])-ord('0');
f[i].j:=s[5];break
end;
end;
close(ff);
end;

Пометим биты клетки ладьи
procedure FillLD(i:byte;j:char);
var ii:byte;jj:char; {помечает «битые клетки» ладьи}
begin
ii:=i;jj:=j; {«бежим» вверх до препятствия}
While (ii<8)and(a[ii+1,jj] in [0,255]) do
begin inc(ii);a[ii,jj]:=255 end;
ii:=i;jj:=j; {«бежим» вниз до препятствия}
While (ii>1)and(a[ii-1,jj] in [0,255]) do
begin dec(ii);a[ii,jj]:=255 end;
ii:=i;jj:=j; {«бежим» вправо до препятствия}
While (jj<'H')and(a[ii,chr(ord(jj)+1)]in [0,255]) do
begin inc(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j; {«бежим» влево до препятствия}
While (jj>'A')and(a[ii,chr(ord(jj)-1)]in [0,255]) do
begin dec(jj);a[ii,jj]:=255 end;
a[i,j]:=BLD;
end;

procedure FillSn(i:byte;j:char);
var ii:byte;jj:char; {помечает «битые клетки» слона}
begin
ii:=i;jj:=j;
While (jj<'H')and(ii<8)and(a[ii+1,chr(ord(jj)+1)] in [0,255]) do
Begin inc(ii);inc(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj>'A')and(ii>1)and(a[ii-1,chr(ord(jj)-1)] in [0,255]) do
Begin dec(ii);dec(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj<'H')and(ii>1)and(a[ii-1,chr(ord(jj)+1)] in [0,255]) do
Begin dec(ii);inc(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj>'A')and(ii<8)and(a[ii+1,chr(ord(jj)-1)] in [0,255]) do
Begin inc(ii);dec(jj);a[ii,jj]:=255 end;
a[i,j]:=BSN;
end;
Пометим биты клетки слона

procedure FillKn(i:integer;j:char);
Const di:array[1..8]of integer=(-2,-2,-1,+1,+2,+2,+1,-1);
dj:array[1..8]of integer=(-1,+1,+2,+2,+1,-1,-2,-2);
var ii,k:byte;jj:char; {помечает «битые клетки» коня}
begin
for k:=1 to 8 do
if ((i+di[k])>=1)and((i+di[k])<=8)and(chr(ord(j)+dj[k])
in['A'..'H'])and(a[i+di[k],chr(ord(j)+dj[k])]=0)
then a[i+di[k],chr(ord(j)+dj[k])]:=255
end;
Пометим биты клетки коня

procedure FillFz(i:byte;j:char);
var ii:byte;jj:char; {помечает «битые клетки» ферзя}
begin
ii:=i;jj:=j;
While (ii<8)and(a[ii+1,jj] in [0,255]) do Begin inc(ii);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (ii>1)and(a[ii-1,jj] in [0,255]) do Begin dec(ii);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj<'H')and(a[ii,chr(ord(jj)+1)]in [0,255]) do Begin inc(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj>'A')and(a[ii,chr(ord(jj)-1)]in [0,255]) do Begin dec(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj<'H')and(ii<8)and(a[ii+1,chr(ord(jj)+1)] in [0,255]) do
Begin inc(ii);inc(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj>'A')and(ii>1)and(a[ii-1,chr(ord(jj)-1)] in [0,255]) do
Begin dec(ii);dec(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj<'H')and(ii>1)and(a[ii-1,chr(ord(jj)+1)] in [0,255]) do
Begin dec(ii);inc(jj);a[ii,jj]:=255 end;
ii:=i;jj:=j;
While (jj>'A')and(ii<8)and(a[ii+1,chr(ord(jj)-1)] in [0,255]) do
Begin inc(ii);dec(jj);a[ii,jj]:=255 end;
a[i,j]:=Bfz;
end;
Пометим биты клетки ферзя

Волновой поиск пути
procedure FillAlisa(var m:tMatr;n,ki:integer;kj:char;
const hodKni,hodKnj:hod);
var k:integer;{поиск минимальной стоимости пути от Алисы до пешки}
begin
g:=1;h:=0;l:=0; {инициализация очереди}
putQ(ki,kj);m[ki,kj]:=1; {помечаем точку финиша 1}
while l<>0 do{пока очередь не пуста}
begin
GetQ(ki,kj); {извлекаем координаты точки из очереди}
for k:=1 to 8 do{перебираем 8 направлений движения}
if (InR(ki+hodKni[k]))and(InR(ord(kj)-ord('A')+1 +hodKnj[k]))and(m[ki+hodKni[k],chr(ord(kj)+hodKnj[k])]=0)
then begin{если ход возможен и там небыли }
m[ki+hodKni[k],chr(ord(kj)+hodKnj[k])]:=m[ki,kj]+1;
putQ(ki+hodKni[k],chr(ord(kj)+hodKnj[k]));
end; {то помечаем клетку числом +1 и помещаем ее коорд.в очередь}
end;
end;

Восстановим путь
function Path(var a:tMatr;ai:integer;aj:char;pi:integer;
{восстановим путь Алисы} pj:char):string;
var I,j,ii:integer;jj:char; s:string;
begin s:='';
while not((ai=pi)and(aj=pj)) do{пока не дошли до пешки}
begin
for i:=-1 to 1 do{переберем 8 вариантов направления}
for j:=-1 to 1 do{если пришли от туда, то}
if a[ai+i,chr(ord(aj)+j)]=a[ai,aj]-1
then begin{смещаемся туда}
ii:=ai+i;jj:=chr(ord(aj)+j)
end;
ai:=ii;aj:=jj; {приклеим результат к строке}
s:=s+aj+chr(ai+ord('0'))+' '
end;
delete(s,length(s)-3,3); {удалим последние координаты}
Path:=s
end;

Задача B. Верхом на шахматной фигуре
«..пока не настанет день, когда господь отдернет пред человеком завесу будущего, вся человеческая мудрость будет заключена в двух словах: Ждать и надеяться..» «Ждать? - вскричала Алиса, - этого еще не хватало! Мы будем действовать! Мы освободим Белую Королеву сами! Для этого необходимо добраться до Черной пещеры, куда ее заточила Черная Королева».
Все Зазеркалье представляет собой огромную шахматную доску, разбитую на клетки с координатами (А1..Н8). В некоторых клетках этой доски стоят белые и черные шахматные фигуры: слоны, кони, ладьи и ферзи. Они могут легко перемещаться между клетками, в соответствии с шахматными правилами (на то они и фигуры ☺). Правда сейчас на них наложено заклятье сна – они дремлют, то есть остаются неподвижными. Однако, если вступить на поле, которое находится под боем фигуры, она немедленно проснется и скушает нарушителя. Алиса хочет использовать любую белую фигуру, как транспорт, чтобы добраться до клетки, где находится вход в пещеру. Ваша задача - определить, сможет ли Алиса это сделать, при этом найти фигуру, которая доберется до пещеры за минимальное количество ходов.

Формат входного файла input.txt:
В первой строке содержатся координаты точки назначения – входа в пещеру (заглавная латинская буква, цифра, например, А7)
Во второй строке задается число N – количество фигур на доске. (0<=N<=63)
Далее следует N строк, в каждой через один пробел располагается название фигуры (заглавные латинские буквы) и ее координаты:
BKN (WKN) – черный или белый конь (бьет поля «буквой Г»),
BSN (WSN) – черный или белый слон (бьет поля по диагонали),
BLD (WLD) – черная или белая ладья (бьет поля по вертикали, горизонтали),
BFZ (WFZ) – черный или белый ферзь (королева) (бьет поля по вертикали, горизонтали, диагонали)
Замечания:
фигуры могут загораживать друг друга;
в одной клетке запрещено находиться двум шахматным фигурам;
в полях, битых черными фигурами, останавливаться нельзя, «есть» черные фигуры нельзя;
ходы фигур и нумерация клеток соответствуют правилам шахмат;
Алиса в качестве транспорта может выбрать любую белую фигуру, не находящуюся под боем;
одним ходом считается одно перемещение фигуры в любом разрешенном направлении. Например, на пустой доске белая ладья переместится из клетки А1 в клетку Н8 за 2 хода (А8, Н8 или Н1, Н8), а слон – за 1 ход (Н8).

Этап первый: загрузка матрицы поля, выделение черных и белых фигур
Этап второй: трассировка битых полей черных фигур, исключение битых белых фигур
Черный конь
Черный слон
Черная ладья
Этап третий: поиск модифицированным волновым алгоритмом кратчайшего расстояния от каждой «небитой» белой фигуры до пещеры
Белый конь
2
2
2
2
3
3
Белая ладья
3
2
3
2
2
2
2
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
3
4
4
4
4
4
4
4
Для каждой фигуры запоминаем количество ходов, за которые она может добраться до пещеры и ищем среди них минимум

Спам
Все на игру! Все на Великую игру, - кричала Черная Королева, - победитель получит абонемент на вечное чаепитие в кабачке Болванщика.» «В чем состоит игра? - спросила Алиса пробегавшего мимо неё Белого кролика, обвешенного фотоаппаратами, как новогодняя ёлка цветными шарами. «О…это старинная компьютерная игра - «Лохотрон» называется…, - пробубнил кролик и, поняв, что удрать не удастся, продолжил, - правила таковы:
Имеется N компьютеров, соединенных между собой локальной сетью и пронумерованных числами от 1 до N. Все компьютеры заражены особым рекламным вирусом, рассылающим спам-рекламу.
Играющим известно, какой компьютер, с каким соединен (соединение не обязательно действует в обоих направлениях).
Первоначально каждый компьютер содержит одно спам-сообщение, обозначенное номером, который совпадает с номером компьютера.
Черная Королева борется с вирусом радикальным способом – она выключает некоторый компьютер, после чего все оставшиеся «в живых» вирусы копируют все имевшиеся на данный момент у них спам-сообщения по сети на непосредственно соединенный с ними компьютер с наименьшим номером (если таковых нет, то сообщения остаются на данном компьютере). Считается, что копирование происходит одновременно и мгновенно. Особенностью данного процесса является то, что каждое пришедшее сообщение на винчестере конкретного ПК не дублируется, а хранится в единственном экземпляре.
Процесс повторяется с пункта 4, пока все компьютеры не будут выключены.
Выиграет тот, кто правильно назовет для каждого спам-сообщения номер компьютера, на котором оно «погибло» последним.

Задание: напишите программу, которая по имеющемуся списку номеров выключаемых компьютеров, определит для каждого спам-сообщения номер компьютера, на котором оно осталось последним.
Формат входного файла input.txt:
В первой строке дается число N – количество компьютеров. (1<=N<=200)
В последующих N строках описывается компьютерная сеть, i-ая строка описывает связи i-го компьютера: первое число m – количество компьютеров, непосредственно связанных с i-ым, затем идет m чисел – номера ПК, связанных с данным.
Далее следует N строк – каждая строка содержит номер ПК в порядке их выключения.
Описание выходного файла output.txt:
Выведите N строк, каждая строка будет соответствовать своему сообщению и содержать номер ПК, на котором оно было отключено последним.

Структура данных
Const Max=200;
Type tstr=array[0..max] of byte;
matr=array[1..max] of tstr;
tNew=array[1..max] of boolean; tSet=set of byte;
tMess=array[1..max] of tset;
var a:matr;
n:integer;
nNew:tNew;
Mess,OMess:tMess;
x,ver:tStr;
Представим компьютерную сеть графом. Каждый ПК – вершина, а сетевой провод – дуга, соединяющая соответствующие вершины. Припишем каждой вершине (ПК) множество, оно будет хранить номера ПК, с которых данный компьютер получил спам сообщения. Для этого будут использоваться массивы Mess и Omess. Массив NNew хранит информацию о том работает ПК или уже выключен. Матрица А хранит информацию о связях между ПК (список инцидентности).

Ввод данных
fillchar(a,SizeOF(a),0);
fillchar(nNew,SizeOF(nNew),true);
assign(f,'input.txt'); reset(f);
readln(f,N); {Считаем количество ПК-вершин в графе}
for i:=1 to n do begin {Для каждой вершины графа}
read(f,k);a[i,0]:=k; {Считаем количество вершин, непосредственно связанных ней}
for j:=1 to k do {Повторяем нужное количество раз}
begin {Считаем номер очередного ПК}
read(f,z); a[i,j]:=z;
end;
sort(a[i],k); {упорядочим номера ПК по убыванию}
mess[i]:=[i];
readln(f);
end;

for i:=1 to n do {для каждого выключаемого ПК}
begin
readln(f,x[i]); {считать номер выключаемого ПК}
Omess:=Mess; {запомним состояние сообщений}
nNew[x[i]]:=false; {выключим ПК – теперь он не рассылает сообщения}
for z:=1 to N do {переберем все ПК}
begin
if nNew[z] {если ПК еще не выключен}
then begin
j:=a[z,0]; {найдем номер ПК, кому посылать сообщения}
while (j>0)and(not nNew[a[z,j]]) do
dec(j);
if (j>0)and(nNew[a[z,j]]) {если нашли ПК, то «сливаем» ему все, что у нас есть}
then mess[a[z,j]]:=mess[a[z,j]]+Omess[z]
end; {then}
end; {for z}
end; {for i}

Порядок выключения ПК: Х= 5 2 3 1 4 6
Первым ЧК выключает ПК №5. Он ничего не успевает сделать, поэтому спам-сообщение №5 остается навсегда в ПК №5, остальные ПК делают свое черное дело.
Затем ЧК выключает ПК №2. Те ПК, что еще «живы», рассылают свои сообщения.
Затем ЧК выключает ПК №3. Те ПК, что еще «живы», рассылают свои сообщения.
Затем ЧК выключает ПК №1, 4 и 6.
Теперь надо восстановить ответ. Для этого перебираем ПК в обратном порядке из выключения: 6, 4, 1, 3, 2, 5. и ПК в порядке возрастания их номеров. Тот ПК, который содержит сообщение и имеет минимальный номер и является ответом для спам сообщения
for i:= n downto 1 do
begin
for j:=1 to n do
if (j in mess[x[i]])and(ver[j]=0)
then ver[j]:=x[i]
end;
for i:=1 to n do
writeln(f,ver[i]);

Задача В. Путешествие на хамелеоне
Вот уже несколько лет в Зазеркалье проводится удивительная игра – «Гонки на хамелеоне». Игра состоит в следующем: имеется игровое поле размером NxМ, каждая клетка поля покрашена в некоторый цвет, который кодируется целым числом от 1 до К (1<=K<=10000). Игрок, верхом на хамелеоне, должен пробраться из верхней левой клетки игрового поля в нижнюю правую, при этом потратив минимальное количество яблок. Яблоко приходится отдать хамелеону за то, что он меняет свой цвет, попав в клетку другого цвета. Изначально хамелеон находится в клетке с координатами (1, 1), и имеет ее цвет. Он может перемещаться в 4-х направлениях в любую соседнюю клетку, имеющую с текущей общую сторону.
Задание: определите минимальное количество яблок, которое придется скормить хамелеону, чтобы осуществить указанное путешествие.

Формат входного файла input.txt:
Первая строка содержит два числа N и М – размер игрового поля (2<=N, М<=100).
Далее следует N строк, каждая содержит по М целых чисел, разделенных пробелом, кодирующих цвет клетки (1..10 000).
Формат выходного файла output.txt:
Выходной файл должен содержать целое неотрицательное число – минимальное количество яблок, которые придется скормить хамелеону.

Почему не обход в ширину?
Пометим точку старта числом 1. Все соседние клетки
Конфликт! Все поле «левее» необходимо пересчитать, но этих ячеек нет в очереди!

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

procedure rec(i, j, Path, Col:integer);
var k:integer;
begin
w[i, j]:=Path; PutQ(i, j, Path);
for k:=1 to 4 do
if (i+di[k]>0)and(i+di[k]<=N)and (j+dj[k]>0)and(j+dj[k]<=M)
then if (w[i+di[k],j+dj[k]]=0) and
(a[i+di[k],j+dj[k]]=a[i,j]) then Rec(i+di[k],j+dj[k],Path,a[i,j])
end;
procedure Solve(var a:matr; N,M:integer);
var i,j,k,Col:integer;
begin
g:=1;xv:=0; L:=0;
Rec(1,1,1,a[1,1]);
While L<>0 do
begin
GetQ(i,j,Col); {WritePole;}
for k:=1 to 4 do
if (i+di[k]>0)and(i+di[k]<=N)and
(j+dj[k]>0)and(j+dj[k]<=M) and (w[i+di[k], j+dj[k]]=0)
then Rec(i+di[k],j+dj[k],Col+1,a[i, j])
end;

procedure rec(i, j, Path, Col:integer);
var k:integer;
begin
w[i, j]:=Path; PutQ(i, j, Path);
for k:=1 to 4 do
if (i+di[k]>0)and(i+di[k]<=N)and (j+dj[k]>0)and(j+dj[k]<=M)
then if (w[i+di[k],j+dj[k]]=0)
then if a[i+di[k],j+dj[k]]=a[i,j] then Rec(i+di[k],j+dj[k],Path,a[i,j])
end;
procedure Solve(var a:matr; N,M:integer);
var i,j,k,Col:integer;
begin
g:=1;xv:=0; L:=0;
Rec(1,1,1,a[1,1]);
While L<>0 do
begin
GetQ(i,j,Col); {WritePole;}
for k:=1 to 4 do
if (i+di[k]>0)and(i+di[k]<=N)and
(j+dj[k]>0)and(j+dj[k]<=M) and (w[i+di[k], j+dj[k]]=0)
then Rec(i+di[k],j+dj[k],Col+1,a[i, j])
end;

Задача D. 38 попугаев
«Сегодня удивительное утро», - подумала Алиса, заходя в кабачок Болванщика. «Что случилось, друзья?», - спросила она у завсегдатаев, понуро сидевших за столами, с грустными лицами и мрачным настроением. «Видишь ли, Алиса», - пробормотал Белый Кролик, - «сегодня, после просмотра мультфильма 38 попугаев, мы решили измерить свой рост и сравнить его между собой, но у нас ничего не получилось. Теперь жизнь прожита зря, небо упадет на землю, а Дунай потечет вспять!» «Не стоит так падать духом», - воскликнул Болванщик, - «ведь у нас есть хакер Алиса, она нам поможет нам провести измерения». «А в чем, собственно, проблема?», - важно нахмурив лоб, спросила у присутствующих Алиса, и тут же пожалела об этом. Хор, перебивающих друг друга голосов, сообщил следующее:
Каждый присутствующий посетитель измерил свой рост в некоторых единицах, нравящихся исключительно ему, (метрах, сантиметрах, локтях, попугаях, мартышках и так далее).
Имеется таблица соответствия, в которой некоторым единицам измерения ставятся в соответствие другие величины. Например,
1 м=100 см.
Проблема: сравнить рост указанных посетителей и определить кто выше или ниже.
Задание: по имеющейся информации о росте жителей Зазеркалья, таблице соответствия метрических единиц сравнить рост указанных жителей.

Формат входного файла input.txt:
Первая строка содержит три числа: N - количество посетителей, присутствовавших в кабачке (1<= N <=50), К – количество соответствий единиц измерения (1<=K<=100, общее количество единиц измерения также не более 100) и М – количество пар посетителей, рост которых необходимо сравнить (1<=M
Далее следует N строк, каждая имеет следующий формат: Имя жителя (строка не более 20 символов и не содержащая пробелов), пробел, натуральное число (не более миллиарда) и название единицы измерения (строка не более 15 символов), разделенные пробелом.
Далее идут К строк, каждая ставит в соответствие две различные величины:
неотрицательное число, не превосходящее 1000, пробел, название единицы измерения, затем следует символ «=», далее снова неотрицательное число, не превосходящее 1000, пробел и название единицы измерения (например, 5 м=500 см). Гарантируется отсутствие противоречий в соотношениях единиц измерения длины (например, 1 м=100 см, 1 см=10 мм, 1 мм=1 м). Рост самого высокого жителя Зазеркалья в самых мелких единицах не превосходит 10^18, а рост самого низкого в самых крупных единицах не меньше 10^-18.
Далее следует М строк, каждая содержит имена двух жителей, разделенных пробелом, рост которых необходимо сравнить.
Формат выходного файла output.txt:
Выведите в выходной файл один символ для каждой соответствующей строки из М строк входного файла:
> – если рост первого жителя больше второго;
< – если рост первого жителя меньше второго;
= – если рост первого жителя равен росту второго;
? – если соотношение ростов указанных жителей сравнить не удалось.

Матрица А будет хранить соотношение между различными единицами. Так как матрицу нельзя индексировать названиями единиц, то сохраним их названия в списках Ed
Теперь единице мм соответствует код 1, а м – 3. Считывая данные из файла мы дополняем список единиц и заполняем матрицу А. Если известно, что 1 ed1=4 ed2, то
1 ed2=1/ 4 ed1.
Предположим, что мы не знаем соотношение между метрами и миллиметрами, но нам известно, что:
1 м = 100 см
1 см = 10 мм
Можем представить ситуацию графом, где вершины – это единицы, а дуги – соотношение между ними. Тогда, если мы сможем добраться из вершины ‘мм’ в ‘м’, то мы сможем установить соотношение между ними
10*100=1000

assign(f,NameF); reset(f); assign(fOut,'Output.txt'); reWrite(fOut);
Readln(f,N,K,M);
for i:=1 to N do
begin readln(f,s);
j:=pos(' ',s); Name[i]:=copy(s,1,j-1); delete(s,1,j);
j:=pos(' ',s); Val(copy(s,1,j-1),Rost[i],code); delete(s,1,j);
EdRost[i]:=AddEd(s)
end;
for i:=1 to K do
begin
readln(f,s);Os:=s;
j:=pos(' ',s); Val(copy(s,1,j-1),V1r,code); delete(s,1,j);
j:=pos('=',s); ed1:=AddEd(copy(s,1,j-1)); delete(s,1,j);
j:=pos(' ',s); Val(copy(s,1,j-1),V2r,code); delete(s,1,j);
ed2:=AddEd(s);
a^[Ed1,Ed2]:=v2r/v1r; a^[Ed2,Ed1]:=v1r/v2r;
end;

Function AddEd(s:string):integer; {добавляет имя в список имен}
var i:integer;
begin
Ed[KolEd+1]:=s; i:=1;
While Ed[i]<>s do
inc(i);
if i>kolEd then inc(KolEd);
AddEd:=i
end;
Function SeekName(s:string):integer; {ищет имя и возвращает его индекс}
var i:integer;
begin
Name[N+1]:=s; i:=1;
While Name[i]<>s do
inc(i);
if i>N then i:=0;
SeekName:=i
end;

Procedure Floid(a:pMatr;n:integer); {строит таблицу соотношений}
var i,j,m:integer; {между различными единицами}
function min(x,y:real):real;
begin
if x=0 then Min:=y
else if y=0 then Min:=x
else if x
end;
Begin
For i:=1 to N do
For j:=1 to n do
if A^[i,j]=0 then W^[i,j]:=0 else W^[i,j]:=A^[i,j];
For i:=1 to N do W^[i,i]:=1;
For m:=1 to N do
For i:=1 to N do
For j:=1 to N do
if W^[i, j]=0 then W^[i,j]:= min(W^[i,j],W^[i,m]*W^[m,j]);
End;
Задача установления пути между всеми парами вершин решается алгоритмом Флойда, однако на практике он не работает, так как ищет не путь, а наименьший путь и из-за падения точности все значения обнуляются

Floid(a,KolEd);
for i:=1 to m do
begin
readln(f,s);
j:=pos(' ',s); v1:=SeekName(copy(s,1,j-1));
delete(s,1,j); v2:=SeekName(s);
r1:=Rost[v1]; r2:=Rost[v2];
vv1:=EdRost[v1]; vv2:=EdRost[v2];
if W^[vv1,vv2]=0
then writeln(fout,'?')
else if abs(r1-r2*w^[vv2,vv1])<0.01
then writeln(fout,'=')
else if (r1>r2*w^[vv2,vv1])
then writeln(fout,'>')
else writeln(fout,'<')
end;

Второй способ решения – обход графа в глубину: если мы смогли добраться до вершины, значит нашли соотношение ростов двух людей.
function dsu_find(x:integer):integer;
var a:extended;
begin
if units[x].SI=x
then dsu_Find:=x
else begin
dsu_find(units[x].si);
units[x].factor:=units[x].factor*
units[units[x].SI].factor;
units[x].SI:=units[units[x].SI].SI;
dsu_find:=units[x].SI;
end;
end;

Задача А. Волшебная Змейка
Однажды Алисе приснился странный сон, будто тот, чье имя нельзя произносить, решил проникнуть из волшебного мира Гарри Поттера в обыденность Зазеркалья и уничтожить живые краски зазеркального мира, доброту и спокойствие этих мест. Для этого Воланд де Морт решил послать в Зазеркалье свою змею Нагайну, которая должна покусать всех жителей или, в крайнем случае, обшипеть (а кому приятно, когда на него шипят?). «Что же делать?» - во сне обратилась Алиса к Белой Королеве. Та, полистав древние мудрые книги (это всегда полезно), ответила – «надо вырастить свою Змейку, да не обычную, а большую и прокаченную, ответить, так сказать, силой на силу». Чтобы вырастить длинную Змейку, её нужно накормить волшебными яблоками, которые падают на землю в саду Черной Королевы. Сад представляет собой прямоугольное поле, разбитое на клетки. Каждая клетка может быть пустой, содержать яблоко или камень. Змейка умеет ползать только вперед и есть яблоки, встречающиеся на ее пути. Чтобы управлять Змейкой существует программа, состоящая из простых команд L, R, U, D, которые означают повернуть голову Змейки влево, вправо, вверх и вниз соответственно, а затем сместить каждое звено тела Змейки на одну позицию вперед. Например, выполняя команду L, Змейка поворачивает голову влево, смещает ее в клетку игрового поля, расположенную слева от текущей. Затем каждое звено тела Змейки смещается в клетку, которую занимало предыдущее звено.

Змейка прекращает выполнение программы, если:
она выполнила все команды программы;
ее голова вышла за пределы игрового поля;
ее голова встретила на своем пути камень;
голова Змейки врезалась в собственное тело.
Существует два режима игры: с увеличением длины Змейки или нет (прокачивается ее «крутизна»). Если игра идет с увеличением длины хвоста, то после того, как голова Змейки переместилась в клетку с яблоком (съела очередное яблоко), тело остается на месте, то есть длина Змейки увеличивается на одну клетку. В другом режиме, Змейка просто смещается на одну клетку вперед – это означает смещение головы в соседнюю клетку в заданном программой направлении.

Формат входного файла input.txt:
Первая строка содержит одно число Z (0 или 1), которое определяет режим игры, если Z=0, то игра происходит без увеличения длины хвоста, иначе – с увеличением.
Во второй строке дано два числа N и M, разделенные пробелом. (2<=N, M<=100) - размеры игрового поля.
В следующих N строках по М символов в каждой задается само поле (нет пробелов!):
символ ‘.’ (точка) означает, что это пустая клетка;
символ ‘@’ обозначает голову Змейки;
‘#’ (только на рисунках) – обозначает тело змеи, первоначально длина тела (хвоста) всегда 0 звеньев – Змейка только что вылупилась из яйца, но в процессе поедания яблок длина хвоста может расти;
‘*’ - значит, что в этой клетке лежит яблоко;
% - означает камень.
В следующей строке дается число K (1<=K<=1000) - количество команд, которые заданы змейке.
В последней строке задается последовательность из K символов – алгоритм, задающий передвижение Змейки.
Гарантируется, что входные данные корректны и две последовательные команды алгоритма не будут заставлять Змейку двигаться в противоположном направлении.
Формат выходного файла output.txt:
Вывести единственное число – количество яблок, которые удастся съесть Змейке.
Особенности тестов:
не менее 5 тестов без увеличения длины хвоста Змейки;
порядка 10 тестов с увеличением длины ее хвоста;
8 тестов с программой длиной не более 255 команд, 7 тестов – не более 1000.

Задача относится к классу «моделирование» - самые простые задачи. Достаточно корректно выполнить все условия задачи. Считаем поле в матрицу и будем моделировать движение Змейки. В подзадаче 0, когда Змейка не растет, Змейка превращается в точку (голову). В подзадаче 1 – есть два случая – Змейка сдвигает кончик хвоста (в случае простого движения) и не сдвигает (когда съела яблоко), в этом случае сдвигается только голова, а длина Змейки увеличивается на 1. Так как каждое «звено» Змейки повторяет предыдущий путь головы, то будем хранить все тело Змейки в очереди, а затем каждое «звено» сдвигать вперед.

Procedure Load(NameF:string;Var a: tMatr; var Z,N,M,K:integer; Var Pr:tPr);
Var i,j:integer; f:text;
begin
assign(f,NameF);reset(f); readln(f,Z); readln(f,N,M); {считаем размеры поля}
for i:=1 to N do
begin
for j:=1 to M do
begin
read(f,a[i,j]); {считаем само поле}
if a[i,j]='@‘ {если это голова Змеки, то запомним ее координаты}
then begin zi:=i; zj:=j end
end;
readln(f);
end;
readln(f,K); {считаем направление движения Змейки}
for i:=1 to K do read(f,Pr[i]);
close(f);
end;

apple:=0; g:=1;xv:=0;l:=0; {инициализируем очередь}
for i:=1 to k do
begin
case Pr[i] of {зададим вектор направления движения Змейки}
'L': if zj=1 then break else begin di:=0;dj:=-1; end;
'R': if zj=M then break else begin di:=0;dj:=1; end;
'U': if zi=1 then break else begin di:=-1;dj:=0; end;
'D': if zi=N then break else begin di:=1;dj:=0; end;
end;
case a[zi+di,zj+dj] of {посмотрим, что впереди Змейки}
'%','#': break; {Если камень или собственное тело, то - выход}
'.': begin {Если пусто, то вместо головы – тело}
a[zi,zj]:='#'; PutQ(zi,zj); {новое «звено» - в очередь}
zi:=zi+di; zj:=zj+dj; a[zi,zj]:='@'; {голову - вперед}
GetQ(XVi,XVj); a[XVi,XVj]:='.'; {удалим «конец» хвоста}
end;
'*':begin {если яблоко, то:}
inc(apple); {увеличим количество яблок}
if z=0 then a[zi,zj]:='.‘{если режим 0, то тело не удлиняется}
else begin a[zi,zj]:='#'; PutQ(zi,zj); end;
zi:=zi+di; zj:=zj+dj; {сдвинем координаты головы}
a[zi,zj]:='@'; {поместим голову в матрицу}
end;
end;

Задача В. Компьютерный вирус
Вот уже несколько лет подряд Белая Королева проводила информатизацию Зазеркалья. Сотни компьютеров были установлены в различных точках страны, а затем объединены в локальную сеть. Но работы по информатизации не подчиняются лозунгу «Всем по компу», а предусматривают целый комплекс мероприятий по обучению персонала правилам поиска, хранения и обработки информации (К сожалению, большинство пользователей до сих пор крутит презентации на своих компах). По приказу Черной Королевы злобный Бормоглот заразил некоторые ПК несколькими типами вирусов, которые начали неконтролируемо размножаться. Каждый «больной» компьютер, заражает все «здоровые» ПК, непосредственно связанные с ним проводами. Если соседний ПК уже заражен, то новый вирус уже не может попасть на этот компьютер. Таким образом, заболела вся сеть. Белая Королева призвала на помощь Алису. Чтобы начать писать программу антивирус, Алисе необходимо узнать, сколько ПК «болеет» конкретным типом вируса. Помогите Алисе справиться с данной проблемой!
Имеется N компьютеров, объединенных в сеть (некоторые группы ПК могут быть изолированы от других компьютеров) и К типов вирусов. Каждый экземпляр вируса размножается раз в секунду, копируя свой код на все непосредственно связанные с данным компьютером ПК. Особенности заражения:
каждый вирус обозначается числом от 1 до К;
вирус типа «1» может создавать копии только своего типа («1»);
вирусы могут заражать только «незараженный» ПК;
если несколько типов вирусов одновременно пытаются заразить некоторый компьютер, то приоритет отдается вирусу с наименьшим номером.
Задание: определите для каждого типа вируса, какое количество ПК ему удастся заразить.

Формат входного файла input.txt:
Первая строка содержит два числа N – количество ПК (2<=N<=100) и К – количество типов компьютерных вирусов (1<=K <=10<=N).
Вторая строка содержит К чисел – номера ПК, которые были первоначально заражены (первое число соответствует номеру ПК, зараженному вирусом типа 1 и т.д.).
Далее следует N строк, каждая описывает связи i-го ПК: первое число – количество ПК, непосредственно связанных с i-ым. Далее следуют номера этих компьютеров.
Формат выходного файла output.txt:
Выходной файл должен содержать К целых чисел: i-ое число равно количеству ПК, зараженных вирусом i-го типа.

for i:=1 to 10 do {для каждого типа вирусов будет своя очередь}
begin New(Q[i]); g[i]:=1;l[i]:=0;xv[i]:=0 end;
FillChar(fNew,SizeOf(fNew),0);
Load('input.txt'); Time:=0; {время, прошедшее от начала процесса}
repeat
inc(Time); f:=true;
for i:=1 to k do {переберем все вирусы}
if l[i]<>0
then begin
zz:=l[i]; f:=false;
for ii:=1 to zz do begin
v:=GetQ(q[i],g[i],l[i]);
for j:=1 to a[v][0] do begin
y:=a[v][j];
if fNew[y]=0 then begin
fNew[y]:=i; PutQ(Q[i],xv[i],l[i],y);
end;
end;
end
end
until f;
Save('output.txt');
8
4
4
6
3

Задача D. Темный лабиринт (30 баллов)
Одной из главных достопримечательностей Зазеркалья был Темный лабиринт, построенный по личному проекту Черной Королевы. Лабиринт представлял собой несколько огромных залов, соединенных между собой коридорами. По этим коридорам путешественники могли переходить из одного зала в другой. В каждом зале размещалась латинская буква, украшенная драгоценными камнями. Очень часто в лабиринте устраивали игры на Кубок ЧК. Игра состояла в том, что путешественник начинал движение из стартового холла (с номером 0) и, последовательно посещая некоторые залы, собирал заданное слово (каждый зал можно посещать только один раз). Тот, кому удавалось собрать слов больше, чем другие, объявлялся чемпионом Темного лабиринта.
Благодаря сайту ВискасЛикс Алисе с большим трудом удалось достать карту Темного лабиринта, а также список слов, которые необходимо попытаться составить, перемещаясь между залами лабиринта.
Задание: Помогите Алисе, напишите программу, которая по карте лабиринта и списку загаданных слов ответит, возможно ли составить заданное слово или нет.

Формат входного файла input.txt:
Первая строка содержит два числа: N – количество залов с буквами (2<=N<=20) и М – количество загаданных слов (1<=M<=10).
Вторая строка содержит N строчных латинских букв (без пробелов), первая буква соответствует первому залу, вторая – второму и т.д. Буквы могут повторяться несколько раз.
Далее следует N+1 строка, каждая содержит: число К – количество коридоров исходящих из данного зала (не по всем коридорам можно двигаться в обоих направлениях). Далее следует К целых чисел, разделенных пробелом, задающих номера залов, с которыми непосредственно связан данный зал. Первая строка этой группы соответствует стартовому холлу, имеющему номер 0, именно с него путешественники начинают свое движение.
Далее следует М строк – каждая содержит загаданное непустое слово (длина не более N строчных латинских символов).
Формат выходного файла output.txt:
Выходной файл должен состоять из М строк, каждая строка должна содержать слово yes, если можно собрать соответствующее слово из входного файла, или no – если нельзя. (5 секунд на тест)
Ограничения и особенности тестов:
5 секунд на тест.
2<=N<=10 порядка 10 тестов
2<=N<=20, количество путей в лабиринте не более 10^8 – 15 тестов
2<=N<=20 – 5 тестов

Procedure Load(NameF:string);
var f:text; k,i,j:integer; c:char; s:string;
begin
assign(f,Namef); reset(f);
readln(f,N,M); fillchar(a,SizeOf(a),0);
for i:=1 to n do {считаем слово}
read(f,Lit[i]);
readln(f);
for i:=0 to n do {считаем граф}
begin {считаем количество связей i-ой вершины}
read(f,k); a[i,0]:=k; NewF[i]:=true;
for j:=1 to k do {считаем номера вершин, связанных с вершиной i}
begin
read(f,a[i,j]);
end;
readln(f)
end;
for i:=1 to M do
begin
Readln(f,w[i]); {считаем буквы, расположенные в вершинах}
IF w[i]='' THEN begin
Writeln('Not correct word'); halt(1);
end;
end;
close(f);
end;

Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true {если слово составлено, то ОК}
else begin {если слово не составлено, то}
for i:=1 to a[v,0] do {переберем все связи вершины V}
begin
k:=a[v,i]; {выберем связанную с V вершину к}
if (Lit[k]=st[L])and NewF[k] {если там не были}
then begin {и буква вершины к нас устраивает, то}
NewF[k]:=false; {пометим вершину к}
Rec(k,L+1,len,res); {пойдем дальше}
NewF[k]:=true; {снимем отметку с вершины к}
end
end
end;
end;
begin
for i:=1 to M do {переберем все слова, которые надо построить}
begin
St:=W[i]; Res:=false;
Rec(0,1,length(St),Res) ;
if Res then writeln(f,'yes') else writeln(f,'no');
end;
end;

Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
c
7 3
amambdc
3 1 2 3
2 5 4
1 1
2 2 4
2 3 6
2 4 7
0
2 6 4
mama
abc
abd
1
L
0
v
4
Len
k
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Перебираем все вершины, связанные с v, их a[v,0] =3 штуки (a, m, a)
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем первую в списке, это вершина ‘a’.
Она не совпадает с St[k]=‘m’, дальше идти нет смысла
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем вторую в списке, это вершина ‘m’.
Она совпадает с St[k]=‘m’, идем дальше.
m
mama
mama
1
2
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем очередную вершину ‘а’.
Она совпадает с St[k]=‘а’, идем дальше.
а
mama
1
2
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем очередную вершину ‘b’.
Она не совпадает с St[k]=‘m’, ищем дальше.
b
mama
3
3
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем очередную вершину ‘m’.
Она совпадает с St[k]=‘m’, идем дальше.
m
mama
4
3
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем очередную вершину ‘d’.
Она не совпадает с St[k]=‘а’, ищем дальше.
d
mama
6
4
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
Выбираем очередную вершину ‘a’.
Она совпадает с St[k]=‘а’, ищем дальше.
a
mama
5
Procedure Rec(v,L,len:byte;var Res:boolean);
var i,k:byte;
begin
if L>len then res:=true
else begin
for i:=1 to a[v,0] do
begin
k:=a[v,i];
if (Lit[k]=st[L])and NewF[k]
then begin
NewF[k]:=false;
Rec(k,L+1,len,res);
NewF[k]:=true;
end
end
end;
end;
L>len, слово найдено
5