20140708郑州培训第二题Impossible Game

  1 type node=record
  2      go,next:longint;
  3      end;
  4 var le,ri:array[0..100,0..10] of longint;
  5     a,b:array[0..100] of string;
  6     e,e2:array[0..1000000] of node;
  7     c:array[0..35,0..35] of int64;
  8     dfn,low,w,ww,www:array[0..850000] of int64;
  9     head,head2,sta,scc,q,inp:array[0..800000] of longint;
 10     i,j,k,l,p,tot,cnt,n,m,h,t,x,y:longint;
 11     tmp1,tmp2,ans,ti,top:int64;
 12     num:array[0..32,0..32,0..32] of int64;
 13   function min(x,y:int64):int64;
 14    begin
 15    if x<y then exit(x) else exit(y);
 16    end;
 17   function max(x,y:int64):int64;
 18    begin
 19    if x>y then exit(x) else exit(y);
 20    end;
 21 
 22   procedure insert(x,y:longint);
 23    begin
 24    inc(tot);
 25    e[tot].go:=y;e[tot].next:=head[x];head[x]:=tot;
 26    end;
 27   procedure insert2(x,y:longint);
 28    begin
 29    inc(tot);
 30    e2[tot].go:=y;e2[tot].next:=head2[x];head2[x]:=tot;
 31    end;
 32   function jz(x,y,z:longint):int64;
 33    begin
 34     jz:=x*(n+1)*(n+1)+y*(n+1)+z;
 35    end;
 36   procedure init;
 37    begin
 38      readln(n,m);
 39      fillchar(x,sizeof(x),0);
 40      fillchar(y,sizeof(y),0);
 41      for i:=1 to m do readln(a[i]);
 42      for i:=1 to m do readln(b[i]);
 43      for i:=1 to m do
 44         for j:=1 to length(a[i]) do
 45           begin
 46             inc(le[i,ord(a[i][j])-ord(‘A‘)+1]);
 47             inc(ri[i,ord(b[i][j])-ord(‘A‘)+1]);
 48           end;
 49    end;
 50   procedure zuhe;
 51    begin
 52    c[0,0]:=1;
 53    for i:=1 to 30 do
 54      begin
 55        c[i,0]:=1;c[i,i]:=1;
 56        for j:=1 to i-1 do
 57          c[i,j]:=c[i-1,j-1]+c[i-1,j];
 58      end;
 59    end;
 60   procedure prepare;
 61    begin
 62      for i:=0 to n do
 63        for j:=0 to n do
 64          for k:=0 to n do
 65            begin
 66              l:=n-i-j-k;if l<0 then continue;
 67              tmp1:=jz(i,j,k);
 68              tmp2:=c[n,i]*c[n-i,j]*c[n-i-j,k];
 69              num[i,j,k]:=tmp1;
 70              w[tmp1]:=tmp2;
 71            end;
 72      for i:=0 to n do
 73        for j:=0 to n do
 74          for k:=0 to n do
 75            begin
 76              l:=n-i-j-k;if l<0 then continue;
 77            for p:=1 to m do
 78               if (i>=le[p,1]) and (j>=le[p,2]) and (k>=le[p,3]) and (l>=le[p,4])
 79               then insert(num[i,j,k],num[i-le[p,1]+ri[p,1],j-le[p,2]+ri[p,2],k-le[p,3]+ri[p,3]]);
 80            end;
 81   end;
 82 procedure dfs(u:longint);
 83   var i,v,x:longint;
 84    begin
 85    inc(ti);dfn[u]:=ti;low[u]:=ti;
 86    inc(top);sta[top]:=u;
 87    i:=head[u];
 88    while i<>0 do
 89     begin
 90       v:=e[i].go;
 91       if dfn[v]=0 then
 92        begin
 93          dfs(v);
 94          low[u]:=min(low[u],low[v]);
 95        end
 96       else
 97          if scc[v]=0 then low[u]:=min(low[u],dfn[v]);
 98       i:=e[i].next;
 99     end;
100    if low[u]=dfn[u] then
101      begin
102        inc(cnt);
103        repeat
104        x:=sta[top];dec(top);
105        scc[x]:=cnt;
106        inc(ww[cnt],w[x]);
107        if x=u then break;
108        until false;
109       end;
110    end;
111 procedure tarjan;
112   begin
113    top:=0;
114    fillchar(dfn,sizeof(dfn),0);
115    ti:=0;cnt:=0;
116    for i:=0 to (n+1)*(n+1)*(n+1) do
117      if w[i]<>0 then
118       begin
119         if dfn[i]=0 then dfs(i);
120       end;
121   end;
122 procedure topsort;
123   begin
124    fillchar(inp,sizeof(inp),0);
125    for x:=0 to (n+1)*(n+1)*(n+1) do
126      begin
127        i:=head[x];
128        while i<>0 do
129         begin
130           y:=e[i].go;
131           if scc[x]<>scc[y] then
132             begin
133               inc(inp[scc[y]]);insert2(scc[x],scc[y]);
134             end;
135           i:=e[i].next;
136         end;
137      end;
138    h:=0;t:=0;www:=ww;
139    for i:=1 to cnt do if inp[i]=0 then begin inc(t);q[t]:=i;end;
140    while h<t do
141     begin
142     inc(h);
143     x:=q[h];
144     i:=head2[x];
145     while i<>0 do
146       begin
147       y:=e2[i].go;
148       dec(inp[y]);if inp[y]=0 then begin inc(t);q[t]:=y;end;
149       www[y]:=max(www[y],www[x]+ww[y]);
150       i:=e2[i].next;
151       end;
152     end;
153   end;
154 procedure getans;
155  begin
156  ans:=0;
157  for i:=1 to cnt do ans:=max(ans,www[i]);
158  writeln(ans);
159  end;
160 begin
161   assign(input,‘game.in‘);assign(output,‘game.out‘);
162   reset(input);rewrite(output);
163   init;
164   zuhe;
165   prepare;
166   tarjan;
167   topsort;
168   getans;
169   close(input);close(output);
170 end.
171