|
{ Бэк-трекинг: Домино }
{--------------------------------------------------------------------------}
{ Берутся случайных 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.
| |