PAS蜜汁WA

program teams2;
type
  ty=record
    a,b:set of 1..100;
  end;
var
  ren:array[1..100,1..100] of boolean;
  get:array[1..100] of boolean;
  zu1,zu2,a:array[1..100] of longint;
  f,g:array[1..100,-200..200] of boolean;
  n,i,j,x,total,r,l:longint;
  dom:array[1..100] of ty;
procedure sou(x,y:longint);{构建骨牌}
var
  i,j,k:longint;
begin
  get[x]:=true;
  for i:=1 to n do
  begin
    if ((not ren[x,i])or(not ren[i,x])) then  {互不认识放入相反组}
    begin
      if y=1 then
      begin
        if (get[i])and(i in dom[total].a) then  {是否矛盾}
        begin
          writeln('No solution');
          close(output);
          halt;
        end;
        if get[i] then continue;  {不矛盾直接跳过，避免死循环}
        dom[total].b:=dom[total].b+[i];
        sou(i,2);
      end;
      if y=2 then
      begin
        if (get[i])and(i in dom[total].b) then
        begin
          writeln('No solution');
          halt;
        end;
        if get[i] then continue;
        dom[total].a:=dom[total].a+[i];
        sou(i,1);
      end;
    end;
  end;
end;
procedure huisu(x,y:longint); {回溯输出方案}
var
  i:longint;
begin
  if x=0 then exit;
  if g[x,y] then    {g[x,y]=true：当前x骨牌翻了}
  begin            
    for i:=1 to n do
    if i in dom[x].a then begin inc(l); zu2[l]:=i; end;
    for i:=1 to n do
    if i in dom[x].b then begin inc(r); zu1[r]:=i; end;
    huisu(x-1,y+a[x]);
  end
  else
  begin            {g[x,y]=false：当前骨牌没翻}  
    for i:=1 to n do
    if i in dom[x].a then begin inc(r); zu1[r]:=i; end;
    for i:=1 to n do
    if i in dom[x].b then begin inc(l); zu2[l]:=i; end;
    huisu(x-1,y-a[x]);
  end;
end;
begin
  read(n);
  for i:=1 to n do
  begin
    for j:=1 to n do
    begin
      read(x);
      if x<>0 then
      ren[i,x]:=true
      else break;
    end;
    ren[i,i]:=true;           {认识自己....}
  end;
  total:=0;
  for i:=1 to n do
  if not get[i] then
  begin
  inc(total);
  dom[total].a:=dom[total].a+[i];
  sou(i,1);
  end;
  for i:=1 to total do{保存骨牌上下差，要用动归使所有骨牌上下差之和最小；上代表组1，下代表组2，差代表组1、组2人数差}
  begin
  for j:=1 to n do
  if j in dom[i].a then
  begin
   inc(a[i]);
  end;
  for j:=1 to n do
  if j in dom[i].b then
  begin
   dec(a[i]);
  end;  
  end;
   f[1,a[1]]:=true;
  g[1,a[1]]:=false;
   f[1,-a[1]]:=true;
   g[1,-a[1]]:=true;
   for i:=2 to total do
    for j:=-n to n do
    begin
      if (j-a[i]>=-n)and(j-a[i]<=n)
      and(f[i-1,j-a[i]])               {f[x,y]:到第x个骨牌，组1组2人数差能否达到y}
      then                             {g[x,y]:记录当前骨牌是否翻转}
      begin
      f[i,j]:=true;
      g[i,j]:=false;
      end;
      if (j+a[i]>=-n)and(j+a[i]<=n)
      and(f[i-1,j+a[i]])
      then
      begin
      f[i,j]:=true;
      g[i,j]:=true;
      end;
    end;
  r:=0; l:=0;
  for i:=0 to n do                         {回溯输方案}
  begin
  if f[total,i] then
  begin
   huisu(total,i);
   write((i+n) div 2,' ');
   for j:=1 to r do write(zu1[j],' ');
   writeln;
   write(n-(i+n) div 2,' ');
   for j:=1 to l do write(zu2[j],' ');
   halt;
  end;
  if f[total,-i] then
  begin
   huisu(total,-i);
   write((n-i) div 2,' ');
   for j:=1 to r do write(zu1[j],' ');
   writeln;
   write(n-(n-i) div 2,' ');
   for j:=1 to l do write(zu2[j],' ');
   halt;
  end;
  end;
end.