Калейдоскоп из комбинаторных алгоритмов
Бинарное дерево
Строится бинарное дерево. В узлы дерева засылаются целые положительные числа, выбранные случайным образом. После задания значений вершин на каждом уровне эти значения выводятся на экран, начиная с корневой. Пользователю предлагается сделать выбор номера уровня, в нем определяется максимальное значение и выводится на экран.
Программа 3. Поиск максимального элемента.
{ Алгоритм реализован на языке программирования Turbo-Pascal}
uses crt;
type sp=^tree;
tree=record
val:integer;
l:sp;
r:sp;
end;
var
t:sp;
nh, max,h,i:integer;
procedure find(t:sp; h,nh:integer);
begin
if t=nil then exit;
if h=nh then
begin
if t^.val> max then max:=t^.val;
end
else
begin
find(t^.l,h+1,nh);
find(t^.r,h+1,nh);
end;
end;
procedure zadtree(var t:sp; h,nh:integer);
begin
if h=5 then
begin
new(t);
t^.l:=nil;
t^.r:=nil;
t^.val:=random(100);
end
else
begin
new(t);
zadtree(t^.l, h+1,nh);
zadtree(t^.r, h+1,nh);
t^.val:=random(100);
end;
end;
procedure writetree(t:sp; h,nh:integer);
begin
if t=nil then exit;
if h=nh then
begin
write(t^.val,' ');
end
else
begin
writetree(t^.l,h+1,nh);
writetree(t^.r,h+1,nh);
end;
end;
begin
clrscr;
randomize;
t:=nil;
zadtree(t,1,nh);
for i:=1 to 5 do
begin
writetree(t,1,i);
writeln;
end;
max:=0;
write('vvedite uroven ');
readln(nh);
find(t,1,nh);
write('max= ',max);
readln;
end.Задача о восьми ферзях
Условие задачи. Найти все такие расстановки восьми ферзей на шахматной доске, при которых ферзи не бьют друг друга.
Анализ задачи. Пусть 
- множество искомых расстановок (конфигураций).
Рассмотрим следующий подход к решению задачи. Будем искать множество
конфигураций 
со следующими свойствами:
-
. - Имеется условие, позволяющее по элементу из определить,
принадлежит ли он .
- Имеется процедура, генерирующая все элементы из .
С помощью процедуры из пункта 3 будем генерировать по очереди все
элементы из ; для элементов из проверяем (см.
пункт 2) принадлежит
ли он : в результате в силу 1 свойства будут порождены все
элементы .
Заметим теперь, что ферзи, которые не бьют друг друга, должны располагаться
на разных горизонталях. Поэтому можно упорядочить ферзи и всегда ставить 
-го ферзя на -ю горизонталь. Тогда в качестве можно
взять множество конфигураций, в которых на каждой из первых 
горизонталей стоит
ровно по одному ферзю, причем никакие два ферзя не бьют друг друга.
Программа 4. Расстановка восьми ферзей на шахматной доске.
{ Программа выдает все комбинации ферзей, которые не бьют друг друга.
Алгоритм реализован на языке программирования Turbo-Pascal }
program ferz;
uses crt;
const desksize=8;
type sizeint=1..desksize;
unuses=set of sizeint;
combinates=array[shortint] of sizeint;
var num:byte;
combinate:combinates;
unuse:unuses;
function attack(combinate:combinates):boolean;
var i,j:byte;
rightdiag,leftdiag:combinates;
begin
attack:=false;
for i:=1 to desksize do
begin
leftdiag[i]:=i+combinate[i];
rightdiag[i]:=i-combinate[i];
end;
for j:=1 to desksize do
for i:=1 to desksize do
begin
if (i<>j) and ((leftdiag[i]=leftdiag[j])or(rightdiag[i]=rightdiag[j]))
then
begin
attack:=true;
exit;
end;
end;
end;
procedure output(combinate:combinates);
var i,j:byte;
begin
for i:=1 to desksize do
for j:=1 to desksize do
begin
gotoxy(i,j);
if(combinate[i]=j) then write(#2) else write(' ');
end;
readln;
end;
procedure create(num:byte; unuse:unuses; combinate:combinates);
var i:byte;
begin
if num<=desksize then
for i:=1 to desksize do
begin
if i in unuse then
begin
combinate[num]:=i;
create(num+1,unuse-[i],combinate);
end;
end
else if not attack(combinate) then output(combinate);
end;
begin
textmode(c40);
clrscr;
unuse:=[1..desksize];
create(1,unuse,combinate);
end.