maxflow_dinic.dpr

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

Program MaxFlow_Dinic;
Const
	MaxNodeNum = 5000 ;
	MaxEdgeNum = 50000 ;
	Infinity = MaxLongint Div 2;
Type
	TIndex = Longint;
	TCapacity = Longint;
	TEdge = Record
		Start,Target:TIndex;
		Flow,Capa:TCapacity;
		PrevEdge:TIndex;
	End;
	TLast = Array [1..MaxNodeNum] Of TIndex;
	TNetwork = Object
		NodeNum,EdgeNum:TIndex;
		Source,Sink:TIndex;
		Edge:Array [1..MaxEdgeNum] Of TEdge;
		Last,LastBackup:TLast;
		TotalFlow:TCapacity;
		Visit:Array [1..MaxNodeNum] Of Boolean;
		PrevE:Array [1..MaxNodeNum] Of TIndex;
		Dist:Array [1..MaxNodeNum] Of TIndex;
		Team:Array [1..MaxNodeNum] Of TIndex;
			Head,Tail:TIndex;
		Procedure ClearFlow;
		Procedure Initialize(FNodeNum,FSource,FSink:TIndex);
		Procedure InsertEdge(FStart,FTarget:TIndex;FCapa:TCapacity);
		Function Opposite(Num:TIndex):TIndex;
		Function SetDistLabel:Boolean;
		Function FindPath(Cur:TIndex;Var Delta:TCapacity):Boolean;
		Procedure Augment(Delta:TCapacity);
		Procedure Dinic;
		Procedure DFS(Cur:TIndex);
		Procedure FindCut;
		Function GetFlowValue:TCapacity;
	End;
	Procedure TNetwork.ClearFlow;
	Var
		I:TIndex;
	Begin
		For I := 1 To EdgeNum Do
			Edge[I].Flow := 0 ;
	End;
	Procedure TNetwork.Initialize(FNodeNum,FSource,FSink:TIndex);
	Begin
		NodeNum := FNodeNum ;
		EdgeNum := 0 ;
		Source := FSource ;
		Sink := FSink ;
		FillChar(Last,SizeOf(Last),0);
	End;
	Procedure TNetwork.InsertEdge(FStart,FTarget:TIndex;FCapa:TCapacity);
	Begin
		Inc(EdgeNum);
		Edge[EdgeNum].Start := FStart ;
		Edge[EdgeNum].Target := FTarget ;
		Edge[EdgeNum].Capa := FCapa ;
		Edge[EdgeNum].Flow := 0 ;
		Edge[EdgeNum].PrevEdge := Last[FStart] ;
		Last[FStart] := EdgeNum ;
		Inc(EdgeNum);
		Edge[EdgeNum].Start := FTarget ;
		Edge[EdgeNum].Target := FStart ;
		Edge[EdgeNum].Capa := 0 ;
		Edge[EdgeNum].Flow := 0 ;
		Edge[EdgeNum].PrevEdge := Last[FTarget] ;
		Last[FTarget] := EdgeNum ;
	End;
	Function TNetwork.Opposite(Num:TIndex):TIndex;
	Begin
		If Odd(Num) Then
			Result := Num + 1
		Else
			Result := Num - 1 ;
	End;
	Function TNetwork.SetDistLabel:Boolean;
	Var
		Cur:TIndex;
		CurEdge:TIndex;
	Begin
		FillChar(Visit,SizeOf(Visit),False);
		Visit[Source] := True ;
		Dist[Source] := 0 ;
		Head := 0 ;
		Tail := 1 ;
		Team[Tail] := Source ;
		Repeat
			Inc(Head);
			Cur := Team[Head] ;
			CurEdge := Last[Cur] ;
			While CurEdge > 0 Do
			Begin
				If Not Visit[Edge[CurEdge].Target] And (Edge[CurEdge].Flow < Edge[CurEdge].Capa) Then
				Begin
					Inc(Tail);
					Team[Tail] := Edge[CurEdge].Target ;
					Visit[Team[Tail]] := True ;
					Dist[Team[Tail]] := Dist[Cur] + 1 ;
				End;
				CurEdge := Edge[CurEdge].PrevEdge ;
			End;
		Until Head = Tail ;
		Result := Visit[Sink] ;
	End;
	Function TNetwork.FindPath(Cur:TIndex;Var Delta:TCapacity):Boolean;
	Begin
		Visit[Cur] := True ;
		Result := True ;
		If Cur = Sink Then
			Exit;
		While Last[Cur] > 0 Do
			With Edge[Last[Cur]] Do
			Begin
				If (Dist[Target] = Dist[Start] + 1) And Not Visit[Target] And (Flow < Capa) Then
					If FindPath(Target,Delta) Then
					Begin
						PrevE[Target] := Last[Cur] ;
						If Delta > Capa - Flow Then
							Delta := Capa - Flow ;
						Exit;
					End;
				Last[Cur] := Edge[Last[Cur]].PrevEdge ;
			End;
		Result := False ;
	End;
	Procedure TNetwork.Augment(Delta:TCapacity);
	Var
		Cur:TIndex;
		CurEdge:TIndex;
	Begin
		Cur := Sink ;
		TotalFlow := TotalFlow + Delta ;
		Repeat
			CurEdge := PrevE[Cur] ;
			Edge[CurEdge].Flow := Edge[CurEdge].Flow + Delta ;
			Edge[Opposite(CurEdge)].Flow := Edge[Opposite(CurEdge)].Flow - Delta ;
			Cur := Edge[CurEdge].Start ;
		Until Cur = Source ;
	End;
	Procedure TNetwork.Dinic;
	Var
		Delta:TCapacity;
	Begin
		TotalFlow := 0 ;
		LastBackup := Last ;
		While SetDistLabel Do
		Begin
			Repeat
				FillChar(Visit,SizeOf(Visit),False);
				Delta := Infinity ;
				If Not FindPath(Source,Delta) Then
					Break;
				Augment(Delta);
			Until False ;
			Last := LastBackup ;
		End;
	End;
	Procedure TNetwork.DFS(Cur:TIndex);
	Var
		CurEdge:TIndex;
	Begin
		Visit[Cur] := True ;
		CurEdge := Last[Cur] ;
		While CurEdge > 0 Do
		Begin
			If Not Visit[Edge[CurEdge].Target] And (Edge[CurEdge].Flow < Edge[CurEdge].Capa) Then
				DFS(Edge[CurEdge].Target);
			CurEdge := Edge[CurEdge].PrevEdge ;
		End;
	End;
	Procedure TNetwork.FindCut;
	Begin
		FillChar(Visit,SizeOf(Visit),False);
		Last := LastBackup ;
		DFS(Source);
	End;
	Function TNetwork.GetFlowValue:TCapacity;
	Begin
		Result := TotalFlow ;
	End;
Var
	Network:TNetwork;