如果发现广告等破坏行为,请尽量将条目恢复到较早的版本而不是把相应内容直接删除,谢谢合作。
URAL/1099
来自"NOCOW"
< URAL
一般图匹配 亦可随机化。。。
一般图匹配用带花树算法 因为非原创且实现复杂度较高 我就不讲方法了 之所以把标程贴出来是因为其太强大了 贴出来供大家一起膜拜 要学的从网上查一下就知道了。
program Ural_1099(Input, Output); const MaxN = 222; type TIndex = Longint; TGraph = array [1..MaxN, 1..MaxN] of Boolean; TExist = array [1..MaxN] of Boolean; TLink = array [1..MaxN] of TIndex; TQueue = array [1..MaxN] of TIndex; var N: TIndex; Graph: TGraph; Match: TLink; InQueue, InPath, InBlossom: TExist; Head, Tail: TIndex; Queue: TQueue; Start, Finish: TIndex; NewBase: TIndex; Father, Base: TLink; Count: TIndex; procedure CreateGraph; var u, v: TIndex; begin FillChar(Graph, SizeOf(Graph), false); Readln(N); while not SeekEof do begin Readln(u, v); Graph[u, v] := true; Graph[v, u] := true; end; end; procedure Push(u: TIndex); begin Queue[Tail] := u; Inc(Tail); InQueue[u] := true; end; function Pop: TIndex; begin Pop := Queue[Head]; Inc(Head); end; function FindCommonAncestor(u, v: TIndex): TIndex; begin FillChar(InPath, SizeOf(InPath), false); while true do begin u := Base[u]; InPath[u] := true; if u = Start then Break; u := Father[Match[u]]; end; while true do begin v := Base[v]; if InPath[v] then Break; v := Father[Match[v]]; end; FindCommonAncestor := v; end; procedure ResetTrace(u: TIndex); var v: TIndex; begin while Base[u] <> NewBase do begin v := Match[u]; InBlossom[Base[u]] := true; InBlossom[Base[v]] := true; u := Father[v]; if Base[u] <> NewBase then Father[u] := v; end; end; procedure BlossomContract(u, v: TIndex); begin NewBase := FindCommonAncestor(u, v); FillChar(InBlossom, SizeOf(InBlossom), false); ResetTrace(u); ResetTrace(v); if Base[u] <> NewBase then Father[u] := v; if Base[v] <> NewBase then Father[v] := u; for u := 1 to N do if InBlossom[Base[u]] then begin Base[u] := NewBase; if not InQueue[u] then Push(u); end; end; procedure FindAugmentingPath; var u, v: TIndex; begin FillChar(InQueue, SizeOf(InQueue), false); FillChar(Father, SizeOf(Father), 0); for u := 1 to N do Base[u] := u; Head := 1; Tail := 1; Push(Start); Finish := 0; while Head < Tail do begin u := Pop; for v := 1 to N do if Graph[u, v] and (Base[u] <> Base[v]) and (Match[u] <> v) then if (v = Start) or ((Match[v] > 0) and (Father[Match[v]] > 0)) then BlossomContract(u, v) else if Father[v] = 0 then begin Father[v] := u; if Match[v] > 0 then Push(Match[v]) else begin Finish := v; Exit; end; end; end; end; procedure AugmentPath; var u, v, w: TIndex; begin u := Finish; while u > 0 do begin v := Father[u]; w := Match[v]; Match[v] := u; Match[u] := v; u := w; end; end; procedure Edmonds; var u: TIndex; begin FillChar(Match, SizeOf(Match), 0); for u := 1 to N do if Match[u] = 0 then begin Start := u; FindAugmentingPath; if Finish > 0 then AugmentPath; end; end; procedure PrintMatch; var u: TIndex; begin for u := 1 to N do if Match[u] > 0 then Inc(Count); Writeln(Count); for u := 1 to N do if u < Match[u] then Writeln(u, ' ', Match[u]); end; procedure Main; begin CreateGraph; Edmonds; PrintMatch; end; begin Main; end.