Описание
Игровое поле для игры "Кошки-Мышки" представляет собой совокупность кружков, некоторые из которых соединены линиями. Первый игрок играет за "кошек", второй - за "мышек". В процессе игры кошки и мышки располагаются в кружках игрового поля. Ходы совершаются игроками по очереди. За один ход игрок может передвинуть некоторые из своих фигур (кошек или мышек) по линиям, ведущим из тех кружков, где они в данный момент находятся. Первыми ходят кошки. В случае если кошка окажется в одном кружке с мышкой, мышка считается съеденной. Цель первого игрока – съесть максимальное число мышек и сделать это как можно быстрее, цель второго - помешать первому игроку

Задание
Напишите программу, определяющую максимальное число мышек, которых съедят кошки, и номер хода, на котором будет съедена последняя из них, в предположении о наилучших действиях обоих игроков


Входные данные
В первой строке входного файла содержатся два целых числа N и M - количество кружков (1
N20) и линий (1M200) на игровом поле. В следующих M строках указаны номера кружков, которые соединяются очередной линией. Далее следуют количество кошек и номера кружков, в которых они первоначально располагаются. После этого в таком же формате записаны данные о мышках. Суммарное количество кошек и мышек не превосходит четырех

Выходные данные
Запишите в выходной файл максимальное количество мышек, съедаемых кошками, минимальное число ходов, необходимых для этого, и все возможные положения кошек после первого хода, обеспечивающие достижение цели за указанное число ходов


Например:

TWOMOUSE.IN
8 9
1 2
2 3
3 4
4 1
1 5
5 6
6 7
7 8
8 6
1 5
2 3 7


TWOMOUSE.OUT
1 2
6






Идеи и комментарии
Авторами не представлены



Решение

{$A+,B-,D+,E-,F-,G+,I+,L+,N+,O-,P-,Q-,R-,S-,T-,V+,X+,Y+}

{$M 63384,0,655360}
 
program Lots_Of_Mice;
type Tarr = array [1..21,1..21,1..21] of byte;
     Parr = ^tarr;
     abyte = array [1..4] of byte;
var m, n: integer;
    lc: array [1..21] of byte;
    ll: array [1..21,1..21] of byte;
    fs, x, y, rr, tp: abyte;
    ms, cs, k: byte;
    a: array [1..2, 1..21] of Parr;
    did: boolean;
    exitflag: boolean;
 
procedure CheckEx (a: integer);
var i: integer;
begin
  for i := 1 to lc[a] - 1 do
    if ll[a, i] = ll[a, lc[a]] then begin dec (lc[a]); exit; end;
end;
 
procedure ReadAll;
var i, x, y: integer;
begin
  assign (input, '
twomouse.in'); reset (input);
  read(n, m);
  FillChar(lc, sizeof(lc), 0);
  for i := 1 to 4 do fs [i] := n+1;
  for i := 1 to m do
  begin
    read (x, y);
    inc(lc[x]); ll[x, lc[x]] := y;
    inc(lc[y]); ll[y, lc[y]] := x;
    CheckEx (x);
    CheckEx (y);
  end;
  read(cs);  for i := 1 to cs do read (fs[i]);
  read(ms); for i := 1 to ms do read (fs[i+cs]);
  k := cs + ms;
  inc (n);
  close (input);
end;
 
procedure FillFF;
var i, j: integer;
begin
  for j := 1 to 2 do
  for i := 1 to n do
    FillChar (a[j, i]^, Sizeof(a[j,i]^), 255);
end;
 
procedure MarkPositions (kills: byte);
var i, j, t, f: integer;
begin
  FillFF;
  for i := 4 downto k-kills+1 do
  begin x[i] := n; tp[i] := n; end;
  for i := 1 to k-kills do tp[i] := 1;
  for i := tp[1] to n do if (1 > cs) or (i < n) then
    for j := tp[2] to n do if (2 > cs) or (j < n) then
      for t := tp[3] to n do if (3 > cs) or (t < n) then
        for f := tp[4] to n do if (4 > cs) or (f < n) then
          a[2, i]^[j,t,f] := 0;
  for i := 1 to k do tp[i] := 1;
  for i := k+1 to 4 do tp[i] := n;
end;
 
procedure SortRR;
var j, i: byte;
begin
  if cs > 1 then if rr[1] > rr[2] then
                  begin i := rr[1]; rr[1] := rr[2]; rr[2] := i; end;
  if cs > 2 then
      begin
        if rr[2] > rr[3] then
                  begin i := rr[2]; rr[2] := rr[3]; rr[3] := i; end;
        if rr[1] > rr[2] then
                  begin i := rr[1]; rr[1] := rr[2]; rr[2] := i; end;
      end;
  if ms > 1 then if rr[k-1] > rr[k-0] then
                  begin i := rr[k-0]; rr[k-0] := rr[k-1]; rr[k-1] := i; end;
  if ms > 2 then
      begin
        if rr[k-2] > rr[k-1] then
                 begin i := rr[k-1]; rr[k-1] := rr[k-2]; rr[k-2] := i; end;
        if rr[k-1] > rr[k-0] then
                 begin i := rr[k-0]; rr[k-0] := rr[k-1]; rr[k-1] := i; end;
      end;
  if cs > 3 then
     begin
       for i := 3 downto 1 do
         if rr[i+1] < rr[i] then
          begin
            j := rr[i+1];
            rr[i+1] := rr[i];
            rr[i] := j;
          end;
     end;
end;
 
procedure GoCat (s, i1, i2, i3, i4: byte);
var r, rs: abyte;
    mst: byte;
     procedure Rec (c: byte);
     var sv, i: byte;
     begin
       if c > cs then
         begin
           rr := r; SortRR;
           if a[1, rr[1]]^[rr[2],rr[3],rr[4]] > s + 1 then
             begin
               a[1, rr[1]]^[rr[2],rr[3],rr[4]] := s + 1;
               did := true;
             end;
           exit;
         end;
       rec (c+1);
       for i := 1 to lc [r[c]] do
       begin
         r[c] := ll[r[c], i];
         Rec (c+1);
         r[c] := rs[c];
       end;
       if mst > 0 then
       for i := 1 to lc [r[c]] do
       begin
         r[c] := ll[r[c], i];
         for sv := 1 to mst do
         begin
           dec (mst);
           r[k-mst] := rs[c];
           Rec (c+1);
         end;
         for sv := 1 to sv do
         begin
           r[k-mst] := n;
           inc (mst);
         end;
         r[c] := rs[c];
       end;
     end;
begin
  r[1] := i1;
  r[2] := i2;
  r[3] := i3;
  r[4] := i4; rs := r;
  mst := 0;
  while (mst < ms) and (r[k-mst] = n) do inc (mst);
  rec (1);
end;
 
procedure GoMouse (s, i1, i2, i3, i4: byte);
var r, rs: abyte;
    lm: byte;
    cf: byte;
 
     procedure Recc (c: byte);
     var i: byte;
     begin
       if c > k-ms+1 then
         for i := 1 to cs do
           if r[i] = r[c-1] then exit;
       if c > lm then
         begin
           rr := r; sortRR;
           if a[1, rr[1]]^[rr[2],rr[3],rr[4]] = 255 then
             begin
               ExitFlag := true;
               exit;
             end;
           if a[1, rr[1]]^[rr[2],rr[3],rr[4]] > cf then
               cf := a[1, rr[1]]^[rr[2],rr[3],rr[4]];
           exit;
         end;
       recc (c+1);
       for i := 1 to lc [r[c]] do
       begin
         r[c] := ll[r[c], i];
         Recc (c+1);
         r[c] := rs[c];
         if exitflag then exit;
       end;
     end;
begin
  cf := 0;
  r[1] := i1;
  r[2] := i2;
  r[3] := i3;
  r[4] := i4; rs := r;
  lm := k;
  while (lm > (k-ms)) and (r[lm] = n) do dec (lm);
  exitflag := false;
  if lm > (k-ms) then recc (k-ms+1);
  if not exitflag then
     a[2, i1]^[i2,i3,i4] := cf;
end;
 
procedure GoCats (s: byte);
var i1, i2, i3, i4: byte;
begin
  for i1 := tp[1] to n do
  for i2 := tp[2] to n do
  if (cs = 1) or (i2 >= i1) then
    for i3 := tp[3] to n do
    if (cs = 2) or (i3 >= i2) then
      for i4 := tp[4] to n do
      if (cs = 3) or (i4>=i3) then
  if a[2, i1]^[i2,i3,i4] = s then
      GoCat (s, i1, i2, i3, i4);
end;
 
procedure GoMice (s: byte);
var i1, i2, i3, i4: byte;
begin
  for i1 := tp[1] to n do
  for i2 := tp[2] to n do
  if (cs = 1) or (i2 >= i1) then
    for i3 := tp[3] to n do
    if (cs = 2) or (i3 >= i2) then
      for i4 := tp[4] to n do
      if (cs = 3) or (i4>=i3) then
      if a[2, i1]^[i2,i3,i4] = 255 then
          GoMouse (s, i1, i2, i3, i4);
end;
 
procedure OutSol;
var i: integer;
begin
  for i := 1 to cs do
    write(rr[i], ' ');
  writeln;
end;
 
procedure Shugat (i1, i2, i3, i4, s: byte);
var r, rs: abyte;
    mst: byte;
     procedure Recs (c: byte);
     var j, i: byte;
     begin
       if c > cs then
         begin
           rr := r;
           for j := 1 to cs do
             for i := cs + 1 to k do
              if rr[i] = rr[j] then rr[i] := n;  { Eat it! }
           SortRR;
           if a[2, rr[1]]^[rr[2],rr[3],rr[4]] = s then
              begin
                OutSol;
                a[2, rr[1]]^[rr[2],rr[3],rr[4]] := 255-s;
              end;
           exit;
         end;
       recs (c+1);
       for i := 1 to lc [r[c]] do
       begin
         r[c] := ll[r[c], i];
         Recs (c+1);
         r[c] := rs[c];
       end;
     end;
begin
  r[1] := i1;
  r[2] := i2;
  r[3] := i3;
  r[4] := i4; rs := r;
  recs (1);
end;
 
procedure TryToKill (kills: byte);
var s: integer;
begin
  MarkPositions (kills);
  s := 0;
  repeat
    did := false;
    GoCats (s);
    if a[1, fs[1]]^[fs[2],fs[3],fs[4]] < 255 then
       begin
         assign (output, '
twomouse.out'); rewrite (output);
         write(kills, ' ');
         writeln(a[1, fs[1]]^[fs[2],fs[3],fs[4]]);
         Shugat (fs[1], fs[2], fs[3], fs[4], a[1, fs[1]]^[fs[2],fs[3],fs[4]]-1);
         close (output);
         halt;
       end;
    inc (s);
    GoMice (s);
  until did = false;
end;
 
procedure Solve;
var j, i: integer;
begin
  rr := fs; sortRR; fs := rr;
  for j := 1 to 2 do
   for i := 1 to n do
    new (a[j, i]);
  if (cs > 0) and (ms > 0) then
  for i := ms downto 1 do
    TryToKill (i);
  assign (output, '
twomouse.out'); rewrite (output);
  writeln (0,' ',0);
  FillFF;
  if cs > 0 then
  Shugat (fs[1], fs[2], fs[3], fs[4], 255);
  close (output);
end;
 
begin
  ReadAll;
  Solve;
end.


 


© Особенности национальных задач по информатике