maxflow_preflowpush.dpr

CQF大牛关于网络流方面的程序代码

Const
	MaxN = 5000 ;
	MaxM = 50000 ;
	MaxNodeNum = MaxN + MaxM + 2 ;
	MaxEdgeNum = (MaxN + 3 * MaxM) * 2 ;
	Infinity = 10000000 ;
Type
	EdgeType = record
		Start,Target:Longint;
		Capa,Flow:Longint;
		Prev:Longint;
	End;
	NetworkType = object
	public
		Procedure Initialize(FSource,FSink,FTotalNode:Longint);
		Procedure InsertEdge(FStart,FTarget,FCapa:Longint);
		Procedure PreFlowPush;
	private
		Source,Sink,TotalNode,TotalEdge:Longint;
		MaxFlowValue:Longint;
		Edge:array [1..MaxEdgeNum] of Edgetype;
		Current,Last:array [1..MaxNodeNum] of Longint;
		Height:Array [1..MaxNodeNum] Of Longint;
		E:Array [1..MaxNodeNum] Of Longint;
		Queue:Array [0..MaxNodeNum] Of Record
				Next,Prev:Longint;
			End;
		Head:Longint;
		Function Opposite(EdgeNum:Longint):Longint;
		Function GetFlowValue:Longint;
		Function GetMin(A,B:Longint):Longint;
		Procedure PreWork;
		Procedure Push(Num:Longint);
		Procedure DisCharge(Cur:Longint);
		Procedure Relabel(Cur:Longint);
	End;
	Function NetworkType.GetMin(A,B:Longint):Longint;
	Begin
		Result := A * Ord(A < B) + B * Ord(Not (A < B)) ;
	End;
	Procedure NetworkType.Initialize(FSource,FSink,FTotalNode:Longint);
	Begin
		Source := FSource ;
		Sink := FSink ;
		TotalNode := FTotalNode ;
		TotalEdge := 0 ;
		Fillchar(Edge,Sizeof(Edge),0);
		Fillchar(Last,Sizeof(Last),0);
	End;
	Procedure NetworkType.InsertEdge(FStart,FTarget,FCapa:Longint);
	Begin
		Inc(TotalEdge);
		Edge[TotalEdge].Start := FStart ;
		Edge[TotalEdge].Target := FTarget ;
		Edge[TotalEdge].Capa := FCapa ;
		Edge[TotalEdge].Flow := 0 ;
		Edge[TotalEdge].Prev := Last[FStart] ;
		Last[FStart] := TotalEdge ;
		Inc(TotalEdge);
		Edge[TotalEdge].Start := FTarget ;
		Edge[TotalEdge].Target := FStart ;
		Edge[TotalEdge].Capa := 0 ;
		Edge[TotalEdge].Flow := 0 ;
		Edge[TotalEdge].Prev := Last[FTarget] ;
		Last[FTarget] := TotalEdge ;
	End;
	Function NetworkType.Opposite(EdgeNum:Longint):Longint;
	Begin
		if odd(EdgeNum) then
			Result := EdgeNum + 1
		Else
			Result := EdgeNum - 1 ;
	End;
	Procedure NetworkType.Relabel(Cur:Longint);
	Var
		Min,V:Longint;
	Begin
		Min := -1 ;
		V := Last[Cur] ;
		While V > 0 Do
		Begin
			If Edge[V].Flow < Edge[V].Capa Then
				If (Min = -1) Or (Height[Edge[V].Target] < Min) Then
					Min := Height[Edge[V].Target] ;
			V := Edge[V].Prev;
		End;
		Height[Cur] := Min + 1 ;
	End;
	Procedure NetworkType.Push(Num:Longint);
	Var
		D:Longint;
	Begin
		D := GetMin(E[Edge[Num].Start],Edge[Num].Capa - Edge[Num].Flow);
		Inc(Edge[Num].Flow,D);
		Edge[Opposite(Num)].Flow := -Edge[Num].Flow;
		Dec(E[Edge[Num].Start],D);
		Inc(E[Edge[NUm].Target],D);
	End;
	Procedure NetworkType.PreWork;
	Var
		I,U:Longint;
	Begin
		For I := 1 To TotalNode Do
		Begin
			Height[I] := 0 ;
			E[I] := 0 ;
		End;
		Height[Source] := TotalNode ;
		U := Last[Source] ;
		While U <> 0 Do
		Begin
			Edge[U].Flow := Edge[U].Capa ;
			Edge[Opposite(U)].Flow := -Edge[U].Capa ;
			E[Edge[U].Target] := Edge[U].Capa ;
			Dec(E[Source],Edge[U].Capa);
			U := Edge[U].Prev ;
		End;
		Head := 0 ;
		For I := 1 To TotalNode Do
		If (I <> Source) And (I <> Sink) Then
		Begin
			Current[I] := Last[I] ;
			Queue[I].Prev := 0 ;
			Queue[I].Next := Head ;
			Queue[Head].Prev := I ;
			Head := I ;
		End;
	End;
	Procedure NetworkType.DisCharge(Cur:Longint);
	Var
		V:Longint;
	Begin
		While E[Cur] > 0 Do
		Begin
			V := Current[Cur] ;
			If V = 0 Then
			Begin
				Relabel(Cur);
				Current[Cur] := Last[Cur] ;
			End
			Else	If (Edge[V].Capa - Edge[V].Flow > 0) And (Height[Edge[V].Target] + 1 = Height[Cur]) Then
					Push(V)
				Else
					Current[Cur] := Edge[V].Prev ;
		End;
	End;
	Procedure NetworkType.PreFlowPush;
	Var
		Cur,OldHeight:longint;
	Begin
		PreWork;
		Cur := Head ;
		While Cur <> 0 Do
		Begin
			OldHeight := Height[Cur] ;
			DisCharge(Cur);
			If (Height[Cur] > OldHeight) And (Cur <> Head) Then
			Begin
				Queue[Queue[Cur].Prev].Next := Queue[Cur].Next ;
				Queue[Queue[Cur].Next].Prev := Queue[Cur].Prev ;
				Queue[Head].Prev := Cur ;
				Queue[Cur].Prev := 0 ;
				Queue[Cur].Next := Head ;
				Head := Cur ;
			End;
			Cur := Queue[Cur].Next ;
		End;
	End;
	Function NetworkType.GetFlowValue:Longint;
	Begin
		Result := E[Sink] ;
	End;
Var
	Network:NetworkType;