Домино — Pascal(Паскаль)

Берутся случайных N костяшек из одного набора домино (1<=N<=28). Задача состоит в том, чтобы образовать из этих N костяшек самую длинную цепочку, состыковывая их по правилам домино частями с равным количеством точек.
Входные данные: Входной файл с именем «D.IN» содержит информацию о наборе костяшек. 1-я строка — количество костяшек.
2-я и последующие строки — парные наборы точек (числа разделены пробелом). В каждой строке записана пара точек, указанной на одной костяшке. Количество пар соответствует числу из первой строки.
Выходные данные: результаты работы программы записываются в файл «D.OUT».
1-я строка содержит длину максимальной цепочки костяшек.
2-я строка содержит пример такой цепочки, при этом пары (цифры) на костяшках записываются без пробелов, подряд, а между костяшками в цепочке ставится двоеточие.

{ Задача "Домино", решение: А.Никитина, Самара }
{$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.

Похожие записи/страницы:

Leave a Comment

9 + 1 =