Описание
Игровое поле для игры "Кошки-Мышки" представляет собой совокупность кружков, некоторые из которых соединены линиями. Первый игрок играет за "кошек", второй - за "мышек". В процессе игры кошки и мышки располагаются в кружках игрового поля. Ходы совершаются игроками по очереди. За один ход игрок может передвинуть некоторые из своих фигур (кошек или мышек) по линиям, ведущим из тех кружков, где они в данный момент находятся. Первыми ходят кошки. В случае если кошка окажется в одном кружке с мышкой, мышка считается съеденной. Цель первого игрока – съесть максимальное число мышек и сделать это как можно быстрее, цель второго - помешать первому игроку
Задание
Напишите программу, определяющую максимальное число мышек, которых съедят кошки, и номер хода, на котором будет съедена последняя из них, в предположении о наилучших действиях обоих игроков
Входные данные
В первой строке входного файла содержатся два целых числа N и M - количество кружков (1≤N≤20) и линий (1≤M≤200) на игровом поле. В следующих 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.
|