http://acm.pku.edu.cn/JudgeOnline/problem?id=1112
Код:
program PKU1112;
{$i-,s-,q-,r-}
const maxn = 401;
type integer = longint;
node = record
tow, next: integer;
end;
var hash, mark, g, clo: array[1..maxn] of integer;
a: array[1..maxn * maxn] of node;
s: array[0..maxn, 1..2] of integer;
f, h: array[0..maxn, 0..maxn] of integer;
n, m, sum1, sum2, tot: integer;
procedure insert(u, v: integer);
begin
tot := tot + 1;
a[tot].tow := v; a[tot].next := g[u];
g[u] := tot;
end;
procedure prepare;
var u, v: integer;
begin
read(n); tot := 0;
fillchar(g, sizeof(g), 0);
fillchar(hash, sizeof(hash), 0);
for u := 1 to n do begin
read(v); hash[u] := u;
while v <> 0 do begin
hash[v] := u;
read(v);
end;
for v := 1 to n do if hash[v] <> u then begin
insert(u, v);
insert(v, u);
end;
end;
end;
function search(c, u, p: integer): boolean;
var tmp, v: integer;
begin
if p = 1 then inc(sum1) else inc(sum2);
mark[u] := p; clo[u] := c;
search := false;
tmp := g[u];
while tmp <> 0 do begin
v := a[tmp].tow;
if mark[v] = mark[u] then exit;
if (mark[v] = 0) and (not search(c, v, 3 - p)) then exit;
tmp := a[tmp].next;
end;
search := true;
end;
procedure main;
var u, v, i, j, k, x0, y0, ans: integer;
begin
fillchar(mark, sizeof(mark), 0);
fillchar(clo, sizeof(clo), 0);
m := 0;
for u := 1 to n do if mark[u] = 0 then begin
sum1 := 0; sum2 := 0;
m := m + 1;
if not search(m, u, 1) then begin
writeln('No solution');
exit;
end;
s[m, 1] := sum1; s[m, 2] := sum2;
end;
fillchar(f, sizeof(f), 0);
fillchar(h, sizeof(h), 0);
f[s[1, 1], s[1, 2]] := 1;
h[s[1, 1], s[1, 2]] := 1;
for k := 2 to m do begin
for i := n downto 0 do
for j := n downto 0 do if f[i, j] = k - 1 then begin
x0 := i + s[k, 1];
y0 := j + s[k, 2];
if (x0 <= n) and (y0 <= n) then begin
f[x0, y0] := k;
h[x0, y0] := 1;
end;
x0 := i + s[k, 2];
y0 := j + s[k, 1];
if (x0 <= n) and (y0 <= n) then begin
f[x0, y0] := k;
h[x0, y0] := 2;
end;
end;
end;
x0 := -1; y0 := -1;
ans := maxint;
for i := 1 to n - 1 do begin
j := n - i;
if (f[i, j] > 0) and (abs(i - j) < ans) then begin
ans := abs(i - j);
x0 := i; y0 := j;
end;
end;
if x0 = -1 then begin
writeln('No solution');
exit;
end;
fillchar(hash, sizeof(hash), 0);
sum1 := x0; sum2 := y0;
while (x0 + y0 > 0) do begin
v := h[x0, y0]; u := f[x0, y0];
hash[u] := v;
x0 := x0 - s[u, v]; y0 := y0 - s[u, 3 - v];
end;
write(sum1, ' '); for i := 1 to n do if hash[clo[i]] = mark[i] then write(i, ' '); writeln;
write(sum2, ' '); for i := 1 to n do if hash[clo[i]] <> mark[i] then write(i, ' '); writeln;
end;
begin
while not eof do begin
prepare;
main;
end;
end.