//==========================
蒟蒻Macaulish:http://www.cnblogs.com/Macaulish/ 转载要声明!
//==========================
判断二分图中某条路是否是唯一的。
网络流做法要加个tarjan
二分图就是再增广看能不能增广
网络流(快但是长)
type
arr=record
toward,next,cap,from:longint;
end;
const
maxn=100000;
maxm=1000000;
var
edge:array[0..maxm]of arr;
first,cur,d,p,gap,num,e,belong,dfn,low:array[0..maxn]of longint;
chose:array[0..maxn]of boolean;
trie:array[0..maxn,'A'..'z'] of longint;
n,esum,s,t,tot,total,peo,time,scc,top:longint;
procedure add(j,k,l:longint);
begin
inc(esum);
edge[esum].toward:=k;
edge[esum].next:=first[j];
first[j]:=esum;
edge[esum].from:=j;
edge[esum].cap:=l;
end;
procedure addedge(j,k,l:longint);
begin
add(j,k,l);
add(k,j,0);
end;
function find(ss:string):longint;
var
i,u:longint;
begin
u:=0;
for i:=1 to length(ss) do u:=trie[u][ss[i]];
exit(num[u]);
end;
function min(x,y:longint):longint;
begin
if x<y then exit(x);
exit(y);
end;
procedure into;
var
i,j,k,m,u,boy,girl:longint;
ss:string;
begin
esum:=-1;
tot:=0;
total:=0;
peo:=0;
fillchar(first,sizeof(first),255);
readln(n);
s:=n<<1+1;
t:=n<<1+2;
tot:=n<<1+2;
for i:=1 to n do begin
readln(ss);
ss:=ss+' ';
u:=0;
j:=1;
while (ss[j]<>' ') do begin
if trie[u][ss[j]]=0 then begin
inc(total);
trie[u][ss[j]]:=total;
end;
u:=trie[u][ss[j]];
inc(j);
end;
inc(peo);
num[u]:=peo;
girl:=peo;
inc(j);
u:=0;
while (ss[j]<>' ') do begin
if trie[u][ss[j]]=0 then begin
inc(total);
trie[u][ss[j]]:=total;
end;
u:=trie[u][ss[j]];
inc(j);
end;
inc(peo);
num[u]:=peo;
boy:=peo;
e[i]:=esum+1;
addedge(girl,boy,1);
addedge(s,girl,1);
addedge(boy,t,1);
end;
readln(m);
while m>0 do begin
dec(m);
readln(ss);
i:=pos(' ',ss);
j:=find(copy(ss,1,i-1));
k:=find(copy(ss,i+1,length(ss)-i));
addedge(j,k,1);
end;
end;
function sap(x,flow:longint):longint;
var
now,more,i,too:longint;
begin
if x=t then exit(flow);
now:=0;
i:=cur[x];
while i>=0 do begin
too:=edge[i].toward;
if (d[x]=d[too]+1) and (edge[i].cap>0) then begin
more:=sap(too,min(flow-now,edge[i].cap));
dec(edge[i].cap,more);
inc(edge[i xor 1].cap,more);
inc(now,more);
cur[x]:=i;
if flow=now then exit(flow);
end;
i:=edge[i].next;
end;
dec(gap[d[x]]);
if gap[d[x]]=0 then d[s]:=tot;
inc(d[x]);
inc(gap[d[x]]);
cur[x]:=first[x];
exit(now);
end;
procedure maxflow;
var
i:longint;
begin
fillchar(gap,sizeof(gap),0);
fillchar(d,sizeof(d),0);
gap[0]:=tot;
for i:=1 to tot do cur[i]:=first[i];
while d[s]<tot do sap(s,maxlongint);
end;
procedure tarjan(x:longint);
var
i,j,too:longint;
begin
inc(time);
dfn[x]:=time;
low[x]:=time;
inc(top);
p[top]:=x;
chose[x]:=true;
i:=first[x];
while i>=0 do begin
if edge[i].cap>0 then begin
too:=edge[i].toward;
if dfn[too]=0 then begin
tarjan(too);
low[x]:=min(low[x],low[too]);
end
else
if chose[too] then
low[x]:=min(low[x],low[too]);
end;
i:=edge[i].next;
end;
if low[x]=dfn[x] then begin
inc(scc);
repeat
j:=p[top];
dec(top);
chose[j]:=false;
belong[j]:=scc;
until j=x;
end;
end;
procedure work;
var
head,tail,i,j,k,l,x,too:longint;
flag:boolean;
begin
time:=0;
fillchar(chose,sizeof(chose),false);
fillchar(dfn,sizeof(dfn),0);
top:=0;
for i:=1 to tot do
if dfn[i]=0 then tarjan(i);
for i:=1 to n do begin
j:=e[i];
k:=edge[j].from;
l:=edge[j].toward;
if (belong[k]=belong[l]) or (edge[j].cap>0) then writeln('Unsafe')
else writeln('Safe');
end;
end;
begin
into;
maxflow;
work;
end.
View Code
匈牙利版
type
arr=record
toward,next,from:longint;
flag:boolean;
end;
const
maxn=100000;
maxm=1000000;
var
edge:array[0..maxm]of arr;
first,cur,d,p,gap,num,e,match,matche:array[0..maxn]of longint;
chose:array[0..maxn]of boolean;
trie:array[0..maxn,'A'..'z'] of longint;
n,esum,s,t,tot,total,peo,time,scc,top:longint;
procedure addedge(j,k:longint);
begin
inc(esum);
edge[esum].from:=j;
edge[esum].toward:=k;
edge[esum].next:=first[j];
edge[esum].flag:=true;
first[j]:=esum;
end;
function find(ss:string):longint;
var
i,u:longint;
begin
u:=0;
for i:=1 to length(ss) do u:=trie[u][ss[i]];
exit(num[u]);
end;
procedure into;
var
i,j,k,m,u,boy,girl:longint;
ss:string;
begin
esum:=0;
tot:=0;
total:=0;
peo:=0;
fillchar(first,sizeof(first),0);
readln(n);
for i:=1 to n do begin
readln(ss);
ss:=ss+' ';
u:=0;
j:=1;
while (ss[j]<>' ') do begin
if trie[u][ss[j]]=0 then begin
inc(total);
trie[u][ss[j]]:=total;
end;
u:=trie[u][ss[j]];
inc(j);
end;
inc(peo);
num[u]:=peo;
girl:=peo;
inc(j);
u:=0;
while (ss[j]<>' ') do begin
if trie[u][ss[j]]=0 then begin
inc(total);
trie[u][ss[j]]:=total;
end;
u:=trie[u][ss[j]];
inc(j);
end;
inc(peo);
num[u]:=peo;
boy:=peo;
e[i]:=esum+1;
addedge(girl,boy);
end;
readln(m);
while m>0 do begin
dec(m);
readln(ss);
i:=pos(' ',ss);
j:=find(copy(ss,1,i-1));
k:=find(copy(ss,i+1,length(ss)-i));
addedge(j,k);
end;
end;
function dfs(x:longint):boolean;
var
i,too:longint;
begin
i:=first[x];
while i>0 do begin
too:=edge[i].toward;
if edge[i].flag and chose[too] then begin
chose[too]:=false;
if (match[too]=0) or dfs(match[too]) then begin
edge[matche[too]].flag:=true;
matche[too]:=i;
match[too]:=x;
edge[i].flag:=false;
exit(true);
end;
end;
i:=edge[i].next;
end;
exit(false);
end;
procedure work;
var
i,j,boy,girl:longint;
begin
for i:=1 to n do begin
fillchar(chose,sizeof(chose),true);
dfs(edge[e[i]].from);
end;
//for i:=1 to n do writeln(match[i<<1]);
for i:=1 to n do begin
fillchar(chose,sizeof(chose),true);
j:=e[i];
if edge[j].flag then begin
writeln('Unsafe');
continue;
end;
boy:=edge[j].toward;
girl:=edge[j].from;
match[boy]:=0;
if not dfs(girl) then begin
match[boy]:=girl;
matche[boy]:=j;
writeln('Safe');
end
else writeln('Unsafe');
end;
end;
begin
into;
work;
end.
View Code
转载于:https://www.cnblogs.com/Macaulish/p/4358199.html