poj 1112图论+DP

就这几天在扫分类练习题时在DP里看到的，竟是POJ的原题。。。不好怎么说，DP是有，但比较少，更郁闷的是前几道状态压缩DP的被我的搜索水过去了，搜索竟比标程DP快，神奇的分类练习！

饿，来讲题目吧。这道题的确很好，正确的思路很难想到，我一开始想到的就是二分图01着色，用DFS直接求解，反正一有解就可以输出+HALT了，不过马上战神就否定了我的想发，还又狠狠抨击了我 。。。。我百度了，才发现其实不难解决，先求原图的补图，即未连接的和单向的都视为无连接，在补图中连无向边，再求连通分量，就能发现在同一连同分量中任意一点都不能在同一组，于是就可以二分染色，若不成功就无解了，否则就可以类似背包的DP了，将每个分量中选一些构成A组，剩下的组成B，使A,B尽量相等。

var
        link:array[0..101,0..101]of longint;
        map:array[0..101,0..101]of 0..1;
        i,j,a1:longint;
        bj:array[0..101]of boolean;
        count,sum:longint;
        ans:array[0..105,0..1,0..105]of longint;
        color:array[0..105]of 0..1;
        f:array[0..1,0..105]of boolean;
        cnt:array[0..105,0..1]of longint;
        n,t,now:longint;
        pre:array[0..105,0..105]of 0..1;
procedure add(x,y:longint);
begin
        inc(link[x,0]);
        link[x,link[x,0]]:=y;
        inc(link[y,0]);
        link[y,link[y,0]]:=x;
end;
function dfs(x:longint):boolean;
var     ii:longint;
begin
        bj[x]:=true;
        inc(cnt[count,color[x]]);
        ans[count,color[x],cnt[count,color[x]]]:=x;
        for ii:=1 to link[x,0] do
          begin
                if not bj[link[x,ii]] then
                  begin
                        color[link[x,ii]]:=1-color[x];
                        if not dfs(link[x,ii]) then exit(false);
                  end
                else
                    if color[link[x,ii]]=color[x] then exit(false);
          end;
        exit(true);
end;
procedure dp;
begin
        fillchar(f,sizeof(f),false);
        f[0,0]:=true;
        now:=0;
        for i:=1 to count do
        begin
         now:=1-now;
         for j:=0 to n shr 1 do
           begin
                f[now,j]:=false;
                t:=j-cnt[i,0];
                if (t>=0)and(f[1-now,t]) then
                  begin
                        f[now,j]:=true;
                        pre[i,j]:=0;
                  end;
                t:=j-cnt[i,1];
                if (t>=0)and(f[1-now,t]) then
                  begin
                        f[now,j]:=true;
                        pre[i,j]:=1;
                  end;
           end;
         end;
end;
procedure print;
var
        tmp,k:longint;
        flag:array[0..105]of boolean;
begin
        fillchar(flag,sizeof(flag),false);
        for k:=n shr 1 downto 1 do
          if f[now,k] then break;
        if k=0 then begin write('No solution');halt;end
                else
                  begin
                       tmp:=k;
                       for i:=count downto 1 do
                         begin
                                t:=pre[i,tmp];
                                tmp:=tmp-cnt[i,t];
                                for j:=1 to cnt[i,t] do
                                 flag[ans[i,t,j]]:=true;
                         end;
                  end;
        write(n-k,' ');
        for i:=1 to n do
          if not flag[i] then write(i,' ');
        writeln;
        write(k,' ');
        for i:=1 to n do
          if flag[i] then write(i,' ');

end;
procedure solve;
var     pd:boolean;
begin
        fillchar(bj,sizeof(bj),false);
        fillchar(color,sizeof(color),0);
        fillchar(cnt,sizeof(cnt),0);
        count:=0;
        pd:=true;
        for i:=1 to n do
         if bj[i]=false then
           begin
                inc(count);
                if dfs(i)=false then begin pd:=false; break;end;
           end;
        if  not pd then begin writeln('No solution');halt;end
          else
            begin
                dp;
                print;
            end;
end;
begin
        readln(n);
        for i:=1 to n do
         begin
              read(a1);
              while a1<>0 do
                begin
                        map[i,a1]:=1;
                        read(a1);
                end;
         end;
        for i:=1 to n do
         for j:=i+1 to n do
          if (map[i,j]=0) or (map[j,i]=0) then add(i,j);
        solve;
end.