ENG  RUS Timus Online Judge
Online Judge
Problems
Authors
Online contests
Site news
Webboard
Problem set
Submit solution
Judge status
Guide
Register
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

## Discussion of Problem 1182. Team Them Up!

Posted by FailedWing 9 Nov 2005 12:24
type
anstype  = array[0..100] of longint;

var
l    : longint;
n    : longint;
f    : array[1..100, -100..200] of boolean;
ans  : array[1..2] of anstype;
go   : array[1..100, 0..100] of longint;
save : array[1..100, 0..100] of longint;
g    : array[1..100, 0..100] of longint;
done : array[1..100] of boolean;
list : array[1..100, 1..2] of anstype;
que  : array[1..100] of longint;
edge : array[1..100, 1..100] of boolean;

procedure init;
var
have       : boolean;
i, j, a, k : longint;
hash        : array[0..100] of boolean;
begin
fillchar(g, sizeof(g), 0);
for i := 1 to n do
begin
fillchar(hash, sizeof(hash), false);
repeat
hash[a] := true;
until a = 0;
for j := 1 to n do
if (not hash[j]) and (i <> j)
then begin
have := false;
for k := 1 to g[i, 0] do
if g[i, k] = j
then begin
have := true;
break;
end;
if not have
then begin
inc(g[i, 0]);
g[i, g[i, 0]] := j;
end;
have := false;
for k := 1 to g[j, 0] do
if g[j, k] = i
then begin
have := true;
break;
end;
if not have
then begin
inc(g[j, 0]);
g[j, g[j, 0]] := i;
end;
end;
end;
fillchar(edge, sizeof(edge), false);
for i := 1 to n do
for j := 1 to g[i, 0] do
edge[i, g[i, j]] := true;
end;

procedure get_tree(start : longint);
var
now           : array[1..100] of longint;
get_in        : array[1..100] of boolean;
level         : longint;
i, h, t, k, j : longint;
begin
que[1] := start;
h := 1;
t := 1;
now[1] := 1;
fillchar(get_in, sizeof(get_in), false);
get_in[start] := true;
while true do
begin
k := que[h];
level := now[h];
done[k] := true;
for i := 1 to g[k, 0] do
begin
if get_in[g[k, i]]
then continue;
inc(t);
que[t] := g[k, i];
get_in[g[k, i]] := true;
now[t] := level + 1;
end;
inc(list[l, level mod 2 + 1, 0]);
k := list[l, level mod 2 + 1, 0];
list[l, level mod 2 + 1, k] := que[h];
inc(h);
if h > t then break;
end;
for k := 1 to 2 do
for i := 1 to list[l, k, 0] do
for j := i + 1 to list[l, k, 0] do
if edge[list[l, k, i], list[l, k, j]]
then begin
writeln('No solution');
halt;
end;
end;

procedure make;
var
i : longint;
begin
l := 0;
fillchar(done, sizeof(done), false);
for i := 1 to n do
if not done[i]
then begin
inc(l);
get_tree(i);
end;
end;

procedure dp;
var
tmp     : anstype;
i, t, j : longint;
begin
fillchar(f, sizeof(f), false);
f[1, abs(list[1, 1, 0] - list[1, 2, 0])] := true;
for i := 2 to l do
begin
t := abs(list[i, 1, 0] - list[i, 2, 0]);
for j := 0 to 100 do
begin
f[i, j] := f[i - 1, j - t] or f[i - 1, j + t];
if not f[i, j]
then continue;
if (f[i - 1, j - t])
then begin
save[i, j] := j - t;
go[i, j] := 2
end
else begin
save[i, j] := j + t;
go[i, j] := 1;
end
end;
end;
for i := 1 to l do
if list[i, 1, 0] < list[i, 2, 0]
then begin
tmp := list[i, 1];
list[i, 1] := list[i, 2];
list[i, 2] := tmp;
end;
end;

procedure add(a, b, c : longint);
var
tmp : anstype;
i   : longint;
begin
for i := 1 to list[b, c, 0] do
ans[a, ans[a, 0] + i] := list[b, c, i];
inc(ans[a, 0], list[b, c, 0]);
if ans[1, 0] < ans[2, 0]
then begin
tmp := ans[1];
ans[1] := ans[2];
ans[2] := tmp;
end;
end;

procedure out(x, y : longint);
var
tmp  : anstype;
i, t : longint;
begin
if x = 1
then begin
exit;
end;
out(x - 1, save[x, y]);
if go[x, y] = 1
then begin
end
else begin
end;
end;

procedure print;
var
i, j, t : longint;
begin
fillchar(ans, sizeof(ans), 0);
for i := 0 to 100 do
if f[l, i]
then break;
out(l, i);
for t := 1 to 2 do
begin
write(ans[t, 0]);
for i := 1 to ans[t, 0] do
write(' ', ans[t, i]);
writeln;
end;
end;

begin
init;
make;
dp;
print;
end.