{ 3.Бэк-трекинг: Домино }
{--------------------------------------------------------------------------} 
{ Берутся случайных N костяшек из одного набора домино (1<=N<=28). }
{ Задача состоит в том, чтобы образовать из этих N костяшек самую длинную }
{ цепочку, состыковывая их по правилам домино частями с равным количеством }
{ точек. }
{ }
{ Входные данные: Входной файл с именем "D.IN" содержит информацию о }
{ наборе костяшек. 1-я строка - количество костяшек. }
{ 2-я и последующие строки - парные наборы точек (числа разделены }
{ пробелом). В каждой строке записана пара точек, указанной на одной }
{ костяшке. Количество пар соответствует числу из первой строки. }
{ Выходные данные: результаты работы программы записываются в файл "D.OUT".}
{ 1-я строка содержит длину максимальной цепочки костяшек. 2-я строка }
{ содержит пример такой цепочки, при этом пары (цифры) на костяшках }
{ записываются без пробелов, подряд, а между костяшками в цепочке ставится }
{ двоеточие. }
{ Пример входного файла: Пример выходного файла: }
{ 5 5 }
{ 1 2 56:62:21:13:36 }
{ 1 3 }
{ 2 6 }
{ 3 6 }
{ 5 6 }
{--------------------------------------------------------------------------} 

{ Задача "Домино", решение: А.Никитина, Самара }
{$M $C000,0,650000}
const max = 28;
 maxtime = 60;
 tl :longint = (maxtime*18); { чуть меньше 60 сек }
 yes :boolean = false; {флаг выхода, если уже есть цепочка из n}
var m :array [0..6,0..6] of boolean;
 n :byte; {кол-во костяшек на входе, 1..28}
 cep,best :array [1..max*2] of byte; { цепочка/память }
 p,maxlen :integer; { указатель на хвост цепочки/длина макс.цеп. }
 jiffy :longint absolute $0040:$006C; { секундомер, точнее тикомер }

procedure ReadData; { начальные установки и считывание данных }
var i,a,b : byte;
begin
 tl:=jiffy + tl;
 p:=1; maxlen:=0;
 assign(input,'d.in'); reset(input);
 fillchar(cep,sizeof(cep),0);
 fillchar(m,sizeof(m),false);
 readln(n);
 for i:=1 to n do begin
 readln(a,b);
 m[a,b]:=true; m[b,a]:=true;
 end;
 close(input);
end;

procedure WriteResults; { запись результата }
var i : integer;
begin
 assign(output,'d.out'); rewrite(output);
 writeln(maxlen div 2);
 if (maxlen > 1) then begin
 i:=1;
 while (i < pred(maxlen)) do begin
 write(best[i],best[i+1],':');
 inc(i,2);
 end;
 write(best[pred(maxlen)],best[maxlen]);
 end;
 close(output);
end;
{ более длинная цепочка запоминается в массиве best }
procedure s_cep;
begin
 if (p-1 > maxlen) then begin
 move(cep,best,p-1);
 maxlen:=p-1;
 yes:=(maxlen div 2=n);
 end;
end;
{ сущеуствует ли еще подходящие костяшки? }
function exist(k:integer):boolean;
var i : integer;
begin
 i:=0; while (i<=6) and not(m[k,i]) do inc(i);
 exist:=(i<=6);
end;
{ построение цепочек }
procedure make_cep(f:integer);
var s:integer;
begin
 if (yes) or (tl-jiffy<=0) then exit; {пора остановиться?}
 if (m[f,f]) then begin {исключение позволяет улучшить перебор}
 m[f,f]:=false; { убираем костяшку }
 cep[p]:=f; cep[succ(p)]:=f; inc(p,2); {идея исключения - Савин}
 if exist(f) then make_cep(f) else s_cep;
 dec(p,2);
 m[f,f]:=true; { возвращаем костяшку }
 end else
 for s:=0 to 6 do {стандартный бэк-трекинг}
 if (m[f,s]) then begin
 m[f,s]:=false; m[s,f]:=false; { убираем костяшку }
 cep[p]:=f; cep[succ(p)]:=s; inc(p,2);
 if exist(s) then make_cep(s) else s_cep;
 dec(p,2);
 m[f,s]:=true; m[s,f]:=true; { возвращаем костяшку }
 end;
end;

var i:integer;
begin
 ReadData;
 for i:=0 to 6 do make_cep(i);
 WriteResults;
end.

{ 4.Бэк-трекинг: Последовательность }
{--------------------------------------------------------------------------}
{ Дана последовательность натуральных чисел (значение каждого числа }
{ от 1 до 1000). После-довательность может быть не отсортирована. }
{ Надо найти вариант самой большой (по количеству элементов) неубывающей }
{ последовательности, составленной из чисел этого ряда. Порядок включения }
{ чисел в неубывающую последовательность должен соответствовать порядку }
{ следования чисел в первоначальной последова-тельности. Иными словами, }
{ числа с большими номерам и в новой последовательности размещаются правее }
{ чисел с меньшими номерами. }
{ }
{ Входные данные: файл SEQ.IN в 1-й строке содержит количество чисел в }
{ последовательности - N (1<=N<=100). }
{ Со 2-й строки и далее указан ряд чисел, каждое число размещается на }
{ новой строке. Поиск ошибок в файле не требуется, входные данные }
{ корректны. }
{ }
{ Выходные данные: }
{ В файле SEQ.OUT помещаются выходные данные. }
{ 1-я строка содержит длину максимальной неубыващей последовательности. }
{ 2-я строка и далее - пример такой последовательности, каждое число в }
{ порядке следования размещается на новой строке. }
{ }
{ Пример возможного теста: }
{ }
{ Файл "SEQ.IN" Файл "SEQ.OUT" }
{ 12 7 }
{ 59 4 }
{ 4 21 }
{ 21 27 }
{ 36 34 }
{ 18 45 }
{ 27 47 }
{ 79 93 }
{ 34 }
{ 45 }
{ 47 }
{ 34 }
{ 93 }
{--------------------------------------------------------------------------}

{$M $8000,0,$4ffff} (* последовательность, Никитин *)
Const MaxItem = 100;
 TimeLimit = 29*18; {29 sec}

var Numbers, Seq, Best: array[1..MaxItem] of integer;
 pc,maxpc,num:integer;
 timer:longint absolute $0040:$006C;
 jiffy:longint;

Procedure Init;
var i:integer;
begin
 jiffy:=timer;
 fillchar(Numbers, Sizeof(Numbers),#0);
 Seq:=Numbers; Best:=Numbers; pc:=0; maxpc:=0;
 assign(input,'seq.in'); reset(input);
 readln(num); if num>MaxItem then num:=MaxItem;
 for i:=1 to num do readln(Numbers[i]);
 close(input);
end;

Procedure Done;
var i:integer;
begin
 assign(output,'seq.out'); rewrite(output);
 writeln(maxpc);
 for i:=1 to maxpc do writeln(Best[i]);
 close(output);
end;

procedure StoreChain;
begin
 if (pc > maxpc) then begin
 Best:=Seq;
 maxpc:=pc;
 if (maxpc=num) then begin
 Done;
 Halt(0);
 end;
 end;
end;

function testFWD(i:integer):integer;
var m:integer;
begin
 m:=Numbers[i]; inc(i);
 while (i <= num) and (m > Numbers[i]) do inc(i);
 if i > num then testFWD:=0 else testFWD:=i;
end;

procedure solution(n:integer); { Основная процедура }
var i,s:integer;
begin
 if ((timer-jiffy)>TimeLimit) then exit;
 i:=testFWD(n);
 if (i=0) then begin
 StoreChain;
 end else begin
 inc(pc); {проверили этот путь}
 Seq[pc]:=Numbers[i];
 solution(i);
 dec(pc); {идем по другому}
 s:=Numbers[i]; Numbers[i]:=-1; {вычеркнули}
 solution(n);
 Numbers[i]:=s; {вернули}
 end;
end;

var index:integer;
begin
 Init;
 index:=1;
 repeat
 pc:=1;
 Seq[pc]:=Numbers[index];
 solution(index);
 while (index <= num) and (Numbers[index] >= Seq[pc]) do inc(index);
 until (index > num);
 Done;
end.
{ 5.Бэк-трекинг: Магические квадраты }
{ Построить матрицу NxN, в которой сумма элементов в каждой строке, в }
{ столбце, в каждой диагонали (их 2) имеют одинаковую сумму. }
{ Подсказка: такая сумма может быть определена заранее и равна }
{ n*n(n*n+1) div (2*n) }
{--------------------------------------------------------------------------}
const N=3; SQRN = N*N; {будет матрица NxN}
 IdealSum = N*(SQRN+1) div 2;
var a:array[1..SQRN] of byte;
 b:array[1..SQRN] of byte;
 f:boolean; recurse:longint;

Procedure PRINT;
var i,j:integer;
begin
 assign(output,'magic.out'); rewrite(output);
 for i:=1 to N do begin
 for j:=1 to N do write(a[pred(i)*N+j],' ');
 writeln;
 end;
end;

function TestRow(i:integer):boolean;
var j,s:integer;
begin
 s:=0; i:=(i-1)*n;
 for j:=1 to N do s:=s+a[i+j];
 TestRow:=(s=IdealSum);
end;

function TestCol(i:integer):boolean;
var j,s:integer;
begin
 s:=0;
 for j:=1 to N do s:=s+a[(j-1)*N+i];
 TestCol:=(s=IdealSum);
end;

function TestDiag:boolean;
var j,s:integer;
begin
 s:=0;
 for j:=1 to N do s:=s+a[(N-j)*N+j];
 TestDiag:=(s=IdealSum);
end;

function TestMagic:boolean; {Тест всей матрицы на соотв. маг. квадрату}
var srow,scol,sdiag1,sdiag2,i,j:integer;
begin
 TestMagic:=FALSE;
 sdiag1:=0; sdiag2:=0;
 for i:=1 to N do begin
 srow:=0; scol:=0;
 for j:=1 to N do begin
 srow:=srow+a[pred(i)*N+j];
 scol:=scol+a[pred(j)*N+i];
 end;
 if (srow<>scol) or (scol<>IdealSum) then EXIT;
 sdiag1:=sdiag1+a[pred(i)*N+i];
 sdiag2:=sdiag2+a[(N-i)*N+i];
 end;
 if (sdiag1<>sdiag2) or (sdiag2<>IdealSum) then EXIT;
 TestMagic:=TRUE;
end;

procedure SqMagic(k:integer);
var i:integer; still:boolean;
begin
 i:=1;
 while (i<=SQRN) and NOT(f) do begin
 still:=true;
 if b[i]=0 then begin
 b[i]:=1; a[k]:=i;
 if k=SQRN then begin
 if TestMagic then begin PRINT; f:=true; still:=false; end;
 end else if (k mod n=0) then begin {если завершена строка}
 if NOT(TestRow(k div n)) then still:=false;
 end else if (k>SQRN-N) then begin {если завершен столбец}
 if NOT(TestCol(k mod n)) then still:=false;
 end else if (k=SQRN-N+1) then begin {если завершена диагональ}
 if NOT(TestDiag) then still:=false;
 end;
 if still then SqMagic(k+1);
 b[i]:=0;
 end;
 inc(i);
 end;
end;

begin
 f:=false; recurse:=0;
 fillchar(a,sizeof(a),0); fillchar(b,sizeof(b),0);
 SqMagic(1);
end.