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.