Chapter 24 — Maximum Flow

CLRS, fourth edition · Lean 4 formalization

The proofs below use the models and assumptions described in the scope and implementation notes.

Imports

import Mathlib

24.1. Flow Networks

This section formalizes the maximum-flow problem model from CLRS Chapter 24. We define a flow network as a finite directed graph with a nonnegative capacity function, distinguished source and sink vertices, and formalize the notions of a feasible flow, flow value, residual network, augmenting path, and cut. The section proves the fundamental property that the net flow across any cut equals the flow value (Lemma 24.5) and the generic Ford-Fulkerson correctness statement: if there is no augmenting path in the residual network, the flow is maximal (the forward direction of the Max-Flow Min-Cut Theorem).

Main results:

FlowNetwork: a finite directed graph with capacity c : V → V → ℝ, nonnegative, zero on self-loops, with source s and sink t (s ≠ t).
Flow: a feasible flow satisfying capacity, skew-symmetry, and flow-conservation axioms.
Flow.value: the flow value |f| = ∑_{v} f(s,v).
Flow.netFlow_eq_value (Lemma 24.5): for any cut (S,T) with s ∈ S and t ∉ S, the net flow across the cut equals |f|.
Flow.residualCapacity and Flow.residualEdge: the residual network.
Flow.augmentingPathReachable: reachability in the residual network.
Flow.exists_cut_value_eq_of_noAugmentingPath: absence of an augmenting path yields a source-side cut whose capacity equals the flow value.
Flow.maximal_of_noAugmentingPath: if no augmenting path exists in the residual network, the flow is maximal (generic Ford-Fulkerson correctness).

The complete Max-Flow Min-Cut equivalence is assembled in Section_24_6_MaxFlow_MinCut. Edmonds-Karp analysis and the executable augmenting-path loop remain separate algorithmic obligations.

Notation conventions:

G : a flow network on a vertex type V
c u v : capacity of edge (u,v)
f u v : flow on edge (u,v)
cf u v : residual capacity of (u,v) after flow f
|f| : value of flow f
Sᶜ : complement of set S (the T side of a cut)

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finsetopen Classical

A finite flow network over vertex type V with capacity c, source s, and sink t.

Capacities are nonnegative and zero on self-loops. The source and sink are distinct.

Capacity function c(u,v) ≥ 0. Pairs with zero capacity are non-edges in the underlying directed graph.

The source vertex.

The sink vertex.

Capacities are nonnegative.

Self-loop capacity is zero: c u u = 0.

The source and sink are distinct vertices.

              structure FlowNetwork (V : Type*) [Fintype V] [DecidableEq V] where  c : V → V → ℝ  s : V  t : V  hc_nonneg : ∀ u v, 0 ≤ c u v  hc_self : ∀ u, c u u = 0  hs_ne_t : s ≠ t

A feasible flow on a flow network G.

A flow f : V → V → ℝ must satisfy:

Capacity constraint: f u v ≤ c u v for all u,v.
Skew symmetry: f u v = -f v u for all u,v.
Flow conservation: for all u ≠ s, t, ∑_{v} f u v = 0.

The lower-bound 0 ≤ f u v on forward edges is a derived consequence of the capacity constraint on the reverse pair coupled with skew symmetry (see nonneg_of_zero_reverse_cap).

The flow function.

Capacity constraint: f(u,v) ≤ c(u,v).

Skew symmetry: f(u,v) = -f(v,u).

Flow conservation: ∑_{v} f(u,v) = 0 for every non-source non-sink vertex.

              structure Flow (V : Type*) [Fintype V] [DecidableEq V] (G : FlowNetwork V) where  f : V → V → ℝ  hcapacity : ∀ u v, f u v ≤ G.c u v  hskew_symm : ∀ u v, f u v = -f v u  hconservation : ∀ u, u ≠ G.s → u ≠ G.t →
    Finset.sum (Finset.univ : Finset V) (fun v => f u v) = 0

Flow value and auxiliary lemmas

The flow value |f| = ∑_{v} f(s,v), the net flow out of the source.

noncomputable def Flow.value {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : ℝ :=
  Finset.sum (Finset.univ : Finset V) (fun v => φ.f G.s v)

Skew symmetry implies zero flow on self-loops.

theorem Flow.self_zero {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (u : V) : φ.f u u = 0 := by
  have h := φ.hskew_symm u u
  linarith

If the reverse edge has zero capacity, flow is nonnegative on the forward edge: c(v,u) = 0 implies 0 ≤ f(u,v).

theorem Flow.nonneg_of_zero_reverse_cap {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (u v : V) (h : G.c v u = 0) : 0 ≤ φ.f u v := by
  have hcap_rev : φ.f v u ≤ 0 := by
    calc
      φ.f v u ≤ G.c v u := φ.hcapacity v u
      _ = 0 := h
  have hskew : φ.f u v = -φ.f v u := φ.hskew_symm u v
  linarith

If the forward edge has zero capacity, flow is nonpositive on that edge: c(u,v) = 0 implies f(u,v) ≤ 0.

theorem Flow.nonpos_of_zero_cap {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (u v : V) (h : G.c u v = 0) : φ.f u v ≤ 0 := by
  have hcap : φ.f u v ≤ G.c u v := φ.hcapacity u v
  have h_nonneg : 0 ≤ G.c u v := G.hc_nonneg u v
  linarith

On an edge with zero reverse capacity, flow is bounded by 0 and c(u,v): 0 ≤ f(u,v) ≤ c(u,v). This recovers the CLRS capacity-constraint form for graphs with no anti-parallel edges.

theorem Flow.range_of_zero_reverse_cap {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (u v : V) (h : G.c v u = 0) :
    0 ≤ φ.f u v ∧ φ.f u v ≤ G.c u v :=
  ⟨Flow.nonneg_of_zero_reverse_cap φ u v h, φ.hcapacity u v⟩

Skew symmetry gives f(u,v) + f(v,u) = 0.

theorem Flow.add_skew {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (u v : V) : φ.f u v + φ.f v u = 0 := by
  have h := φ.hskew_symm u v
  linarith

Lemma 24.5: Net flow across a cut equals the flow value

The net flow across a cut (S, Sᶜ) is ∑_{u∈S} ∑_{v∈Sᶜ} f(u,v).

noncomputable def Flow.netFlowAcrossCut {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (S : Finset V) : ℝ :=
  Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => φ.f u v))

Double sum of flow over a set S cancels to zero by skew symmetry.


lemma Flow.skew_symm_cancel {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (S : Finset V) :
    Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v)) = 0 := by
  have hA : Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v)) =
      -(Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v))) := by
    calc
      Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v))
          = Finset.sum S (fun u => Finset.sum S (fun v => -φ.f v u)) := by
        refine Finset.sum_congr rfl fun u hu => Finset.sum_congr rfl fun v hv => ?_
        rw [φ.hskew_symm u v]
      _ = -(Finset.sum S (fun u => Finset.sum S (fun v => φ.f v u))) := by
        simp [Finset.sum_neg_distrib]
      _ = -(Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v))) := by
        rw [Finset.sum_comm]
  linarith

Lemma 24.5 (CLRS). For any cut (S, T) with source in S and sink not in S, the net flow across the cut equals the flow value:

∑_{u∈S} ∑_{v∈T} f(u,v) = |f|.


theorem Flow.netFlow_eq_value {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (S : Finset V) (hs : G.s ∈ S) (ht : G.t ∉ S) :
    φ.netFlowAcrossCut S = φ.value := by
  unfold Flow.netFlowAcrossCut Flow.value
  -- The total flow out of all vertices in S, summed over all V.
  have h_total_out : Finset.sum S (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))
      = Finset.sum (Finset.univ : Finset V) (fun v => φ.f G.s v) := by
    -- For u ≠ s,t, conservation gives total flow out = 0
    have h_cons : ∀ u ∈ S, u ≠ G.s → Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v) = 0 := by
      intro u hu h_ne_s
      have h_ne_t : u ≠ G.t := by
        intro h_eq
        apply ht
        simpa [h_eq] using hu
      exact φ.hconservation u h_ne_s h_ne_t
    -- Partition S into {s} and (S \ {s})
    have h_not_mem : G.s ∉ S.erase G.s := by simp
    have h_disjoint : Disjoint ({G.s} : Finset V) (S.erase G.s) := by
      rw [Finset.disjoint_singleton_left]
      exact h_not_mem
    have h_union : ({G.s} : Finset V) ∪ (S.erase G.s) = S := by
      ext u; simp [hs]
    have h_split : Finset.sum S (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)) =
        Finset.sum (Finset.univ : Finset V) (fun v => φ.f G.s v) +
        (Finset.sum (S.erase G.s) (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))) := by
      calc
        Finset.sum S (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))
            = Finset.sum (({G.s} : Finset V) ∪ (S.erase G.s))
                (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)) := by rw [h_union]
        _ = Finset.sum ({G.s} : Finset V) (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))
            + Finset.sum (S.erase G.s) (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)) := by
          rw [Finset.sum_union h_disjoint]
        _ = Finset.sum (Finset.univ : Finset V) (fun v => φ.f G.s v)
            + Finset.sum (S.erase G.s) (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)) := by simp
    -- The remaining sum is 0 by conservation
    have h_rest_zero : Finset.sum (S.erase G.s)
        (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)) = 0 := by
      refine Finset.sum_eq_zero (fun x hx => ?_)
      apply h_cons x (Finset.mem_of_mem_erase hx)
      exact (Finset.mem_erase.mp hx).1
    rw [h_split, h_rest_zero, add_zero]

  -- Now decompose each total sum into S and Sᶜ parts.
  calc
    Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => φ.f u v))
        = Finset.sum S (fun u => (Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))
            - Finset.sum S (fun v => φ.f u v)) := by
      refine Finset.sum_congr rfl fun u hu => ?_
      have hsplit : Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)
          = Finset.sum S (fun v => φ.f u v) + Finset.sum (Sᶜ) (fun v => φ.f u v) := by
        linarith [Finset.sum_add_sum_compl S (fun v => φ.f u v)]
      have h_eq : Finset.sum (Sᶜ) (fun v => φ.f u v)
          = Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)
            - Finset.sum S (fun v => φ.f u v) := by
        linarith
      rw [h_eq]
    _ = Finset.sum S (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))
        - Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v)) := by
      rw [Finset.sum_sub_distrib]
    _ = Finset.sum S (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v))
        - 0 := by rw [Flow.skew_symm_cancel φ S]
    _ = Finset.sum S (fun u => Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v)) := by simp
    _ = Finset.sum (Finset.univ : Finset V) (fun v => φ.f G.s v) := h_total_out

Residual network and augmenting paths

Residual capacity of edge (u,v) after pushing flow φ:

cf(u,v) = c(u,v) - f(u,v).

Intuitively, cf(u,v) is the amount of additional flow that can be sent from u to v without exceeding the capacity c(u,v). Because of skew symmetry, a negative f(u,v) (equivalently f(v,u) > 0) makes cf(u,v) > c(u,v), reflecting the ability to cancel previously routed flow.

noncomputable def Flow.residualCapacity {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (u v : V) : ℝ :=
  G.c u v - φ.f u v

An edge (u,v) is present in the residual network when its residual capacity is positive.

def Flow.residualEdge {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (u v : V) : Prop :=
  Flow.residualCapacity φ u v > 0

Reachability from u to v in the residual network. This is the reflexive-transitive closure of the residualEdge relation.

def Flow.augmentingPathReachable {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (u v : V) : Prop :=
  Relation.ReflTransGen (Flow.residualEdge φ) u v

Source can reach sink via an augmenting path in the residual network.

def Flow.hasAugmentingPath {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : Prop :=
  Flow.augmentingPathReachable φ G.s G.t

Maximal flow and Ford-Fulkerson correctness

A flow φ is maximal (a maximum flow) if no other feasible flow has a larger value.

def Flow.isMaximal {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : Prop :=
  ∀ ψ : Flow V G, ψ.value ≤ φ.value

The value of any feasible flow is bounded above by the capacity of any cut (S,T):

|ψ| ≤ ∑_{u∈S} ∑_{v∈T} c(u,v).

This is a direct consequence of Lemma 24.5 and the capacity constraint.

set_option linter.unusedVariables false in


theorem Flow.value_le_cut_capacity {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (ψ : Flow V G) (S : Finset V)
    (hs : G.s ∈ S) (ht : G.t ∉ S) :
    ψ.value ≤ Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
  have hnet : ψ.value = ψ.netFlowAcrossCut S := (ψ.netFlow_eq_value S hs ht).symm
  have hle : ψ.netFlowAcrossCut S ≤ Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
    unfold Flow.netFlowAcrossCut
    refine Finset.sum_le_sum fun u hu => Finset.sum_le_sum fun v hv => ?_
    exact ψ.hcapacity u v
  linarith

If no augmenting path exists from s to t, residual reachability from the source determines a cut whose capacity equals the current flow value.

This is the cut-certificate core of the Ford--Fulkerson correctness argument: every edge leaving the reachable side has zero residual capacity and is therefore saturated.


theorem Flow.exists_cut_value_eq_of_noAugmentingPath {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} (φ : Flow V G)
    (hNoPath : ¬ Flow.hasAugmentingPath φ) :
    ∃ S : Finset V, G.s ∈ S ∧ G.t ∉ S ∧
      φ.value = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
  -- Build the cut S from residual-network reachability
  let S : Finset V := Finset.filter (fun v => Flow.augmentingPathReachable φ G.s v) Finset.univ
  have hs_S : G.s ∈ S := by
    apply Finset.mem_filter.mpr
    exact ⟨Finset.mem_univ _, Relation.ReflTransGen.refl⟩
  have ht_not_S : G.t ∉ S := by
    intro h
    have h_reach : Flow.augmentingPathReachable φ G.s G.t :=
      (Finset.mem_filter.mp h).2
    exact hNoPath h_reach
  -- All edges crossing the cut are saturated: for every u∈S, v∉S, we have
  -- f(u,v) = c(u,v).  Because otherwise cf(u,v) > 0, making v reachable.
  have hcut_residual_nonpos : ∀ u, u ∈ S → ∀ v, v ∉ S → Flow.residualCapacity φ u v ≤ 0 := by
    intro u hu v hv
    by_contra! hpos
    have h_reach_u : Flow.augmentingPathReachable φ G.s u := (Finset.mem_filter.mp hu).2
    have h_edge : Flow.residualEdge φ u v := hpos
    have h_reach_v : Flow.augmentingPathReachable φ G.s v :=
      Relation.ReflTransGen.tail h_reach_u h_edge
    apply hv
    apply Finset.mem_filter.mpr
    exact ⟨Finset.mem_univ _, h_reach_v⟩
  have h_saturated : ∀ u, u ∈ S → ∀ v, v ∉ S → φ.f u v = G.c u v := by
    intro u hu v hv
    have hcf_nonpos := hcut_residual_nonpos u hu v hv
    unfold Flow.residualCapacity at hcf_nonpos
    have hcap := φ.hcapacity u v
    linarith
  -- Show φ.value equals the capacity of cut (S, Sᶜ)
  have h_cut_capacity : φ.value = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
    calc
      φ.value = φ.netFlowAcrossCut S := (φ.netFlow_eq_value S hs_S ht_not_S).symm
      _ = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => φ.f u v)) := rfl
      _ = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
        refine Finset.sum_congr rfl fun u hu => Finset.sum_congr rfl fun v hv => ?_
        have hv_not_S : v ∉ S := by simpa using hv
        rw [h_saturated u hu v hv_not_S]
  exact ⟨S, hs_S, ht_not_S, h_cut_capacity⟩

If no augmenting path exists from s to t in the residual network, then the flow is maximal.

This is the generic Ford-Fulkerson correctness argument (the forward direction of the Max-Flow Min-Cut Theorem, CLRS Theorem 24.6). It reuses the saturated cut certificate supplied by exists_cut_value_eq_of_noAugmentingPath.

theorem Flow.maximal_of_noAugmentingPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (hNoPath : ¬ Flow.hasAugmentingPath φ) :
    Flow.isMaximal φ := by
  rcases Flow.exists_cut_value_eq_of_noAugmentingPath φ hNoPath with
    ⟨S, hs_S, ht_not_S, h_cut_capacity⟩
  intro ψ
  have hψ_value_le : ψ.value ≤ Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) :=
    Flow.value_le_cut_capacity φ ψ S hs_S ht_not_S
  linarith

end Chapter26end CLRS

Imports

import Mathlib
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.Ford_Fulkerson_Augmentation

24.2. The Edmonds-Karp Algorithm

This section formalizes the residual-distance infrastructure used by the Edmonds-Karp analysis and proves the monotonic residual-distance theorem (CLRS Lemma 24.7) for augmentation along a shortest residual path.

Main results:

ResidualPathLength: inductive predicate for path existence in G_f
IsShortestDist: shortest-path distance in G_f
isShortestDist_self: the residual distance from a vertex to itself is zero
IsShortestDist.unique: shortest residual distances are unique
isShortestDist_triangle: one residual edge extends a shortest path by at most one step
ShortestAugmentingPath: bundled shortest source-to-sink residual path data
IsShortestDist.exists_predecessor: predecessor and exact-distance witness for a positive shortest path
ShortestAugmentingPath.shortest_prefix: every prefix of a shortest augmenting path is itself shortest
ShortestAugmentingPath.exists_shortestDist_le_augment: augmentation cannot create a smaller finite source distance
shortest_path_nondec: CLRS Lemma 24.7

The shortest-path construction itself lives in the companion submodule S1_ShortestAugmentingPath, whose headline result exists_shortest_augmenting_path turns residual reachability into an explicit shortest augmenting path.

The work analysis lives in S3_WorkAnalysis: critical edges, Lemma 24.8, the recovery-step timeline lemma, and the full O(VE²) counting argument (critical_count_bound and augmentation_count_bound). The executable breadth-first search computing shortest residual paths — and with them the shortest augmenting paths the loop augments along — lives in S4_ExecutableBFS (residualBFS, bfs_shortestAugmenting).

Implementation details

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finsetopen Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}inductive ResidualPathLength (φ : Flow V G) : V → V → ℕ → Prop where
  | refl (u : V) : ResidualPathLength φ u u 0
  | tail (u v w : V) (n : ℕ) : ResidualPathLength φ u v n → Flow.residualEdge φ v w →
      ResidualPathLength φ u w (n + 1)

Concatenation of length-indexed residual paths.

theorem ResidualPathLength.trans {φ : Flow V G} {u v w : V} {m n : ℕ}
    (h₁ : ResidualPathLength φ u v m) (h₂ : ResidualPathLength φ v w n) :
    ResidualPathLength φ u w (m + n) := by
  induction h₂ generalizing u with
  | refl => simpa using h₁
  | tail mid w n hprev hedge ih =>
      have h := ResidualPathLength.tail u mid w (m + n) (ih h₁) hedge
      simpa [Nat.add_assoc] using h

              def IsShortestDist (φ : Flow V G) (u v : V) (d : ℕ) : Prop :=
  ResidualPathLength φ u v d ∧ ∀ n, ResidualPathLength φ u v n → d ≤ nlemma isShortestDist_self (φ : Flow V G) (u : V) : IsShortestDist φ u u 0 := by
  refine ⟨ResidualPathLength.refl u, ?_⟩
  intro n hn
  cases hn with
  | refl => exact Nat.zero_le _
  | tail _ _ _ _ _ => apply Nat.zero_lelemma IsShortestDist.unique {φ : Flow V G} {u v : V} {d₁ d₂ : ℕ}
    (h₁ : IsShortestDist φ u v d₁) (h₂ : IsShortestDist φ u v d₂) : d₁ = d₂ := by
  rcases h₁ with ⟨hpath₁, hmin₁⟩
  rcases h₂ with ⟨hpath₂, hmin₂⟩
  exact le_antisymm (hmin₁ d₂ hpath₂) (hmin₂ d₁ hpath₁)lemma isShortestDist_triangle (φ : Flow V G) (s u v : V) (d : ℕ)
    (hsu : IsShortestDist φ s u d) (h_edge : Flow.residualEdge φ u v) :
    ∃ d', IsShortestDist φ s v d' ∧ d' ≤ d + 1 := by
  rcases hsu with ⟨hsu_path, hsu_min⟩
  have hsv_path : ResidualPathLength φ s v (d + 1) :=
    ResidualPathLength.tail s u v d hsu_path h_edge
  have h_exists_v : ∃ n, ResidualPathLength φ s v n := ⟨d + 1, hsv_path⟩
  let d' := Nat.find h_exists_v
  have h_d'_path : ResidualPathLength φ s v d' := Nat.find_spec h_exists_v
  have h_d'_min : ∀ n, ResidualPathLength φ s v n → d' ≤ n :=
    fun n hn => Nat.find_min' h_exists_v hn
  have h_d'_le : d' ≤ d + 1 := Nat.find_min' h_exists_v hsv_path
  exact ⟨d', ⟨h_d'_path, h_d'_min⟩, h_d'_le⟩

A positive-length shortest residual path has a predecessor whose distance is exactly one smaller.


lemma exists_pred_on_path {φ : Flow V G} {s v : V} {d : ℕ}
    (hd : IsShortestDist φ s v d) (hd_pos : d ≠ 0) :
    ∃ u, Flow.residualEdge φ u v ∧ IsShortestDist φ s u (d - 1) := by
  rcases hd with ⟨hpath, hmin⟩
  cases hpath with
  | refl => exact (hd_pos rfl).elim
  | tail u v n hpath_to_u hedge =>
      have hu_min : ∀ m, ResidualPathLength φ s u m → n ≤ m := by
        intro m hm
        have hextend : ResidualPathLength φ s v (m + 1) :=
          ResidualPathLength.tail s u v m hm hedge
        have := hmin (m + 1) hextend
        omega
      refine ⟨u, hedge, ?_⟩
      simpa [IsShortestDist] using And.intro hpath_to_u hu_min

Successor-form predecessor theorem, convenient for induction on a known positive distance.

theorem IsShortestDist.exists_predecessor {φ : Flow V G} {s v : V} {d : ℕ}
    (hd : IsShortestDist φ s v (d + 1)) :
    ∃ u, Flow.residualEdge φ u v ∧ IsShortestDist φ s u d := by
  simpa using exists_pred_on_path hd (by omega)

A shortest augmenting path tied directly to the concrete path consumed by Flow.augment.

The concrete simple residual path to augment.

Its edge count realizes the source-to-sink residual distance.

              structure ShortestAugmentingPath (φ : Flow V G) where  path : Flow.AugmentingPath φ  h_shortest : IsShortestDist φ G.s G.t path.edges.length

              

private lemma residualPathLength_segment (φ : Flow V G) (xs : List V)
    (hchain : xs.IsChain φ.residualEdge) (i k : ℕ)
    (hik : i + k < xs.length) :
    ResidualPathLength φ xs[i] xs[i + k] k := by
  induction k with
  | zero => simpa using ResidualPathLength.refl (φ := φ) xs[i]
  | succ k ih =>
      have hik' : i + k < xs.length := by omega
      have hedge : φ.residualEdge xs[i + k] xs[i + k + 1] :=
        hchain.getElem (i + k) (by omega)
      have htail := ResidualPathLength.tail (φ := φ)
        xs[i] xs[i + k] xs[i + k + 1] k (ih hik') hedge
      simpa [Nat.add_assoc] using htailprivate lemma getElem_zero_eq_of_head?_eq_some {α : Type*} {xs : List α} {u : α}
    (hzero : 0 < xs.length) (hhead : xs.head? = some u) :
    xs[0] = u := by
  cases xs with
  | nil => simp at hzero
  | cons x tail => simpa using hhead

private lemma getElem_last_eq_of_getLast?_eq_some
    {α : Type*} {xs : List α} {u : α}
    (hne : xs ≠ []) (hlast : xs.getLast? = some u) :
    xs[xs.length - 1]'(Nat.sub_lt (List.length_pos_iff.mpr hne) (by omega)) = u := by
  rw [← List.getLast_eq_getElem hne]
  exact List.getLast_of_getLast?_eq_some hlast

The prefix through index i is a residual path of exactly i edges.


theorem ShortestAugmentingPath.prefix_path {φ : Flow V G}
    (p : ShortestAugmentingPath φ) (i : ℕ)
    (hi : i < p.path.vertices.length) :
    ResidualPathLength φ G.s p.path.vertices[i] i := by
  have hsegment := residualPathLength_segment φ p.path.vertices p.path.chain 0 i (by
    simpa using hi)
  have hfirst : p.path.vertices[0] = G.s :=
    getElem_zero_eq_of_head?_eq_some (by omega) p.path.head_eq
  simpa [hfirst] using hsegment

The suffix from index i reaches the sink in the remaining edge count.


theorem ShortestAugmentingPath.suffix_path {φ : Flow V G}
    (p : ShortestAugmentingPath φ) (i : ℕ)
    (hi : i < p.path.vertices.length) :
    ResidualPathLength φ p.path.vertices[i] G.t (p.path.edges.length - i) := by
  have hne : p.path.vertices ≠ [] := by
    intro hnil
    simpa [hnil] using p.path.head_eq
  have hedges_length := p.path.edges_length
  have hi_le_edges : i ≤ p.path.edges.length := by omega
  have hsegment := residualPathLength_segment φ p.path.vertices p.path.chain i
    (p.path.edges.length - i) (by omega)
  have hlast : p.path.vertices[p.path.edges.length] = G.t := by
    simpa only [hedges_length] using
      getElem_last_eq_of_getLast?_eq_some hne p.path.last_eq
  simpa [Nat.add_sub_of_le hi_le_edges, hlast] using hsegment

Every prefix of a shortest augmenting path is itself shortest.


theorem ShortestAugmentingPath.shortest_prefix {φ : Flow V G}
    (p : ShortestAugmentingPath φ) (i : ℕ)
    (hi : i < p.path.vertices.length) :
    IsShortestDist φ G.s p.path.vertices[i] i := by
  refine ⟨p.prefix_path i hi, ?_⟩
  intro n hn
  have htotal := hn.trans (p.suffix_path i hi)
  have hmin := p.h_shortest.2 _ htotal
  have hi_le_edges : i ≤ p.path.edges.length := by
    rw [p.path.edges_length]
    omega
  omega



private theorem ShortestAugmentingPath.exists_shortestDist_le_pathLength_augment
    {φ : Flow V G} (p : ShortestAugmentingPath φ) {v : V} {n : ℕ}
    (hpath : ResidualPathLength (φ.augment p.path) G.s v n) :
    ∃ d, IsShortestDist φ G.s v d ∧ d ≤ n := by
  induction hpath with
  | refl =>
      exact ⟨0, isShortestDist_self φ G.s, le_rfl⟩
  | tail u v n hpath_to_u hedge ih =>
      rcases ih with ⟨du, hdu, hdu_le⟩
      by_cases hold : φ.residualEdge u v
      · rcases isShortestDist_triangle φ G.s u v du hdu hold with
          ⟨dv, hdv, hdv_le⟩
        exact ⟨dv, hdv, by omega⟩
      · have hreverse : (v, u) ∈ p.path.edges :=
          p.path.reverse_mem_edges_of_new_residualEdge hedge hold
        rcases p.path.exists_index_of_mem_edges hreverse with
          ⟨i, hi, hvi, hui⟩
        have hpref_v := p.shortest_prefix i (by omega)
        have hpref_u := p.shortest_prefix (i + 1) hi
        have hdv : IsShortestDist φ G.s v i := by
          simpa [hvi] using hpref_v
        have hdu_path : IsShortestDist φ G.s u (i + 1) := by
          simpa [hui] using hpref_u
        have hdu_eq : du = i + 1 := hdu.unique hdu_path
        exact ⟨i, hdv, by omega⟩

Every vertex at finite residual distance after augmentation already had a finite residual distance before augmentation, no larger than the new one.

This is the path-lifting core of Lemma 24.7. An edge that already existed uses the one-edge triangle theorem. If an edge is new, the concrete augmentation formula identifies its reverse on the chosen augmenting path; shortest-prefix optimality then supplies the old distance directly.

theorem ShortestAugmentingPath.exists_shortestDist_le_augment
    {φ : Flow V G} (p : ShortestAugmentingPath φ) {v : V} {d' : ℕ}
    (hd' : IsShortestDist (φ.augment p.path) G.s v d') :
    ∃ d, IsShortestDist φ G.s v d ∧ d ≤ d' := by
  exact p.exists_shortestDist_le_pathLength_augment hd'.1

CLRS Lemma 24.7 (monotonic residual distance). Augmenting along a shortest residual source-to-sink path cannot decrease the finite residual distance from the source to any vertex.

theorem shortest_path_nondec (φ : Flow V G) (p : ShortestAugmentingPath φ)
    {v : V} {d d' : ℕ}
    (hd : IsShortestDist φ G.s v d)
    (hd' : IsShortestDist (φ.augment p.path) G.s v d') :
    d ≤ d' := by
  rcases p.exists_shortestDist_le_augment hd' with ⟨d₀, hd₀, hd₀_le⟩
  have hdist : d = d₀ := hd.unique hd₀
  omega

end Chapter26end CLRS

Definitions and proofs

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.Ford_Fulkerson_Augmentation

24.2. Ford--Fulkerson Augmentation

This file formalizes the constructive augmentation step of the Ford--Fulkerson method. It packages a simple residual path as an explicit list of vertices, defines its bottleneck, constructs the resulting feasible flow, and proves the exact and strict increase in flow value. It also converts residual source-to-sink reachability into a concrete simple augmenting path and derives non-maximality from that witness.

The directed-edge representation is important for networks with anti-parallel capacities: traversing an ordered edge always consumes its directed residual capacity, whether that capacity comes from unused forward capacity, cancellation of existing flow, or both.

Main results:

Flow.augmentBy_value and Flow.augment_value: augmentation increases the flow value by exactly the selected amount or path bottleneck.
Flow.value_lt_augment: full bottleneck augmentation strictly increases the flow value.
Flow.hasAugmentingPath_iff_nonempty_augmentingPath: residual reachability is equivalent to an explicit simple augmenting path.
Flow.not_maximal_of_hasAugmentingPath: a flow with an augmenting path is not maximal.

Current gaps: none for the concrete mathematical augmentation layer. The executable Edmonds--Karp loop remains in the companion analysis; its Lemma 24.7 distance-monotonicity foundation is proved there.

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finset Classicalnamespace Flow

A simple directed residual path between two specified vertices.

The endpoint equations ensure that the vertex list is nonempty. The no-duplicates field supplies the local edge-indicator formula, rules out the simultaneous appearance of both orientations of one edge, and supports the capacity proof. Skew symmetry of the update itself does not require path simplicity.

Vertices in path order, including both endpoints.

Every consecutive pair is a residual edge.

The first vertex is the requested path source.

The final vertex is the requested path target.

The path is simple.

              structure ResidualPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (u v : V) where  vertices : List V  chain : vertices.IsChain φ.residualEdge  head_eq : vertices.head? = some u  last_eq : vertices.getLast? = some v  nodup : vertices.Nodup

A simple residual path from the network source to its sink.

abbrev AugmentingPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) :=
  ResidualPath φ G.s G.t

Consecutive directed edges of a residual path.

def ResidualPath.edges {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {φ : Flow V G} {u v : V}
    (p : ResidualPath φ u v) : List (V × V) :=
  p.vertices.zip p.vertices.tail

The number of directed edges is one less than the number of vertices.

theorem ResidualPath.edges_length {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G} {u v : V}
    (p : ResidualPath φ u v) :
    p.edges.length = p.vertices.length - 1 := by
  simp [ResidualPath.edges]

Membership in the directed edge list determines a consecutive pair of vertex indices.


theorem ResidualPath.exists_index_of_mem_edges {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G} {s t u v : V}
    (p : ResidualPath φ s t) (huv : (u, v) ∈ p.edges) :
    ∃ i, ∃ hi : i + 1 < p.vertices.length,
      p.vertices[i] = u ∧ p.vertices[i + 1] = v := by
  rw [List.mem_iff_getElem] at huv
  rcases huv with ⟨i, hi, hget⟩
  have hi_vertices : i + 1 < p.vertices.length := by
    rw [p.edges_length] at hi
    omega
  refine ⟨i, hi_vertices, ?_⟩
  have hpair : (p.vertices[i], p.vertices[i + 1]) = (u, v) := by
    calc
      (p.vertices[i], p.vertices[i + 1]) = p.edges[i] := by
        simp [ResidualPath.edges, List.getElem_zip, List.getElem_tail]
      _ = (u, v) := hget
  exact ⟨congrArg Prod.fst hpair, congrArg Prod.snd hpair⟩

private theorem residualEdge_of_mem_zip_tail {V : Type*}
    {r : V → V → Prop} {vertices : List V} (hchain : vertices.IsChain r)
    {u v : V} (hmem : (u, v) ∈ vertices.zip vertices.tail) : r u v := by
  induction vertices with
  | nil => simp at hmem
  | cons a l ih =>
      cases l with
      | nil => simp at hmem
      | cons b l =>
          simp only [List.tail_cons, List.zip_cons_cons, List.mem_cons] at hmem
          rcases hmem with hfirst | hrest
          · have hu : u = a := congrArg Prod.fst hfirst
            have hv : v = b := congrArg Prod.snd hfirst
            subst u
            subst v
            exact List.IsChain.rel_head hchain
          · exact ih hchain.tail hrest

Every edge listed by a residual path has positive residual capacity.

theorem ResidualPath.residualEdge_of_mem_edges {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G} {s t x y : V}
    (p : ResidualPath φ s t) (hxy : (x, y) ∈ p.edges) :
    φ.residualEdge x y := by
  exact residualEdge_of_mem_zip_tail p.chain hxy

An augmenting path contains at least one directed edge.


theorem AugmentingPath.edges_nonempty {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G}
    (p : AugmentingPath φ) : p.edges ≠ [] := by
  cases hvertices : p.vertices with
  | nil =>
      have hhead := p.head_eq
      simp [hvertices] at hhead
  | cons a l =>
      cases l with
      | nil =>
          have has : a = G.s := by simpa [hvertices] using p.head_eq
          have hat : a = G.t := by simpa [hvertices] using p.last_eq
          exfalso
          exact G.hs_ne_t (has.symm.trans hat)
      | cons b l => simp [ResidualPath.edges, hvertices]

private theorem reverse_not_mem_zip_tail {V : Type*} [DecidableEq V]
    {vertices : List V} (hnodup : vertices.Nodup) {u v : V}
    (huv : (u, v) ∈ vertices.zip vertices.tail) :
    (v, u) ∉ vertices.zip vertices.tail := by
  induction vertices with
  | nil => simp at huv
  | cons a l ih =>
      cases l with
      | nil => simp at huv
      | cons b l =>
          simp only [List.tail_cons, List.zip_cons_cons, List.mem_cons] at huv ⊢
          simp only [List.nodup_cons] at hnodup
          rcases hnodup with ⟨ha, htail⟩
          rcases huv with hfirst | hrest
          · have hu : u = a := congrArg Prod.fst hfirst
            have hv : v = b := congrArg Prod.snd hfirst
            subst u
            subst v
            intro hreverse
            rcases hreverse with hba | hba
            · have hba' : b = a := congrArg Prod.fst hba
              exact ha (by simp [hba'])
            · exact ha (List.mem_of_mem_tail (List.of_mem_zip hba).2)
          · intro hreverse
            rcases hreverse with hfirst | hrest_reverse
            · have hv : v = a := congrArg Prod.fst hfirst
              have hu : u = b := congrArg Prod.snd hfirst
              subst v
              subst u
              exact ha (List.mem_of_mem_tail (List.of_mem_zip hrest).2)
            · exact ih (List.nodup_cons.mpr htail) hrest hrest_reverse

A simple residual path cannot contain both orientations of the same edge.

This combinatorial fact is independent of capacities. In particular, it continues to hold when the network itself has positive capacities in both directions.

theorem ResidualPath.reverse_not_mem_edges {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G} {s t u v : V}
    (p : ResidualPath φ s t) (huv : (u, v) ∈ p.edges) :
    (v, u) ∉ p.edges := by
  exact reverse_not_mem_zip_tail p.nodup huv

private theorem AugmentingPath.edgeFinset_nonempty {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G}
    (p : AugmentingPath φ) : p.edges.toFinset.Nonempty := by
  exact (List.toFinset_nonempty_iff p.edges).2 p.edges_nonempty

private theorem AugmentingPath.capacityFinset_nonempty {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G}
    (p : AugmentingPath φ) :
    (p.edges.toFinset.image
      (fun e => φ.residualCapacity e.1 e.2)).Nonempty := by
  exact Finset.image_nonempty.mpr p.edgeFinset_nonempty

Minimum residual capacity among the directed edges of an augmenting path.

noncomputable def AugmentingPath.bottleneck {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G}
    (p : AugmentingPath φ) : ℝ :=
  let capacities := p.edges.toFinset.image
    (fun e => φ.residualCapacity e.1 e.2)
  capacities.min' p.capacityFinset_nonempty

The bottleneck of an augmenting path is strictly positive.


theorem AugmentingPath.bottleneck_pos {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G}
    (p : AugmentingPath φ) : 0 < p.bottleneck := by
  unfold AugmentingPath.bottleneck
  rw [Finset.lt_min'_iff]
  intro capacity hcapacity
  rcases Finset.mem_image.mp hcapacity with ⟨edge, hedge, rfl⟩
  exact p.residualEdge_of_mem_edges (by simpa using hedge)

The path bottleneck is at most the residual capacity of each path edge.

theorem AugmentingPath.bottleneck_le_residualCapacity {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} {φ : Flow V G}
    (p : AugmentingPath φ) {u v : V} (huv : (u, v) ∈ p.edges) :
    p.bottleneck ≤ φ.residualCapacity u v := by
  unfold AugmentingPath.bottleneck
  apply Finset.min'_le
  exact Finset.mem_image.mpr ⟨(u, v), by simpa using huv, rfl⟩

Path updates

Skew-symmetric update contributed by one oriented path edge.

def edgeDelta {V : Type*} [DecidableEq V]
    (delta : ℝ) (a b u v : V) : ℝ :=
  (if u = a ∧ v = b then delta else 0) -
  (if u = b ∧ v = a then delta else 0)

Sum of the skew-symmetric updates contributed by consecutive path edges.

def pathDelta {V : Type*} [DecidableEq V]
    (delta : ℝ) : List V → V → V → ℝ
  | [], _, _ => 0
  | [_], _, _ => 0
  | a :: b :: xs, u, v =>
      edgeDelta delta a b u v + pathDelta delta (b :: xs) u v
termination_by xs => xs.length

A single oriented-edge update is skew-symmetric.

theorem edgeDelta_skew {V : Type*} [DecidableEq V]
    (delta : ℝ) (a b u v : V) :
    edgeDelta delta a b u v = -edgeDelta delta a b v u := by
  simp only [edgeDelta]
  by_cases hua : u = a <;> by_cases hvb : v = b <;>
    by_cases hub : u = b <;> by_cases hva : v = a <;>
    simp [hua, hvb, hub, hva, and_comm]

The complete path update is skew-symmetric.


theorem pathDelta_skew {V : Type*} [DecidableEq V]
    (delta : ℝ) (xs : List V) (u v : V) :
    pathDelta delta xs u v = -pathDelta delta xs v u := by
  induction xs with
  | nil => simp [pathDelta]
  | cons a xs ih =>
      cases xs with
      | nil => simp [pathDelta]
      | cons b xs =>
          simp only [pathDelta]
          rw [edgeDelta_skew, ih]
          ring

Net divergence of the update contributed by one oriented edge.


theorem edgeDelta_sum {V : Type*} [Fintype V] [DecidableEq V]
    (delta : ℝ) (a b u : V) :
    (Finset.univ : Finset V).sum (fun v => edgeDelta delta a b u v) =
      (if u = a then delta else 0) - (if u = b then delta else 0) := by
  rw [show (fun v => edgeDelta delta a b u v) =
      (fun v => (if u = a ∧ v = b then delta else 0) -
        (if u = b ∧ v = a then delta else 0)) by rfl]
  rw [Finset.sum_sub_distrib]
  have hforward :
      (Finset.univ : Finset V).sum
          (fun v => if u = a ∧ v = b then delta else 0) =
        (if u = a then delta else 0) := by
    by_cases h : u = a
    · simp [h]
    · simp [h]
  have hbackward :
      (Finset.univ : Finset V).sum
          (fun v => if u = b ∧ v = a then delta else 0) =
        (if u = b then delta else 0) := by
    by_cases h : u = b
    · simp [h]
    · simp [h]
  rw [hforward, hbackward]

Net divergence of a path update is concentrated at its two endpoints.


theorem pathDelta_sum {V : Type*} [Fintype V] [DecidableEq V]
    (delta : ℝ) (xs : List V) (u : V) :
    (Finset.univ : Finset V).sum (fun v => pathDelta delta xs u v) =
      (if xs.head? = some u then delta else 0) -
      (if xs.getLast? = some u then delta else 0) := by
  induction xs with
  | nil => simp [pathDelta]
  | cons a xs ih =>
      cases xs with
      | nil => simp [pathDelta]
      | cons b xs =>
          simp only [pathDelta, Finset.sum_add_distrib]
          rw [edgeDelta_sum, ih]
          rw [List.getLast?_cons_cons]
          simp only [List.head?_cons, Option.some.injEq]
          by_cases hua : u = a <;> by_cases hub : u = b <;>
            simp [hua, hub, eq_comm]

private theorem fst_mem_of_mem_consecutivePairs {V : Type*}
    {a b : V} {xs : List V} (h : (a, b) ∈ xs.consecutivePairs) : a ∈ xs := by
  exact (List.of_mem_zip h).1

private theorem snd_mem_of_mem_consecutivePairs {V : Type*}
    {a b : V} {xs : List V} (h : (a, b) ∈ xs.consecutivePairs) : b ∈ xs := by
  exact List.mem_of_mem_tail (List.of_mem_zip h).2

On a simple vertex list, the path update is exactly the difference of the two directed edge-membership indicators.


theorem pathDelta_eq_edgeIndicators_of_nodup
    {V : Type*} [DecidableEq V]
    (delta : ℝ) (xs : List V) (u v : V) (hxs : xs.Nodup) :
    pathDelta delta xs u v =
      (if (u, v) ∈ xs.consecutivePairs then delta else 0) -
      (if (v, u) ∈ xs.consecutivePairs then delta else 0) := by
  induction xs with
  | nil => simp [pathDelta, List.consecutivePairs]
  | cons a xs ih =>
      cases xs with
      | nil => simp [pathDelta, List.consecutivePairs]
      | cons b xs =>
          have hparts := List.nodup_cons.mp hxs
          have ha_not : a ∉ b :: xs := hparts.1
          have htail : (b :: xs).Nodup := hparts.2
          have hab : a ≠ b := by
            intro hab
            apply ha_not
            simp [hab]
          have hab_not_tail : (a, b) ∉ (b :: xs).consecutivePairs := by
            intro h
            exact ha_not (fst_mem_of_mem_consecutivePairs h)
          have hba_not_tail : (b, a) ∉ (b :: xs).consecutivePairs := by
            intro h
            exact ha_not (snd_mem_of_mem_consecutivePairs h)
          have hcp : (a :: b :: xs).consecutivePairs =
              (a, b) :: (b :: xs).consecutivePairs := rfl
          rw [pathDelta]
          rw [ih htail]
          by_cases hf : (u, v) = (a, b)
          · have hu : u = a := congrArg Prod.fst hf
            have hv : v = b := congrArg Prod.snd hf
            subst u
            subst v
            simp [edgeDelta, hcp, hab, hab_not_tail, hba_not_tail]
          · by_cases hr : (v, u) = (a, b)
            · have hv : v = a := congrArg Prod.fst hr
              have hu : u = b := congrArg Prod.snd hr
              subst u
              subst v
              simp [edgeDelta, hcp, hab, hab_not_tail, hba_not_tail]
            · have hforward : ¬(u = a ∧ v = b) := by
                intro h
                exact hf (Prod.ext h.1 h.2)
              have hreverse : ¬(u = b ∧ v = a) := by
                intro h
                exact hr (Prod.ext h.2 h.1)
              simp [edgeDelta, hcp, hf, hr, hforward, hreverse]

Augment a flow by a nonnegative amount bounded by every residual capacity on the selected path.


def augmentBy {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ)
    (delta : ℝ) (hdelta : 0 ≤ delta)
    (hcap : ∀ e ∈ p.edges, delta ≤ φ.residualCapacity e.1 e.2) :
    Flow V G where
  f u v := φ.f u v + pathDelta delta p.vertices u v
  hcapacity := by
    intro u v
    rw [pathDelta_eq_edgeIndicators_of_nodup delta p.vertices u v p.nodup]
    by_cases huv : (u, v) ∈ p.vertices.consecutivePairs <;>
      by_cases hvu : (v, u) ∈ p.vertices.consecutivePairs
    · rw [if_pos huv, if_pos hvu]
      ring_nf
      exact φ.hcapacity u v
    · rw [if_pos huv, if_neg hvu]
      have hmem : (u, v) ∈ p.edges := by
        simpa [ResidualPath.edges] using huv
      have h := hcap (u, v) hmem
      unfold residualCapacity at h
      linarith
    · rw [if_neg huv, if_pos hvu]
      have h := φ.hcapacity u v
      linarith
    · rw [if_neg huv, if_neg hvu]
      ring_nf
      exact φ.hcapacity u v
  hskew_symm := by
    intro u v
    rw [φ.hskew_symm, pathDelta_skew]
    ring
  hconservation := by
    intro u hu_s hu_t
    simp only [Finset.sum_add_distrib]
    rw [φ.hconservation u hu_s hu_t]
    rw [pathDelta_sum]
    rw [p.head_eq, p.last_eq]
    simp [Ne.symm hu_s, Ne.symm hu_t]

Augmenting by an admissible amount increases flow value by exactly that amount.


theorem augmentBy_value {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ)
    (delta : ℝ) (hdelta : 0 ≤ delta)
    (hcap : ∀ e ∈ p.edges, delta ≤ φ.residualCapacity e.1 e.2) :
    (φ.augmentBy p delta hdelta hcap).value = φ.value + delta := by
  unfold value augmentBy
  rw [Finset.sum_add_distrib]
  rw [pathDelta_sum]
  rw [p.head_eq, p.last_eq]
  simp [Ne.symm G.hs_ne_t]

Augment a flow by the full bottleneck capacity of a selected augmenting path.

noncomputable def augment {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ) : Flow V G :=
  φ.augmentBy p p.bottleneck p.bottleneck_pos.le (by
    intro e he
    rcases e with ⟨u, v⟩
    exact p.bottleneck_le_residualCapacity (by simpa using he))

Exact residual-capacity update for full augmentation along a simple path.

The formula remains valid when the original network has anti-parallel positive capacities: it records directed path membership rather than classifying an edge as globally forward or backward.


theorem augment_residualCapacity {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ) (u v : V) :
    (φ.augment p).residualCapacity u v =
      φ.residualCapacity u v -
        (if (u, v) ∈ p.edges then p.bottleneck else 0) +
        (if (v, u) ∈ p.edges then p.bottleneck else 0) := by
  change G.c u v - (φ.f u v + pathDelta p.bottleneck p.vertices u v) = _
  rw [pathDelta_eq_edgeIndicators_of_nodup
    p.bottleneck p.vertices u v p.nodup]
  simp only [ResidualPath.edges]
  unfold residualCapacity
  ring_nf

Every residual edge created by full augmentation reverses a directed edge of the augmented path.


theorem AugmentingPath.reverse_mem_edges_of_new_residualEdge
    {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {φ : Flow V G} (p : AugmentingPath φ) {u v : V}
    (hnew : (φ.augment p).residualEdge u v)
    (hold : ¬φ.residualEdge u v) :
    (v, u) ∈ p.edges := by
  have hold_nonpos : φ.residualCapacity u v ≤ 0 := le_of_not_gt hold
  change (φ.augment p).residualCapacity u v > 0 at hnew
  rw [φ.augment_residualCapacity p] at hnew
  by_contra hreverse
  rw [if_neg hreverse] at hnew
  by_cases hforward : (u, v) ∈ p.edges
  · rw [if_pos hforward] at hnew
    nlinarith [p.bottleneck_pos]
  · rw [if_neg hforward] at hnew
    linarith

Full bottleneck augmentation increases value by exactly the bottleneck.

theorem augment_value {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ) :
    (φ.augment p).value = φ.value + p.bottleneck := by
  simpa [augment] using
    φ.augmentBy_value p p.bottleneck p.bottleneck_pos.le (by
      intro e he
      rcases e with ⟨u, v⟩
      exact p.bottleneck_le_residualCapacity (by simpa using he))

Augmenting along a residual source-to-sink path strictly increases value.


theorem value_lt_augment {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ) :
    φ.value < (φ.augment p).value := by
  rw [φ.augment_value p]
  linarith [p.bottleneck_pos]

Reachability bridge and non-maximality



private theorem exists_dup_decomp {α : Type*} [DecidableEq α] :
    ∀ {xs : List α}, ¬xs.Nodup →
      ∃ (x : α) (left middle right : List α),
        xs = left ++ x :: middle ++ x :: right := by
  intro xs
  induction xs with
  | nil =>
      intro h
      simp at h
  | cons a tail ih =>
      intro h
      by_cases ha : a ∈ tail
      · obtain ⟨middle, right, htail⟩ := List.mem_iff_append.mp ha
        exact ⟨a, [], middle, right, by rw [htail]; simp⟩
      · have htail : ¬tail.Nodup :=
          fun htail => h (List.nodup_cons.mpr ⟨ha, htail⟩)
        obtain ⟨x, left, middle, right, htail_eq⟩ := ih htail
        exact ⟨x, a :: left, middle, right, by rw [htail_eq]; simp⟩



private theorem exists_nodup_chain_same_ends
    {α : Type*} [DecidableEq α] {r : α → α → Prop} :
    ∀ (n : ℕ) (xs : List α), xs.length ≤ n → xs ≠ [] →
      xs.IsChain r →
      ∃ ys : List α,
        ys ≠ [] ∧ ys.IsChain r ∧ ys.head? = xs.head? ∧
          ys.getLast? = xs.getLast? ∧ ys.Nodup := by
  intro n
  induction n with
  | zero =>
      intro xs hlen hne _
      have hnil : xs = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hlen)
      exact (hne hnil).elim
  | succ n ih =>
      intro xs hlen hne hchain
      by_cases hnodup : xs.Nodup
      · exact ⟨xs, hne, hchain, rfl, rfl, hnodup⟩
      · obtain ⟨x, left, middle, right, hxs⟩ := exists_dup_decomp hnodup
        let shorter := left ++ x :: right
        have hleft_middle : (left ++ x :: middle) <+: xs := by
          refine ⟨x :: right, ?_⟩
          rw [hxs]
        have hright : (x :: right) <:+ xs := by
          refine ⟨left ++ x :: middle, ?_⟩
          rw [hxs]
        have hchain_left_middle : (left ++ x :: middle).IsChain r :=
          hchain.prefix hleft_middle
        have hchain_left : left.IsChain r := hchain_left_middle.left_of_append
        have hchain_right : (x :: right).IsChain r := hchain.suffix hright
        have hchain_shorter : shorter.IsChain r := by
          dsimp [shorter]
          refine hchain_left.append hchain_right ?_
          intro a ha b hb
          have hbx : b = x := (show x = b by simpa using hb).symm
          rw [hbx]
          exact (List.isChain_append.1 hchain_left_middle).2.2 a ha x (by simp)
        have hhead_shorter : shorter.head? = xs.head? := by
          dsimp [shorter]
          rw [hxs]
          cases left <;> simp
        have hlast_shorter : shorter.getLast? = xs.getLast? := by
          dsimp [shorter]
          have hxright : (x :: right).getLast? = xs.getLast? := by
            rw [hxs, List.getLast?_append_of_ne_nil _ (by simp : (x :: right) ≠ [])]
          rw [List.getLast?_append_of_ne_nil _ (by simp : (x :: right) ≠ [])]
          exact hxright
        have hshorter_ne : shorter ≠ [] := by
          dsimp [shorter]
          simp
        have hlen_xs : xs.length = left.length + middle.length + right.length + 2 := by
          rw [hxs]
          simp only [List.length_append, List.length_cons]
          omega
        have hlen_shorter : shorter.length = left.length + right.length + 1 := by
          dsimp [shorter]
          simp only [List.length_append, List.length_cons]
          omega
        have hshorter_le : shorter.length ≤ n := by omega
        obtain ⟨ys, hys_ne, hys_chain, hys_head, hys_last, hys_nodup⟩ :=
          ih shorter hshorter_le hshorter_ne hchain_shorter
        exact ⟨ys, hys_ne, hys_chain, hys_head.trans hhead_shorter,
          hys_last.trans hlast_shorter, hys_nodup⟩

Residual reachability from source to sink is equivalent to the existence of an explicit simple augmenting path.


theorem hasAugmentingPath_iff_nonempty_augmentingPath
    {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {φ : Flow V G} :
    φ.hasAugmentingPath ↔ Nonempty (AugmentingPath φ) := by
  constructor
  · intro hreach
    rcases List.exists_isChain_ne_nil_of_relationReflTransGen hreach with
      ⟨xs, hxs_ne, hxs_chain, hxs_head, hxs_last⟩
    obtain ⟨ys, hys_ne, hys_chain, hys_head, hys_last, hys_nodup⟩ :=
      exists_nodup_chain_same_ends xs.length xs le_rfl hxs_ne hxs_chain
    have hxs_head_option : xs.head? = some G.s :=
      (List.head?_eq_some_head hxs_ne).trans (congrArg some hxs_head)
    have hxs_last_option : xs.getLast? = some G.t :=
      (List.getLast?_eq_some_getLast hxs_ne).trans (congrArg some hxs_last)
    exact ⟨{
      vertices := ys
      chain := hys_chain
      head_eq := hys_head.trans hxs_head_option
      last_eq := hys_last.trans hxs_last_option
      nodup := hys_nodup
    }⟩
  · rintro ⟨path⟩
    have hvertices_ne : path.vertices ≠ [] := by
      intro hnil
      simpa [hnil] using path.head_eq
    have hhead : path.vertices.head hvertices_ne = G.s := by
      have h := path.head_eq
      rw [List.head?_eq_some_head hvertices_ne] at h
      exact Option.some.inj h
    have hlast : path.vertices.getLast hvertices_ne = G.t := by
      have h := path.last_eq
      rw [List.getLast?_eq_some_getLast hvertices_ne] at h
      exact Option.some.inj h
    have hreach := List.relationReflTransGen_of_exists_isChain
      path.vertices path.chain hvertices_ne
    simpa [hasAugmentingPath, augmentingPathReachable, hhead, hlast]
      using hreach

A concrete augmenting path witnesses that the current flow is not maximal.

theorem not_maximal_of_augmentingPath
    {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (p : AugmentingPath φ) :
    ¬φ.isMaximal := by
  intro hmaximal
  exact (not_le_of_gt (φ.value_lt_augment p)) (hmaximal (φ.augment p))

Residual source-to-sink reachability implies that the current flow is not maximal.

theorem not_maximal_of_hasAugmentingPath
    {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (hpath : φ.hasAugmentingPath) :
    ¬φ.isMaximal := by
  rcases hasAugmentingPath_iff_nonempty_augmentingPath.mp hpath with ⟨p⟩
  exact φ.not_maximal_of_augmentingPath p

              end Flowend Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S1_ShortestAugmentingPath

24.2 S1. Shortest augmenting paths

This module constructs an explicit shortest residual source-to-sink path whenever the sink is residual-reachable. The construction walks backwards from the sink through exact predecessors (IsShortestDist.exists_predecessor), collecting vertices into a list whose distance from the source strictly decreases, then reverses it into a simple Flow.ResidualPath whose edge count realizes the residual distance.

Main results:

back: the backwards walk from a vertex at distance d
back_head, back_last, back_length, back_chain_rev, back_nodup, and back_getElem_shortest: its structural properties
shortestFlow.ResidualPath: the assembled shortest residual source-to-sink path
exists_shortest_augmenting_path: residual reachability yields a shortest augmenting path (the mathematical core shared by the Edmonds-Karp loop and the O(VE²) analysis)

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finsetopen Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}

The vertices of a shortest residual path from s to v, listed from v back to s: v, its exact predecessor, and so on down to the source.

noncomputable def back {φ : Flow V G} : (d : ℕ) → (v : V) → IsShortestDist φ G.s v d → List V
  | 0, v, _ => [v]
  | d + 1, v, hd =>
      let u := Classical.choose (IsShortestDist.exists_predecessor hd)
      let hdu := (Classical.choose_spec (IsShortestDist.exists_predecessor hd)).2
      v :: back d u hdu

The backward walk starts at the requested vertex.

lemma back_head {φ : Flow V G} (d : ℕ) (v : V) (hd : IsShortestDist φ G.s v d) :
    (back d v hd).head? = some v := by
  induction d generalizing v with
  | zero => simp [back]
  | succ d ih =>
      have hspec := Classical.choose_spec (IsShortestDist.exists_predecessor hd)
      simp [back]

The backward walk ends at the source.


lemma back_last {φ : Flow V G} (d : ℕ) (v : V) (hd : IsShortestDist φ G.s v d) :
    (back d v hd).getLast? = some G.s := by
  induction d generalizing v with
  | zero =>
      have hv : v = G.s := by
        rcases hd with ⟨hpath, _⟩
        cases hpath with
        | refl => rfl
      simp [back, hv]
  | succ d ih =>
      have hspec := Classical.choose_spec (IsShortestDist.exists_predecessor hd)
      simp [back, List.getLast?_cons, ih (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2]

The backward walk from distance d has exactly d + 1 vertices.

lemma back_length {φ : Flow V G} (d : ℕ) (v : V) (hd : IsShortestDist φ G.s v d) :
    (back d v hd).length = d + 1 := by
  induction d generalizing v with
  | zero => simp [back]
  | succ d ih =>
      have hspec := Classical.choose_spec (IsShortestDist.exists_predecessor hd)
      simp [back, ih (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2]

The vertex at position i of the backward walk has residual distance d - i from the source.


lemma back_getElem_shortest {φ : Flow V G} (d : ℕ) (v : V) (hd : IsShortestDist φ G.s v d) :
    ∀ i (hi : i < (back d v hd).length),
      IsShortestDist φ G.s (back d v hd)[i] (d - i) := by
  induction d generalizing v with
  | zero =>
      intro i hi
      have hlen : (back 0 v hd).length = 1 := by simp [back]
      have hi0 : i = 0 := by omega
      subst i
      simpa [back] using hd
  | succ d ih =>
      have hspec := Classical.choose_spec (IsShortestDist.exists_predecessor hd)
      intro i hi
      cases i with
      | zero => simpa [back] using hd
      | succ j =>
          have hj : j < (back d (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2).length := by
            simpa [back] using hi
          have hget : (back (d + 1) v hd)[j + 1] =
              (back d (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2)[j] := by
            rfl
          rw [hget]
          have hshort := ih (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2 j hj
          convert hshort using 1
          omega

Consecutive pairs of the backward walk are residual edges (in the reverse direction: a precedes b when the residual edge is b → a).


lemma back_chain_rev {φ : Flow V G} (d : ℕ) (v : V) (hd : IsShortestDist φ G.s v d) :
    (back d v hd).IsChain (fun a b => φ.residualEdge b a) := by
  induction d generalizing v with
  | zero => simp [back]
  | succ d ih =>
      have hspec := Classical.choose_spec (IsShortestDist.exists_predecessor hd)
      apply List.IsChain.cons
      · exact ih (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2
      · intro y hy
        have hu := back_head d (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2
        have hyu : y = Classical.choose (IsShortestDist.exists_predecessor hd) := by
          simpa [hu, eq_comm] using hy
        simpa [hyu] using hspec.1

The backward walk is a simple list: its distances strictly decrease, so no vertex repeats.


lemma back_nodup {φ : Flow V G} (d : ℕ) (v : V) (hd : IsShortestDist φ G.s v d) :
    (back d v hd).Nodup := by
  induction d generalizing v with
  | zero => simp [back]
  | succ d ih =>
      have hspec := Classical.choose_spec (IsShortestDist.exists_predecessor hd)
      constructor
      · intro hmem hmem_mem
        have hmem' : ∃ i, ∃ (h : i < (back d (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2).length),
            (back d (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2)[i] = hmem :=
          List.mem_iff_getElem.mp hmem_mem
        rcases hmem' with ⟨j, hj, hget⟩
        have hshort := back_getElem_shortest d (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2 j hj
        have hd' : IsShortestDist φ G.s hmem (d - j) := by
          simpa [hget] using hshort
        intro hv
        have hd'' : IsShortestDist φ G.s v (d - j) := by
          simpa [hv] using hd'
        have heq : d + 1 = d - j := hd.unique hd''
        omega
      · exact ih (Classical.choose (IsShortestDist.exists_predecessor hd)) hspec.2

Appending a vertex related to the last element of a chain preserves the chain.


lemma IsChain_append_last {α : Type*} {R : α → α → Prop} {xs : List α} {x : α}
    (hchain : xs.IsChain R) (hlast : ∀ y, y ∈ xs.getLast? → R y x) :
    (xs ++ [x]).IsChain R := by
  induction xs with
  | nil => simp
  | cons a xs ih =>
      apply List.IsChain.cons
      · exact ih hchain.tail (by
          intro y hy
          have h' : y ∈ (a :: xs).getLast? := by
            rw [List.getLast?_cons]
            simp
            have hys : xs.getLast? = some y := by simpa using hy
            rw [hys]
            rfl
          simpa using hlast y h')
      · intro y hy
        cases xs with
        | nil =>
            have hyx : y = x := by
              have hxy : x = y := by simpa using hy
              exact hxy.symm
            simpa [hyx] using hlast a (by simp)
        | cons b xs =>
            have hyb : y = b := by
              have hby : b = y := by simpa using hy
              exact hby.symm
            simpa [hyb] using hchain.rel_head

Decomposing a chain that ends in a singleton: the prefix is a chain and its last element relates to the appended one.


lemma IsChain_append_elim {α : Type*} {R : α → α → Prop} {xs : List α} {a : α}
    (h : (xs ++ [a]).IsChain R) (hxs : xs ≠ []) :
    xs.IsChain R ∧ ∀ y, y ∈ xs.getLast? → R y a := by
  induction xs with
  | nil => simp at hxs
  | cons b xs ih =>
      cases xs
      case nil =>
          constructor
          · simp
          · intro y hy
            have hyb : y = b := by
              have hby : b = y := by simpa using hy
              exact hby.symm
            simpa [hyb] using h.rel_head
      case cons c xs =>
          rcases ih h.tail (by simp) with ⟨hxs_chain, hlast_xs⟩
          constructor
          · apply List.IsChain.cons
            · exact hxs_chain
            · intro y hy
              have hyc : y = c := by
                have hcy : c = y := by simpa using hy
                exact hcy.symm
              simpa [hyc] using h.rel_head
          · intro y hy
            have hget : (b :: c :: xs).getLast? = (c :: xs).getLast? := by
              simp [List.getLast?_cons_cons]
            have hy' : y ∈ (c :: xs).getLast? := by
              simpa [hget] using hy
            simpa using hlast_xs y hy'

Reversing a chain swaps the relation.

lemma IsChain_reverse_swap {α : Type*} {R : α → α → Prop} {l : List α}
    (h : l.IsChain (fun a b => R b a)) : l.reverse.IsChain R := by
  induction l using List.reverseRecOn with
  | nil => simp
  | append_singleton xs a ih =>
      by_cases hxs : xs = []
      · simp [hxs]
      · rcases IsChain_append_elim (R := fun a b => R b a) h hxs with ⟨hxs_chain, hlast_xs⟩
        simp [List.reverse_append]
        apply List.IsChain.cons
        · exact ih hxs_chain
        · intro y hy
          simpa [List.head?_reverse] using hlast_xs y (by simpa [List.head?_reverse] using hy)

A residual chain from u to v of length k gives a length-indexed residual path.


lemma chain_segment {φ : Flow V G} (xs : List V)
    (hchain : xs.IsChain φ.residualEdge) (i k : ℕ)
    (hik : i + k < xs.length) :
    ResidualPathLength φ xs[i] xs[i + k] k := by
  induction k with
  | zero => simpa using ResidualPathLength.refl (φ := φ) xs[i]
  | succ k ih =>
      have hik' : i + k < xs.length := by omega
      have hedge : φ.residualEdge xs[i + k] xs[i + k + 1] :=
        hchain.getElem (i + k) (by omega)
      have htail := ResidualPathLength.tail (φ := φ)
        xs[i] xs[i + k] xs[i + k + 1] k (ih hik') hedge
      simpa [Nat.add_assoc] using htail

The shortest residual source-to-sink path realizing residual distance d.

noncomputable def shortestFlow.ResidualPath {φ : Flow V G} (d : ℕ)
    (hd : IsShortestDist φ G.s G.t d) : Flow.ResidualPath φ G.s G.t :=
  { vertices := (back d G.t hd).reverse
  , chain := by
      exact IsChain_reverse_swap (back_chain_rev d G.t hd)
  , head_eq := by
      simpa [List.head?_reverse] using back_last d G.t hd
  , last_eq := by
      simpa [List.getLast?_reverse] using back_head d G.t hd
  , nodup := by
      exact List.nodup_reverse.mpr (back_nodup d G.t hd)
  }

The edge count of the shortest path realizes the residual distance.


lemma shortestFlow.ResidualPath_edges_length {φ : Flow V G} (d : ℕ)
    (hd : IsShortestDist φ G.s G.t d) :
    (shortestFlow.ResidualPath d hd).edges.length = d := by
  rw [Flow.ResidualPath.edges_length]
  simp [shortestFlow.ResidualPath, back_length d G.t hd]

Shortest augmenting path existence. If the sink is residual-reachable from the source, there is an explicit simple augmenting path whose edge count realizes the residual distance (the mathematical core of the Edmonds-Karp loop and its analysis).


theorem exists_shortest_augmenting_path (φ : Flow V G) (h : φ.hasAugmentingPath) :
    Nonempty (ShortestAugmentingPath φ) := by
  rcases (Flow.hasAugmentingPath_iff_nonempty_augmentingPath.mp h) with ⟨p⟩
  have hne : p.vertices ≠ [] := by
    intro hnil
    simpa [hnil] using p.head_eq
  have hlen : 0 < p.vertices.length := List.length_pos_iff.mpr hne
  have hseg := chain_segment p.vertices p.chain 0 (p.vertices.length - 1) (by omega)
  have hfirst : p.vertices[0] = G.s := by
    have hhead : p.vertices.head hne = G.s := by
      simpa [List.head?_eq_some_head hne] using p.head_eq
    exact (List.head_eq_getElem hne).symm.trans hhead
  have hlast : p.vertices[p.vertices.length - 1]'(Nat.sub_lt hlen (by omega)) = G.t := by
    rw [← List.getLast_eq_getElem hne]
    exact List.getLast_of_getLast?_eq_some p.last_eq
  have hpath : ResidualPathLength φ G.s G.t (p.vertices.length - 1) := by
    simpa [hfirst, hlast] using hseg
  let d := Nat.find ⟨p.vertices.length - 1, hpath⟩
  have hd : IsShortestDist φ G.s G.t d :=
    ⟨Nat.find_spec ⟨p.vertices.length - 1, hpath⟩,
     fun n hn => Nat.find_min' ⟨p.vertices.length - 1, hpath⟩ hn⟩
  have hshort : IsShortestDist φ G.s G.t (shortestFlow.ResidualPath d hd).edges.length := by
    rw [shortestFlow.ResidualPath_edges_length d hd]
    exact hd
  exact ⟨{ path := shortestFlow.ResidualPath d hd, h_shortest := hshort }⟩

end Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S2_EK_Loop

24.2 S2. The Edmonds-Karp loop

This module implements the Edmonds-Karp algorithm: repeatedly augment along a shortest residual source-to-sink path until none exists. Shortest paths come from exists_shortest_augmenting_path (S1); integrality and the termination argument reuse the infrastructure of Section 24.3 (Flow.IsIntegral, bottleneck_ge_one, IsIntegral_augment), so each augmentation step increases the integral value by at least one and the iteration terminates at a flow without augmenting paths, which is maximal.

Main results:

shortestAugmentingPath_iff_hasAugmentingPath: a shortest augmenting path exists exactly when the sink is residual-reachable
ekStep: one Edmonds-Karp augmentation step (along a shortest path)
ekIter: the full loop from a starting flow
IsIntegral_ekIter and ekStep_value_ge: integrality and value increase are preserved by every step
exists_noAugmentingPath_ekIter: the loop terminates at a flow without augmenting paths
edmondsKarp_maximal: the terminal flow is maximal and integral

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finsetopen Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}

A shortest augmenting path exists exactly when the sink is residual-reachable.

lemma shortestAugmentingPath_iff_hasAugmentingPath (φ : Flow V G) :
    Nonempty (ShortestAugmentingPath φ) ↔ φ.hasAugmentingPath := by
  constructor
  · intro ⟨p⟩
    exact Flow.hasAugmentingPath_iff_nonempty_augmentingPath.mpr ⟨p.path⟩
  · intro h
    exact exists_shortest_augmenting_path φ h

One Edmonds-Karp step: augment along a shortest residual source-to-sink path if one exists.

noncomputable def ekStep {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : Flow V G :=
  if h : Nonempty (ShortestAugmentingPath φ) then
    φ.augment (Classical.choice h).path
  else φ

ekStep preserves integrality.

lemma IsIntegral_ekStep {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) :
    (ekStep φ).IsIntegral := by
  unfold ekStep
  by_cases h : Nonempty (ShortestAugmentingPath φ)
  · simp [h]
    exact IsIntegral_augment φ hint hc (Classical.choice h).path
  · simp [h]
    exact hint

One Edmonds-Karp step along a shortest path increases the integral value by at least one.

lemma ekStep_value_increase {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (h : Nonempty (ShortestAugmentingPath φ)) :
    φ.value + 1 ≤ (ekStep φ).value := by
  unfold ekStep
  simp [h]
  exact augment_value_ge_one φ hint hc (Classical.choice h).path

Repeatedly apply Edmonds-Karp steps from a starting flow.

noncomputable def ekIter {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : ℕ → Flow V G
  | 0 => φ
  | n + 1 => ekStep (ekIter φ n)

Every iterate of ekIter is integral.

lemma IsIntegral_ekIter {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) :
    ∀ n, (ekIter φ n).IsIntegral := by
  intro n
  induction n with
  | zero => simpa [ekIter] using hint
  | succ n ih =>
      simpa [ekIter] using (IsIntegral_ekStep (ekIter φ n) ih hc)

Each Edmonds-Karp step increases the value by at least one, unless the flow is already free of augmenting paths.

lemma ekStep_value_ge {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (n : ℕ) :
    ¬(ekIter φ n).hasAugmentingPath ∨
      (ekIter φ n).value + 1 ≤ (ekIter φ (n + 1)).value := by
  by_cases h : (ekIter φ n).hasAugmentingPath
  · right
    have hshort : Nonempty (ShortestAugmentingPath (ekIter φ n)) :=
      (shortestAugmentingPath_iff_hasAugmentingPath (ekIter φ n)).mpr h
    have hinc := ekStep_value_increase (ekIter φ n) (IsIntegral_ekIter φ hint hc n) hc hshort
    simpa [ekIter] using hinc
  · left
    exact h

While every step finds an augmenting path, the value after n steps is at least n.

lemma ekIter_value_ge {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (hφ : 0 ≤ φ.value) (hsteps : ∀ n, (ekIter φ n).hasAugmentingPath) :
    ∀ n : ℕ, (n : ℝ) ≤ (ekIter φ n).value := by
  intro n
  induction n with
  | zero => simpa [ekIter] using hφ
  | succ n ih =>
      have hinc := (ekStep_value_ge φ hint hc n).resolve_left (not_not_intro (hsteps n))
      push_cast
      linarith

The Edmonds-Karp loop terminates at a flow without augmenting paths: the value strictly increases by at least one each step and is bounded by the (integral) source-side cut capacity.


lemma exists_noAugmentingPath_ekIter {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (hint : φ.IsIntegral)
    (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) (hφ : 0 ≤ φ.value) :
    ∃ n, ¬ (ekIter φ n).hasAugmentingPath := by
  by_contra hnot
  have hsteps : ∀ n, (ekIter φ n).hasAugmentingPath := by
    intro n
    by_contra h
    exact hnot ⟨n, h⟩
  rcases source_cut_integral hc with ⟨K, hK⟩
  have hge : ((K + 1 : ℕ) : ℝ) ≤ (ekIter φ (K + 1)).value :=
    ekIter_value_ge φ hint hc hφ hsteps (K + 1)
  have hle : (ekIter φ (K + 1)).value ≤ (K : ℝ) := by
    rw [← hK]
    exact value_le_source_cut (ekIter φ (K + 1))
  have hle' : ((K + 1 : ℕ) : ℝ) ≤ (K : ℝ) := le_trans hge hle
  norm_num at hle'

Edmonds-Karp correctness. On an integral-capacity network, the Edmonds-Karp loop reaches an integral maximal flow.


theorem edmondsKarp_maximal {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) :
    ∃ φ : Flow V G, φ.isMaximal ∧ φ.IsIntegral := by
  let zf : Flow V G := zeroFlow G
  have hz : 0 ≤ zf.value := by
    unfold Flow.value
    simp [zf, zeroFlow]
  rcases exists_noAugmentingPath_ekIter zf (IsIntegral_zero (G := G)) hc hz with
    ⟨n, hn⟩
  let φ : Flow V G := ekIter zf n
  refine ⟨φ, ?_, ?_⟩
  · exact Flow.maximal_of_noAugmentingPath φ hn
  · exact IsIntegral_ekIter zf (IsIntegral_zero (G := G)) hc n

end Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S3_WorkAnalysis

24.2 S3. The O(VE²) work analysis

This module develops the mathematical core of the Edmonds-Karp complexity analysis: critical edges and the distance-growth lemma.

An edge (u,v) of the selected augmenting path is critical when augmentation saturates it (its residual capacity drops to zero). Every augmentation saturates at least one edge (the bottleneck is attained by some path edge). The key lemma (CLRS Lemma 24.8) states that when (u,v) is on a shortest augmenting path and later (v,u) is on another shortest augmenting path (the only way the residual capacity of (u,v) can recover), the residual distance to u has increased by at least two:

δ'(u) = δ'(v) + 1 ≥ δ(v) + 1 = δ(u) + 2

Here the first equality is the BFS-path property on the later path, the inequality is monotonicity (Lemma 24.7), and the last equality is the BFS-path property on the earlier path. Since residual distances are bounded by |V| - 1 (shortest paths are simple), each edge can be critical at most |V| times, giving O(VE) augmentations and O(VE²) total work.

Main results:

Flow.AugmentingPath.isCritical: an edge saturated by the augmentation
exists_critical_edge: every augmentation saturates at least one edge
shortest_edge_dist: edges of a shortest path join adjacent distance levels
critical_dist_increase: CLRS Lemma 24.8, forward direction (distance to u grows by at least two when (v,u) later lies on a shortest path)
critical_dist_increase_rev: the reverse-direction variant used by the timeline argument
IsShortestDist.lt_card: residual distances are bounded by |V| - 1
ekSeq/ekPath/criticalAt: the Edmonds-Karp timeline (flow after n steps, selected shortest path, critical-edge predicate)
ekStep_dist_nondec and distAt_mono: reverse distance monotonicity across one and several steps
exists_recovery_step: if (u,v) is critical at step i and again lies on a selected path at step j > i + 1, some intermediate step augments along (v,u) (the residual-capacity recovery argument)
criticalAt_growth: CLRS Lemma 24.8 on the timeline — if (u,v) is critical at steps i and j with i + 1 < j, the residual distance to u grows by at least two
criticalAt_not_succ and criticalAt_growth_strict: consecutive critical steps are impossible, so distances strictly increase between critical occurrences
critical_count_bound: each edge is critical at most |V| times
augmentation_count_bound: at most |V|² · |V| augmenting steps, giving the O(VE²) bound once each step is charged O(E) for BFS

The O(VE²) counting argument is complete; the executable BFS that computes the shortest augmenting paths lives in S4_ExecutableBFS.

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finsetopen Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}

An edge of the selected augmenting path is critical when augmentation saturates it: its residual capacity after augmentation is zero.

def Flow.AugmentingPath.isCritical {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {φ : Flow V G} (p : Flow.AugmentingPath φ) (u v : V) : Prop :=
  (u, v) ∈ p.edges ∧ (φ.augment p).residualCapacity u v = 0

In a simple list, equal elements occur at the same index.


lemma nodup_getElem_inj {α : Type*} {l : List α} (h : l.Nodup)
    {i j : ℕ} (hi : i < l.length) (hj : j < l.length)
    (hij : l[i] = l[j]) : i = j := by
  revert h i j hi hj
  induction l with
  | nil => simp
  | cons a l ih =>
      intro h i j hi hj hij
      cases i with
      | zero =>
          cases j with
          | zero => rfl
          | succ j =>
              exfalso
              have hj' : j < l.length := by simpa using hj
              have ha_eq : a = l[j] := by simpa using hij
              have ha : a ∈ l := by
                simp [ha_eq]
              exact (List.nodup_cons.mp h).1 ha
      | succ i =>
          cases j with
          | zero =>
              exfalso
              have hi' : i < l.length := by simpa using hi
              have ha_eq : a = l[i] := by
                have hla : l[i] = a := by simpa using hij
                exact hla.symm
              have ha : a ∈ l := by
                simp [ha_eq]
              exact (List.nodup_cons.mp h).1 ha
          | succ j =>
              have hi' : i < l.length := by simpa using hi
              have hj' : j < l.length := by simpa using hj
              have hih : i = j :=
                ih (List.nodup_cons.mp h).2 hi' hj' (by simpa using hij)
              omega

A simple path contains no pair of opposite directed edges.


lemma edge_reverse_not_mem {φ : Flow V G} (p : Flow.AugmentingPath φ) {u v : V}
    (huv : (u, v) ∈ p.edges) : (v, u) ∉ p.edges := by
  intro hvu
  rcases p.exists_index_of_mem_edges huv with ⟨i, hi, hvi, hui⟩
  rcases p.exists_index_of_mem_edges hvu with ⟨j, hj, hvj, huj⟩
  have h1 : i + 1 = j := by
    exact nodup_getElem_inj p.nodup (by omega) (by omega) (hui.trans hvj.symm)
  have h2 : i = j + 1 := by
    exact nodup_getElem_inj p.nodup (by omega) (by omega) (hvi.trans huj.symm)
  omega

Every augmentation saturates at least one edge of the selected path.


lemma exists_critical_edge {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {φ : Flow V G} (p : Flow.AugmentingPath φ) :
    ∃ u v, p.isCritical u v := by
  have hmem : p.bottleneck ∈ p.edges.toFinset.image (fun e => φ.residualCapacity e.1 e.2) := by
    unfold Flow.AugmentingPath.bottleneck
    exact Finset.min'_mem _ _
  rcases Finset.mem_image.mp hmem with ⟨e, he, hEq⟩
  have he_edges : e ∈ p.edges := List.mem_toFinset.mp he
  have hpost : (φ.augment p).residualCapacity e.1 e.2 = 0 := by
    rw [Flow.augment_residualCapacity]
    have hrev : (e.2, e.1) ∉ p.edges := edge_reverse_not_mem p he_edges
    rw [hEq]
    simp [he_edges, hrev]
  exact ⟨e.1, e.2, he_edges, hpost⟩

Every edge of a shortest augmenting path joins adjacent distance levels: δ(u) = i and δ(v) = i + 1.


lemma shortest_edge_dist {φ : Flow V G} (p : ShortestAugmentingPath φ) {u v : V}
    (huv : (u, v) ∈ p.path.edges) :
    ∃ d, IsShortestDist φ G.s u d ∧ IsShortestDist φ G.s v (d + 1) := by
  rcases p.path.exists_index_of_mem_edges huv with ⟨i, hi, hvi, hui⟩
  have hpref_u := p.shortest_prefix i (by omega)
  have hpref_v := p.shortest_prefix (i + 1) hi
  refine ⟨i, ?_, ?_⟩
  · simpa [hvi] using hpref_u
  · simpa [hui] using hpref_v

CLRS Lemma 24.8 (critical-edge distance growth). If (u,v) is on a shortest augmenting path of φ and later (v,u) is on a shortest augmenting path of ψ, with residual distances not decreasing from φ to ψ, then the residual distance to u in ψ exceeds that in φ by at least two:

δ_ψ(u) = δ_ψ(v) + 1 ≥ δ_φ(v) + 1 = δ_φ(u) + 2.

lemma critical_dist_increase {φ : Flow V G} (p : ShortestAugmentingPath φ)
    {ψ : Flow V G} (q : ShortestAugmentingPath ψ) {u v : V}
    (hp : (u, v) ∈ p.path.edges) (hq : (v, u) ∈ q.path.edges)
    (hmono : ∀ w d, IsShortestDist φ G.s w d →
      ∃ d', IsShortestDist ψ G.s w d' ∧ d ≤ d') :
    ∃ du du', IsShortestDist φ G.s u du ∧ IsShortestDist ψ G.s u du' ∧ du + 2 ≤ du' := by
  rcases shortest_edge_dist p hp with ⟨du, hdu, hdv⟩
  rcases shortest_edge_dist q hq with ⟨dv', hdv', hdu'⟩
  rcases hmono v (du + 1) hdv with ⟨dv'', hdv'', hle⟩
  have hdv_eq : dv'' = dv' := hdv''.unique hdv'
  refine ⟨du, dv' + 1, hdu, hdu', ?_⟩
  have : du + 1 ≤ dv'' := hle
  omega

Residual distances are bounded by the number of vertices minus one: shortest paths are simple.

lemma IsShortestDist.lt_card {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {φ : Flow V G} {v : V} {d : ℕ}
    (hd : IsShortestDist φ G.s v d) : d < Fintype.card V := by
  have hlen : (back d v hd).length = d + 1 := back_length d v hd
  have hcard : (back d v hd).length ≤ Fintype.card V :=
    List.Nodup.length_le_card (back_nodup d v hd)
  omega

Augmentation counting

The flow after n Edmonds-Karp steps from the zero flow.

noncomputable def ekSeq {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (n : ℕ) : Flow V G :=
  ekIter (zeroFlow G) n

The shortest augmenting path selected at step n, when one exists.

noncomputable def ekPath {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (n : ℕ) : Option (Flow.AugmentingPath (ekSeq (G := G) n)) :=
  if h : Nonempty (ShortestAugmentingPath (ekSeq (G := G) n)) then
    some (Classical.choice h).path
  else none

Edge (u,v) is critical at step n: it lies on the selected augmenting path and the augmentation along it saturates the edge.

def criticalAt {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (n : ℕ) (u v : V) : Prop :=
  ∃ p, ekPath n = some p ∧ (u, v) ∈ p.edges ∧
    ((ekSeq (G := G) n).augment p).residualCapacity u v = 0

Reverse monotonicity across one step: if the distance to u is finite after the step, it was finite before the step and no larger.


lemma ekStep_dist_nondec {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (n : ℕ) (u : V) {d' : ℕ}
    (hd' : IsShortestDist (ekSeq (G := G) (n + 1)) G.s u d') :
    ∃ d, IsShortestDist (ekSeq (G := G) n) G.s u d ∧ d ≤ d' := by
  by_cases hn : (ekSeq (G := G) n).hasAugmentingPath
  · have h : Nonempty (ShortestAugmentingPath (ekSeq (G := G) n)) :=
      (shortestAugmentingPath_iff_hasAugmentingPath (ekSeq (G := G) n)).mpr hn
    have hekstep : ekStep (ekIter (zeroFlow G) n) = (ekIter (zeroFlow G) n).augment (Classical.choice h).path := by
      change ekStep (ekSeq (G := G) n) = (ekSeq (G := G) n).augment (Classical.choice h).path
      unfold ekStep
      simp [h]
    have hd'' : IsShortestDist ((ekIter (zeroFlow G) n).augment (Classical.choice h).path) G.s u d' := by
      simpa [ekSeq, ekIter, hekstep] using hd'
    exact (Classical.choice h).exists_shortestDist_le_augment hd''
  · have hno : ¬ Nonempty (ShortestAugmentingPath (ekSeq (G := G) n)) := by
      intro h
      exact hn ((shortestAugmentingPath_iff_hasAugmentingPath (ekSeq (G := G) n)).mp h)
    have hekstep : ekStep (ekIter (zeroFlow G) n) = ekIter (zeroFlow G) n := by
      change ekStep (ekSeq (G := G) n) = ekSeq (G := G) n
      unfold ekStep
      simp [hno]
    have heq : ekSeq (G := G) (n + 1) = ekSeq (G := G) n := by
      simp [ekSeq, ekIter, hekstep]
    exact ⟨d', by simpa [heq] using hd', le_rfl⟩

Reverse monotonicity across several steps.

lemma distAt_mono {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    {i j : ℕ} (hij : i ≤ j) (u : V) {d' : ℕ}
    (hd' : IsShortestDist (ekSeq (G := G) j) G.s u d') :
    ∃ d, IsShortestDist (ekSeq (G := G) i) G.s u d ∧ d ≤ d' := by
  revert u d' hd'
  refine Nat.le_induction (m := i)
    (P := fun k h => ∀ u d', IsShortestDist (ekSeq (G := G) k) G.s u d' →
      ∃ d, IsShortestDist (ekSeq (G := G) i) G.s u d ∧ d ≤ d') ?_ ?_ j hij
  · intro u d' hd'
    exact ⟨d', hd', le_rfl⟩
  · intro n hn ih u d'' hd''
    rcases ekStep_dist_nondec n u hd'' with ⟨dn, hdn, hle0⟩
    rcases ih u dn hdn with ⟨d, hd, hle⟩
    exact ⟨d, hd, le_trans hle hle0⟩

Reverse-direction version of Lemma 24.8: when (u,v) lies on a shortest augmenting path of φ and (v,u) lies on one of ψ, with distances of ψ no smaller than those of φ (for vertices reachable in ψ), the distance to u in ψ exceeds that in φ by at least two.


lemma critical_dist_increase_rev {φ : Flow V G} (p : ShortestAugmentingPath φ)
    {ψ : Flow V G} (q : ShortestAugmentingPath ψ) {u v : V}
    (hp : (u, v) ∈ p.path.edges) (hq : (v, u) ∈ q.path.edges)
    (hmono : ∀ w d', IsShortestDist ψ G.s w d' →
      ∃ d, IsShortestDist φ G.s w d ∧ d ≤ d') :
    ∃ du du', IsShortestDist φ G.s u du ∧ IsShortestDist ψ G.s u du' ∧ du + 2 ≤ du' := by
  rcases shortest_edge_dist p hp with ⟨du, hdu, hdv⟩
  rcases shortest_edge_dist q hq with ⟨dv', hdv', hdu'⟩
  rcases hmono v dv' hdv' with ⟨dv, hdv0, hle⟩
  have hdv_eq : dv = du + 1 := hdv0.unique hdv
  refine ⟨du, dv' + 1, hdu, hdu', ?_⟩
  have : du ≤ dv' := by omega
  omega

The selected path at step n equals the path extracted from the shortest-path witness.

lemma ekPath_eq_of_hasAugmentingPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (n : ℕ) (hn : (ekSeq (G := G) n).hasAugmentingPath) :
    ∃ p : Flow.AugmentingPath (ekSeq (G := G) n), ekPath n = some p ∧
      ekStep (ekSeq (G := G) n) = (ekSeq (G := G) n).augment p := by
  have h : Nonempty (ShortestAugmentingPath (ekSeq (G := G) n)) :=
    (shortestAugmentingPath_iff_hasAugmentingPath (ekSeq (G := G) n)).mpr hn
  refine ⟨(Classical.choice h).path, ?_, ?_⟩
  · unfold ekPath
    simp [h]
  · unfold ekStep
    simp [h]

If (u,v) is critical at step i and j with i + 1 < j, then between them some step augments along (v,u) — the only way the residual capacity of (u,v) can recover from zero.


lemma exists_recovery_step {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {i j : ℕ} (hij : i + 1 < j) {u v : V}
    (hci : criticalAt (G := G) i u v) (hcj : criticalAt (G := G) j u v) :
    ∃ k : ℕ, ∃ h : Nonempty (ShortestAugmentingPath (ekSeq (G := G) k)),
      i < k ∧ k < j ∧ (v, u) ∈ (Classical.choice h).path.edges := by
  rcases hci with ⟨p_i, hekpath_i, hp_edges, hpost⟩
  rcases hcj with ⟨p_j, hekpath_j, hp_edges_j, _⟩
  have hpos : 0 < (ekSeq (G := G) j).residualCapacity u v := by
    have hres : (ekSeq (G := G) j).residualEdge u v :=
      Flow.ResidualPath.residualEdge_of_mem_edges (φ := ekSeq (G := G) j) p_j hp_edges_j
    exact hres
  -- ekSeq (i+1) = (ekSeq (G := G) i).augment p_i — residual capacity of (u,v) becomes 0
  have hcf_i : (ekSeq (G := G) (i + 1)).residualCapacity u v = 0 := by
    by_cases h_i : Nonempty (ShortestAugmentingPath (ekSeq (G := G) i))
    · have hpath : (Classical.choice h_i).path = p_i := by
        have : ekPath i = some (Classical.choice h_i).path := by
          unfold ekPath
          simp [h_i]
        simpa [this] using hekpath_i
      have hekstep : ekStep (ekIter (zeroFlow G) i) = (ekIter (zeroFlow G) i).augment p_i := by
        change ekStep (ekSeq (G := G) i) = (ekSeq (G := G) i).augment p_i
        unfold ekStep
        simp [h_i, hpath]
      have heq : ekSeq (G := G) (i + 1) = (ekSeq (G := G) i).augment p_i := by
        simp [ekSeq, ekIter, hekstep]
      simpa [heq] using hpost
    · have : ekPath (V := V) (G := G) i = none := by
        unfold ekPath
        simp [h_i]
      simp [this] at hekpath_i
  -- first step j' after i with positive residual capacity
  let P : ℕ → Prop := fun m => i + 1 < m ∧ m ≤ j ∧ 0 < (ekSeq (G := G) m).residualCapacity u v
  have hnonempty : ∃ m, P m := ⟨j, by omega, le_rfl, hpos⟩
  let k := Nat.find hnonempty
  have hk : P k := Nat.find_spec hnonempty
  let k' := k - 1
  have hk_gt : i + 1 < k := hk.1
  have hk_ge2 : i + 2 ≤ k := by omega
  have hk'_ge : i + 1 ≤ k' := by omega
  have hk'_lt : k' < k := by omega
  have hk'_le : k' < j := by omega
  have hnotP : ¬ P k' := by
    intro hP
    have hmin := Nat.find_min' hnonempty hP
    omega
  have hcf_le : (ekSeq (G := G) k').residualCapacity u v ≤ 0 := by
    by_contra h
    apply hnotP
    have hk'_gt : i + 1 < k' := by
      by_contra hnot
      have hk'eq : k' = i + 1 := by omega
      have : (ekSeq (G := G) k').residualCapacity u v = (ekSeq (G := G) (i + 1)).residualCapacity u v := by
        rw [hk'eq]
      linarith [hcf_i, h]
    exact ⟨hk'_gt, by omega, by linarith⟩
  -- step k' must augment (otherwise the residual capacity would not change)
  have hk'_aug : (ekSeq (G := G) k').hasAugmentingPath := by
    by_contra h
    have hno : ¬ Nonempty (ShortestAugmentingPath (ekSeq (G := G) k')) := by
      intro h'
      exact h ((shortestAugmentingPath_iff_hasAugmentingPath (ekSeq (G := G) k')).mp h')
    have hekstep : ekStep (ekIter (zeroFlow G) k') = ekIter (zeroFlow G) k' := by
      change ekStep (ekSeq (G := G) k') = ekSeq (G := G) k'
      unfold ekStep
      simp [hno]
    have heq : ekSeq (G := G) (k' + 1) = ekSeq (G := G) k' := by
      simp [ekSeq, ekIter, hekstep]
    have hk_eq : k = k' + 1 := by omega
    have : (ekSeq (G := G) (k' + 1)).residualCapacity u v = (ekSeq (G := G) k').residualCapacity u v := by
      rw [heq]
    have hpos' : 0 < (ekSeq (G := G) (k' + 1)).residualCapacity u v := by
      simpa [hk_eq] using hk.2.2
    linarith [hpos', hcf_le, this]
  have h : Nonempty (ShortestAugmentingPath (ekSeq (G := G) k')) :=
    (shortestAugmentingPath_iff_hasAugmentingPath (ekSeq (G := G) k')).mpr hk'_aug
  let p' : Flow.AugmentingPath (ekSeq (G := G) k') := (Classical.choice h).path
  have hekstep' : ekStep (ekSeq (G := G) k') = (ekSeq (G := G) k').augment p' := by
    unfold ekStep
    rw [dif_pos h]
  have heq' : ekSeq (G := G) (k' + 1) = (ekSeq (G := G) k').augment p' := by
    change ekStep (ekSeq (G := G) k') = (ekSeq (G := G) k').augment p'
    exact hekstep'
  have hchange : 0 < (ekSeq (G := G) (k' + 1)).residualCapacity u v - (ekSeq (G := G) k').residualCapacity u v := by
    have hk_eq : k = k' + 1 := by omega
    have hpos' : 0 < (ekSeq (G := G) (k' + 1)).residualCapacity u v := by
      simpa [hk_eq] using hk.2.2
    linarith [hpos', hcf_le]
  have hrev : (v, u) ∈ p'.edges := by
    by_contra hnot
    have hformula := Flow.augment_residualCapacity (ekSeq (G := G) k') p' u v
    by_cases huv' : (u, v) ∈ p'.edges
    · have hcf_eq : (ekSeq (G := G) (k' + 1)).residualCapacity u v =
        (ekSeq (G := G) k').residualCapacity u v - p'.bottleneck := by
        have := hformula
        rw [← heq'] at this
        simpa [huv', hnot] using this
      have hb : 0 < p'.bottleneck := p'.bottleneck_pos
      linarith
    · have hcf_eq : (ekSeq (G := G) (k' + 1)).residualCapacity u v =
        (ekSeq (G := G) k').residualCapacity u v := by
        have := hformula
        rw [← heq'] at this
        simpa [huv', hnot] using this
      linarith
  refine ⟨k', h, ?_, ?_, hrev⟩
  · omega
  · exact hk'_le

Counting the augmentations

If ekPath n = some p, the selected path p is the path of the shortest-augmenting-path witness at step n.


lemma ekPath_some_spec {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {n : ℕ} {p : Flow.AugmentingPath (ekSeq (G := G) n)}
    (h : ekPath (G := G) n = some p) :
    ∃ h' : Nonempty (ShortestAugmentingPath (ekSeq (G := G) n)),
      (Classical.choice h').path = p := by
  by_cases h' : Nonempty (ShortestAugmentingPath (ekSeq (G := G) n))
  · refine ⟨h', ?_⟩
    have : ekPath (G := G) n = some (Classical.choice h').path := by
      unfold ekPath
      simp [h']
    simpa [this] using h
  · have hnone : ekPath (G := G) n = none := by
      unfold ekPath
      simp [h']
    simp [hnone] at h

Timeline Lemma 24.8. If (u,v) is critical at step i and again at step j with i + 1 < j, the residual distance to u at step j exceeds that at step i by at least two.

lemma criticalAt_growth {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {i j : ℕ} (hij : i + 1 < j) {u v : V}
    (hci : criticalAt (G := G) i u v) (hcj : criticalAt (G := G) j u v) :
    ∃ du du', IsShortestDist (ekSeq (G := G) i) G.s u du ∧
      IsShortestDist (ekSeq (G := G) j) G.s u du' ∧ du + 2 ≤ du' := by
  rcases exists_recovery_step (G := G) hij hci hcj with ⟨k, h_k, hik, hkj, hrev⟩
  rcases hci with ⟨p_i, hekpath_i, hp_edges, _⟩
  rcases hcj with ⟨p_j, hekpath_j, hp_edges_j, _⟩
  rcases ekPath_some_spec (G := G) hekpath_i with ⟨h_i, hpath_i⟩
  rcases ekPath_some_spec (G := G) hekpath_j with ⟨h_j, hpath_j⟩
  rcases critical_dist_increase_rev (φ := ekSeq (G := G) i) (Classical.choice h_i)
      (ψ := ekSeq (G := G) k) (Classical.choice h_k)
      (by simpa [hpath_i] using hp_edges) hrev
      (fun w d' hd' => distAt_mono (G := G) (i := i) (j := k) (by omega) w hd')
    with ⟨du, dk, hdu, hdk, hgrow⟩
  rcases shortest_edge_dist (Classical.choice h_j) (by simpa [hpath_j] using hp_edges_j)
    with ⟨dj, hdu_j, _⟩
  rcases distAt_mono (G := G) (i := k) (j := j) (by omega) u hdu_j with ⟨dk', hdk', hle⟩
  have hdk_eq : dk' = dk := hdk'.unique hdk
  refine ⟨du, dj, hdu, hdu_j, ?_⟩
  omega

A critical edge cannot be critical at the following step: the previous augmentation saturated it, leaving residual capacity zero.


lemma criticalAt_not_succ {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {n : ℕ} {u v : V}
    (hci : criticalAt (G := G) n u v) :
    ¬ criticalAt (G := G) (n + 1) u v := by
  rcases hci with ⟨p_n, hekpath_n, hp_edges, hpost⟩
  rcases ekPath_some_spec (G := G) hekpath_n with ⟨h_n, hpath_n⟩
  have hekstep : ekStep (ekIter (zeroFlow G) n) = (ekIter (zeroFlow G) n).augment p_n := by
    change ekStep (ekSeq (G := G) n) = (ekSeq (G := G) n).augment p_n
    unfold ekStep
    simp [h_n, hpath_n]
  have heq : ekSeq (G := G) (n + 1) = (ekSeq (G := G) n).augment p_n := by
    simp [ekSeq, ekIter, hekstep]
  have hzero : (ekSeq (G := G) (n + 1)).residualCapacity u v = 0 := by
    simpa [heq] using hpost
  intro hcj
  rcases hcj with ⟨p_j, hekpath_j, hp_edges_j, _⟩
  have hres : (ekSeq (G := G) (n + 1)).residualEdge u v :=
    Flow.ResidualPath.residualEdge_of_mem_edges (φ := ekSeq (G := G) (n + 1)) p_j hp_edges_j
  have hpos : 0 < (ekSeq (G := G) (n + 1)).residualCapacity u v := hres
  linarith

Strict distance growth between critical occurrences: the residual distance to u at the later critical step is strictly larger than at the earlier one.


lemma criticalAt_growth_strict {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {i j : ℕ} (hij : i < j) {u v : V}
    (hci : criticalAt (G := G) i u v) (hcj : criticalAt (G := G) j u v) :
    ∃ du du', IsShortestDist (ekSeq (G := G) i) G.s u du ∧
      IsShortestDist (ekSeq (G := G) j) G.s u du' ∧ du < du' := by
  by_cases hsep : i + 1 < j
  · rcases criticalAt_growth (G := G) hsep hci hcj with ⟨du, du', hdu, hdu', hgrow⟩
    exact ⟨du, du', hdu, hdu', by omega⟩
  · exfalso
    have hsucc : j = i + 1 := by omega
    exact criticalAt_not_succ hci (by simpa [hsucc] using hcj)

At a critical step, the tail u of the critical edge has a residual distance, bounded by |V| - 1.

lemma criticalAt_dist {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} {n : ℕ} {u v : V} (h : criticalAt (G := G) n u v) :
    ∃ d, IsShortestDist (ekSeq (G := G) n) G.s u d ∧ d < Fintype.card V := by
  rcases h with ⟨p, hekpath, hp_edges, _⟩
  rcases ekPath_some_spec (G := G) hekpath with ⟨h_n, hpath⟩
  rcases shortest_edge_dist (Classical.choice h_n) (by simpa [hpath] using hp_edges)
    with ⟨d, hdu, _⟩
  exact ⟨d, hdu, IsShortestDist.lt_card hdu⟩

Every augmenting step has at least one critical edge.

lemma exists_critical_pair_at {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (n : ℕ) (h : (ekSeq (G := G) n).hasAugmentingPath) :
    ∃ u v, criticalAt (G := G) n u v := by
  rcases ekPath_eq_of_hasAugmentingPath (G := G) n h with ⟨p, hekpath, _⟩
  rcases exists_critical_edge p with ⟨u, v, he, hpost⟩
  exact ⟨u, v, p, hekpath, he, hpost⟩

Edge criticality count. A fixed edge (u,v) is critical at most |V| times: every critical occurrence determines a residual distance to u, and that distance strictly increases between occurrences.


lemma critical_count_bound {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (u v : V) (N : ℕ) :
    ((Finset.range N).filter (fun n => criticalAt (G := G) n u v)).card ≤
      Fintype.card V := by
  let s : Finset ℕ := (Finset.range N).filter (fun n => criticalAt (G := G) n u v)
  let hcrit : ∀ x : {n : ℕ // n ∈ s}, criticalAt (G := G) x.1 u v :=
    fun x => (Finset.mem_filter.mp x.2).2
  let distOf : {n : ℕ // n ∈ s} → ℕ :=
    fun x => Classical.choose (criticalAt_dist (hcrit x))
  let f : {n : ℕ // n ∈ s} → Fin (Fintype.card V) :=
    fun x => ⟨distOf x, (Classical.choose_spec (criticalAt_dist (hcrit x))).2⟩
  have hinj : Set.InjOn f (↑(s.attach) : Set {n : ℕ // n ∈ s}) := by
    intro x hx y hy hxy
    apply Subtype.ext
    by_contra hne
    have hxy' : distOf x = distOf y :=
      congrArg (fun z : Fin (Fintype.card V) => z.1) hxy
    have hlt_or : x.1 < y.1 ∨ y.1 < x.1 := by omega
    rcases hlt_or with hxy_lt | hyx_lt
    · rcases criticalAt_growth_strict (G := G) hxy_lt (hcrit x) (hcrit y) with
        ⟨du, du', hdu, hdu', hgrow⟩
      have hdx : distOf x = du :=
        (Classical.choose_spec (criticalAt_dist (hcrit x))).1.unique hdu
      have hdy : distOf y = du' :=
        (Classical.choose_spec (criticalAt_dist (hcrit y))).1.unique hdu'
      omega
    · rcases criticalAt_growth_strict (G := G) hyx_lt (hcrit y) (hcrit x) with
        ⟨du, du', hdu, hdu', hgrow⟩
      have hdy : distOf y = du :=
        (Classical.choose_spec (criticalAt_dist (hcrit y))).1.unique hdu
      have hdx : distOf x = du' :=
        (Classical.choose_spec (criticalAt_dist (hcrit x))).1.unique hdu'
      omega
  have hsub : s.attach.image f ⊆ (Finset.univ : Finset (Fin (Fintype.card V))) := by
    intro x hx
    simp
  have hcard : (s.attach.image f).card = s.attach.card :=
    Finset.card_image_of_injOn hinj
  calc
    s.card = s.attach.card := Finset.card_attach.symm
    _ = (s.attach.image f).card := hcard.symm
    _ ≤ (Finset.univ : Finset (Fin (Fintype.card V))).card := Finset.card_le_card hsub
    _ = Fintype.card V := by simp

Augmentation count. There are at most |V|² · |V| augmenting steps: each one has a critical edge, and each of the |V|² edges is critical at most |V| times.


lemma augmentation_count_bound {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (N : ℕ) :
    ((Finset.range N).filter (fun n => (ekSeq (G := G) n).hasAugmentingPath)).card ≤
      Fintype.card (V × V) * Fintype.card V := by
  let s : Finset ℕ :=
    (Finset.range N).filter (fun n => (ekSeq (G := G) n).hasAugmentingPath)
  let haug : ∀ x : {n : ℕ // n ∈ s}, (ekSeq (G := G) x.1).hasAugmentingPath :=
    fun x => (Finset.mem_filter.mp x.2).2
  let pair : {n : ℕ // n ∈ s} → V × V := fun x =>
    let h := exists_critical_pair_at (G := G) x.1 (haug x)
    (Classical.choose h, Classical.choose (Classical.choose_spec h))
  let hcrit : ∀ x : {n : ℕ // n ∈ s},
      criticalAt (G := G) x.1 (pair x).1 (pair x).2 :=
    fun x =>
      Classical.choose_spec
        (Classical.choose_spec (exists_critical_pair_at (G := G) x.1 (haug x)))
  let distOf : {n : ℕ // n ∈ s} → ℕ :=
    fun x => Classical.choose (criticalAt_dist (hcrit x))
  let f : {n : ℕ // n ∈ s} → (V × V) × Fin (Fintype.card V) :=
    fun x => (pair x, ⟨distOf x, (Classical.choose_spec (criticalAt_dist (hcrit x))).2⟩)
  have hinj : Set.InjOn f (↑(s.attach) : Set {n : ℕ // n ∈ s}) := by
    intro x hx y hy hxy
    apply Subtype.ext
    by_contra hne
    have hpair_eq : pair x = pair y := congrArg Prod.fst hxy
    have hdist_eq : distOf x = distOf y :=
      congrArg (fun z : (V × V) × Fin (Fintype.card V) => z.2.1) hxy
    have hcy : criticalAt (G := G) y.1 (pair x).1 (pair x).2 := by
      simpa [hpair_eq] using hcrit y
    have hlt_or : x.1 < y.1 ∨ y.1 < x.1 := by omega
    rcases hlt_or with hxy_lt | hyx_lt
    · rcases criticalAt_growth_strict (G := G) hxy_lt (hcrit x) hcy with
        ⟨du, du', hdu, hdu', hgrow⟩
      have hdx : distOf x = du :=
        (Classical.choose_spec (criticalAt_dist (hcrit x))).1.unique hdu
      have hdy : distOf y = du' := by
        have hd := (Classical.choose_spec (criticalAt_dist (hcrit y))).1
        exact hd.unique (by simpa [hpair_eq] using hdu')
      omega
    · rcases criticalAt_growth_strict (G := G) hyx_lt hcy (hcrit x) with
        ⟨du, du', hdu, hdu', hgrow⟩
      have hdy : distOf y = du := by
        have hd := (Classical.choose_spec (criticalAt_dist (hcrit y))).1
        exact hd.unique (by simpa [hpair_eq] using hdu)
      have hdx : distOf x = du' :=
        (Classical.choose_spec (criticalAt_dist (hcrit x))).1.unique hdu'
      omega
  have hsub : s.attach.image f ⊆ (Finset.univ : Finset ((V × V) × Fin (Fintype.card V))) := by
    intro x hx
    simp
  have hcard : (s.attach.image f).card = s.attach.card :=
    Finset.card_image_of_injOn hinj
  calc
    s.card = s.attach.card := Finset.card_attach.symm
    _ = (s.attach.image f).card := hcard.symm
    _ ≤ (Finset.univ : Finset ((V × V) × Fin (Fintype.card V))).card :=
      Finset.card_le_card hsub
    _ = Fintype.card (V × V) * Fintype.card V := by simp

end Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S4_ExecutableBFS.CostedSupportBFS

Costed residual BFS over finite support buckets

This is the adjacency-list execution companion to residualBFS. A step reads only the bucket of the dequeued vertex and charges one dequeue plus four RAM operations per inspected candidate (residual test, visited test, and the possible discovery bookkeeping). Under residual-support coverage, erasing the counter gives the existing semantic BFS state exactly.

As in the textbook RAM model, bucket access and queue/discovery primitives carry stipulated unit charges. The attached counter measures that abstract execution, not Lean evaluator time for the underlying persistent containers.

              namespace CLRSnamespace Chapter26open Finset Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}

A support contains every residual edge of φ.

def SupportsResidual (A : SupportAdjacency V) (φ : Flow V G) : Prop :=
  ∀ ⦃u v⦄, Flow.residualEdge φ u v → v ∈ A.bucket u

Residual candidates in the bucket of u.

noncomputable def supportResidualAdj (A : SupportAdjacency V)
    (φ : Flow V G) (u : V) : Finset V :=
  (A.bucket u).filter fun v => Flow.residualEdge φ u v

Undiscovered residual candidates in the bucket of u.

noncomputable def supportBFSNewNeighbors (A : SupportAdjacency V)
    (φ : Flow V G) (state : BFSState V) (u : V) : Finset V :=
  (supportResidualAdj A φ u).filter fun v => v ∉ state.visited

The ordinary BFS state update, using only a support bucket.

noncomputable def supportBFSStateAdvance (A : SupportAdjacency V)
    (φ : Flow V G) (state : BFSState V) (u : V) (rest : List V) : BFSState V :=
  let newNeighbors := supportBFSNewNeighbors A φ state u
  let nextDistance := state.level u + 1
  {
    visited := state.visited ∪ newNeighbors
    queue := rest ++ newNeighbors.toList
    distance := fun v =>
      if v ∈ newNeighbors then some nextDistance else state.distance v
    parent := fun v =>
      if v ∈ newNeighbors then some u else state.parent v
  }

              theorem supportResidualAdj_eq_residualAdj (A : SupportAdjacency V)
    (φ : Flow V G) (cover : SupportsResidual A φ) (u : V) :
    supportResidualAdj A φ u = residualAdj φ u := by
  ext v
  simp only [supportResidualAdj, Finset.mem_filter, mem_residualAdj]
  constructor
  · exact fun h => h.2
  · exact fun h => ⟨cover h, h⟩theorem supportBFSNewNeighbors_eq_bfsNewNeighbors (A : SupportAdjacency V)
    (φ : Flow V G) (cover : SupportsResidual A φ) (state : BFSState V) (u : V) :
    supportBFSNewNeighbors A φ state u = bfsNewNeighbors φ state u := by
  simp [supportBFSNewNeighbors, bfsNewNeighbors,
    supportResidualAdj_eq_residualAdj A φ cover u]theorem supportBFSStateAdvance_eq_bfsStateAdvance (A : SupportAdjacency V)
    (φ : Flow V G) (cover : SupportsResidual A φ) (state : BFSState V)
    (u : V) (rest : List V) :
    supportBFSStateAdvance A φ state u rest = bfsStateAdvance φ state u rest := by
  simp [supportBFSStateAdvance, bfsStateAdvance,
    supportBFSNewNeighbors_eq_bfsNewNeighbors A φ cover state u]

Result of the support-bucket execution.

structure CostedBFSRun (V : Type*) [DecidableEq V] where
  state : BFSState V
  work : Nat

Work already performed before state: every dequeued vertex costs one unit and four units per candidate in its support bucket.

noncomputable def supportBFSWork (A : SupportAdjacency V)
    (visited : Finset V) (queue : List V) : Nat :=
  let processed := visited \ queue.toFinset
  processed.card + 4 * ∑ u ∈ processed, (A.bucket u).card

theorem mem_supportBFSNewNeighbors_iff {A : SupportAdjacency V}
    {φ : Flow V G} {state : BFSState V} {u v : V} :
    v ∈ supportBFSNewNeighbors A φ state u ↔
      v ∈ A.bucket u ∧ Flow.residualEdge φ u v ∧ v ∉ state.visited := by
  simp [supportBFSNewNeighbors, supportResidualAdj, and_assoc]

Dequeuing u advances the work measure by the exact charge recorded by the recursive execution.


theorem supportBFSWork_step (A : SupportAdjacency V) (φ : Flow V G)
    {u : V} {rest : List V} {state : BFSState V}
    (hu : u ∈ state.visited) (hu_rest : u ∉ rest) :
    supportBFSWork A (supportBFSStateAdvance A φ state u rest).visited
        (supportBFSStateAdvance A φ state u rest).queue =
      supportBFSWork A state.visited (u :: rest) + 1 + 4 * (A.bucket u).card := by
  let newNeighbors := supportBFSNewNeighbors A φ state u
  have hnotVisited {x : V} (hx : x ∈ newNeighbors) : x ∉ state.visited :=
    (mem_supportBFSNewNeighbors_iff.mp hx).2.2
  have huNew : u ∉ newNeighbors := by
    intro h
    exact hnotVisited h hu
  have hdequeued :
      (state.visited ∪ newNeighbors) \ (rest.toFinset ∪ newNeighbors) =
        insert u (state.visited \ insert u rest.toFinset) := by
    ext x
    by_cases hxNew : x ∈ newNeighbors
    · simp [hxNew, hnotVisited hxNew]
      intro hxu
      rw [hxu] at hxNew
      exact huNew hxNew
    · simp [hxNew]
      constructor
      · rintro ⟨hxVisited, hxRest⟩
        by_cases hxu : x = u
        · exact Or.inl hxu
        · exact Or.inr ⟨hxVisited, hxu, hxRest⟩
      · rintro (hxu | ⟨hxVisited, _hxne, hxRest⟩)
        · subst x
          exact ⟨hu, hu_rest⟩
        · exact ⟨hxVisited, hxRest⟩
  simp [supportBFSWork, supportBFSStateAdvance]
  rw [hdequeued]
  have huProcessed : u ∉ state.visited \ insert u rest.toFinset := by simp
  simp [huProcessed]
  omega

A support-BFS step preserves duplicate-freedom of the queue.


theorem supportBFSStateAdvance_queue_nodup (A : SupportAdjacency V)
    (φ : Flow V G) {state : BFSState V} {u : V} {rest : List V}
    (hnodup : (u :: rest).Nodup)
    (hqueue : BFSQueueInv φ state.visited (u :: rest)) :
    (supportBFSStateAdvance A φ state u rest).queue.Nodup := by
  let newNeighbors := supportBFSNewNeighbors A φ state u
  have hrest : rest.Nodup := (List.nodup_cons.mp hnodup).2
  have hnew : newNeighbors.toList.Nodup := Finset.nodup_toList newNeighbors
  have hdisjoint : ∀ a ∈ rest, ∀ b ∈ newNeighbors.toList, a ≠ b := by
    intro a ha b hb hab
    rw [← hab] at hb
    have haVisited : a ∈ state.visited := hqueue a (by simp [ha])
    have haNew : a ∈ newNeighbors := Finset.mem_toList.mp hb
    exact (mem_supportBFSNewNeighbors_iff.mp haNew).2.2 haVisited
  have : (rest ++ newNeighbors.toList).Nodup := by
    rw [List.nodup_append]
    exact ⟨hrest, hnew, hdisjoint⟩
  simpa [supportBFSStateAdvance, newNeighbors] using this

Fuelled costed support BFS.

noncomputable def costedBFSAux (A : SupportAdjacency V) (φ : Flow V G) :
    Nat → BFSState V → CostedBFSRun V
  | 0, state => ⟨state, 0⟩
  | fuel + 1, state =>
      match state.queue with
      | [] => ⟨state, 0⟩
      | u :: rest =>
          let tail := costedBFSAux A φ fuel
            (supportBFSStateAdvance A φ state u rest)
          ⟨tail.state, 1 + 4 * (A.bucket u).card + tail.work⟩

Costed support BFS, fuelled by the finite vertex count.

noncomputable def costedResidualBFS (A : SupportAdjacency V)
    (φ : Flow V G) : CostedBFSRun V :=
  costedBFSAux A φ (Fintype.card V) (bfsStateInit G.s)



theorem costedBFSAux_state (A : SupportAdjacency V) (φ : Flow V G)
    (cover : SupportsResidual A φ) (fuel : Nat) (state : BFSState V) :
    (costedBFSAux A φ fuel state).state = bfsStateAux φ fuel state := by
  induction fuel generalizing state with
  | zero => simp [costedBFSAux, bfsStateAux]
  | succ fuel ih =>
      cases hqueue : state.queue with
      | nil => simp [costedBFSAux, bfsStateAux, hqueue]
      | cons u rest =>
          simp only [costedBFSAux, bfsStateAux, hqueue]
          rw [ih]
          exact congrArg (bfsStateAux φ fuel)
            (supportBFSStateAdvance_eq_bfsStateAdvance A φ cover state u rest)

Erasing the support execution and counters gives the existing residual BFS state exactly.

theorem costedResidualBFS_state (A : SupportAdjacency V) (φ : Flow V G)
    (cover : SupportsResidual A φ) :
    (costedResidualBFS A φ).state = residualBFS φ := by
  exact costedBFSAux_state A φ cover (Fintype.card V) (bfsStateInit G.s)

The accumulated recursive counter equals the increase of the execution work measure.


theorem costedBFSAux_work_eq (A : SupportAdjacency V) (φ : Flow V G)
    (cover : SupportsResidual A φ) (fuel : Nat) (state : BFSState V)
    (hqueue : BFSQueueInv φ state.visited state.queue)
    (hnodup : state.queue.Nodup) :
    (costedBFSAux A φ fuel state).work +
        supportBFSWork A state.visited state.queue =
      supportBFSWork A (costedBFSAux A φ fuel state).state.visited
        (costedBFSAux A φ fuel state).state.queue := by
  induction fuel generalizing state with
  | zero => simp [costedBFSAux]
  | succ fuel ih =>
      cases hq : state.queue with
      | nil => simp [costedBFSAux, hq]
      | cons u rest =>
          have hqueueCons : BFSQueueInv φ state.visited (u :: rest) := by
            simpa [hq] using hqueue
          have hnodupCons : (u :: rest).Nodup := by simpa [hq] using hnodup
          let next := supportBFSStateAdvance A φ state u rest
          have hnextEq : next = bfsStateAdvance φ state u rest :=
            supportBFSStateAdvance_eq_bfsStateAdvance A φ cover state u rest
          have hqueueNext : BFSQueueInv φ next.visited next.queue := by
            rw [hnextEq]
            exact bfsQueueInv_step hqueueCons
          have hnodupNext : next.queue.Nodup := by
            exact supportBFSStateAdvance_queue_nodup A φ hnodupCons hqueueCons
          have hih := ih next hqueueNext hnodupNext
          have hu : u ∈ state.visited := hqueue u (by simp [hq])
          have huRest : u ∉ rest := (List.nodup_cons.mp hnodupCons).1
          have hstep := supportBFSWork_step A φ hu huRest
          simp only [costedBFSAux, hq]
          change 1 + 4 * (A.bucket u).card +
              (costedBFSAux A φ fuel next).work +
                supportBFSWork A state.visited (u :: rest) =
            supportBFSWork A (costedBFSAux A φ fuel next).state.visited
              (costedBFSAux A φ fuel next).state.queue
          rw [← hih, hstep]
          omega

theorem supportBFSWork_init (A : SupportAdjacency V) (s : V) :
    supportBFSWork A (bfsStateInit s).visited (bfsStateInit s).queue = 0 := by
  simp [supportBFSWork, bfsStateInit]

The actual support-BFS scan execution is linear in vertices plus stored candidate arcs.


theorem costedResidualBFS_scanWork_le (A : SupportAdjacency V) (φ : Flow V G)
    (cover : SupportsResidual A φ) :
    (costedResidualBFS A φ).work ≤ Fintype.card V + 4 * A.storage := by
  have hinitQueue : BFSQueueInv φ (bfsStateInit G.s).visited
      (bfsStateInit G.s).queue := by
    intro v hv
    simpa [BFSQueueInv, bfsStateInit] using hv
  have hinitNodup : (bfsStateInit G.s).queue.Nodup := by
    simp [bfsStateInit]
  have hcost := costedBFSAux_work_eq A φ cover (Fintype.card V)
    (bfsStateInit G.s) hinitQueue hinitNodup
  have hzero := supportBFSWork_init A G.s
  have hqueueEmpty : (costedResidualBFS A φ).state.queue = [] := by
    rw [costedResidualBFS_state A φ cover]
    exact residualBFS_queue_empty φ
  have hcostEq : (costedResidualBFS A φ).work =
      supportBFSWork A (costedResidualBFS A φ).state.visited
        (costedResidualBFS A φ).state.queue := by
    rw [hzero] at hcost
    simpa [costedResidualBFS] using hcost
  rw [hcostEq, hqueueEmpty]
  simp only [supportBFSWork, List.toFinset_nil, Finset.sdiff_empty]
  have hcard : (costedResidualBFS A φ).state.visited.card ≤ Fintype.card V :=
    Finset.card_le_univ _
  have hsum :
      ∑ u ∈ (costedResidualBFS A φ).state.visited, (A.bucket u).card ≤ A.storage :=
    sum_bucket_card_le_storage A _
  omega

Public work bound for the costed support BFS.

theorem costedResidualBFS_work_le (A : SupportAdjacency V) (φ : Flow V G)
    (cover : SupportsResidual A φ) :
    (costedResidualBFS A φ).work ≤ Fintype.card V + 4 * A.storage :=
  costedResidualBFS_scanWork_le A φ cover

Attached parent-path recovery

A recovered path list and the work performed to construct it.

structure CostedPathVertices (V : Type*) where
  vertices : List V
  work : Nat

namespace BFSParentPath

Build the parent path in reverse order using constant-time list cons.

noncomputable def reverseVerticesWithCost {parent : V → Option V} {s v : V} {n : Nat}
    (h : BFSParentPath parent s v n) : CostedPathVertices V :=
  match h with
  | root => ⟨[s], 1⟩
  | @tail _ _ _ _ v _ hprev _ =>
      let prev := reverseVerticesWithCost hprev
      ⟨v :: prev.vertices, prev.work + 1⟩

omit [Fintype V] [DecidableEq V] in
theorem reverseVerticesWithCost_vertices {parent : V → Option V} {s v : V} {n : Nat}
    (h : BFSParentPath parent s v n) :
    (reverseVerticesWithCost h).vertices = (BFSParentPath.vertices h).reverse := by
  induction h with
  | root => rfl
  | @tail u v n hprev hparent ih =>
      simp [reverseVerticesWithCost, BFSParentPath.vertices, ih]

omit [Fintype V] [DecidableEq V] in
theorem reverseVerticesWithCost_work {parent : V → Option V} {s v : V} {n : Nat}
    (h : BFSParentPath parent s v n) :
    (reverseVerticesWithCost h).work = n + 1 := by
  induction h with
  | root => rfl
  | @tail u v n hprev hparent ih =>
      simp [reverseVerticesWithCost, ih]

Recover source-to-target order and charge the final linear reversal.

noncomputable def verticesWithCost {parent : V → Option V} {s v : V} {n : Nat}
    (h : BFSParentPath parent s v n) : CostedPathVertices V :=
  let reverseRun := reverseVerticesWithCost h
  ⟨reverseRun.vertices.reverse, reverseRun.work + reverseRun.vertices.length⟩

              omit [Fintype V] [DecidableEq V] in
theorem verticesWithCost_vertices {parent : V → Option V} {s v : V} {n : Nat}
    (h : BFSParentPath parent s v n) :
    (verticesWithCost h).vertices = BFSParentPath.vertices h := by
  simp [verticesWithCost, reverseVerticesWithCost_vertices]theorem verticesWithCost_work {parent : V → Option V} {s v : V} {n : Nat}
    (h : BFSParentPath parent s v n) :
    (verticesWithCost h).work = 2 * (n + 1) := by
  simp [verticesWithCost, reverseVerticesWithCost_work,
    reverseVerticesWithCost_vertices, BFSParentPath.vertices_length]
  omegaend BFSParentPathend Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S4_ExecutableBFS.SupportAdjacency

Finite support adjacency buckets

This module builds adjacency buckets from a finite directed support. The builder records one RAM-model unit for each executed bucket insertion. Its membership, work, and total-storage specifications are independent of flow semantics and are reused by the costed residual BFS.

This is an explicit unit-cost RAM abstraction for the textbook analysis; the counter is not a claim about Lean kernel reduction or a particular compiled Finset representation.

              namespace CLRSnamespace Chapter26open Finset Classicalvariable {V : Type*} [DecidableEq V]

A finite directed support indexed by its source vertex.

structure SupportAdjacency (V : Type*) [DecidableEq V] where
  bucket : V → Finset V

namespace SupportAdjacency

The empty support adjacency.

def empty : SupportAdjacency V where
  bucket := fun _ => ∅

Insert one directed support arc into its source bucket.

def insertArc (A : SupportAdjacency V) (e : V × V) : SupportAdjacency V where
  bucket := Function.update A.bucket e.1 (insert e.2 (A.bucket e.1))

@[simp]
theorem empty_bucket (u : V) : (empty : SupportAdjacency V).bucket u = ∅ := rfl

@[simp]
theorem mem_insertArc_bucket {A : SupportAdjacency V} {e : V × V} {u v : V} :
    v ∈ (A.insertArc e).bucket u ↔ (u, v) = e ∨ v ∈ A.bucket u := by
  rcases e with ⟨a, b⟩
  by_cases h : u = a
  · subst u
    simp [insertArc]
  · simp [insertArc, Function.update, h]

Total number of stored bucket entries.

noncomputable def storage [Fintype V] (A : SupportAdjacency V) : Nat :=
  ∑ u : V, (A.bucket u).card



theorem storage_insertArc_of_not_mem [Fintype V] (A : SupportAdjacency V)
    (e : V × V) (hnew : e.2 ∉ A.bucket e.1) :
    (A.insertArc e).storage = A.storage + 1 := by
  unfold storage
  change (∑ u, (Function.update A.bucket e.1
    (insert e.2 (A.bucket e.1)) u).card) = ∑ u, (A.bucket u).card + 1
  have hfun : (fun u => (Function.update A.bucket e.1
      (insert e.2 (A.bucket e.1)) u).card) =
      Function.update (fun u => (A.bucket u).card) e.1
        (insert e.2 (A.bucket e.1)).card := by
    funext u
    by_cases h : u = e.1 <;> simp [Function.update, h]
  rw [hfun]
  rw [Finset.sum_update_of_mem (Finset.mem_univ e.1)]
  rw [Finset.card_insert_of_notMem hnew]
  rw [Finset.sdiff_singleton_eq_erase]
  have hsum := Finset.sum_erase_add (Finset.univ : Finset V)
    (fun u => (A.bucket u).card) (Finset.mem_univ e.1)
  omega

end SupportAdjacency

Result of building adjacency buckets, including the executed insert count.

structure SupportBuild (V : Type*) [DecidableEq V] where
  adjacency : SupportAdjacency V
  work : Nat

Build buckets from a support list, charging one unit for each insertion.

def buildSupportAux : List (V × V) → SupportBuild V
  | [] => ⟨SupportAdjacency.empty, 0⟩
  | e :: rest =>
      let tail := buildSupportAux rest
      ⟨tail.adjacency.insertArc e, tail.work + 1⟩

              @[simp]
theorem buildSupportAux_work (support : List (V × V)) :
    (buildSupportAux support).work = support.length := by
  induction support with
  | nil => rfl
  | cons e rest ih => simp [buildSupportAux, ih]theorem mem_buildSupportAux {support : List (V × V)} {u v : V} :
    v ∈ (buildSupportAux support).adjacency.bucket u ↔ (u, v) ∈ support := by
  induction support with
  | nil => simp [buildSupportAux, SupportAdjacency.empty]
  | cons e rest ih =>
      simp [buildSupportAux, SupportAdjacency.mem_insertArc_bucket, ih]

theorem buildSupportAux_storage [Fintype V] {support : List (V × V)}
    (hnodup : support.Nodup) :
    (buildSupportAux support).adjacency.storage = support.length := by
  induction support with
  | nil => simp [buildSupportAux, SupportAdjacency.storage]
  | cons e rest ih =>
      rw [List.nodup_cons] at hnodup
      have hnew : e.2 ∉ (buildSupportAux rest).adjacency.bucket e.1 := by
        intro hmem
        exact hnodup.1 ((mem_buildSupportAux.mp hmem))
      rw [buildSupportAux]
      rw [SupportAdjacency.storage_insertArc_of_not_mem _ _ hnew]
      rw [ih hnodup.2]
      simp

Build adjacency buckets from a duplicate-free finite support.

noncomputable def buildSupportAdjacency (support : Finset (V × V)) : SupportBuild V :=
  buildSupportAux support.toList

              theorem mem_buildSupportAdjacency {support : Finset (V × V)} {u v : V} :
    v ∈ (buildSupportAdjacency support).adjacency.bucket u ↔ (u, v) ∈ support := by
  simp [buildSupportAdjacency, mem_buildSupportAux]theorem buildSupportAdjacency_work (support : Finset (V × V)) :
    (buildSupportAdjacency support).work = support.card := by
  simp [buildSupportAdjacency]

theorem buildSupportAdjacency_storage [Fintype V] (support : Finset (V × V)) :
    (buildSupportAdjacency support).adjacency.storage = support.card := by
  rw [buildSupportAdjacency, buildSupportAux_storage support.nodup_toList]
  simptheorem sum_bucket_card_le_storage [Fintype V] (A : SupportAdjacency V)
    (processed : Finset V) :
    ∑ u ∈ processed, (A.bucket u).card ≤ A.storage := by
  exact Finset.sum_le_sum_of_subset (Finset.subset_univ processed)end Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S4_ExecutableBFS

24.2 S4. Executable breadth-first search

This module implements an executable breadth-first search over the residual network of a flow φ and proves its correctness: the BFS distance labels are the exact residual distances (IsShortestDist), the parent pointers walk back to the source along residual edges, and the parent chain from the sink assembles a shortest augmenting path whenever one exists. This is the executable core of the Edmonds-Karp loop: the augmenting path it computes can be fed to Flow.augment in place of the classical choice used by ekStep (see ekStep_shortest_path_bfs).

The search mirrors the Chapter 22 BFS state (visited, queue, distance, parent), fuelled by the number of vertices; the queue invariants (BFSClosedInv, BFSQueueInv, BFSDistanceInvariant) are the same, with graph adjacency replaced by the residual relation Flow.residualEdge φ.

Main results:

residualBFS: the fuelled breadth-first search over the residual network
residualBFS_distanceInvariant: the distance/predecessor invariant holds
residualBFS_queue_empty: the search exhausts its queue after |V| steps
bfsState_distance_eq_some_iff: the BFS distance of a vertex is its residual shortest distance IsShortestDist
bfsParentResidualPath: the parent chain from the sink assembles a simple residual path
bfs_shortestAugmenting: an executable shortest augmenting path whenever one exists
ekStep_shortest_path_bfs: the Edmonds-Karp step augments along a shortest path of the same length as the BFS path

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finsetopen Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}

The residual out-neighborhood of u: vertices reachable from u by one residual edge.

noncomputable def residualAdj (φ : Flow V G) (u : V) : Finset V :=
  Finset.univ.filter (fun v => Flow.residualEdge φ u v)

@[simp]
theorem mem_residualAdj {φ : Flow V G} {u v : V} :
    v ∈ residualAdj φ u ↔ Flow.residualEdge φ u v := by
  simp [residualAdj]

BFS state: discovered vertices, FIFO queue, distance labels, and parent pointers. A vertex is discovered exactly when it belongs to visited; distance and parent record its first discovery.

structure BFSState (V : Type*) [DecidableEq V] where
  visited : Finset V
  queue : List V
  distance : V → Option ℕ
  parent : V → Option V

namespace BFSState

Numeric level used by the queue invariants. It is only inspected for discovered vertices, where the distance is known to be present.

def level (state : BFSState V) (v : V) : ℕ :=
  (state.distance v).getD 0

end BFSState

Initial BFS state at the source.

noncomputable def bfsStateInit (s : V) : BFSState V where
  visited := {s}
  queue := [s]
  distance := fun v => if v = s then some 0 else none
  parent := fun _ => none

As-yet undiscovered residual out-neighbors of u.

noncomputable def bfsNewNeighbors (φ : Flow V G) (state : BFSState V) (u : V) : Finset V :=
  (residualAdj φ u).filter (fun v => v ∉ state.visited)

Process the front vertex u, assigning distance level u + 1 and parent u to every newly discovered residual neighbor.

noncomputable def bfsStateAdvance (φ : Flow V G) (state : BFSState V)
    (u : V) (rest : List V) : BFSState V :=
  let newNeighbors := bfsNewNeighbors φ state u
  let nextDistance := state.level u + 1
  {
    visited := state.visited ∪ newNeighbors
    queue := rest ++ newNeighbors.toList
    distance := fun v =>
      if v ∈ newNeighbors then some nextDistance else state.distance v
    parent := fun v =>
      if v ∈ newNeighbors then some u else state.parent v
  }

Fuelled residual BFS.

noncomputable def bfsStateAux (φ : Flow V G) : ℕ → BFSState V → BFSState V
  | 0, state => state
  | fuel + 1, state =>
      match state.queue with
      | [] => state
      | u :: rest => bfsStateAux φ fuel (bfsStateAdvance φ state u rest)

BFS over the residual network of φ, fuelled by the number of vertices.

noncomputable def residualBFS (φ : Flow V G) : BFSState V :=
  bfsStateAux φ (Fintype.card V) (bfsStateInit G.s)

Closure invariant: every neighbor of a processed (no longer queued) vertex is already visited.

def BFSClosedInv (φ : Flow V G) (visited : Finset V) (queue : List V) : Prop :=
  ∀ u ∈ visited, u ∉ queue → ∀ v, Flow.residualEdge φ u v → v ∈ visited

Queue invariant: every queued vertex is already marked visited.

def BFSQueueInv (Variable name `φ` is not explicitly referenced.

The binding can be removed (if unused) or named `_` (if used implicitly).

Note: This linter can be disabled with `set_option linter.unusedVariables false`φ : Flow V G) (visited : Finset V) (queue : List V) : Prop :=
  ∀ v ∈ queue, v ∈ visited

theorem mem_bfsNewNeighbors_iff {φ : Flow V G} {state : BFSState V} {u v : V} :
    v ∈ bfsNewNeighbors φ state u ↔ Flow.residualEdge φ u v ∧ v ∉ state.visited := by
  simp [bfsNewNeighbors]

The closure invariant is preserved by one BFS step.


theorem bfsClosedInv_step {φ : Flow V G} {u : V} {rest : List V} {visited : Finset V}
    (hclosed : BFSClosedInv φ visited (u :: rest)) :
    BFSClosedInv φ
      (visited ∪ (residualAdj φ u).filter (fun v => v ∉ visited))
      (rest ++ ((residualAdj φ u).filter (fun v => v ∉ visited)).toList) := by
  intro x hx hxnotin v hvx
  simp [BFSClosedInv] at hclosed
  simp [Finset.mem_union, Finset.mem_filter] at hx
  rcases hx with (hx | ⟨hxadj, hxnvis⟩)
  · by_cases hxu : x = u
    · rw [hxu] at hvx
      by_cases h : v ∈ visited
      · simp [h]
      · simp [h, hvx]
    · by_cases hxrest : x ∈ rest
      · exfalso
        simp [hxrest] at hxnotin
      · have hxnotin' : x ∉ u :: rest := by
          simp [hxu, hxrest]
        have hxne : x ≠ u := by
          intro h
          apply hxnotin'
          simp [h]
        have hxnrest : x ∉ rest := by
          intro h
          apply hxnotin'
          simp [h]
        have : v ∈ visited := hclosed x hx hxne hxnrest v hvx
        simp [this]
  · exfalso
    have : x ∈ rest ++ ((residualAdj φ u).filter (fun v => v ∉ visited)).toList := by
      simp [hxadj, hxnvis]
    contradiction

The queue invariant is preserved by one BFS step.

theorem bfsQueueInv_step {φ : Flow V G} {u : V} {rest : List V} {visited : Finset V}
    (hqueue : BFSQueueInv φ visited (u :: rest)) :
    BFSQueueInv φ
      (visited ∪ (residualAdj φ u).filter (fun v => v ∉ visited))
      (rest ++ ((residualAdj φ u).filter (fun v => v ∉ visited)).toList) := by
  intro x hx
  simp [BFSQueueInv] at hqueue
  rcases hqueue with ⟨hu, hrest⟩
  simp [List.mem_append, Finset.mem_toList, Finset.mem_filter] at hx
  rcases hx with (hx | ⟨hxadj, hxnvis⟩)
  · have : x ∈ visited := hrest x hx
    simp [this]
  · simp [hxadj, hxnvis]

Invariant connecting the FIFO search state to CLRS distance and predecessor labels. The queue is ordered by nondecreasing level and spans at most two consecutive levels; processed edges already satisfy the shortest-path upper bound needed at termination.

structure BFSDistanceInvariant (φ : Flow V G) (s : V) (state : BFSState V) : Prop where
  closed : BFSClosedInv φ state.visited state.queue
  queued : BFSQueueInv φ state.visited state.queue
  source_distance : state.distance s = some 0
  source_parent : state.parent s = none
  distance_iff_visited : ∀ v, v ∈ state.visited ↔ ∃ d, state.distance v = some d
  distance_zero : ∀ v, state.distance v = some 0 → v = s
  parent_exists : ∀ v, v ∈ state.visited → v ≠ s → ∃ u, state.parent v = some u
  parent_unvisited : ∀ v, v ∉ state.visited → state.parent v = none
  parent_step : ∀ u v, state.parent v = some u →
    Flow.residualEdge φ u v ∧ ∃ d, state.distance u = some d ∧ state.distance v = some (d + 1)
  queue_ordered : state.queue.Pairwise (fun u v => state.level u ≤ state.level v)
  visited_span : ∀ u rest, state.queue = u :: rest →
    ∀ v ∈ state.visited, state.level v ≤ state.level u + 1
  processed_edge : ∀ u ∈ state.visited, u ∉ state.queue →
    ∀ v, Flow.residualEdge φ u v → state.level v ≤ state.level u + 1

Processing a vertex does not change labels of already discovered vertices.


theorem bfsStateAdvance_distance_of_visited {φ : Flow V G} {state : BFSState V} {u v : V}
    {rest : List V} (hv : v ∈ state.visited) :
    (bfsStateAdvance φ state u rest).distance v = state.distance v := by
  have hvnew : v ∉ bfsNewNeighbors φ state u := by
    simp [mem_bfsNewNeighbors_iff, hv]
  simp [bfsStateAdvance, hvnew]



theorem bfsStateAdvance_parent_of_visited {φ : Flow V G} {state : BFSState V} {u v : V}
    {rest : List V} (hv : v ∈ state.visited) :
    (bfsStateAdvance φ state u rest).parent v = state.parent v := by
  have hvnew : v ∉ bfsNewNeighbors φ state u := by
    simp [mem_bfsNewNeighbors_iff, hv]
  simp [bfsStateAdvance, hvnew]

theorem bfsStateAdvance_level_of_visited {φ : Flow V G} {state : BFSState V} {u v : V}
    {rest : List V} (hv : v ∈ state.visited) :
    (bfsStateAdvance φ state u rest).level v = state.level v := by
  simp [BFSState.level, bfsStateAdvance_distance_of_visited (φ := φ) hv]

Every newly discovered vertex receives the front vertex's level plus one and records the front vertex as its parent.

theorem bfsStateAdvance_distance_of_new {φ : Flow V G} {state : BFSState V} {u v : V}
    {rest : List V} (hv : v ∈ bfsNewNeighbors φ state u) :
    (bfsStateAdvance φ state u rest).distance v = some (state.level u + 1) := by
  simp [bfsStateAdvance, hv]

theorem bfsStateAdvance_parent_of_new {φ : Flow V G} {state : BFSState V} {u v : V}
    {rest : List V} (hv : v ∈ bfsNewNeighbors φ state u) :
    (bfsStateAdvance φ state u rest).parent v = some u := by
  simp [bfsStateAdvance, hv]

theorem bfsStateAdvance_level_of_new {φ : Flow V G} {state : BFSState V} {u v : V}
    {rest : List V} (hv : v ∈ bfsNewNeighbors φ state u) :
    (bfsStateAdvance φ state u rest).level v = state.level u + 1 := by
  simp [BFSState.level, bfsStateAdvance_distance_of_new (φ := φ) hv]

The initial labelled state satisfies all distance and predecessor invariants.

theorem bfsDistanceInvariant_init (φ : Flow V G) (s : V) :
    BFSDistanceInvariant φ s (bfsStateInit s) := by
  constructor <;> simp [BFSClosedInv, BFSQueueInv, bfsStateInit, BFSState.level]

One FIFO step preserves the distance and predecessor invariant.


theorem bfsDistanceInvariant_step {φ : Flow V G} {s u : V} {rest : List V} {state : BFSState V}
    (hqueue : state.queue = u :: rest)
    (hinv : BFSDistanceInvariant φ s state) :
    BFSDistanceInvariant φ s (bfsStateAdvance φ state u rest) := by
  have hu_queue : u ∈ state.queue := by simp [hqueue]
  have hu_visited : u ∈ state.visited := hinv.queued u hu_queue
  have hu_not_new : u ∉ bfsNewNeighbors φ state u := by
    simp [mem_bfsNewNeighbors_iff, hu_visited]
  have hclosed : BFSClosedInv φ state.visited (u :: rest) := by
    simpa [hqueue] using hinv.closed
  have hqueued : BFSQueueInv φ state.visited (u :: rest) := by
    simpa [hqueue] using hinv.queued
  have hs_visited : s ∈ state.visited :=
    (hinv.distance_iff_visited s).2 ⟨0, hinv.source_distance⟩
  have hs_not_new : s ∉ bfsNewNeighbors φ state u := by
    simp [mem_bfsNewNeighbors_iff, hs_visited]
  have hordered : (u :: rest).Pairwise
      (fun a b => state.level a ≤ state.level b) := by
    simpa [hqueue] using hinv.queue_ordered
  constructor
  · simpa [bfsStateAdvance, bfsNewNeighbors] using
      (bfsClosedInv_step (φ := φ) hclosed)
  · simpa [bfsStateAdvance, bfsNewNeighbors] using
      (bfsQueueInv_step (φ := φ) hqueued)
  · simpa [bfsStateAdvance, hs_not_new] using hinv.source_distance
  · simpa [bfsStateAdvance, hs_not_new] using hinv.source_parent
  · intro v
    constructor
    · intro hv
      change v ∈ state.visited ∪ bfsNewNeighbors φ state u at hv
      rcases Finset.mem_union.mp hv with hvold | hvnew
      · rcases (hinv.distance_iff_visited v).1 hvold with ⟨d, hd⟩
        exact ⟨d, by simpa [bfsStateAdvance_distance_of_visited (φ := φ) hvold] using hd⟩
      · exact ⟨state.level u + 1, bfsStateAdvance_distance_of_new (φ := φ) hvnew⟩
    · rintro ⟨d, hd⟩
      by_cases hvnew : v ∈ bfsNewNeighbors φ state u
      · exact Finset.mem_union_right _ hvnew
      · have hdold : state.distance v = some d := by
          simpa [bfsStateAdvance, hvnew] using hd
        exact Finset.mem_union_left _ ((hinv.distance_iff_visited v).2 ⟨d, hdold⟩)
  · intro v hvzero
    by_cases hvnew : v ∈ bfsNewNeighbors φ state u
    · have := bfsStateAdvance_distance_of_new (φ := φ) (rest := rest) hvnew
      rw [hvzero] at this
      simp at this
    · have hvold : state.distance v = some 0 := by
        simpa [bfsStateAdvance, hvnew] using hvzero
      exact hinv.distance_zero v hvold
  · intro v hv hvs
    change v ∈ state.visited ∪ bfsNewNeighbors φ state u at hv
    rcases Finset.mem_union.mp hv with hvold | hvnew
    · rcases hinv.parent_exists v hvold hvs with ⟨p, hp⟩
      exact ⟨p, by simpa [bfsStateAdvance_parent_of_visited (φ := φ) hvold] using hp⟩
    · exact ⟨u, bfsStateAdvance_parent_of_new (φ := φ) hvnew⟩
  · intro v hv
    have hvold : v ∉ state.visited := by
      intro h
      exact hv (Finset.mem_union_left _ h)
    have hvnew : v ∉ bfsNewNeighbors φ state u := by
      intro h
      exact hv (Finset.mem_union_right _ h)
    simpa [bfsStateAdvance, hvnew] using hinv.parent_unvisited v hvold
  · intro p v hp
    by_cases hvnew : v ∈ bfsNewNeighbors φ state u
    · have hp_eq : p = u := by
        have hnewParent := bfsStateAdvance_parent_of_new (φ := φ) (rest := rest) hvnew
        rw [hp] at hnewParent
        exact Option.some.inj hnewParent
      subst p
      have hadj : Flow.residualEdge φ u v := (mem_bfsNewNeighbors_iff (φ := φ)).1 hvnew |>.1
      rcases (hinv.distance_iff_visited u).1 hu_visited with ⟨d, hd⟩
      have hlevel : state.level u = d := by simp [BFSState.level, hd]
      refine ⟨hadj, d, ?_, ?_⟩
      simpa [bfsStateAdvance_distance_of_visited (φ := φ) hu_visited] using hd
      simpa [hlevel] using bfsStateAdvance_distance_of_new (φ := φ) (rest := rest) hvnew
    · have hpold : state.parent v = some p := by
        simpa [bfsStateAdvance, hvnew] using hp
      rcases hinv.parent_step p v hpold with ⟨hadj, d, hdp, hdv⟩
      have hp_visited : p ∈ state.visited :=
        (hinv.distance_iff_visited p).2 ⟨d, hdp⟩
      have hv_visited : v ∈ state.visited :=
        (hinv.distance_iff_visited v).2 ⟨d + 1, hdv⟩
      refine ⟨hadj, d, ?_, ?_⟩
      · simpa [bfsStateAdvance_distance_of_visited (φ := φ) hp_visited] using hdp
      · simpa [bfsStateAdvance_distance_of_visited (φ := φ) hv_visited] using hdv
  · change (rest ++ (bfsNewNeighbors φ state u).toList).Pairwise
      (fun a b => (bfsStateAdvance φ state u rest).level a ≤
        (bfsStateAdvance φ state u rest).level b)
    rw [List.pairwise_append]
    refine ⟨?_, ?_, ?_⟩
    · have hrest := hordered.tail
      rw [List.pairwise_iff_get] at hrest ⊢
      intro i j hij
      have hi_visited : rest.get i ∈ state.visited := hqueued _ (by simp)
      have hj_visited : rest.get j ∈ state.visited := hqueued _ (by simp)
      rw [bfsStateAdvance_level_of_visited (φ := φ) (rest := rest) hi_visited,
        bfsStateAdvance_level_of_visited (φ := φ) (rest := rest) hj_visited]
      exact hrest i j hij
    · apply List.pairwise_of_reflexive_of_forall_ne
      intro a ha b hb _
      have ha_new : a ∈ bfsNewNeighbors φ state u := Finset.mem_toList.mp ha
      have hb_new : b ∈ bfsNewNeighbors φ state u := Finset.mem_toList.mp hb
      rw [bfsStateAdvance_level_of_new (φ := φ) ha_new,
        bfsStateAdvance_level_of_new (φ := φ) hb_new]
    · intro a ha b hb
      have ha_visited : a ∈ state.visited := hqueued a (by simp [ha])
      have hb_new : b ∈ bfsNewNeighbors φ state u := Finset.mem_toList.mp hb
      rw [bfsStateAdvance_level_of_visited (φ := φ) ha_visited,
        bfsStateAdvance_level_of_new (φ := φ) hb_new]
      exact hinv.visited_span u rest hqueue a ha_visited
  · intro front tail hnext_queue v hv
    have hv_union : v ∈ state.visited ∪ bfsNewNeighbors φ state u := by
      simpa [bfsStateAdvance] using hv
    have hv_bound : (bfsStateAdvance φ state u rest).level v ≤ state.level u + 1 := by
      rcases Finset.mem_union.mp hv_union with hvold | hvnew
      · rw [bfsStateAdvance_level_of_visited (φ := φ) hvold]
        exact hinv.visited_span u rest hqueue v hvold
      · rw [bfsStateAdvance_level_of_new (φ := φ) hvnew]
    cases rest with
    | nil =>
        have hlist : (bfsNewNeighbors φ state u).toList = front :: tail := by
          simpa [bfsStateAdvance] using hnext_queue
        have hfront_new : front ∈ bfsNewNeighbors φ state u := by
          apply Finset.mem_toList.mp
          rw [hlist]
          simp
        rw [bfsStateAdvance_level_of_new (φ := φ) hfront_new]
        omega
    | cons next remaining =>
        have hlist : next :: (remaining ++ (bfsNewNeighbors φ state u).toList) =
            front :: tail := by
          simpa [bfsStateAdvance] using hnext_queue
        have hfront : front = next := by
          injection hlist with hhead _
          exact hhead.symm
        subst front
        have hnext_visited : next ∈ state.visited := hqueued next (by simp)
        have hu_le_next : state.level u ≤ state.level next :=
          List.rel_of_pairwise_cons hordered (by simp)
        rw [bfsStateAdvance_level_of_visited (φ := φ) hnext_visited]
        omega
  · intro x hx hnotin y hxy
    have hx_union : x ∈ state.visited ∪ bfsNewNeighbors φ state u := by
      simpa [bfsStateAdvance] using hx
    rcases Finset.mem_union.mp hx_union with hxold | hxnew
    · by_cases hxu : x = u
      · subst x
        by_cases hyold : y ∈ state.visited
        · rw [bfsStateAdvance_level_of_visited (φ := φ) hyold,
            bfsStateAdvance_level_of_visited (φ := φ) hu_visited]
          exact hinv.visited_span u rest hqueue y hyold
        · have hynew : y ∈ bfsNewNeighbors φ state u :=
            (mem_bfsNewNeighbors_iff (φ := φ)).2 ⟨hxy, hyold⟩
          rw [bfsStateAdvance_level_of_new (φ := φ) hynew,
            bfsStateAdvance_level_of_visited (φ := φ) hu_visited]
      · have hx_not_rest : x ∉ rest := by
          intro hxrest
          apply hnotin
          change x ∈ rest ++ (bfsNewNeighbors φ state u).toList
          exact List.mem_append_left _ hxrest
        have hx_not_queue : x ∉ state.queue := by
          rw [hqueue]
          simp [hxu, hx_not_rest]
        have hyold : y ∈ state.visited := hclosed x hxold (by
          simp [hxu, hx_not_rest]) y hxy
        rw [bfsStateAdvance_level_of_visited (φ := φ) hyold,
          bfsStateAdvance_level_of_visited (φ := φ) hxold]
        exact hinv.processed_edge x hxold hx_not_queue y hxy
    · exfalso
      apply hnotin
      change x ∈ rest ++ (bfsNewNeighbors φ state u).toList
      exact List.mem_append_right _ (Finset.mem_toList.mpr hxnew)

Every fuelled execution preserves the distance invariant.

theorem bfsDistanceInvariant_aux {φ : Flow V G} {s : V} (fuel : ℕ) (state : BFSState V)
    (hinv : BFSDistanceInvariant φ s state) :
    BFSDistanceInvariant φ s (bfsStateAux φ fuel state) := by
  induction fuel generalizing state with
  | zero => simpa [bfsStateAux]
  | succ fuel ih =>
      cases hqueue : state.queue with
      | nil => simpa [bfsStateAux, hqueue]
      | cons u rest =>
          simp only [bfsStateAux, hqueue]
          exact ih (bfsStateAdvance φ state u rest)
            (bfsDistanceInvariant_step (φ := φ) hqueue hinv)

The final residual BFS state satisfies the distance invariant.

theorem residualBFS_distanceInvariant (φ : Flow V G) :
    BFSDistanceInvariant φ G.s (residualBFS φ) := by
  simpa [residualBFS] using
    (bfsDistanceInvariant_aux (φ := φ) (Fintype.card V) (bfsStateInit G.s)
      (bfsDistanceInvariant_init φ G.s))

The BFS measure: unvisited vertices plus queue length. Every step with a nonempty queue decreases it by exactly one, and it starts at |V|.

def bfsMeasure (state : BFSState V) : ℕ :=
  (Finset.univ \ state.visited).card + state.queue.length

Processing the front vertex decreases the measure by exactly one.


theorem bfsStateAdvance_measure {φ : Flow V G} {state : BFSState V} {u : V} {rest : List V} :
    bfsMeasure (bfsStateAdvance φ state u rest) + 1 =
      bfsMeasure {state with queue := u :: rest} := by
  unfold bfsMeasure bfsStateAdvance
  have hnew_sub : bfsNewNeighbors φ state u ⊆ Finset.univ \ state.visited := by
    intro x hx
    simp [Finset.mem_sdiff]
    exact (Finset.mem_filter.mp hx).2
  have hcard : (Finset.univ \ (state.visited ∪ bfsNewNeighbors φ state u)).card =
      (Finset.univ \ state.visited).card - (bfsNewNeighbors φ state u).card := by
    have hset : Finset.univ \ (state.visited ∪ bfsNewNeighbors φ state u) =
        (Finset.univ \ state.visited) \ bfsNewNeighbors φ state u := by
      ext x
      simp [Finset.mem_sdiff]
    have hEq : bfsNewNeighbors φ state u ∩ (Finset.univ \ state.visited) =
        bfsNewNeighbors φ state u := by
      exact Finset.inter_eq_left.mpr hnew_sub
    rw [hset, Finset.card_sdiff, hEq]
  have hle : (bfsNewNeighbors φ state u).card ≤
      (Finset.univ \ state.visited).card :=
    Finset.card_le_card hnew_sub
  simp [hcard]
  omega

If the queue is nonempty throughout, the measure drops by exactly one per step.


theorem bfsStateAux_measure_of_nonempty {φ : Flow V G} (fuel : ℕ) (state : BFSState V)
    (h : (bfsStateAux φ fuel state).queue ≠ []) :
    bfsMeasure (bfsStateAux φ fuel state) = bfsMeasure state - fuel := by
  refine Nat.rec
    (motive := fun fuel => ∀ state : BFSState V,
      (bfsStateAux φ fuel state).queue ≠ [] →
        bfsMeasure (bfsStateAux φ fuel state) = bfsMeasure state - fuel)
    ?_ ?_ fuel state h
  · intro state h
    simp [bfsStateAux]
  · intro fuel ih state h
    cases hqueue : state.queue with
    | nil =>
        have hnil : (bfsStateAux φ (fuel + 1) state).queue = [] := by
          simp [bfsStateAux, hqueue]
        exact (h hnil).elim
    | cons u rest =>
        have h' : (bfsStateAux φ fuel (bfsStateAdvance φ state u rest)).queue ≠ [] := by
          simpa [bfsStateAux, hqueue] using h
        have hih := ih (bfsStateAdvance φ state u rest) h'
        have hdec' : bfsMeasure (bfsStateAdvance φ state u rest) = bfsMeasure state - 1 := by
          have hdec := bfsStateAdvance_measure (φ := φ) (state := state) (u := u)
            (rest := rest)
          have hEq : bfsMeasure {state with queue := u :: rest} = bfsMeasure state := by
            unfold bfsMeasure
            simp [hqueue]
          omega
        have hmeas : bfsMeasure (bfsStateAux φ fuel (bfsStateAdvance φ state u rest)) =
            bfsMeasure state - (fuel + 1) := by
          rw [hih, hdec']
          omega
        simpa [bfsStateAux, hqueue] using hmeas

The fuelled residual BFS exhausts its queue: after |V| steps every vertex reachable in the residual network has been discovered.


theorem residualBFS_queue_empty (φ : Flow V G) : (residualBFS φ).queue = [] := by
  by_contra h
  have hmeas := bfsStateAux_measure_of_nonempty (φ := φ) (fuel := Fintype.card V)
    (state := bfsStateInit G.s) h
  have hinit : bfsMeasure (bfsStateInit G.s) = Fintype.card V := by
    change (Finset.univ \ ({G.s} : Finset V)).card + ([G.s] : List V).length =
      Fintype.card V
    simp
    have hpos : 0 < Fintype.card V := Fintype.card_pos (α := V) (h := ⟨G.s⟩)
    have hcard : (Finset.univ \ ({G.s} : Finset V)).card = Fintype.card V - 1 := by
      rw [Finset.sdiff_singleton_eq_erase]
      exact Finset.card_erase_of_mem (Finset.mem_univ G.s)
    rw [hcard]
    omega
  have hzero : bfsMeasure (residualBFS φ) = 0 := by
    unfold residualBFS
    rw [hmeas, hinit]
    omega
  have hge : 1 ≤ bfsMeasure (residualBFS φ) := by
    unfold bfsMeasure
    have hlen : 1 ≤ (residualBFS φ).queue.length := List.length_pos_iff.mpr h
    omega
  omega

A path following the recorded parent function from the source. This is a Type rather than a Prop so that its vertex list can be extracted by pattern matching (see BFSParentPath.vertices).

inductive BFSParentPath (parent : V → Option V) (s : V) : V → ℕ → Type _ where
  | root : BFSParentPath parent s s 0
  | tail {u v : V} {n : ℕ} :
      BFSParentPath parent s u n → parent v = some u →
        BFSParentPath parent s v (n + 1)

Every distance label maintained by the invariant is witnessed by a parent path of exactly that length.


noncomputable def BFSDistanceInvariant.parentPath_of_distance
    {φ : Flow V G} {s : V} {state : BFSState V} (hinv : BFSDistanceInvariant φ s state)
    {v : V} {d : ℕ} (hd : state.distance v = some d) :
    BFSParentPath state.parent s v d := by
  refine (inferInstance : IsWellFounded ℕ (· < ·)).wf.fix
    (C := fun n => ∀ v (hd : state.distance v = some n),
      BFSParentPath state.parent s v n) ?_ d v hd
  intro n ih v hd
  cases n with
  | zero =>
      have hvs : v = s := hinv.distance_zero v hd
      subst v
      exact BFSParentPath.root
  | succ n =>
      have hv_visited : v ∈ state.visited :=
        (hinv.distance_iff_visited v).2 ⟨n + 1, hd⟩
      have hvs : v ≠ s := by
        intro h
        subst v
        rw [hinv.source_distance] at hd
        simp at hd
      have hu' : ∃ u, state.parent v = some u := hinv.parent_exists v hv_visited hvs
      let u := Classical.choose hu'
      have hparent : state.parent v = some u := Classical.choose_spec hu'
      have hstep := hinv.parent_step u v hparent
      have hdv' : ∃ d, state.distance u = some d ∧ state.distance v = some (d + 1) := hstep.2
      let d' := Classical.choose hdv'
      have hdu : state.distance u = some d' := (Classical.choose_spec hdv').1
      have hdv : state.distance v = some (d' + 1) := (Classical.choose_spec hdv').2
      have hdn : d' = n := by
        rw [hd] at hdv
        simp at hdv
        omega
      have hdu'' : state.distance u = some n := by
        simpa [hdn] using hdu
      exact BFSParentPath.tail (ih n (by omega) u hdu'') hparent

Parent paths in a valid BFS state are residual paths with the same number of edges.

theorem BFSDistanceInvariant.parentPath_ResidualPathLength
    {φ : Flow V G} {s : V} {state : BFSState V} (hinv : BFSDistanceInvariant φ s state)
    {v : V} {d : ℕ} (hpath : BFSParentPath state.parent s v d) :
    ResidualPathLength φ s v d := by
  induction hpath with
  | root => exact ResidualPathLength.refl s
  | @tail u v n hpath hparent ih =>
      exact ResidualPathLength.tail s u v n ih (hinv.parent_step u v hparent).1

Exact-length reachability in the residual network implies residual reachability.

lemma ResidualPathLength.reachable {φ : Flow V G} {u v : V} {n : ℕ}
    (h : ResidualPathLength φ u v n) : Flow.augmentingPathReachable φ u v := by
  refine ResidualPathLength.rec
    (motive := fun (v : V) (n : ℕ) (_h : ResidualPathLength φ u v n) =>
      Flow.augmentingPathReachable φ u v)
    (by exact Relation.ReflTransGen.refl)
    (fun v w n hprev hedge ih => Relation.ReflTransGen.tail ih hedge)
    h

Every recorded distance is attained by a residual path of exactly that length.

theorem bfsState_distance_ResidualPathLength (φ : Flow V G) {v : V} {d : ℕ}
    (hd : (residualBFS φ).distance v = some d) :
    ResidualPathLength φ G.s v d := by
  have hinv := residualBFS_distanceInvariant φ
  exact hinv.parentPath_ResidualPathLength (hinv.parentPath_of_distance hd)

Along any exact-length residual path from the source, the final BFS distance is no larger than the path length.


theorem bfsState_distance_le_of_ResidualPathLength (φ : Flow V G) {v : V} {n : ℕ}
    (hpath : ResidualPathLength φ G.s v n) :
    ∃ d, (residualBFS φ).distance v = some d ∧ d ≤ n := by
  let result := residualBFS φ
  have hinv : BFSDistanceInvariant φ G.s result := residualBFS_distanceInvariant φ
  have hqueue : result.queue = [] := residualBFS_queue_empty φ
  have h := ResidualPathLength.rec
    (motive := fun (v : V) (n : ℕ) (_h : ResidualPathLength φ G.s v n) =>
      ∃ d, result.distance v = some d ∧ d ≤ n)
    (by exact ⟨0, hinv.source_distance, le_rfl⟩)
    (fun v w n hprev hedge ih => by
      rcases ih with ⟨dv, hdv, hle⟩
      have hv_visited : v ∈ result.visited :=
        (hinv.distance_iff_visited v).2 ⟨dv, hdv⟩
      have hw_visited : w ∈ result.visited :=
        hinv.closed v hv_visited (by simp [hqueue]) w hedge
      rcases (hinv.distance_iff_visited w).1 hw_visited with ⟨dw, hdw⟩
      have hdv' : result.distance v = some dv := by simpa [result] using hdv
      have hv_level : result.level v = dv := by simp [BFSState.level, hdv']
      have hw_level : result.level w = dw := by simp [BFSState.level, hdw]
      have hedge' := hinv.processed_edge v hv_visited (by simp [hqueue]) w hedge
      rw [hv_level, hw_level] at hedge'
      exact ⟨dw, hdw, by omega⟩)
    hpath
  simpa [result] using h

Every present final BFS label is the residual shortest-path distance.


theorem bfsState_distance_isShortest (φ : Flow V G) {v : V} {d : ℕ}
    (hd : (residualBFS φ).distance v = some d) :
    IsShortestDist φ G.s v d := by
  constructor
  · exact bfsState_distance_ResidualPathLength φ hd
  · intro n hn
    rcases bfsState_distance_le_of_ResidualPathLength φ hn with ⟨d', hd', hle⟩
    rw [hd] at hd'
    have : d' = d := (Option.some.inj hd').symm
    omega

BFS discovers exactly the residual-reachable vertices.

theorem residualBFS_visited_iff_reachable (φ : Flow V G) (v : V) :
    v ∈ (residualBFS φ).visited ↔ Flow.augmentingPathReachable φ G.s v := by
  let result := residualBFS φ
  have hinv : BFSDistanceInvariant φ G.s result := residualBFS_distanceInvariant φ
  have hqueue : result.queue = [] := residualBFS_queue_empty φ
  constructor
  · intro hv
    rcases (hinv.distance_iff_visited v).1 hv with ⟨d, hd⟩
    exact (bfsState_distance_ResidualPathLength φ hd).reachable
  · intro hreach
    induction hreach with
    | refl =>
        exact (hinv.distance_iff_visited G.s).2 ⟨0, hinv.source_distance⟩
    | tail hprev hedge ih =>
        exact hinv.closed _ ih (by simp [hqueue]) _ hedge

The final BFS distance map is defined exactly on reachable vertices.

theorem bfsState_distance_defined_iff_reachable (φ : Flow V G) (v : V) :
    (∃ d, (residualBFS φ).distance v = some d) ↔ Flow.augmentingPathReachable φ G.s v := by
  let result := residualBFS φ
  have hinv : BFSDistanceInvariant φ G.s result := residualBFS_distanceInvariant φ
  constructor
  · rintro ⟨d, hd⟩
    exact (bfsState_distance_ResidualPathLength φ hd).reachable
  · intro hreach
    have hv_visited : v ∈ result.visited :=
      (residualBFS_visited_iff_reachable φ v).2 hreach
    simpa [result] using (hinv.distance_iff_visited v).1 hv_visited

Complete iff specification for the distance returned by residual BFS.

theorem bfsState_distance_eq_some_iff (φ : Flow V G) (v : V) {d : ℕ} :
    (residualBFS φ).distance v = some d ↔ IsShortestDist φ G.s v d := by
  constructor
  · exact bfsState_distance_isShortest φ
  · intro hshortest
    rcases (bfsState_distance_defined_iff_reachable φ v).2 hshortest.1.reachable with ⟨d', hd'⟩
    have hd'_shortest := bfsState_distance_isShortest φ hd'
    have h1 : d ≤ d' := hshortest.2 d' hd'_shortest.1
    have h2 : d' ≤ d := hd'_shortest.2 d hshortest.1
    have : d' = d := Nat.le_antisymm h2 h1
    simpa [this] using hd'

Every recorded predecessor is a residual edge and decreases BFS distance by exactly one when followed toward the source.

theorem bfsState_parent_spec (φ : Flow V G) {u v : V}
    (hparent : (residualBFS φ).parent v = some u) :
    Flow.residualEdge φ u v ∧ ∃ d,
      (residualBFS φ).distance u = some d ∧
      (residualBFS φ).distance v = some (d + 1) := by
  exact (residualBFS_distanceInvariant φ).parent_step u v hparent

Following a predecessor edge strictly increases level away from the root.

theorem bfsState_parent_level_lt (φ : Flow V G) {u v : V}
    (hparent : (residualBFS φ).parent v = some u) :
    (residualBFS φ).level u < (residualBFS φ).level v := by
  rcases bfsState_parent_spec φ hparent with ⟨_, d, hdu, hdv⟩
  simp [BFSState.level, hdu, hdv]

The vertices of a parent path, from the source to the endpoint.

noncomputable def BFSParentPath.vertices {parent : V → Option V} {s v : V} {n : ℕ}
    (h : BFSParentPath parent s v n) : List V :=
  match h with
  | root => [s]
  | tail hprev _ => BFSParentPath.vertices hprev ++ [v]

The parent path has exactly n + 1 vertices.

automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_length`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_length`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_length`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_length`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_length`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`
automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_length`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`lemma BFSParentPath.vertices_length {parent : V → Option V} {s v : V} {n : ℕ}
    (h : BFSParentPath parent s v n) : (BFSParentPath.vertices h).length = n + 1 := by
  induction h with
  | root => simp [BFSParentPath.vertices]
  | tail hprev _ ih =>
      simp [BFSParentPath.vertices, ih]

The parent path starts at the source.


lemma BFSParentPath.vertices_head {parent : V → Option V} {s v : V} {n : ℕ}
    (h : BFSParentPath parent s v n) : (BFSParentPath.vertices h).head? = some s := by
  induction h with
  | root => simp [BFSParentPath.vertices]
  | @tail u v n hprev _ ih =>
      have hne : BFSParentPath.vertices hprev ≠ [] := by
        rw [← List.length_pos_iff, BFSParentPath.vertices_length]
        omega
      rw [BFSParentPath.vertices]
      rw [List.head?_append_of_ne_nil _ hne]
      exact ih

The parent path ends at the requested vertex.

automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`
automatically included section variable(s) unused in theorem `CLRS.Chapter26.BFSParentPath.vertices_getLast`:
  [Fintype V]
  [DecidableEq V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] [DecidableEq V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`lemma BFSParentPath.vertices_getLast {parent : V → Option V} {s v : V} {n : ℕ}
    (h : BFSParentPath parent s v n) : (BFSParentPath.vertices h).getLast? = some v := by
  induction h with
  | root => simp [BFSParentPath.vertices]
  | @tail u v n hprev _ ih =>
      rw [BFSParentPath.vertices]
      rw [List.getLast?_append_of_ne_nil _ (by simp)]
      rfl

Consecutive vertices of a parent path are joined by residual edges.


lemma BFSParentPath.vertices_chain {φ : Flow V G} {s : V} {state : BFSState V}
    (hinv : BFSDistanceInvariant φ s state) {v : V} {n : ℕ}
    (h : BFSParentPath state.parent s v n) :
    (BFSParentPath.vertices h).IsChain (Flow.residualEdge φ) := by
  induction h with
  | root => simp [BFSParentPath.vertices]
  | @tail u v n hprev hpar ih =>
      rw [BFSParentPath.vertices]
      apply IsChain_append_last
      · exact ih
      · intro y hy
        have hlast := hprev.vertices_getLast
        have hyu : y = u := by
          have : u = y := by simpa [hlast] using hy
          exact this.symm
        simpa [hyu] using (hinv.parent_step u v hpar).1

The vertex at position i of a parent path has BFS level exactly i.

try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`
lemma BFSParentPath.vertices_level_getElem {φ : Flow V G} {s : V} {state : BFSState V}
    (hinv : BFSDistanceInvariant φ s state) {v : V} {n : ℕ}
    (h : BFSParentPath state.parent s v n) :
    ∀ i (hi : i < (BFSParentPath.vertices h).length),
      state.level (BFSParentPath.vertices h)[i] = i := by
  induction h with
  | root =>
      intro i hi
      have hi0 : i = 0 := by
        simp [BFSParentPath.vertices] at hi
        exact hi
      subst i
      simp [BFSParentPath.vertices, BFSState.level, hinv.source_distance]
  | @tail u v n hprev hpar ih =>
      intro i hi
      by_cases hi_lt : i < (BFSParentPath.vertices hprev).length
      · have hget : (BFSParentPath.vertices hprev ++ [v])[i] =
            (BFSParentPath.vertices hprev)[i] :=
          List.getElem_append_left hi_lt
        have hle := ih i hi_lt
        change state.level ((BFSParentPath.vertices hprev ++ [v])[i]) = i
        rw [hget]
        exact hle
      · have hi_eq : i = (BFSParentPath.vertices hprev).length := by
          simp [BFSParentPath.vertices] at hi
          omega
        subst i
        have hget : (BFSParentPath.vertices hprev ++ [v])[
            (BFSParentPath.vertices hprev).length] = v := by
          try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`simpa using List.getElem_append_right (BFSParentPath.vertices hprev) [v]
            (BFSParentPath.vertices hprev).length le_rfl (by 'simp' tactic does nothing

Note: This linter can be disabled with `set_option linter.unusedTactic false`this tactic is never executed

Note: This linter can be disabled with `set_option linter.unreachableTactic false`simp)
        rcases hinv.parent_step u v hpar with ⟨_, d, hdu, hdv⟩
        have hlv : state.level v = state.level u + 1 := by
          simp [BFSState.level, hdu, hdv]
        have hlen := BFSParentPath.vertices_length (h := hprev)
        have hne : BFSParentPath.vertices hprev ≠ [] := by
          rw [← List.length_pos_iff, hlen]
          omega
        have hlast := hprev.vertices_getLast
        have hgetlast : (BFSParentPath.vertices hprev)[
            (BFSParentPath.vertices hprev).length - 1] = u := by
          rw [← List.getLast_eq_getElem hne]
          exact List.getLast_of_getLast?_eq_some hlast
        have hih := ih ((BFSParentPath.vertices hprev).length - 1) (by
          rw [hlen]
          omega)
        have hlu : state.level u = n := by
          rw [hgetlast] at hih
          have : (BFSParentPath.vertices hprev).length - 1 = n := by omega
          simpa [this] using hih
        simp [BFSParentPath.vertices]
        rw [hlv, hlu]
        rw [BFSParentPath.vertices_length (h := hprev)]

The parent path is a simple list: BFS levels strictly increase along it.


lemma BFSParentPath.vertices_nodup {φ : Flow V G} {s : V} {state : BFSState V}
    (hinv : BFSDistanceInvariant φ s state) {v : V} {n : ℕ}
    (h : BFSParentPath state.parent s v n) : (BFSParentPath.vertices h).Nodup := by
  rw [List.nodup_iff_injective_getElem]
  intro i j hij
  apply Fin.ext
  have hli := h.vertices_level_getElem hinv i.1 i.2
  have hlj := h.vertices_level_getElem hinv j.1 j.2
  have hcong := congrArg (state.level) hij
  calc
    i.1 = state.level (h.vertices[i.1]) := hli.symm
    _ = state.level (h.vertices[j.1]) := hcong
    _ = j.1 := hlj

The parent chain from the sink assembles a simple residual path whose edge count realizes the recorded distance.

noncomputable def bfsParentResidualPath (φ : Flow V G) {d : ℕ}
    (hd : (residualBFS φ).distance G.t = some d) : Flow.ResidualPath φ G.s G.t := by
  let hpp := (residualBFS_distanceInvariant φ).parentPath_of_distance hd
  exact { vertices := BFSParentPath.vertices hpp
        , chain := hpp.vertices_chain (residualBFS_distanceInvariant φ)
        , head_eq := hpp.vertices_head
        , last_eq := hpp.vertices_getLast
        , nodup := hpp.vertices_nodup (residualBFS_distanceInvariant φ) }

The parent-chain path realizes the recorded distance.


lemma bfsParentResidualPath_edges_length (φ : Flow V G) {d : ℕ}
    (hd : (residualBFS φ).distance G.t = some d) :
    (bfsParentResidualPath φ hd).edges.length = d := by
  rw [Flow.ResidualPath.edges_length]
  simp [bfsParentResidualPath, BFSParentPath.vertices_length]

Executable shortest augmenting path. When the sink is residual reachable, the BFS parent chain from the sink is a shortest augmenting path.


noncomputable def bfs_shortestAugmenting (φ : Flow V G) (h : φ.hasAugmentingPath) :
    ShortestAugmentingPath φ := by
  have hd' : ∃ d, (residualBFS φ).distance G.t = some d :=
    (bfsState_distance_defined_iff_reachable φ G.t).2 h
  let d := Classical.choose hd'
  have hd : (residualBFS φ).distance G.t = some d := Classical.choose_spec hd'
  have hshort : IsShortestDist φ G.s G.t d :=
    (bfsState_distance_eq_some_iff φ G.t).1 hd
  let p : Flow.AugmentingPath φ := bfsParentResidualPath φ hd
  have hlen : p.edges.length = d := by
    simpa [p] using bfsParentResidualPath_edges_length φ hd
  exact { path := p, h_shortest := by simpa [hlen] using hshort }

BFS drives the Edmonds-Karp step. ekStep augments along a shortest path whose length is the one the executable BFS computes: both realize the same residual distance.

theorem ekStep_shortest_path_bfs (φ : Flow V G) (h : φ.hasAugmentingPath) :
    ∃ p : ShortestAugmentingPath φ, ekStep φ = φ.augment p.path ∧
      p.path.edges.length = (bfs_shortestAugmenting φ h).path.edges.length := by
  have hnon : Nonempty (ShortestAugmentingPath φ) :=
    (shortestAugmentingPath_iff_hasAugmentingPath φ).mpr h
  refine ⟨Classical.choice hnon, ?_, ?_⟩
  · unfold ekStep
    simp [hnon]
  · exact (Classical.choice hnon).h_shortest.unique (bfs_shortestAugmenting φ h).h_shortest

end Chapter26end CLRS

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.SparseExecution.Execution

Edmonds–Karp from the counted BFS-selected paths

Support buckets and the finite vertex count are prepared once. A polynomial number of rounds suffices for arbitrary nonnegative real capacities. A round that finds no path retains its flow; later rounds may repeat the failed BFS, and their work remains included. The same returned flow, path choices, and local updates are used in the correctness and work proofs.

              noncomputable sectionnamespace CLRS.Chapter26.SparseEKopen Finset Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}structure ExecutionResult (G : FlowNetwork V) where
  flow : Flow V G
  work : Nat
  augmentations : Natdef step (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (prev : ExecutionResult G) : ExecutionResult G :=
  let found := search input A hA prev.flow
  match found.path with
  | none => ⟨prev.flow,prev.work+found.work,prev.augmentations⟩
  | some p =>
    let next := augmentWithCost prev.flow p.path
    ⟨next.flow,prev.work+found.work+next.work,prev.augmentations+1⟩def iterate (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (N : Nat) : ExecutionResult G :=
  Nat.rec ⟨zeroFlow G,0,0⟩ (fun _ previous => step input A hA previous) N@[simp] theorem iterate_zero (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) :
    iterate input A hA 0 = ⟨zeroFlow G,0,0⟩ := rfl@[simp] theorem iterate_succ (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (N : Nat) :
    iterate input A hA (N+1) = step input A hA (iterate input A hA N) := rfldef timeline (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) : Timeline G where
  flow i := (iterate input A hA i).flow
  path i := (search input A hA (iterate input A hA i).flow).path
  next i := by
    cases hp : (search input A hA (iterate input A hA i).flow).path with
    | none => simp [iterate_succ,step,hp]
    | some p => simpa [iterate_succ,step,hp] using
        augmentWithCost_refines (iterate input A hA i).flow p.paththeorem iterate_no_path_step (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (i : Nat)
    (h : ¬ (iterate input A hA i).flow.hasAugmentingPath) :
    (iterate input A hA (i+1)).flow = (iterate input A hA i).flow := by
  have hn := (search_none_iff input A hA _).2 h
  simp [iterate_succ,step,hn]

theorem iterate_stable (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) {i j : Nat} (hij : i ≤ j)
    (h : ¬ (iterate input A hA i).flow.hasAugmentingPath) :
    (iterate input A hA j).flow = (iterate input A hA i).flow := by
  induction j, hij using Nat.le_induction with
  | base => rfl
  | succ k hk ih =>
    rw [iterate_no_path_step input A hA k (by simpa [ih] using h),ih]

The bound comes from the actual selector's timeline, not the old classical chooser.


theorem iterate_terminal (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (N : Nat)
    (hN : (support G).card * Fintype.card V < N) :
    ¬ (iterate input A hA N).flow.hasAugmentingPath := by
  intro hlast
  have hall : ∀ i < N, (timeline input A hA).Augments i := by
    intro i hi
    cases hp : (search input A hA (iterate input A hA i).flow).path with
    | none =>
      have hn := (search_none_iff input A hA _).1 hp
      have hs := iterate_stable input A hA (Nat.le_of_lt hi) hn
      exact (hn (hs ▸ hlast)).elim
    | some p => exact ⟨p,hp⟩
  have hc := (timeline input A hA).all_steps_bound N hall
  omega



theorem iterate_augmentations (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (N : Nat) :
    (iterate input A hA N).augmentations =
      ((Finset.range N).filter (timeline input A hA).Augments).card := by
  induction N with
  | zero => simp
  | succ N ih =>
    rw [Finset.range_add_one]
    cases hp : (search input A hA (iterate input A hA N).flow).path with
    | none =>
      have hn : ¬ (timeline input A hA).Augments N := by
        simp [Timeline.Augments,timeline,hp]
      simp [iterate_succ,step,hp,Finset.filter_insert,hn,ih]
    | some p =>
      have hn : (timeline input A hA).Augments N := ⟨p,hp⟩
      simp [iterate_succ,step,hp,Finset.filter_insert,hn,ih]

theorem iterate_work_le (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (N : Nat) :
    (iterate input A hA N).work ≤ N*(5+17*(support G).card) := by
  induction N with
  | zero => simp
  | succ N ih =>
    have hs := search_work_le input A hA (iterate input A hA N).flow
    simp only [iterate_succ,step]
    split
    · dsimp only
      nlinarith
    · rename_i p hp
      have hu := augmentWithCost_work_le (iterate input A hA N).flow p
      dsimp only
      nlinarith

Count the input vertex enumeration once; no per-round dense initialization occurs.

def countVertices : List V → Nat
  | [] => 0
  | _ :: vs => countVertices vs+1

omit [Fintype V] [DecidableEq V] in
theorem countVertices_eq (vs : List V) : countVertices vs = vs.length := by
  induction vs with
  | nil => rfl
  | cons v vs ih => simp [countVertices,ih]

def execute (input : CapacityInput G) : ExecutionResult G :=
  let prepared := prepare input.arcs
  let vertices := countVertices (Finset.univ.toList : List V)
  let result := iterate input prepared.adjacency rfl (prepared.work*vertices+1)
  { result with work := prepared.work+vertices+result.work }

The actual returned flow is maximal, without an integrality premise.


theorem execute_maximal (input : CapacityInput G) : (execute input).flow.isMaximal := by
  apply Flow.maximal_of_noAugmentingPath
  apply iterate_terminal input _ rfl
  have hc := support_card_le G
  simp only [prepare_work,countVertices_eq,Finset.length_toList,Finset.card_univ]
  rw [input.length_eq]
  nlinarith [Nat.mul_le_mul_right (Fintype.card V) hc]

Actual augmentations are bounded by positive arcs times vertices.


theorem execute_augmentations_le (input : CapacityInput G) :
    (execute input).augmentations ≤ 2*(positiveArcs G).card*Fintype.card V := by
  change (iterate input _ rfl _).augmentations ≤ _
  rw [iterate_augmentations]
  exact (timeline input _ rfl).augmentation_count_sparse _

General bound before absorbing lower-order preparation and failed-search costs.

theorem execute_work_polynomial (input : CapacityInput G) :
    (execute input).work ≤ 2*(positiveArcs G).card+Fintype.card V+
      (2*(positiveArcs G).card*Fintype.card V+1)*(5+34*(positiveArcs G).card) := by
  have hi := iterate_work_le input (prepare input.arcs).adjacency rfl
    ((prepare input.arcs).work*countVertices (Finset.univ.toList : List V)+1)
  have hs := support_card_le G
  simp only [execute,prepare_work,countVertices_eq,Finset.length_toList,Finset.card_univ,input.length_eq] at *
  nlinarith [Nat.mul_le_mul_left (2*(positiveArcs G).card*Fintype.card V+1)
    (show 5+17*(support G).card ≤ 5+34*(positiveArcs G).card by omega)]

On nonempty sparse inputs the complete counted execution is O(V E²).


theorem execute_work_bound (input : CapacityInput G) (hE : 0 < (positiveArcs G).card) :
    (execute input).work ≤ 130*Fintype.card V*((positiveArcs G).card)^2 := by
  have hc := execute_work_polynomial input
  have hV : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
  have hE1 : 1 ≤ (positiveArcs G).card := hE
  have hsq : (positiveArcs G).card ≤ ((positiveArcs G).card)^2 := by nlinarith
  have hVE : (positiveArcs G).card ≤ Fintype.card V*(positiveArcs G).card := by nlinarith
  have hVE2 : ((positiveArcs G).card)^2 ≤ Fintype.card V*((positiveArcs G).card)^2 := by nlinarith
  have hV2 : Fintype.card V ≤ Fintype.card V*((positiveArcs G).card)^2 := by nlinarith
  nlinarith

Empty capacity input still pays for vertex enumeration and one failed search.


theorem execute_work_empty (input : CapacityInput G) (hE : (positiveArcs G).card = 0) :
    (execute input).work ≤ Fintype.card V+2 := by
  have hs : (support G).card = 0 := by have := support_card_le G; omega
  have hn : ¬ (zeroFlow G).hasAugmentingPath := by
    intro h
    obtain ⟨p⟩ := exists_shortest_augmenting_path (zeroFlow G) h
    have hp := shortest_length_support (zeroFlow G) p
    have hpos := p.path.edges_nonempty
    have : 0 < p.path.edges.length := List.length_pos_iff.mpr hpos
    omega
  have hp := (search_none_iff input (prepare input.arcs).adjacency rfl _).2 hn
  have hw := search_work_of_none input (prepare input.arcs).adjacency rfl _ hp
  have hb := bfs_work_le input (zeroFlow G)
  simp only [hs,Nat.mul_zero,Nat.add_zero] at hb
  simp only [execute,prepare_work,countVertices_eq,Finset.length_toList,Finset.card_univ,
    input.length_eq,hE,Nat.mul_zero,Nat.zero_mul,Nat.zero_add,iterate_succ,iterate_zero,step,hp]
  omega

Uniform bound including the empty sparse input and its initialization.

theorem execute_work_uniform (input : CapacityInput G) :
    (execute input).work ≤ Fintype.card V+2+
      130*Fintype.card V*((positiveArcs G).card)^2 := by
  by_cases hE : (positiveArcs G).card = 0
  · simpa [hE] using execute_work_empty input hE
  · have := execute_work_bound input (Nat.pos_of_ne_zero hE)
    omega

end CLRS.Chapter26.SparseEK

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.SparseExecution.Search

Counted BFS parent recovery

The search binds one support-BFS result, tests its stored sink distance, and follows that result's stored parents. The shortest-path proof describes the recovered list; it does not choose a second shortest path or rerun BFS.

              noncomputable sectionnamespace CLRS.Chapter26.SparseEKopen Finset Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}def reverseParents (parent : V → Option V) : Nat → V → CostedPathVertices V
  | 0, v => ⟨[v],1⟩
  | d+1, v =>
    match parent v with
    | none => ⟨[v],2⟩
    | some u =>
      let old := reverseParents parent d u
      ⟨v :: old.vertices, old.work + 2⟩def recoverParents (parent : V → Option V) (d : Nat) (v : V) : CostedPathVertices V :=
  let old := reverseParents parent d v
  ⟨old.vertices.reverse, old.work + old.vertices.length⟩omit [Fintype V] [DecidableEq V] in
theorem reverseParents_spec {parent : V → Option V} {s v : V} {d : Nat}
    (hp : BFSParentPath parent s v d) :
    (reverseParents parent d v).vertices = hp.vertices.reverse ∧
      (reverseParents parent d v).work = 2*d+1 := by
  induction hp with
  | root => simp [reverseParents, BFSParentPath.vertices]
  | @tail u v d hp hpar ih =>
    simp [reverseParents, hpar, BFSParentPath.vertices, ih, Nat.mul_add, Nat.add_assoc]theorem recoverParents_spec {parent : V → Option V} {s v : V} {d : Nat}
    (hp : BFSParentPath parent s v d) :
    (recoverParents parent d v).vertices = hp.vertices ∧
      (recoverParents parent d v).work = 3*d+2 := by
  have hs := reverseParents_spec hp
  simp [recoverParents, hs.1, hs.2, BFSParentPath.vertices_length]
  omega

theorem shortest_length_support (φ : Flow V G) (p : ShortestAugmentingPath φ) :
    p.path.edges.length ≤ (support G).card := by
  have hv : p.path.vertices.toFinset ⊆ (residualBFS φ).visited := by
    intro v h
    obtain ⟨i,hi,hv⟩ := List.getElem_of_mem (List.mem_toFinset.mp h)
    have hr := (p.shortest_prefix i hi).1.reachable
    apply (residualBFS_visited_iff_reachable φ v).2
    simpa [hv] using hr
  have hc := Finset.card_le_card hv
  rw [List.toFinset_card_of_nodup p.path.nodup] at hc
  have hs := Finset.card_le_card (residualBFS_visited_subset φ)
  have hi := Finset.card_insert_le G.s ((support G).image Prod.snd)
  have him := Finset.card_image_le (s := support G) (f := Prod.snd)
  rw [Flow.ResidualPath.edges_length]
  omega

Recover the shortest path from the supplied saved BFS state.


def recoveredShortest (φ : Flow V G) (b : CostedBFSRun V)
    (hb : b.state = residualBFS φ) (d : Nat) (hd : b.state.distance G.t = some d) :
    ShortestAugmentingPath φ × Nat :=
  let recovered := recoverParents b.state.parent d G.t
  let inv : BFSDistanceInvariant φ G.s b.state := hb.symm ▸ residualBFS_distanceInvariant φ
  let hp := inv.parentPath_of_distance hd
  have hv : recovered.vertices = hp.vertices := (recoverParents_spec hp).1
  let path : Flow.AugmentingPath φ :=
    { vertices := recovered.vertices
      chain := hv ▸ hp.vertices_chain inv
      head_eq := hv ▸ hp.vertices_head
      last_eq := hv ▸ hp.vertices_getLast
      nodup := hv ▸ hp.vertices_nodup inv }
  have hlen : path.edges.length = d := by
    rw [Flow.ResidualPath.edges_length]
    change recovered.vertices.length - 1 = d
    rw [hv, BFSParentPath.vertices_length]
    omega
  (⟨path, by
    rw [hlen]
    exact (bfsState_distance_eq_some_iff φ G.t).1 (by simpa [hb] using hd)⟩,
    recovered.work)

              theorem recoveredShortest_work (φ : Flow V G) (b : CostedBFSRun V)
    (hb : b.state = residualBFS φ) (d : Nat) (hd : b.state.distance G.t = some d) :
    (recoveredShortest φ b hb d hd).2 = 3*d+2 := by
  exact (recoverParents_spec ((hb.symm ▸ residualBFS_distanceInvariant φ).parentPath_of_distance hd)).2

theorem recoveredShortest_length (φ : Flow V G) (b : CostedBFSRun V)
    (hb : b.state = residualBFS φ) (d : Nat) (hd : b.state.distance G.t = some d) :
    (recoveredShortest φ b hb d hd).1.path.edges.length = d := by
  simp only [recoveredShortest, Flow.ResidualPath.edges_length]
  rw [(recoverParents_spec ((hb.symm ▸ residualBFS_distanceInvariant φ).parentPath_of_distance hd)).1,
    BFSParentPath.vertices_length]
  omegastructure SearchResult (φ : Flow V G) where
  path : Option (ShortestAugmentingPath φ)
  work : Natdef search (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (φ : Flow V G) : SearchResult φ :=
  let b := costedResidualBFS A φ
  have hb : b.state = residualBFS φ := costedResidualBFS_state A φ (hA ▸ input.covers φ)
  match hd : b.state.distance G.t with
  | none => ⟨none,b.work+1⟩
  | some d =>
    let p := recoveredShortest φ b hb d hd
    ⟨some p.1,b.work+1+p.2⟩

theorem search_none_iff (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (φ : Flow V G) :
    (search input A hA φ).path = none ↔ ¬ φ.hasAugmentingPath := by
  have hb := costedResidualBFS_state A φ (hA ▸ input.covers φ)
  simp only [search]
  split
  · rename_i hd
    have hd' : (residualBFS φ).distance G.t = none := by simpa [hb] using hd
    simp only [true_iff]
    intro h
    obtain ⟨d,he⟩ := (bfsState_distance_defined_iff_reachable φ G.t).2 h
    simp [hd'] at he
  · rename_i d hd
    have hd' : (residualBFS φ).distance G.t = some d := by simpa [hb] using hd
    simp only [Option.some_ne_none, false_iff, not_not]
    exact (bfsState_distance_defined_iff_reachable φ G.t).1 ⟨d,hd'⟩theorem search_work_of_none (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (φ : Flow V G)
    (hn : (search input A hA φ).path = none) :
    (search input A hA φ).work = (costedResidualBFS A φ).work+1 := by
  simp only [search] at *
  split at hn <;> simp_all

theorem search_work_le (input : CapacityInput G) (A : SupportAdjacency V)
    (hA : A = (prepare input.arcs).adjacency) (φ : Flow V G) :
    (search input A hA φ).work ≤ 4 + 8 * (support G).card := by
  have hb : (costedResidualBFS A φ).work ≤ 1 + 5 * (support G).card := by
    simpa [hA] using bfs_work_le input φ
  simp only [search]
  split
  · dsimp only
    omega
  · rename_i d hd
    rw [recoveredShortest_work]
    have hp := shortest_length_support φ
      (recoveredShortest φ (costedResidualBFS A φ)
        (costedResidualBFS_state A φ (hA ▸ input.covers φ)) d hd).1
    rw [recoveredShortest_length] at hp
    dsimp only
    omegaend CLRS.Chapter26.SparseEK

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.SparseExecution.Support

The fixed sparse residual support

Positive-capacity arcs and their reverses contain every residual edge of every feasible flow. The executable input supplies those positive arcs as a list; its representation proof establishes completeness and absence of duplicates. Support preparation executes two bucket insertions per input arc. It does not search an implicit dense capacity matrix to discover the sparse input.

              noncomputable sectionnamespace CLRS.Chapter26.SparseEKopen Finset Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}def positiveArcs (G : FlowNetwork V) : Finset (V × V) :=
  Finset.univ.filter (fun e => 0 < G.c e.1 e.2)def support (G : FlowNetwork V) : Finset (V × V) :=
  positiveArcs G ∪ (positiveArcs G).image Prod.swap@[simp] theorem mem_support (u v : V) :
    (u,v) ∈ support G ↔ 0 < G.c u v ∨ 0 < G.c v u := by
  simp [support, positiveArcs]theorem support_card_le (G : FlowNetwork V) :
    (support G).card ≤ 2 * (positiveArcs G).card := by
  have hi := Finset.card_image_le (s := positiveArcs G) (f := Prod.swap)
  have hu := Finset.card_union_le (positiveArcs G) ((positiveArcs G).image Prod.swap)
  unfold support
  omega

theorem residual_mem_support (φ : Flow V G) {u v : V} (h : φ.residualEdge u v) :
    (u,v) ∈ support G := by
  rw [mem_support]
  by_contra hn
  push Not at hn
  have hc := φ.hcapacity v u
  have hs := φ.hskew_symm u v
  change 0 < G.c u v - φ.f u v at h
  linarith

A sparse-capacity input representation, not a premise about execution counts.

structure CapacityInput (G : FlowNetwork V) where
  arcs : List (V × V)
  nodup : arcs.Nodup
  mem_iff : ∀ u v, (u,v) ∈ arcs ↔ 0 < G.c u v

              

theorem CapacityInput.length_eq (input : CapacityInput G) :
    input.arcs.length = (positiveArcs G).card := by
  have heq : input.arcs.toFinset = positiveArcs G := by
    ext ⟨u,v⟩
    simp [positiveArcs, input.mem_iff]
  rw [← heq, List.toFinset_card_of_nodup input.nodup]def prepare : List (V × V) → SupportBuild V
  | [] => ⟨SupportAdjacency.empty, 0⟩
  | e :: es =>
    let old := prepare es
    ⟨(old.adjacency.insertArc e).insertArc e.swap, old.work + 2⟩omit [Fintype V] in
theorem prepare_work (es : List (V × V)) : (prepare es).work = 2 * es.length := by
  induction es with
  | nil => rfl
  | cons e es ih => simp [prepare, ih, Nat.mul_add, Nat.add_comm]omit [Fintype V] in
theorem prepare_mem (es : List (V × V)) (u v : V) :
    v ∈ (prepare es).adjacency.bucket u ↔ (u,v) ∈ es ∨ (v,u) ∈ es := by
  induction es with
  | nil => simp [prepare]
  | cons e es ih =>
    rcases e with ⟨a,b⟩
    simp [prepare, SupportAdjacency.mem_insertArc_bucket, ih]
    tautotheorem CapacityInput.prepare_mem (input : CapacityInput G) (u v : V) :
    v ∈ (prepare input.arcs).adjacency.bucket u ↔ (u,v) ∈ support G := by
  simp [SparseEK.prepare_mem, input.mem_iff]omit [Fintype V] in
private theorem adjacency_ext {A B : SupportAdjacency V} (h : A.bucket = B.bucket) : A = B := by
  cases A
  cases B
  cases h
  rfl

theorem CapacityInput.prepare_storage (input : CapacityInput G) :
    (prepare input.arcs).adjacency.storage = (support G).card := by
  have heq : (prepare input.arcs).adjacency = (buildSupportAdjacency (support G)).adjacency := by
    apply adjacency_ext
    funext u
    ext v
    rw [input.prepare_mem, mem_buildSupportAdjacency]
  rw [heq, buildSupportAdjacency_storage]theorem CapacityInput.covers (input : CapacityInput G) (φ : Flow V G) :
    SupportsResidual (prepare input.arcs).adjacency φ := by
  intro u v h
  exact (input.prepare_mem u v).2 (residual_mem_support φ h)

Isolated vertices are never dequeued: a reached non-source vertex is a support target.

theorem residualBFS_visited_subset (φ : Flow V G) :
    (residualBFS φ).visited ⊆ insert G.s ((support G).image Prod.snd) := by
  intro v hv
  have hr := (residualBFS_visited_iff_reachable φ v).1 hv
  induction hr with
  | refl => simp
  | @tail v w hprev hedge ih =>
    exact mem_insert_of_mem (mem_image.mpr ⟨(v,w), residual_mem_support φ hedge, rfl⟩)

Actual support BFS work has no ambient-vertex term, even with isolated vertices.


theorem bfs_work_le (input : CapacityInput G) (φ : Flow V G) :
    (costedResidualBFS (prepare input.arcs).adjacency φ).work ≤
      1 + 5 * (support G).card := by
  let A := (prepare input.arcs).adjacency
  have cover := input.covers φ
  have hinitQueue : BFSQueueInv φ (bfsStateInit G.s).visited (bfsStateInit G.s).queue := by
    intro v hv
    simpa [BFSQueueInv, bfsStateInit] using hv
  have hinitNodup : (bfsStateInit G.s).queue.Nodup := by simp [bfsStateInit]
  have hw := costedBFSAux_work_eq A φ cover (Fintype.card V) (bfsStateInit G.s)
    hinitQueue hinitNodup
  rw [supportBFSWork_init] at hw
  have hstate := costedResidualBFS_state A φ cover
  have hqueue : (costedResidualBFS A φ).state.queue = [] := by
    rw [hstate]; exact residualBFS_queue_empty φ
  have hw' : (costedResidualBFS A φ).work =
      (residualBFS φ).visited.card + 4 * ∑ u ∈ (residualBFS φ).visited, (A.bucket u).card := by
    change (costedResidualBFS A φ).work + 0 =
      supportBFSWork A (costedResidualBFS A φ).state.visited
        (costedResidualBFS A φ).state.queue at hw
    rw [Nat.add_zero, hstate] at hw
    simpa [supportBFSWork, residualBFS_queue_empty] using hw
  have hc := Finset.card_le_card (residualBFS_visited_subset φ)
  have hci := Finset.card_insert_le G.s ((support G).image Prod.snd)
  have him := Finset.card_image_le (s := support G) (f := Prod.snd)
  have hsum := sum_bucket_card_le_storage A (residualBFS φ).visited
  have hstorage : A.storage = (support G).card := input.prepare_storage
  rw [hw']
  omega

end CLRS.Chapter26.SparseEK

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.SparseExecution.Timeline

Sparse critical-edge counting for any shortest-path execution

The timeline records actual selected shortest paths and their resulting flows. Its step equation is instantiated by the counted BFS execution. No equality with the separate classical shortest-path chooser is required.

              noncomputable sectionnamespace CLRS.Chapter26.SparseEKopen Finset Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}structure Timeline (G : FlowNetwork V) where
  flow : Nat → Flow V G
  path : (i : Nat) → Option (ShortestAugmentingPath (flow i))
  next : ∀ i, flow (i+1) = match path i with
    | none => flow i
    | some p => (flow i).augment p.pathnamespace Timelinevariable (T : Timeline G)def Critical (i : Nat) (u v : V) : Prop :=
  ∃ p, T.path i = some p ∧ p.path.isCritical u vdef Augments (i : Nat) : Prop := ∃ p, T.path i = some p

theorem next_some {i : Nat} {p : ShortestAugmentingPath (T.flow i)}
    (hp : T.path i = some p) : T.flow (i+1) = (T.flow i).augment p.path := by
  rw [T.next, hp]

theorem distance_step (i : Nat) (u : V) {d : Nat}
    (hd : IsShortestDist (T.flow (i+1)) G.s u d) :
    ∃ d', IsShortestDist (T.flow i) G.s u d' ∧ d' ≤ d := by
  rw [T.next] at hd
  cases hp : T.path i with
  | none => exact ⟨d, by simpa [hp] using hd, le_rfl⟩
  | some p => exact p.exists_shortestDist_le_augment (by simpa [hp] using hd)theorem distance_mono {i j : Nat} (hij : i ≤ j) (u : V) {d : Nat}
    (hd : IsShortestDist (T.flow j) G.s u d) :
    ∃ d', IsShortestDist (T.flow i) G.s u d' ∧ d' ≤ d := by
  induction j, hij using Nat.le_induction generalizing d with
  | base => exact ⟨d,hd,le_rfl⟩
  | succ k hk ih =>
    obtain ⟨dk,hdK,hle⟩ := T.distance_step k u hd
    obtain ⟨di,hdi,hik⟩ := ih hdK
    exact ⟨di,hdi,hik.trans hle⟩

theorem no_reverse_step (i : Nat) (u v : V)
    (hno : ∀ p, T.path i = some p → (v,u) ∉ p.path.edges) :
    (T.flow (i+1)).residualCapacity u v ≤ (T.flow i).residualCapacity u v := by
  rw [T.next]
  cases hp : T.path i with
  | none => exact le_rfl
  | some p =>
    rw [Flow.augment_residualCapacity]
    simp only [if_neg (hno p hp), add_zero]
    split <;> linarith [p.path.bottleneck_pos]theorem no_reverse_interval {i j : Nat} (hij : i ≤ j) (u v : V)
    (hno : ∀ k, i ≤ k → k < j → ∀ p, T.path k = some p → (v,u) ∉ p.path.edges) :
    (T.flow j).residualCapacity u v ≤ (T.flow i).residualCapacity u v := by
  induction j, hij using Nat.le_induction with
  | base => exact le_rfl
  | succ k hk ih =>
    exact (T.no_reverse_step k u v (hno k hk (by omega))).trans
      (ih (fun l hl hlk => hno l hl (by omega)))

Recovery of a saturated arc requires a real reverse traversal in between.


theorem recovery {i j : Nat} (hij : i < j) {u v : V}
    (hci : T.Critical i u v) (hcj : T.Critical j u v) :
    ∃ k, i < k ∧ k < j ∧ ∃ p, T.path k = some p ∧ (v,u) ∈ p.path.edges := by
  obtain ⟨pi,hpi,hei,hzero⟩ := hci
  obtain ⟨pj,hpj,hej,_⟩ := hcj
  have hz : (T.flow (i+1)).residualCapacity u v = 0 := by
    rw [T.next_some hpi]; exact hzero
  have hpos : 0 < (T.flow j).residualCapacity u v :=
    Flow.ResidualPath.residualEdge_of_mem_edges pj.path hej
  by_contra hn
  have hno : ∀ k, i+1 ≤ k → k < j → ∀ p, T.path k = some p → (v,u) ∉ p.path.edges := by
    intro k hik hkj p hp hr
    exact hn ⟨k, by omega, hkj, p, hp, hr⟩
  have hle := T.no_reverse_interval (show i+1 ≤ j by omega) u v hno
  linarith

              

theorem critical_growth {i j : Nat} (hij : i < j) {u v : V}
    (hci : T.Critical i u v) (hcj : T.Critical j u v) :
    ∃ d d', IsShortestDist (T.flow i) G.s u d ∧
      IsShortestDist (T.flow j) G.s u d' ∧ d < d' := by
  obtain ⟨k,hik,hkj,p,hp,hrev⟩ := T.recovery hij hci hcj
  obtain ⟨pi,hpi,hei,_⟩ := hci
  obtain ⟨pj,hpj,hej,_⟩ := hcj
  obtain ⟨di,dk,hdi,hdk,hgrow⟩ := critical_dist_increase_rev pi p hei hrev
    (fun x d hd => T.distance_mono (by omega) x hd)
  obtain ⟨dj,hdj,_⟩ := shortest_edge_dist pj hej
  obtain ⟨dk',hdk',hle⟩ := T.distance_mono (by omega : k ≤ j) u hdj
  have heq := hdk.unique hdk'
  exact ⟨di,dj,hdi,hdj,by omega⟩theorem critical_dist {i : Nat} {u v : V} (hc : T.Critical i u v) :
    ∃ d, IsShortestDist (T.flow i) G.s u d ∧ d < Fintype.card V := by
  obtain ⟨p,hp,he,_⟩ := hc
  obtain ⟨d,hd,_⟩ := shortest_edge_dist p he
  exact ⟨d,hd,hd.lt_card⟩theorem critical_support {i : Nat} {u v : V} (hc : T.Critical i u v) :
    (u,v) ∈ support G := by
  obtain ⟨p,hp,he,_⟩ := hc
  exact residual_mem_support _ (Flow.ResidualPath.residualEdge_of_mem_edges p.path he)theorem exists_critical (i : Nat) (ha : T.Augments i) : ∃ u v, T.Critical i u v := by
  obtain ⟨p,hp⟩ := ha
  obtain ⟨u,v,hc⟩ := exists_critical_edge p.path
  exact ⟨u,v,p,hp,hc⟩

theorem augmentation_count_bound (N : ℕ) :
    ((Finset.range N).filter (fun n => T.Augments n)).card ≤
      (support G).card * Fintype.card V := by
  let s : Finset ℕ :=
    (Finset.range N).filter (fun n => T.Augments n)
  let haug : ∀ x : {n : ℕ // n ∈ s}, T.Augments x.1 :=
    fun x => (Finset.mem_filter.mp x.2).2
  let pair : {n : ℕ // n ∈ s} → V × V := fun x =>
    let h := T.exists_critical x.1 (haug x)
    (Classical.choose h, Classical.choose (Classical.choose_spec h))
  let hcrit : ∀ x : {n : ℕ // n ∈ s},
      T.Critical x.1 (pair x).1 (pair x).2 :=
    fun x =>
      Classical.choose_spec
        (Classical.choose_spec (T.exists_critical x.1 (haug x)))
  let distOf : {n : ℕ // n ∈ s} → ℕ :=
    fun x => Classical.choose (T.critical_dist (hcrit x))
  let f : {n : ℕ // n ∈ s} → (V × V) × Fin (Fintype.card V) :=
    fun x => (pair x, ⟨distOf x, (Classical.choose_spec (T.critical_dist (hcrit x))).2⟩)
  have hinj : Set.InjOn f (↑(s.attach) : Set {n : ℕ // n ∈ s}) := by
    intro x hx y hy hxy
    apply Subtype.ext
    by_contra hne
    have hpair_eq : pair x = pair y := congrArg Prod.fst hxy
    have hdist_eq : distOf x = distOf y :=
      congrArg (fun z : (V × V) × Fin (Fintype.card V) => z.2.1) hxy
    have hcy : T.Critical y.1 (pair x).1 (pair x).2 := by
      simpa [hpair_eq] using hcrit y
    have hlt_or : x.1 < y.1 ∨ y.1 < x.1 := by omega
    rcases hlt_or with hxy_lt | hyx_lt
    · rcases T.critical_growth hxy_lt (hcrit x) hcy with
        ⟨du, du', hdu, hdu', hgrow⟩
      have hdx : distOf x = du :=
        (Classical.choose_spec (T.critical_dist (hcrit x))).1.unique hdu
      have hdy : distOf y = du' := by
        have hd := (Classical.choose_spec (T.critical_dist (hcrit y))).1
        exact hd.unique (by simpa [hpair_eq] using hdu')
      omega
    · rcases T.critical_growth hyx_lt hcy (hcrit x) with
        ⟨du, du', hdu, hdu', hgrow⟩
      have hdy : distOf y = du := by
        have hd := (Classical.choose_spec (T.critical_dist (hcrit y))).1
        exact hd.unique (by simpa [hpair_eq] using hdu)
      have hdx : distOf x = du' :=
        (Classical.choose_spec (T.critical_dist (hcrit x))).1.unique hdu'
      omega
  have hsub : s.attach.image f ⊆ (support G).product
      (Finset.univ : Finset (Fin (Fintype.card V))) := by
    intro x hx
    obtain ⟨y,hy,rfl⟩ := Finset.mem_image.mp hx
    exact Finset.mem_product.mpr ⟨T.critical_support (hcrit y), Finset.mem_univ _⟩
  have hcard : (s.attach.image f).card = s.attach.card :=
    Finset.card_image_of_injOn hinj
  calc
    s.card = s.attach.card := Finset.card_attach.symm
    _ = (s.attach.image f).card := hcard.symm
    _ ≤ ((support G).product (Finset.univ : Finset (Fin (Fintype.card V)))).card :=
      Finset.card_le_card hsub
    _ = (support G).card * Fintype.card V := by simptheorem augmentation_count_sparse (N : Nat) :
    ((Finset.range N).filter (fun i => T.Augments i)).card ≤
      2 * (positiveArcs G).card * Fintype.card V :=
  (T.augmentation_count_bound N).trans (Nat.mul_le_mul_right _ (support_card_le G))

theorem all_steps_bound (N : Nat) (h : ∀ i < N, T.Augments i) :
    N ≤ (support G).card * Fintype.card V := by
  have hc := T.augmentation_count_bound N
  have heq : (Finset.range N).filter T.Augments = Finset.range N := by
    ext i
    simp only [Finset.mem_filter, Finset.mem_range]
    exact ⟨And.left, fun hi => ⟨hi,h i hi⟩⟩
  simpa [heq] using hcend Timelineend CLRS.Chapter26.SparseEK

CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.SparseExecution.Update

Local counted flow updates

The recovered path is converted to consecutive arcs once. A counted scan finds its bottleneck, then two dictionary-cell updates are executed per arc. The resulting dictionary refines the legacy mathematical augmentation. Dictionary reads/writes and exact-real arithmetic are unit-cost abstract primitives, as in the existing support-BFS model; persistent-container evaluator time is excluded.

              noncomputable sectionnamespace CLRS.Chapter26.SparseEKopen Finset Classicalvariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}def edgesWithCost : List V → List (V × V) × Nat
  | [] => ([],0)
  | [_] => ([],0)
  | a :: b :: vs =>
    let old := edgesWithCost (b :: vs)
    ((a,b) :: old.1, old.2+1)omit [Fintype V] [DecidableEq V] in
theorem edgesWithCost_spec (vs : List V) :
    (edgesWithCost vs).1 = vs.consecutivePairs ∧
      (edgesWithCost vs).2 = vs.length-1 := by
  induction vs with
  | nil => exact ⟨rfl,rfl⟩
  | cons a vs ih =>
    cases vs with
    | nil => exact ⟨rfl,rfl⟩
    | cons b vs => simp [edgesWithCost, List.consecutivePairs, ih]def scanCaps (φ : Flow V G) : List (V × V) → WithTop ℝ × Nat
  | [] => (⊤,0)
  | e :: es =>
    let old := scanCaps φ es
    (min (φ.residualCapacity e.1 e.2 : WithTop ℝ) old.1, old.2+4)@[simp] theorem scanCaps_work (φ : Flow V G) (es : List (V × V)) :
    (scanCaps φ es).2 = 4*es.length := by
  induction es with
  | nil => rfl
  | cons e es ih => simp [scanCaps, ih, Nat.mul_add, Nat.add_comm]theorem scanCaps_le (φ : Flow V G) (es : List (V × V)) (e : V × V) (he : e ∈ es) :
    (scanCaps φ es).1 ≤ (φ.residualCapacity e.1 e.2 : WithTop ℝ) := by
  induction es with
  | nil => simp at he
  | cons f es ih =>
    rcases List.mem_cons.mp he with rfl | he
    · exact min_le_left _ _
    · exact (min_le_right _ _).trans (ih he)theorem le_scanCaps (φ : Flow V G) (es : List (V × V)) (x : WithTop ℝ)
    (h : ∀ e ∈ es, x ≤ (φ.residualCapacity e.1 e.2 : WithTop ℝ)) :
    x ≤ (scanCaps φ es).1 := by
  induction es with
  | nil => exact le_top
  | cons e es ih =>
    exact le_min (h e (by simp)) (ih (fun f hf => h f (by simp [hf])))

theorem scanCaps_eq_bottleneck (φ : Flow V G) (p : Flow.AugmentingPath φ) :
    (scanCaps φ p.edges).1 = (p.bottleneck : WithTop ℝ) := by
  apply le_antisymm
  · have hm : p.bottleneck ∈ p.edges.toFinset.image
        (fun e => φ.residualCapacity e.1 e.2) := by
      unfold Flow.AugmentingPath.bottleneck
      exact Finset.min'_mem _ _
    obtain ⟨e,he,heq⟩ := Finset.mem_image.mp hm
    rw [← heq]
    exact scanCaps_le φ p.edges e (List.mem_toFinset.mp he)
  · apply le_scanCaps
    intro e he
    exact_mod_cast p.bottleneck_le_residualCapacity hestructure MapRun (V : Type*) where
  cells : (V × V) → ℝ
  work : Natdef bump (old : MapRun V) (e : V × V) (delta : ℝ) : MapRun V :=
  ⟨Function.update old.cells e (old.cells e + delta),old.work+2⟩def pushPair (f : (V × V) → ℝ) (delta : ℝ) (e : V × V) : MapRun V :=
  bump (bump ⟨f,0⟩ e delta) e.swap (-delta)omit [Fintype V] in
theorem bump_apply (old : MapRun V) (e x : V × V) (delta : ℝ) :
    (bump old e delta).cells x = old.cells x + if x=e then delta else 0 := by
  by_cases h : x=e <;> simp [bump, Function.update, h]omit [Fintype V] in
theorem pushPair_apply (f : (V × V) → ℝ) (delta : ℝ) (a b u v : V) :
    (pushPair f delta (a,b)).cells (u,v) = f (u,v) + Flow.edgeDelta delta a b u v := by
  simp only [pushPair, bump_apply, Prod.swap_prod_mk, Prod.mk.injEq, Flow.edgeDelta]
  split_ifs <;> ringdef updateAll (f : (V × V) → ℝ) (delta : ℝ) : List (V × V) → MapRun V
  | [] => ⟨f,0⟩
  | e :: es =>
    let first := pushPair f delta e
    let rest := updateAll first.cells delta es
    ⟨rest.cells,first.work+rest.work⟩omit [Fintype V] in
@[simp] theorem updateAll_work (f : (V × V) → ℝ) (delta : ℝ) (es : List (V × V)) :
    (updateAll f delta es).work = 4*es.length := by
  induction es generalizing f with
  | nil => rfl
  | cons e es ih => simp [updateAll, pushPair, bump, ih, Nat.mul_add, Nat.add_comm]

omit [Fintype V] in
theorem updateAll_path (f : (V × V) → ℝ) (delta : ℝ) (vs : List V) (u v : V) :
    (updateAll f delta vs.consecutivePairs).cells (u,v) = f (u,v) + Flow.pathDelta delta vs u v := by
  induction vs generalizing f with
  | nil => simp [List.consecutivePairs, updateAll, Flow.pathDelta]
  | cons a vs ih =>
    cases vs with
    | nil => simp [List.consecutivePairs, updateAll, Flow.pathDelta]
    | cons b vs =>
      have he : (a :: b :: vs).consecutivePairs = (a,b) :: (b :: vs).consecutivePairs := rfl
      rw [he]
      simp only [updateAll, ih, pushPair_apply, Flow.pathDelta]
      ringstructure FlowRun (G : FlowNetwork V) where
  flow : Flow V G
  work : Natprivate theorem flow_ext {φ ψ : Flow V G} (h : φ.f = ψ.f) : φ = ψ := by
  cases φ
  cases ψ
  cases h
  rfl

All executable value fields come from the counted scans and local dictionary writes.


def augmentWithCost (φ : Flow V G) (p : Flow.AugmentingPath φ) : FlowRun G :=
  let edges := edgesWithCost p.vertices
  let bottle := scanCaps φ edges.1
  let delta := bottle.1.untopD 0
  let updated := updateAll (fun e => φ.f e.1 e.2) delta edges.1
  have he : edges.1 = p.edges := (edgesWithCost_spec p.vertices).1
  have hd : delta = p.bottleneck := by
    dsimp [delta,bottle]
    rw [he,scanCaps_eq_bottleneck]
    rfl
  have hf : ∀ u v, updated.cells (u,v) = (φ.augment p).f u v := by
    intro u v
    dsimp [updated]
    rw [he,hd]
    exact updateAll_path _ _ p.vertices u v
  let result : Flow V G :=
    { f := fun u v => updated.cells (u,v)
      hcapacity := by intro u v; rw [hf]; exact (φ.augment p).hcapacity u v
      hskew_symm := by intro u v; rw [hf,hf]; exact (φ.augment p).hskew_symm u v
      hconservation := by intro u hu ht; simp only [hf]; exact (φ.augment p).hconservation u hu ht }
  ⟨result, edges.2+bottle.2+updated.work+1⟩

              

theorem augmentWithCost_refines (φ : Flow V G) (p : Flow.AugmentingPath φ) :
    (augmentWithCost φ p).flow = φ.augment p := by
  apply flow_ext
  funext u v
  simp only [augmentWithCost]
  rw [(edgesWithCost_spec p.vertices).1]
  change (updateAll (fun e => φ.f e.1 e.2) ((scanCaps φ p.edges).1.untopD 0) p.edges).cells (u,v) = _
  rw [scanCaps_eq_bottleneck]
  exact updateAll_path _ _ p.vertices u vtheorem augmentWithCost_work (φ : Flow V G) (p : Flow.AugmentingPath φ) :
    (augmentWithCost φ p).work = 9*p.edges.length+1 := by
  simp only [augmentWithCost, (edgesWithCost_spec p.vertices).1,
    (edgesWithCost_spec p.vertices).2, scanCaps_work,updateAll_work,Flow.ResidualPath.edges_length]
  have hlen : p.vertices.consecutivePairs.length = p.vertices.length-1 := p.edges_length
  omega

theorem augmentWithCost_work_le (φ : Flow V G) (p : ShortestAugmentingPath φ) :
    (augmentWithCost φ p.path).work ≤ 9*(support G).card+1 := by
  rw [augmentWithCost_work]
  have h := shortest_length_support φ p
  omegaend CLRS.Chapter26.SparseEK

CLRSLean.FourthEdition.Chapter_24.Section_24_6_MaxFlow_MinCut

Theorem 24.6. Max-Flow Min-Cut

This file proves the complete Max-Flow Min-Cut equivalence (CLRS Theorem 24.6). For a feasible flow, the following conditions are equivalent:

the flow is maximal;
the residual network has no source-to-sink augmenting path;
some source-to-sink cut has capacity equal to the flow value.

Main results:

Flow.eq_cutCapacity_implies_maximal: equality with one cut capacity certifies maximality.
Flow.maximal_iff_noAugmentingPath: maximality is equivalent to the absence of an augmenting path.
Flow.maximal_iff_exists_cut_value_eq: maximality is equivalent to the existence of a cut whose capacity equals the flow value.

Current gaps: none for the mathematical Max-Flow Min-Cut equivalence. Executable Ford--Fulkerson and Edmonds--Karp algorithms are developed separately.

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finset Classical

Every consecutive pair from a List.IsChain chain satisfies the relation.


lemma forall_zip_edges_of_isChain {V : Type*} {r : V → V → Prop} {a : V} {l : List V}
    (h : List.IsChain r (a :: l)) : ∀ (u v : V), (u, v) ∈ List.zip (a :: l) l → r u v := by
  have h_eq : l = [] ∨ ∃ (b : V) (l' : List V), l = b :: l' := by
    cases l
    · left; rfl
    · right; refine ⟨_, _, rfl⟩
  rcases h_eq with (hl | ⟨b, l', hl⟩)
  · subst hl; simp
  · subst hl
    have h_cons_cons := (List.isChain_cons_cons (a := a) (b := b) (l := l')).mp h
    rcases h_cons_cons with ⟨h_rel, h_chain⟩
    intro u v h_mem
    have h_zip : List.zip (a :: b :: l') (b :: l') = (a, b) :: List.zip (b :: l') l' := by simp
    simp [h_zip] at h_mem
    rcases h_mem with (⟨rfl, rfl⟩ | h_rest)
    · exact h_rel
    · exact forall_zip_edges_of_isChain h_chain u v h_rest

If the value of a flow equals the capacity of some cut, the flow is maximal. This is the easy direction of Theorem 24.6.

theorem Flow.eq_cutCapacity_implies_maximal {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (S : Finset V) (hs : G.s ∈ S) (ht : G.t ∉ S)
    (h_eq : φ.value = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v))) :
    Flow.isMaximal φ := by
  intro ψ
  have hψ_le : ψ.value ≤ Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) :=
    Flow.value_le_cut_capacity φ ψ S hs ht
  linarith

A feasible flow is maximal exactly when its residual network contains no source-to-sink augmenting path.

theorem Flow.maximal_iff_noAugmentingPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) :
    φ.isMaximal ↔ ¬φ.hasAugmentingPath := by
  constructor
  · intro hmax hpath
    exact φ.not_maximal_of_hasAugmentingPath hpath hmax
  · exact φ.maximal_of_noAugmentingPath

Max-Flow Min-Cut Theorem (CLRS Theorem 24.6). A feasible flow is maximal exactly when some cut separating source and sink has capacity equal to the flow value.

theorem Flow.maximal_iff_exists_cut_value_eq {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} (φ : Flow V G) :
    φ.isMaximal ↔
      ∃ S : Finset V, G.s ∈ S ∧ G.t ∉ S ∧
        φ.value = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
  constructor
  · intro hmax
    exact φ.exists_cut_value_eq_of_noAugmentingPath
      ((φ.maximal_iff_noAugmentingPath).mp hmax)
  · rintro ⟨S, hs, ht, hvalue⟩
    exact φ.eq_cutCapacity_implies_maximal S hs ht hvalue

end Chapter26end CLRS

Imports

import Mathlib
import CLRSLean.FourthEdition.Chapter_24.Section_24_1_Flow_Networks
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.Ford_Fulkerson_Augmentation

24.3. Maximum Bipartite Matching

This file formalizes the bipartite-to-flow-network reduction of CLRS §24.3 and proves Theorem 24.12: the maximum matching size equals the maximum flow value in the unit-capacity network. It constructs the feasible flow induced by every matching, recovers a matching from every integral flow, iterates augmentation from the zero flow to obtain an integral maximum flow, and combines the two directions.

Main results:

BipartiteGraph, Matching, and Matching.size
capFunc and toFlowNetwork
matchingFlowFun and matchingFlowFunSummand
matchingToFlow and matchingToFlow_value: the feasible flow induced by a matching has value |M|
Flow.IsIntegral, matchingOfIntegralFlow, and matchingOfIntegralFlow_size: an integral flow of value v yields a matching of size v
maxMatching_eq_maxFlow_value (Theorem 24.12): the maximum matching size equals the value of a maximal flow

              namespace CLRSnamespace Chapter26open Finset Classical

A bipartite graph with left partition L, right partition R, and edges E that only go from L to R. (CLRS §24.3.)

structure BipartiteGraph (V : Type*) [Fintype V] [DecidableEq V] where
  L : Finset V
  R : Finset V
  h_disjoint : L ∩ R = ∅
  h_cover : L ∪ R = Finset.univ
  E : Finset (V × V)
  hE_subset : ∀ e ∈ E, e.1 ∈ L ∧ e.2 ∈ R

A matching in a bipartite graph: a set of edges with no shared endpoints.

structure Matching (V : Type*) [Fintype V] [DecidableEq V] (G : BipartiteGraph V) where
  edges : Finset (V × V)
  h_subset : edges ⊆ G.E
  h_unique_left : ∀ (l r₁ r₂ : V), (l, r₁) ∈ edges → (l, r₂) ∈ edges → r₁ = r₂
  h_unique_right : ∀ (l₁ l₂ r : V), (l₁, r) ∈ edges → (l₂, r) ∈ edges → l₁ = l₂

The size (cardinality) of a matching.

def Matching.size {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) : ℕ := M.edges.card

lemma Matching.left_mem_L {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) {l r : V} (h : (l, r) ∈ M.edges) : l ∈ G.L := by
  have hE : (l, r) ∈ G.E := M.h_subset h; exact (G.hE_subset (l, r) hE).1

lemma Matching.right_mem_R {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) {l r : V} (h : (l, r) ∈ M.edges) : r ∈ G.R := by
  have hE : (l, r) ∈ G.E := M.h_subset h; exact (G.hE_subset (l, r) hE).2

Capacity function defined as a standalone def so simp can use it.

def capFunc (V : Type*) [Fintype V] [DecidableEq V] (G : BipartiteGraph V) (u v : V ⊕ Bool) : ℝ :=
  match u, v with
  | Sum.inr true, Sum.inl l' => if l' ∈ G.L then (1 : ℝ) else 0
  | Sum.inl l', Sum.inl r' => if (l', r') ∈ G.E then (1 : ℝ) else 0
  | Sum.inl r', Sum.inr false => if r' ∈ G.R then (1 : ℝ) else 0
  | _, _ => 0

The flow network constructed from a bipartite graph (CLRS eq. (24.11)).

Used `tac1 <;> tac2` where `(tac1; tac2)` would suffice

Note: This linter can be disabled with `set_option linter.unnecessarySeqFocus false`
def toFlowNetwork (V : Type*) [Fintype V] [DecidableEq V] (G : BipartiteGraph V) :
    FlowNetwork (V ⊕ Bool) :=
  { s := Sum.inr true
  , t := Sum.inr false
  , c := capFunc V G
  , hc_nonneg := λ u v =>
    have h_nonneg : 0 ≤ capFunc V G u v := by
      unfold capFunc
      cases u with
      | inl a =>
        cases v with
        | inl b => simp; split_ifs <;> norm_num
        | inr b => cases b <;> simp Used `tac1 <;> tac2` where `(tac1; tac2)` would suffice

Note: This linter can be disabled with `set_option linter.unnecessarySeqFocus false`<;> try (split_ifs <;> norm_num)
      | inr a =>
        cases a with
        | true =>
          cases v with
          | inl b => simp; split_ifs <;> norm_num
          | inr b => cases b <;> simp <;> this tactic is never executed

Note: This linter can be disabled with `set_option linter.unreachableTactic false`'try (split_ifs <;> norm_num)' tactic does nothing

Note: This linter can be disabled with `set_option linter.unusedTactic false`try (split_ifs <;> norm_num)
        | false =>
          cases v with
          | inl b => norm_num
          | inr b => cases b <;> simp <;> this tactic is never executed

Note: This linter can be disabled with `set_option linter.unreachableTactic false`'try (split_ifs <;> norm_num)' tactic does nothing

Note: This linter can be disabled with `set_option linter.unusedTactic false`try (split_ifs <;> norm_num)
    h_nonneg
  , hc_self := λ u =>
    by
      unfold capFunc
      match u with
      | Sum.inl v =>
        by_cases h : (v, v) ∈ G.E
        · have hvL : v ∈ G.L := (G.hE_subset (v, v) h).1
          have hvR : v ∈ G.R := (G.hE_subset (v, v) h).2
          have : v ∈ G.L ∩ G.R := Finset.mem_inter.mpr ⟨hvL, hvR⟩
          rw [G.h_disjoint] at this; simp at this
        · simp [h]
      | Sum.inr _ => simp
  , hs_ne_t := by simp
  }

The flow induced by a matching

The contribution of a single matched edge e to the matching-induced flow on pair (u,v) (CLRS eq. (24.11)): +1 along s → e.1, e.1 → e.2, e.2 → t, −1 on the reverse edges, and 0 elsewhere.

The (e.1, e.2) direction is written as the sum of two indicators so that the forward and reverse contributions cancel on degenerate pairs, making the summand skew-symmetric for every e.

def matchingFlowFunSummand {V : Type*} [DecidableEq V] (e : V × V) (u v : V ⊕ Bool) : ℝ :=
  match u, v with
  | Sum.inr true, Sum.inl l => if e.1 = l then (1 : ℝ) else 0
  | Sum.inl a, Sum.inl b =>
      (if e = (a, b) then (1 : ℝ) else 0) + (if e = (b, a) then (-1 : ℝ) else 0)
  | Sum.inl r, Sum.inr false => if e.2 = r then (1 : ℝ) else 0
  | Sum.inl l, Sum.inr true => if e.1 = l then (-1 : ℝ) else 0
  | Sum.inr false, Sum.inl r => if e.2 = r then (-1 : ℝ) else 0
  | _, _ => 0

The flow induced by a matching M in the constructed flow network.

def matchingFlowFun {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) (u v : V ⊕ Bool) : ℝ :=
  Finset.sum M.edges (fun (e : V × V) => matchingFlowFunSummand e u v)

A matching has at most one edge leaving a given left vertex.


lemma count_left_le_one {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) (l : V) :
    Finset.sum M.edges (fun (e : V × V) => if e.1 = l then (1 : ℝ) else 0) ≤ 1 := by
  have hcard : (M.edges.filter (fun e : V × V => e.1 = l)).card ≤ 1 := by
    refine Finset.card_le_one.mpr ?_
    intro e1 he1 e2 he2
    have he1' : e1 ∈ M.edges := (Finset.mem_filter.mp he1).1
    have he2' : e2 ∈ M.edges := (Finset.mem_filter.mp he2).1
    have h1 : e1.1 = e2.1 := (Finset.mem_filter.mp he1).2.trans (Finset.mem_filter.mp he2).2.symm
    have h2 : e1.2 = e2.2 := M.h_unique_left e1.1 e1.2 e2.2 he1' (by simpa [h1] using he2')
    exact Prod.ext h1 h2
  have hsum : Finset.sum M.edges (fun (e : V × V) => if e.1 = l then (1 : ℝ) else 0)
      = ((M.edges.filter (fun e : V × V => e.1 = l)).card : ℝ) := by
    rw [← Finset.sum_filter]
    simp
  rw [hsum]
  exact_mod_cast hcard

A matching has at most one edge entering a given right vertex.


lemma count_right_le_one {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) (r : V) :
    Finset.sum M.edges (fun (e : V × V) => if e.2 = r then (1 : ℝ) else 0) ≤ 1 := by
  have hcard : (M.edges.filter (fun e : V × V => e.2 = r)).card ≤ 1 := by
    refine Finset.card_le_one.mpr ?_
    intro e1 he1 e2 he2
    have he1' : e1 ∈ M.edges := (Finset.mem_filter.mp he1).1
    have he2' : e2 ∈ M.edges := (Finset.mem_filter.mp he2).1
    have h1 : e1.2 = e2.2 := (Finset.mem_filter.mp he1).2.trans (Finset.mem_filter.mp he2).2.symm
    have h2 : e1.1 = e2.1 := M.h_unique_right e1.1 e2.1 e1.2 he1' (by simpa [h1] using he2')
    exact Prod.ext h2 h1
  have hsum : Finset.sum M.edges (fun (e : V × V) => if e.2 = r then (1 : ℝ) else 0)
      = ((M.edges.filter (fun e : V × V => e.2 = r)).card : ℝ) := by
    rw [← Finset.sum_filter]
    simp
  rw [hsum]
  exact_mod_cast hcard

The single-edge summand is skew-symmetric: its value on (u,v) is the negation of its value on (v,u).


lemma matchingFlowFunSummand_skew {V : Type*} [DecidableEq V] (e : V × V) (u v : V ⊕ Bool) :
    matchingFlowFunSummand e u v = - matchingFlowFunSummand e v u := by
  unfold matchingFlowFunSummand
  cases u with
  | inl a =>
    cases v with
    | inl b =>
      by_cases h1 : e = (a, b)
      · by_cases h2 : e = (b, a)
        · have hab : a = b := by
            exact (congrArg Prod.fst h1).symm.trans (congrArg Prod.fst h2)
          simp [h1, hab]
        · have hab_ne : a ≠ b := by
            intro hab
            apply h2
            simp [h1, hab]
          simp [h1, hab_ne]
      · by_cases h2 : e = (b, a)
        · have hab_ne : a ≠ b := by
            intro hab
            apply h1
            simp [h2, hab]
          simp [h2, hab_ne]
        · simp [h1, h2]
    | inr b =>
      cases b with
      | true => by_cases h : e.1 = a <;> simp [h]
      | false => by_cases h : e.2 = a <;> simp [h]
  | inr b =>
    cases b with
    | true =>
      cases v with
      | inl l => by_cases h : e.1 = l <;> simp [h]
      | inr b' => cases b' <;> simp
    | false =>
      cases v with
      | inl r => by_cases h : e.2 = r <;> simp [h]
      | inr b' => cases b' <;> simp

The flow induced by a matching is skew-symmetric.


lemma matchingFlowFun_skew_symm {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) (u v : V ⊕ Bool) : matchingFlowFun M u v = - matchingFlowFun M v u := by
  unfold matchingFlowFun
  rw [← Finset.sum_neg_distrib]
  refine Finset.sum_congr rfl (fun e _ => ?_)
  exact matchingFlowFunSummand_skew e u v

For a fixed edge e, summing the (inl a, inl b) summand over all b counts how many endpoints of e equal a.


lemma matchingFlowFunSummand_inl_inl_sum {V : Type*} [Fintype V] [DecidableEq V]
    (e : V × V) (a : V) :
    (∑ b : V, matchingFlowFunSummand e (Sum.inl a) (Sum.inl b)) =
      (if e.1 = a then (1 : ℝ) else 0) - (if e.2 = a then (1 : ℝ) else 0) := by
  have hS1 : (∑ b : V, if e = (a, b) then (1 : ℝ) else 0) = if e.1 = a then (1 : ℝ) else 0 := by
    by_cases h : e.1 = a
    · calc
        (∑ b : V, if e = (a, b) then (1 : ℝ) else 0) = if e = (a, e.2) then (1 : ℝ) else 0 := by
          refine Finset.sum_eq_single e.2 ?_ ?_
          · intro b _ hb
            have hNe : e ≠ (a, b) := by
              intro hEq
              exact hb (congrArg Prod.snd hEq).symm
            simp [hNe]
          · simp
      _ = if e.1 = a then 1 else 0 := by
        have hEq : e = (a, e.2) := Prod.ext h rfl
        rw [hEq]
        simp
    · have hsum : (∑ b : V, if e = (a, b) then (1 : ℝ) else 0) = 0 := by
        refine Finset.sum_eq_zero (fun b _ => ?_)
        have hNe : e ≠ (a, b) := by
          intro hEq
          exact h (congrArg Prod.fst hEq)
        simp [hNe]
      simpa [h] using hsum
  have hS2 : (∑ b : V, if e = (b, a) then (-1 : ℝ) else 0) = if e.2 = a then (-1 : ℝ) else 0 := by
    by_cases h : e.2 = a
    · calc
        (∑ b : V, if e = (b, a) then (-1 : ℝ) else 0) = if e = (e.1, a) then (-1 : ℝ) else 0 := by
          refine Finset.sum_eq_single e.1 ?_ ?_
          · intro b _ hb
            have hNe : e ≠ (b, a) := by
              intro hEq
              exact hb (congrArg Prod.fst hEq).symm
            simp [hNe]
          · simp
      _ = if e.2 = a then -1 else 0 := by
        have hEq : e = (e.1, a) := Prod.ext rfl h
        rw [hEq]
        simp
    · have hsum : (∑ b : V, if e = (b, a) then (-1 : ℝ) else 0) = 0 := by
        refine Finset.sum_eq_zero (fun b _ => ?_)
        have hNe : e ≠ (b, a) := by
          intro hEq
          exact h (congrArg Prod.snd hEq)
        simp [hNe]
      simpa [h] using hsum
  calc
    (∑ b : V, matchingFlowFunSummand e (Sum.inl a) (Sum.inl b))
        = (∑ b : V, ((if e = (a, b) then (1 : ℝ) else 0) + (if e = (b, a) then (-1 : ℝ) else 0))) := by
          rfl
    _ = (∑ b : V, if e = (a, b) then (1 : ℝ) else 0)
        + (∑ b : V, if e = (b, a) then (-1 : ℝ) else 0) := by
          rw [Finset.sum_add_distrib]
    _ = (if e.1 = a then (1 : ℝ) else 0) + (if e.2 = a then (-1 : ℝ) else 0) := by
          rw [hS1, hS2]
    _ = (if e.1 = a then (1 : ℝ) else 0) - (if e.2 = a then (1 : ℝ) else 0) := by
          by_cases h1 : e.1 = a <;> by_cases h2 : e.2 = a <;> simp [h1, h2]

The flow induced by a matching satisfies flow conservation at every non-source non-sink vertex.


lemma matchingFlowFun_conservation {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} (M : Matching V G) (a : V) :
    (∑ v : V ⊕ Bool, matchingFlowFun M (Sum.inl a) v) = 0 := by
  have h1 : (∑ b : V, matchingFlowFun M (Sum.inl a) (Sum.inl b)) =
      Finset.sum M.edges (fun (e : V × V) =>
        (if e.1 = a then (1 : ℝ) else 0) - (if e.2 = a then (1 : ℝ) else 0)) := by
    unfold matchingFlowFun
    rw [Finset.sum_comm]
    refine Finset.sum_congr rfl (fun e _ => ?_)
    exact matchingFlowFunSummand_inl_inl_sum e a
  have h2 : matchingFlowFun M (Sum.inl a) (Sum.inr false) =
      Finset.sum M.edges (fun (e : V × V) => if e.2 = a then (1 : ℝ) else 0) := by
    unfold matchingFlowFun
    refine Finset.sum_congr rfl (fun e _ => ?_)
    rfl
  have h3 : matchingFlowFun M (Sum.inl a) (Sum.inr true) =
      -(Finset.sum M.edges (fun (e : V × V) => if e.1 = a then (1 : ℝ) else 0)) := by
    unfold matchingFlowFun
    rw [← Finset.sum_neg_distrib]
    refine Finset.sum_congr rfl (fun e _ => ?_)
    dsimp [matchingFlowFunSummand]
    by_cases h : e.1 = a <;> simp [h]
  calc
    (∑ v : V ⊕ Bool, matchingFlowFun M (Sum.inl a) v)
        = (∑ b : V, matchingFlowFun M (Sum.inl a) (Sum.inl b))
          + (matchingFlowFun M (Sum.inl a) (Sum.inr false) + matchingFlowFun M (Sum.inl a) (Sum.inr true)) := by
          rw [← Finset.univ_disjSum_univ (α := V) (β := Bool)]
          rw [Finset.sum_disjSum (Finset.univ : Finset V) (Finset.univ : Finset Bool)
            (fun v : V ⊕ Bool => matchingFlowFun M (Sum.inl a) v)]
          rw [Fintype.univ_bool]
          rw [Finset.sum_pair (by decide : true ≠ false)]
          ring
    _ = 0 := by
      rw [h1, h2, h3]
      rw [Finset.sum_sub_distrib]
      ring

The flow induced by a matching satisfies the capacity constraint f(u,v) ≤ c(u,v).


lemma matchingFlowFun_capacity {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) (u v : V ⊕ Bool) : matchingFlowFun M u v ≤ capFunc V G u v := by
  cases u with
  | inl a =>
    cases v with
    | inr b =>
      cases b with
      | true =>
        have hflow : matchingFlowFun M (Sum.inl a) (Sum.inr true) ≤ 0 := by
          unfold matchingFlowFun
          exact Finset.sum_nonpos (fun e he => by
            dsimp [matchingFlowFunSummand]
            by_cases h : e.1 = a <;> simp [h])
        simpa [capFunc] using hflow
      | false =>
        by_cases hR : a ∈ G.R
        · have hflow : matchingFlowFun M (Sum.inl a) (Sum.inr false) ≤ 1 := by
            have hsum : matchingFlowFun M (Sum.inl a) (Sum.inr false) =
                Finset.sum M.edges (fun (e : V × V) => if e.2 = a then (1 : ℝ) else 0) := by
              unfold matchingFlowFun
              refine Finset.sum_congr rfl (fun e _ => ?_)
              rfl
            rw [hsum]
            exact count_right_le_one M a
          simpa [capFunc, hR] using hflow
        · have hflow : matchingFlowFun M (Sum.inl a) (Sum.inr false) ≤ 0 := by
            unfold matchingFlowFun
            exact Finset.sum_nonpos (fun e he => by
              have hNe : e.2 ≠ a := by
                intro hEq
                exact hR (by simpa [hEq] using M.right_mem_R he)
              dsimp [matchingFlowFunSummand]
              simp [hNe])
          simpa [capFunc, hR] using hflow
    | inl b =>
      by_cases hE : (a, b) ∈ G.E
      · have hflow : matchingFlowFun M (Sum.inl a) (Sum.inl b) ≤ 1 := by
          have hsum_le : Finset.sum M.edges (fun (e : V × V) => if e = (a, b) then (1 : ℝ) else 0) ≤ 1 := by
            rw [Finset.sum_ite_eq' M.edges (a, b) (fun _ => (1 : ℝ))]
            by_cases h : (a, b) ∈ M.edges <;> simp [h]
          have hflow_le : matchingFlowFun M (Sum.inl a) (Sum.inl b) ≤
              Finset.sum M.edges (fun (e : V × V) => if e = (a, b) then (1 : ℝ) else 0) := by
            unfold matchingFlowFun
            exact Finset.sum_le_sum (fun e he => by
              dsimp [matchingFlowFunSummand]
              by_cases h1 : e = (a, b)
              · by_cases h2 : e = (b, a)
                · have hab : a = b := by
                    exact (congrArg Prod.fst h1).symm.trans (congrArg Prod.fst h2)
                  simp [h1, hab]
                · have hab_ne : a ≠ b := by
                    intro hab
                    apply h2
                    simp [h1, hab]
                  simp [h1, hab_ne]
              · by_cases h2 : e = (b, a)
                · have hab_ne : a ≠ b := by
                    intro hab
                    apply h1
                    simp [h2, hab]
                  simp [h2, hab_ne]
                · simp [h1, h2])
          linarith
        simpa [capFunc, hE] using hflow
      · have hflow : matchingFlowFun M (Sum.inl a) (Sum.inl b) ≤ 0 := by
          unfold matchingFlowFun
          exact Finset.sum_nonpos (fun e he => by
            have hNe : e ≠ (a, b) := by
              intro hEq
              exact hE (by simpa [hEq] using M.h_subset he)
            dsimp [matchingFlowFunSummand]
            by_cases h2 : e = (b, a)
            · have hab_ne : a ≠ b := by
                intro hab
                exact hNe (by simp [h2, hab])
              simp [h2, hab_ne]
            · simp [hNe, h2])
        simpa [capFunc, hE] using hflow
  | inr b =>
    cases b with
    | true =>
      cases v with
      | inr b' => cases b' <;> dsimp [matchingFlowFun, matchingFlowFunSummand] <;> simp [capFunc]
      | inl l =>
        by_cases hL : l ∈ G.L
        · have hflow : matchingFlowFun M (Sum.inr true) (Sum.inl l) ≤ 1 := by
            have hsum : matchingFlowFun M (Sum.inr true) (Sum.inl l) =
                Finset.sum M.edges (fun (e : V × V) => if e.1 = l then (1 : ℝ) else 0) := by
              unfold matchingFlowFun
              refine Finset.sum_congr rfl (fun e _ => ?_)
              rfl
            rw [hsum]
            exact count_left_le_one M l
          simpa [capFunc, hL] using hflow
        · have hflow : matchingFlowFun M (Sum.inr true) (Sum.inl l) ≤ 0 := by
            unfold matchingFlowFun
            exact Finset.sum_nonpos (fun e he => by
              have hNe : e.1 ≠ l := by
                intro hEq
                exact hL (by simpa [hEq] using M.left_mem_L he)
              dsimp [matchingFlowFunSummand]
              simp [hNe])
          simpa [capFunc, hL] using hflow
    | false =>
      cases v with
      | inl r =>
        have hflow : matchingFlowFun M (Sum.inr false) (Sum.inl r) ≤ 0 := by
          unfold matchingFlowFun
          exact Finset.sum_nonpos (fun e he => by
            dsimp [matchingFlowFunSummand]
            by_cases h : e.2 = r <;> simp [h])
        simpa [capFunc] using hflow
      | inr b' => cases b' <;> dsimp [matchingFlowFun, matchingFlowFunSummand] <;> simp [capFunc]

The feasible flow induced by a matching (CLRS §24.3). The flow sends one unit along s → l, l → r, r → t for every matched edge (l, r), with skew-symmetric reverse contributions.

noncomputable def matchingToFlow {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) : Flow (V ⊕ Bool) (toFlowNetwork V G) :=
  { f := matchingFlowFun M
  , hcapacity := matchingFlowFun_capacity M
  , hskew_symm := matchingFlowFun_skew_symm M
  , hconservation := by
      intro u hu hs
      cases u with
      | inl a => exact matchingFlowFun_conservation M a
      | inr b =>
          cases b with
          | true => simp [toFlowNetwork] at hu
          | false => simp [toFlowNetwork] at hs
  }

The total flow out of the source equals the number of matched edges.


lemma matchingFlowFun_value_sum {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) :
    Finset.sum (Finset.univ : Finset (V ⊕ Bool)) (fun v => matchingFlowFun M (Sum.inr true) v)
      = (M.size : ℝ) := by
  calc
    Finset.sum (Finset.univ : Finset (V ⊕ Bool)) (fun v => matchingFlowFun M (Sum.inr true) v)
        = Finset.sum (Finset.univ : Finset (V ⊕ Bool)) (fun v =>
            Finset.sum M.edges (fun (e : V × V) =>
              match v with
              | Sum.inl l => if e.1 = l then (1 : ℝ) else 0
              | Sum.inr _ => 0)) := by
          refine Finset.sum_congr rfl (fun v hv => ?_)
          unfold matchingFlowFun
          cases v with
          | inl l => rfl
          | inr b => cases b <;> rfl
      _ = Finset.sum M.edges (fun (e : V × V) =>
            Finset.sum (Finset.univ : Finset (V ⊕ Bool)) (fun v =>
              match v with
              | Sum.inl l => if e.1 = l then (1 : ℝ) else 0
              | Sum.inr _ => 0)) := by
            rw [Finset.sum_comm]
      _ = Finset.sum M.edges (fun (e : V × V) => (1 : ℝ)) := by
            refine Finset.sum_congr rfl (fun e _ => ?_)
            simp
      _ = (M.size : ℝ) := by
            simp [Matching.size]

Theorem (matching-flow value). The flow induced by a matching M has value equal to |M| (CLRS Theorem 24.12, value direction).

theorem matchingToFlow_value {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (M : Matching V G) : (matchingToFlow M).value = (M.size : ℝ) := by
  simp [Flow.value, matchingToFlow, toFlowNetwork, matchingFlowFun_value_sum M]

Integral flows and the converse construction

An integral flow takes only integer values on every edge. Values may be negative (reverse flow); the {0,1} recovery uses the capacity bounds to force nonnegativity on the relevant pairs.

def Flow.IsIntegral {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : Prop :=
  ∀ u v, ∃ n : ℤ, φ.f u v = (n : ℝ)

A real in [0,1] that is an integer is 0 or 1.


lemma integral_of_unit_range {x : ℝ} (h01 : 0 ≤ x ∧ x ≤ 1) (hint : ∃ n : ℤ, x = (n : ℝ)) :
    x = 0 ∨ x = 1 := by
  rcases hint with ⟨n, hn⟩
  have hn_ge : 0 ≤ n := by
    have hx_ge : 0 ≤ x := h01.1
    rw [hn] at hx_ge
    exact_mod_cast hx_ge
  have hn_le : n ≤ 1 := by
    have hx_le : x ≤ 1 := h01.2
    rw [hn] at hx_le
    exact_mod_cast hx_le
  have hn_eq : n = 0 ∨ n = 1 := by omega
  rcases hn_eq with h | h <;> simp [hn, h]

A vertex in R is not in L (the partitions are disjoint).


lemma BipartiteGraph.not_mem_L_of_mem_R {V : Type*} [Fintype V] [DecidableEq V]
    (G : BipartiteGraph V) {v : V} (h : v ∈ G.R) : v ∉ G.L := by
  intro hL
  have : v ∈ G.L ∩ G.R := Finset.mem_inter.mpr ⟨hL, h⟩
  rw [G.h_disjoint] at this
  simp at this

A vertex in L is not in R (the partitions are disjoint).


lemma BipartiteGraph.not_mem_R_of_mem_L {V : Type*} [Fintype V] [DecidableEq V]
    (G : BipartiteGraph V) {v : V} (h : v ∈ G.L) : v ∉ G.R := by
  intro hR
  have : v ∈ G.L ∩ G.R := Finset.mem_inter.mpr ⟨h, hR⟩
  rw [G.h_disjoint] at this
  simp at this

In the unit-capacity matching network, the flow on every L→R pair lies in [0, 1], and is zero when the edge is absent. The reverse capacity is zero because the graph has no anti-parallel edges: (r, l) ∈ E would put l in both partitions.


lemma matchingFlow_lr_bounds {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) (l : V) (hl : l ∈ G.L) (r : V) :
    0 ≤ φ.f (Sum.inl l) (Sum.inl r) ∧
      φ.f (Sum.inl l) (Sum.inl r) ≤ (if (l, r) ∈ G.E then (1 : ℝ) else 0) := by
  have hrev : (toFlowNetwork V G).c (Sum.inl r) (Sum.inl l) = 0 := by
    simp [toFlowNetwork, capFunc]
    by_cases h : (r, l) ∈ G.E
    · exact False.elim (G.not_mem_R_of_mem_L hl (G.hE_subset (r, l) h).2)
    · simp [h]
  simpa [toFlowNetwork, capFunc] using (Flow.range_of_zero_reverse_cap φ (Sum.inl l) (Sum.inl r) hrev)

In the matching network, the flow out of a left vertex equals its inflow from the source (conservation at l ∈ L).


lemma matchingFlow_conservation_left {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} (φ : Flow (V ⊕ Bool) (toFlowNetwork V G))
    (l : V) (hl : l ∈ G.L) :
    φ.f (Sum.inr true) (Sum.inl l) = ∑ r : V, φ.f (Sum.inl l) (Sum.inl r) := by
  have hcons : (∑ v : V ⊕ Bool, φ.f (Sum.inl l) v) = 0 :=
    φ.hconservation (Sum.inl l) (by simp [toFlowNetwork]) (by simp [toFlowNetwork])
  have hdecomp : (∑ v : V ⊕ Bool, φ.f (Sum.inl l) v) =
      (∑ r : V, φ.f (Sum.inl l) (Sum.inl r)) +
        (φ.f (Sum.inl l) (Sum.inr true) + φ.f (Sum.inl l) (Sum.inr false)) := by
    rw [← Finset.univ_disjSum_univ (α := V) (β := Bool)]
    rw [Finset.sum_disjSum (Finset.univ : Finset V) (Finset.univ : Finset Bool)
      (fun v : V ⊕ Bool => φ.f (Sum.inl l) v)]
    rw [Fintype.univ_bool]
    rw [Finset.sum_pair (by decide : true ≠ false)]
  have hlt : φ.f (Sum.inl l) (Sum.inr false) = 0 := by
    have hrev : (toFlowNetwork V G).c (Sum.inr false) (Sum.inl l) = 0 := by
      simp [toFlowNetwork, capFunc]
    have hr0 := Flow.range_of_zero_reverse_cap φ (Sum.inl l) (Sum.inr false) hrev
    have hcap : (toFlowNetwork V G).c (Sum.inl l) (Sum.inr false) = 0 := by
      simp [toFlowNetwork, capFunc]
      by_cases h : l ∈ G.R
      · exact False.elim (G.not_mem_R_of_mem_L hl h)
      · simp [h]
    linarith
  have hls : φ.f (Sum.inl l) (Sum.inr true) = -φ.f (Sum.inr true) (Sum.inl l) :=
    φ.hskew_symm (Sum.inl l) (Sum.inr true)
  rw [hdecomp, hlt, hls] at hcons
  linarith

In the matching network, the flow into a right vertex equals its outflow to the sink (conservation at r ∈ R).


lemma matchingFlow_conservation_right {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} (φ : Flow (V ⊕ Bool) (toFlowNetwork V G))
    (r : V) (hr : r ∈ G.R) :
    φ.f (Sum.inl r) (Sum.inr false) = ∑ l : V, φ.f (Sum.inl l) (Sum.inl r) := by
  have hcons : (∑ v : V ⊕ Bool, φ.f (Sum.inl r) v) = 0 :=
    φ.hconservation (Sum.inl r) (by simp [toFlowNetwork]) (by simp [toFlowNetwork])
  have hdecomp : (∑ v : V ⊕ Bool, φ.f (Sum.inl r) v) =
      (∑ l : V, φ.f (Sum.inl r) (Sum.inl l)) +
        (φ.f (Sum.inl r) (Sum.inr true) + φ.f (Sum.inl r) (Sum.inr false)) := by
    rw [← Finset.univ_disjSum_univ (α := V) (β := Bool)]
    rw [Finset.sum_disjSum (Finset.univ : Finset V) (Finset.univ : Finset Bool)
      (fun v : V ⊕ Bool => φ.f (Sum.inl r) v)]
    rw [Fintype.univ_bool]
    rw [Finset.sum_pair (by decide : true ≠ false)]
  have hrs : φ.f (Sum.inl r) (Sum.inr true) = 0 := by
    have hrev : (toFlowNetwork V G).c (Sum.inr true) (Sum.inl r) = 0 := by
      simp [toFlowNetwork, capFunc]
      by_cases h : r ∈ G.L
      · exact False.elim (G.not_mem_L_of_mem_R hr h)
      · simp [h]
    have hr0 := Flow.range_of_zero_reverse_cap φ (Sum.inl r) (Sum.inr true) hrev
    have hcap : (toFlowNetwork V G).c (Sum.inl r) (Sum.inr true) = 0 := by
      simp [toFlowNetwork, capFunc]
    linarith
  have hlr_sum : (∑ l : V, φ.f (Sum.inl r) (Sum.inl l)) =
      -(∑ l : V, φ.f (Sum.inl l) (Sum.inl r)) := by
    calc
      (∑ l : V, φ.f (Sum.inl r) (Sum.inl l)) = ∑ l : V, -φ.f (Sum.inl l) (Sum.inl r) := by
        refine Finset.sum_congr rfl (fun l _ => ?_)
        exact φ.hskew_symm (Sum.inl r) (Sum.inl l)
      _ = -(∑ l : V, φ.f (Sum.inl l) (Sum.inl r)) := by
        rw [Finset.sum_neg_distrib]
  rw [hdecomp, hrs, hlr_sum] at hcons
  linarith

Flow between two right vertices is zero (both directions have zero capacity).


lemma matchingFlow_rr_zero {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) {r₁ r₂ : V}
    (hr₁ : r₁ ∈ G.R) (hr₂ : r₂ ∈ G.R) : φ.f (Sum.inl r₁) (Sum.inl r₂) = 0 := by
  have hcap : (toFlowNetwork V G).c (Sum.inl r₁) (Sum.inl r₂) = 0 := by
    simp [toFlowNetwork, capFunc]
    by_cases h : (r₁, r₂) ∈ G.E
    · exact False.elim (G.not_mem_L_of_mem_R hr₁ (G.hE_subset (r₁, r₂) h).1)
    · simp [h]
  have hrev : (toFlowNetwork V G).c (Sum.inl r₂) (Sum.inl r₁) = 0 := by
    simp [toFlowNetwork, capFunc]
    by_cases h : (r₂, r₁) ∈ G.E
    · exact False.elim (G.not_mem_L_of_mem_R hr₂ (G.hE_subset (r₂, r₁) h).1)
    · simp [h]
  have hle := Flow.nonpos_of_zero_cap φ (Sum.inl r₁) (Sum.inl r₂) hcap
  have hge := Flow.nonneg_of_zero_reverse_cap φ (Sum.inl r₁) (Sum.inl r₂) hrev
  linarith

On the unit-capacity network an integral flow takes values in {0, 1} on every L→R pair.


lemma integral_lr_unit {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) (hint : φ.IsIntegral)
    (l : V) (hl : l ∈ G.L) (r : V) :
    φ.f (Sum.inl l) (Sum.inl r) = 0 ∨ φ.f (Sum.inl l) (Sum.inl r) = 1 := by
  have hb := matchingFlow_lr_bounds φ l hl r
  have hle : φ.f (Sum.inl l) (Sum.inl r) ≤ 1 := by
    by_cases hE : (l, r) ∈ G.E
    · simpa [hE] using hb.2
    · simp [hE] at hb
      linarith
  exact integral_of_unit_range ⟨hb.1, hle⟩ (hint (Sum.inl l) (Sum.inl r))

On the unit-capacity network an integral flow sends 0 or 1 units out of the source to every left vertex.


lemma integral_source_unit {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) (hint : φ.IsIntegral)
    (l : V) (hl : l ∈ G.L) :
    φ.f (Sum.inr true) (Sum.inl l) = 0 ∨ φ.f (Sum.inr true) (Sum.inl l) = 1 := by
  have hrev : (toFlowNetwork V G).c (Sum.inl l) (Sum.inr true) = 0 := by
    simp [toFlowNetwork, capFunc]
  exact integral_of_unit_range
    (by simpa [toFlowNetwork, capFunc, hl] using
      (Flow.range_of_zero_reverse_cap φ (Sum.inr true) (Sum.inl l) hrev))
    (hint (Sum.inr true) (Sum.inl l))

An edge carrying one unit of flow in the matching network belongs to G.E.


lemma mem_edges_of_flow_one {V : Type*} [Fintype V] [DecidableEq V] {G : BipartiteGraph V}
    (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) {l r : V}
    (h : φ.f (Sum.inl l) (Sum.inl r) = 1) : (l, r) ∈ G.E := by
  have hle1 : 1 ≤ (toFlowNetwork V G).c (Sum.inl l) (Sum.inl r) := by
    linarith [φ.hcapacity (Sum.inl l) (Sum.inl r), h]
  by_cases hE : (l, r) ∈ G.E
  · exact hE
  · simp [toFlowNetwork, capFunc, hE] at hle1
    norm_num at hle1

The indicator of a one-unit flow into a right vertex equals the flow value: integral flows take 0 or 1 on L→R pairs and zero on R→R pairs.


lemma flow_one_indicator_eq_of_right {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) (hint : φ.IsIntegral)
    {r : V} (hr : r ∈ G.R) (l : V) :
    (if φ.f (Sum.inl l) (Sum.inl r) = 1 then (1 : ℝ) else 0) = φ.f (Sum.inl l) (Sum.inl r) := by
  by_cases hl : l ∈ G.L
  · rcases integral_lr_unit φ hint l hl r with h | h <;> simp [h]
  · have hlR : l ∈ G.R := by
      have : l ∈ G.L ∪ G.R := by simp [G.h_cover]
      exact (Finset.mem_union.mp this).resolve_left hl
    have hz : φ.f (Sum.inl l) (Sum.inl r) = 0 := matchingFlow_rr_zero φ hlR hr
    simp [hz]

The matching recovered from an integral flow: every L→R pair carrying one unit of flow.


noncomputable def matchingOfIntegralFlow {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) (hint : φ.IsIntegral) :
    Matching V G :=
  { edges := (Finset.univ : Finset (V × V)).filter (fun e : V × V => φ.f (Sum.inl e.1) (Sum.inl e.2) = 1)
  , h_subset := by
      intro e he
      exact mem_edges_of_flow_one φ (Finset.mem_filter.mp he).2
  , h_unique_left := by
      intro l r₁ r₂ h1 h2
      have hf1 : φ.f (Sum.inl l) (Sum.inl r₁) = 1 := (Finset.mem_filter.mp h1).2
      have hl : l ∈ G.L := (G.hE_subset (l, r₁) (mem_edges_of_flow_one φ hf1)).1
      have hcount : φ.f (Sum.inr true) (Sum.inl l) =
          ((Finset.univ.filter (fun r : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card : ℝ) := by
        calc
          φ.f (Sum.inr true) (Sum.inl l) = ∑ r : V, φ.f (Sum.inl l) (Sum.inl r) :=
            matchingFlow_conservation_left φ l hl
          _ = ∑ r : V, (if φ.f (Sum.inl l) (Sum.inl r) = 1 then (1 : ℝ) else 0) := by
            refine Finset.sum_congr rfl (fun r _ => ?_)
            rcases integral_lr_unit φ hint l hl r with h | h <;> simp [h]
          _ = ((Finset.univ.filter (fun r : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card : ℝ) := by
            rw [← Finset.sum_filter]
            simp
      have hle : φ.f (Sum.inr true) (Sum.inl l) ≤ 1 := by
        rcases integral_source_unit φ hint l hl with h | h <;> simp [h]
      have hcard : (Finset.univ.filter (fun r : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card ≤ 1 := by
        have hℝ : (↑(Finset.univ.filter (fun r : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card : ℝ) ≤ 1 := by
          rw [← hcount]
          exact hle
        exact_mod_cast hℝ
      exact Finset.card_le_one.mp hcard r₁ (by simp [hf1]) r₂ (by simp [(Finset.mem_filter.mp h2).2])
  , h_unique_right := by
      intro l₁ l₂ r h1 h2
      have hf1 : φ.f (Sum.inl l₁) (Sum.inl r) = 1 := (Finset.mem_filter.mp h1).2
      have hr : r ∈ G.R := (G.hE_subset (l₁, r) (mem_edges_of_flow_one φ hf1)).2
      have hcount : φ.f (Sum.inl r) (Sum.inr false) =
          ((Finset.univ.filter (fun l : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card : ℝ) := by
        calc
          φ.f (Sum.inl r) (Sum.inr false) = ∑ l : V, φ.f (Sum.inl l) (Sum.inl r) :=
            matchingFlow_conservation_right φ r hr
          _ = ∑ l : V, (if φ.f (Sum.inl l) (Sum.inl r) = 1 then (1 : ℝ) else 0) := by
            refine Finset.sum_congr rfl (fun l _ => ?_)
            exact (flow_one_indicator_eq_of_right φ hint hr l).symm
          _ = ((Finset.univ.filter (fun l : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card : ℝ) := by
            rw [← Finset.sum_filter]
            simp
      have hr01 : 0 ≤ φ.f (Sum.inl r) (Sum.inr false) ∧ φ.f (Sum.inl r) (Sum.inr false) ≤ 1 := by
        have hrev : (toFlowNetwork V G).c (Sum.inr false) (Sum.inl r) = 0 := by
          simp [toFlowNetwork, capFunc]
        have hr0 := Flow.range_of_zero_reverse_cap φ (Sum.inl r) (Sum.inr false) hrev
        have hc : (toFlowNetwork V G).c (Sum.inl r) (Sum.inr false) = 1 := by
          simp [toFlowNetwork, capFunc, hr]
        exact ⟨hr0.1, by simpa [hc] using hr0.2⟩
      have hcard : (Finset.univ.filter (fun l : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card ≤ 1 := by
        have hℝ : (↑(Finset.univ.filter (fun l : V => φ.f (Sum.inl l) (Sum.inl r) = 1)).card : ℝ) ≤ 1 := by
          rw [← hcount]
          exact hr01.2
        exact_mod_cast hℝ
      exact Finset.card_le_one.mp hcard l₁ (by simp [hf1]) l₂ (by simp [(Finset.mem_filter.mp h2).2])
  }

Theorem (integral-flow converse). An integral flow of value v in the matching network yields a matching of size v (CLRS Theorem 24.12, converse direction).


theorem matchingOfIntegralFlow_size {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} (φ : Flow (V ⊕ Bool) (toFlowNetwork V G)) (hint : φ.IsIntegral) :
    ((matchingOfIntegralFlow φ hint).size : ℝ) = φ.value := by
  have hcard : ((matchingOfIntegralFlow φ hint).edges.card : ℝ) =
      ∑ e : V × V, (if φ.f (Sum.inl e.1) (Sum.inl e.2) = 1 then (1 : ℝ) else 0) := by
    unfold matchingOfIntegralFlow
    rw [← Finset.sum_filter]
    simp
  have hval : φ.value = ∑ l : V, φ.f (Sum.inr true) (Sum.inl l) := by
    calc
      φ.value = (∑ l : V, φ.f (Sum.inr true) (Sum.inl l)) +
          (φ.f (Sum.inr true) (Sum.inr true) + φ.f (Sum.inr true) (Sum.inr false)) := by
        simp [Flow.value, toFlowNetwork]
      _ = ∑ l : V, φ.f (Sum.inr true) (Sum.inl l) := by
        have hss : φ.f (Sum.inr true) (Sum.inr true) = 0 := Flow.self_zero φ (Sum.inr true)
        have hst : φ.f (Sum.inr true) (Sum.inr false) = 0 := by
          have hrev : (toFlowNetwork V G).c (Sum.inr false) (Sum.inr true) = 0 := by
            simp [toFlowNetwork, capFunc]
          have hr0 := Flow.range_of_zero_reverse_cap φ (Sum.inr true) (Sum.inr false) hrev
          have hcap : (toFlowNetwork V G).c (Sum.inr true) (Sum.inr false) = 0 := by
            simp [toFlowNetwork, capFunc]
          linarith
        simp [hss, hst]
  calc
    ((matchingOfIntegralFlow φ hint).size : ℝ)
        = ∑ e : V × V, (if φ.f (Sum.inl e.1) (Sum.inl e.2) = 1 then (1 : ℝ) else 0) := by
          simp only [Matching.size]
          rw [hcard]
    _ = ∑ l : V, ∑ r : V, (if φ.f (Sum.inl l) (Sum.inl r) = 1 then (1 : ℝ) else 0) := by
          have huniv : (Finset.univ : Finset (V × V)) = Finset.univ.product Finset.univ := by
            ext e; simp
          rw [huniv]
          exact (Finset.sum_product Finset.univ Finset.univ
            (fun e : V × V => if φ.f (Sum.inl e.1) (Sum.inl e.2) = 1 then (1 : ℝ) else 0))
    _ = ∑ l : V, φ.f (Sum.inr true) (Sum.inl l) := by
          refine Finset.sum_congr rfl (fun l _ => ?_)
          by_cases hl : l ∈ G.L
          · calc
              ∑ r : V, (if φ.f (Sum.inl l) (Sum.inl r) = 1 then (1 : ℝ) else 0)
                  = ∑ r : V, φ.f (Sum.inl l) (Sum.inl r) := by
                    refine Finset.sum_congr rfl (fun r _ => ?_)
                    rcases integral_lr_unit φ hint l hl r with h | h <;> simp [h]
              _ = φ.f (Sum.inr true) (Sum.inl l) := (matchingFlow_conservation_left φ l hl).symm
          · have hlR : l ∈ G.R := by
              have : l ∈ G.L ∪ G.R := by simp [G.h_cover]
              exact (Finset.mem_union.mp this).resolve_left hl
            have hsum : ∑ r : V, (if φ.f (Sum.inl l) (Sum.inl r) = 1 then (1 : ℝ) else 0) = 0 := by
              refine Finset.sum_eq_zero (fun r _ => ?_)
              have hcap : (toFlowNetwork V G).c (Sum.inl l) (Sum.inl r) = 0 := by
                simp [toFlowNetwork, capFunc]
                by_cases h : (l, r) ∈ G.E
                · exact False.elim (hl (G.hE_subset (l, r) h).1)
                · simp [h]
              have hf : φ.f (Sum.inl l) (Sum.inl r) ≤ 0 :=
                Flow.nonpos_of_zero_cap φ (Sum.inl l) (Sum.inl r) hcap
              by_cases h : φ.f (Sum.inl l) (Sum.inl r) = 1
              · exfalso; linarith
              · simp [h]
            have hsrc : φ.f (Sum.inr true) (Sum.inl l) = 0 := by
              have hcap : (toFlowNetwork V G).c (Sum.inr true) (Sum.inl l) = 0 := by
                simp [toFlowNetwork, capFunc]
                by_cases h : l ∈ G.L
                · exact False.elim (hl h)
                · simp [h]
              have hrev : (toFlowNetwork V G).c (Sum.inl l) (Sum.inr true) = 0 := by
                simp [toFlowNetwork, capFunc]
              have hr0 := Flow.range_of_zero_reverse_cap φ (Sum.inr true) (Sum.inl l) hrev
              linarith
            rw [hsum, hsrc]
    _ = φ.value := hval.symm

Integral maximum flow and Theorem 24.12

The zero flow on a network.

noncomputable def zeroFlow {V : Type*} [Fintype V] [DecidableEq V] (G : FlowNetwork V) : Flow V G :=
  { f := fun _ _ => 0
  , hcapacity := by intro u v; exact G.hc_nonneg u v
  , hskew_symm := by intro u v; simp
  , hconservation := by intro u hu ht; simp
  }

The zero flow is integral.

lemma IsIntegral_zero {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V} :
    (zeroFlow G).IsIntegral := by
  intro u v
  exact ⟨0, by simp [zeroFlow]⟩

The residual capacity of an integral flow on an integral-capacity network is an integer.


lemma residualCapacity_integral {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (u v : V) : ∃ n : ℤ, φ.residualCapacity u v = (n : ℝ) := by
  rcases hc u v with ⟨m, hm⟩
  rcases hint u v with ⟨n, hn⟩
  unfold Flow.residualCapacity
  refine ⟨m - n, ?_⟩
  rw [hm, hn]
  push_cast
  ring

The bottleneck of an augmenting path in an integral network is an integer.


lemma bottleneck_integral {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (p : Flow.AugmentingPath φ) : ∃ n : ℤ, p.bottleneck = (n : ℝ) := by
  have hmem : p.bottleneck ∈ p.edges.toFinset.image (fun e => φ.residualCapacity e.1 e.2) := by
    unfold Flow.AugmentingPath.bottleneck
    exact Finset.min'_mem _ _
  rcases Finset.mem_image.mp hmem with ⟨e, he, hEq⟩
  rw [← hEq]
  exact residualCapacity_integral φ hint hc e.1 e.2

The bottleneck of an augmenting path in an integral network is at least 1.


lemma bottleneck_ge_one {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (p : Flow.AugmentingPath φ) : 1 ≤ p.bottleneck := by
  unfold Flow.AugmentingPath.bottleneck
  rw [Finset.le_min'_iff]
  intro x hx
  rcases Finset.mem_image.mp hx with ⟨e, he, rfl⟩
  have hpos : 0 < φ.residualCapacity e.1 e.2 :=
    p.residualEdge_of_mem_edges (by simpa using he)
  rcases residualCapacity_integral φ hint hc e.1 e.2 with ⟨n, hn⟩
  rw [hn]
  have hn_pos : 0 < n := by
    have h0 : 0 < (n : ℝ) := by simpa [hn] using hpos
    exact_mod_cast h0
  exact_mod_cast (by omega : 1 ≤ n)

The single-edge update of an integral delta is integral.


lemma edgeDelta_integral {V : Type*} [DecidableEq V] {delta : ℝ}
    (hdelta : ∃ n : ℤ, delta = (n : ℝ)) (a b u v : V) :
    ∃ n : ℤ, Flow.edgeDelta delta a b u v = (n : ℝ) := by
  rcases hdelta with ⟨n, hn⟩
  by_cases h1 : u = a ∧ v = b
  · by_cases h2 : u = b ∧ v = a
    · have hab : a = b := h1.1.symm.trans h2.1
      exact ⟨0, by simp [Flow.edgeDelta, h1, hab, hn]⟩
    · have hab_ne : a ≠ b := by
        intro hab
        apply h2
        exact ⟨by simpa [hab] using h1.1, by simpa [hab] using h1.2⟩
      exact ⟨n, by simp [Flow.edgeDelta, h1, hab_ne, hn]⟩
  · by_cases h2 : u = b ∧ v = a
    · have hab_ne : a ≠ b := by
        intro hab
        apply h1
        exact ⟨by simpa [hab] using h2.1, by simpa [hab] using h2.2⟩
      exact ⟨-n, by simp [Flow.edgeDelta, h2, hab_ne, hn]⟩
    · exact ⟨0, by simp [Flow.edgeDelta, h1, h2]⟩

The path update of an integral delta is integral.


lemma pathDelta_integral {V : Type*} [DecidableEq V] {delta : ℝ}
    (hdelta : ∃ n : ℤ, delta = (n : ℝ)) (xs : List V) (u v : V) :
    ∃ n : ℤ, Flow.pathDelta delta xs u v = (n : ℝ) := by
  induction xs with
  | nil => exact ⟨0, by simp [Flow.pathDelta]⟩
  | cons a xs ih =>
      cases xs with
      | nil => exact ⟨0, by simp [Flow.pathDelta]⟩
      | cons b xs =>
          rcases edgeDelta_integral hdelta a b u v with ⟨m, hm⟩
          rcases ih with ⟨k, hk⟩
          exact ⟨m + k, by
            simp only [Flow.pathDelta]
            rw [hm, hk]
            push_cast
            ring⟩

Augmentation preserves integrality on an integral-capacity network.


lemma IsIntegral_augment {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (p : Flow.AugmentingPath φ) : (φ.augment p).IsIntegral := by
  intro u v
  have hb : ∃ n : ℤ, p.bottleneck = (n : ℝ) := bottleneck_integral φ hint hc p
  have hf : ∃ n : ℤ, φ.f u v = (n : ℝ) := hint u v
  have hp : ∃ n : ℤ, Flow.pathDelta p.bottleneck p.vertices u v = (n : ℝ) :=
    pathDelta_integral hb p.vertices u v
  rcases hf with ⟨n, hn⟩
  rcases hp with ⟨k, hk⟩
  exact ⟨n + k, by
    change φ.f u v + Flow.pathDelta p.bottleneck p.vertices u v = ((n + k : ℤ) : ℝ)
    rw [hn, hk]
    push_cast
    ring⟩

Augmenting along a residual path increases the value by at least one on an integral network.


lemma augment_value_ge_one {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (p : Flow.AugmentingPath φ) : φ.value + 1 ≤ (φ.augment p).value := by
  rw [φ.augment_value p]
  linarith [bottleneck_ge_one φ hint hc p]

One augmentation step: augment along an arbitrary residual source-to-sink path if one exists.

noncomputable def augmentOnce {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : Flow V G :=
  if h : φ.hasAugmentingPath then
    φ.augment (Classical.choice (Flow.hasAugmentingPath_iff_nonempty_augmentingPath.mp h))
  else φ

augmentOnce preserves integrality.

lemma IsIntegral_augmentOnce {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) :
    (augmentOnce φ).IsIntegral := by
  unfold augmentOnce
  by_cases h : φ.hasAugmentingPath
  · simp [h]
    exact IsIntegral_augment φ hint hc
      (Classical.choice (Flow.hasAugmentingPath_iff_nonempty_augmentingPath.mp h))
  · simp [h]
    exact hint

Repeatedly augment from a starting flow.

noncomputable def iterAugment {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : ℕ → Flow V G
  | 0 => φ
  | n + 1 => augmentOnce (iterAugment φ n)

Every iterate of iterAugment is integral.

lemma IsIntegral_iterAugment {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) :
    ∀ n, (iterAugment φ n).IsIntegral := by
  intro n
  induction n with
  | zero => simpa [iterAugment] using hint
  | succ n ih =>
      simpa [iterAugment] using (IsIntegral_augmentOnce (iterAugment φ n) ih hc)

Each augmentation step increases the value by at least one, unless the flow is already free of augmenting paths.

lemma iterAugment_step_value {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) (hint : φ.IsIntegral) (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ))
    (n : ℕ) :
    ¬(iterAugment φ n).hasAugmentingPath ∨
      (iterAugment φ n).value + 1 ≤ (iterAugment φ (n + 1)).value := by
  by_cases h : (iterAugment φ n).hasAugmentingPath
  · right
    simp [iterAugment, augmentOnce, h]
    exact augment_value_ge_one (iterAugment φ n) (IsIntegral_iterAugment φ hint hc n) hc
      (Classical.choice (Flow.hasAugmentingPath_iff_nonempty_augmentingPath.mp h))
  · left
    exact h

Flow value is bounded by the total capacity out of the source.

lemma value_le_source_cut {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Flow V G) : φ.value ≤ Finset.sum (Finset.univ : Finset V) (fun v => G.c G.s v) := by
  unfold Flow.value
  exact Finset.sum_le_sum (fun v _ => φ.hcapacity G.s v)

The total capacity out of the source is an integer on an integral network.


lemma source_cut_integral {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) :
    ∃ n : ℕ, Finset.sum (Finset.univ : Finset V) (fun v => G.c G.s v) = (n : ℝ) := by
  classical
  choose nv hnv using (fun v => hc G.s v)
  refine ⟨Finset.sum (Finset.univ : Finset V) nv, ?_⟩
  rw [show (fun v : V => G.c G.s v) = fun v : V => (nv v : ℝ) by
    funext v
    exact hnv v]
  norm_cast

While every step finds an augmenting path, the value after n steps is at least n.

lemma iterAugment_value_ge {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (hint : φ.IsIntegral)
    (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) (hφ : 0 ≤ φ.value)
    (hsteps : ∀ n, (iterAugment φ n).hasAugmentingPath) :
    ∀ n : ℕ, (n : ℝ) ≤ (iterAugment φ n).value := by
  intro n
  induction n with
  | zero => simpa [iterAugment] using hφ
  | succ n ih =>
      have hinc := (iterAugment_step_value φ hint hc n).resolve_left (not_not_intro (hsteps n))
      push_cast
      linarith

Repeated augmentation from an integral flow terminates at a flow without augmenting paths: the value strictly increases by at least one each step and is bounded by the (integral) source-side cut capacity.


lemma exists_noAugmentingPath_iter {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (hint : φ.IsIntegral)
    (hc : ∀ u v, ∃ n : ℕ, G.c u v = (n : ℝ)) (hφ : 0 ≤ φ.value) :
    ∃ n, ¬ (iterAugment φ n).hasAugmentingPath := by
  by_contra hnot
  have hsteps : ∀ n, (iterAugment φ n).hasAugmentingPath := by
    intro n
    by_contra h
    exact hnot ⟨n, h⟩
  rcases source_cut_integral hc with ⟨K, hK⟩
  have hge : ((K + 1 : ℕ) : ℝ) ≤ (iterAugment φ (K + 1)).value :=
    iterAugment_value_ge φ hint hc hφ hsteps (K + 1)
  have hle : (iterAugment φ (K + 1)).value ≤ (K : ℝ) := by
    rw [← hK]
    exact value_le_source_cut (iterAugment φ (K + 1))
  have hle' : ((K + 1 : ℕ) : ℝ) ≤ (K : ℝ) := le_trans hge hle
  norm_num at hle'

The matching network has integral capacities (in fact 0 or 1).

lemma toFlowNetwork_integral_capacity {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} : ∀ u v, ∃ n : ℕ, (toFlowNetwork V G).c u v = (n : ℝ) := by
  intro u v
  cases u with
  | inl a =>
    cases v with
    | inl b =>
      change ∃ n : ℕ, (if (a, b) ∈ G.E then (1 : ℝ) else 0) = (n : ℝ)
      by_cases h : (a, b) ∈ G.E
      · exact ⟨1, by simp [h]⟩
      · exact ⟨0, by simp [h]⟩
    | inr b =>
      cases b with
      | true =>
        change ∃ n : ℕ, (0 : ℝ) = (n : ℝ)
        exact ⟨0, by norm_num⟩
      | false =>
        change ∃ n : ℕ, (if a ∈ G.R then (1 : ℝ) else 0) = (n : ℝ)
        by_cases h : a ∈ G.R
        · exact ⟨1, by simp [h]⟩
        · exact ⟨0, by simp [h]⟩
  | inr a =>
    cases a with
    | true =>
      cases v with
      | inl b =>
        change ∃ n : ℕ, (if b ∈ G.L then (1 : ℝ) else 0) = (n : ℝ)
        by_cases h : b ∈ G.L
        · exact ⟨1, by simp [h]⟩
        · exact ⟨0, by simp [h]⟩
      | inr b =>
        cases b <;> (change ∃ n : ℕ, (0 : ℝ) = (n : ℝ); exact ⟨0, by norm_num⟩)
    | false =>
      cases v with
      | inl b =>
        change ∃ n : ℕ, (0 : ℝ) = (n : ℝ)
        exact ⟨0, by norm_num⟩
      | inr b =>
        cases b <;> (change ∃ n : ℕ, (0 : ℝ) = (n : ℝ); exact ⟨0, by norm_num⟩)

Theorem 24.12 (CLRS). In the unit-capacity network of a bipartite graph, the maximum matching size equals the maximum flow value: there is a matching at least as large as every matching, and a maximal flow whose value is exactly its size.


theorem maxMatching_eq_maxFlow_value {V : Type*} [Fintype V] [DecidableEq V]
    {G : BipartiteGraph V} :
    ∃ M : Matching V G, (∀ M' : Matching V G, M'.size ≤ M.size) ∧
      ∃ φ : Flow (V ⊕ Bool) (toFlowNetwork V G), φ.isMaximal ∧ φ.value = (M.size : ℝ) := by
  let N : FlowNetwork (V ⊕ Bool) := toFlowNetwork V G
  let zf : Flow (V ⊕ Bool) N := zeroFlow N
  have hc : ∀ u v, ∃ n : ℕ, N.c u v = (n : ℝ) := by
    intro u v
    exact toFlowNetwork_integral_capacity u v
  have hz : 0 ≤ zf.value := by
    unfold Flow.value
    simp [zf, zeroFlow]
  rcases exists_noAugmentingPath_iter zf (IsIntegral_zero (G := N)) hc hz with
    ⟨n, hn⟩
  let φ : Flow (V ⊕ Bool) N := iterAugment zf n
  have hintφ : φ.IsIntegral := IsIntegral_iterAugment zf (IsIntegral_zero (G := N)) hc n
  have hmax : φ.isMaximal := Flow.maximal_of_noAugmentingPath φ hn
  let M : Matching V G := matchingOfIntegralFlow φ hintφ
  refine ⟨M, ?_, φ, hmax, ?_⟩
  · intro M'
    have hvalφ : φ.value = (M.size : ℝ) := (matchingOfIntegralFlow_size φ hintφ).symm
    have hvalM : (matchingToFlow M').value = (M'.size : ℝ) := matchingToFlow_value M'
    have hle : (matchingToFlow M').value ≤ φ.value := hmax (matchingToFlow M')
    have hsize : (M'.size : ℝ) ≤ (M.size : ℝ) := by linarith
    exact_mod_cast hsize
  · exact (matchingOfIntegralFlow_size φ hintφ).symm

end Chapter26end CLRS

Imports

import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.Ford_Fulkerson_Augmentation

24.4. Push-Relabel Algorithms

This section formalizes the generic preflow-push (push-relabel) maximum-flow algorithm from CLRS §24.4. Instead of maintaining a feasible flow throughout, push-relabel works with a preflow — a capacity-respecting, skew-symmetric function that may create excess (net inflow) at internal vertices — together with a height function that certifies admissible edges and eventual termination.

Main results:

Preflow: a capacity-respecting, skew-symmetric function whose excess is nonnegative at every vertex except the source (0 ≤ e(u) for u ≠ s).
Preflow.excess and Preflow.isOverflowing: net inflow e(u) = ∑_v f(v,u) and the predicate u ∈ V \ {s,t} with e(u) > 0.
IsValidHeight: h(s) = |V|, h(t) = 0, and every residual edge (u,v) satisfies h(u) ≤ h(v) + 1.
admissibleEdge: a residual edge with h(u) = h(v) + 1.
Preflow.pushBy and relabel: the two local operations, each preserving the preflow and valid-height invariants.
exists_residualEdge_of_overflowing: an overflowing vertex has a residual edge leaving it, so a relabel (or push) is always possible.
exists_residualPath_to_source_of_overflowing (Lemma 24.13): an overflowing vertex can reach the source in the residual network.
height_le_of_overflowing (Lemma 24.14): every height is bounded by 2|V| - 1; combined with relabel_height_increase this bounds the number of relabel operations by O(V²).
maximal_of_no_overflow: a preflow with a valid height function and no overflowing internal vertex induces a maximum flow, via the max-flow min-cut theorem (Flow.maximal_of_noAugmentingPath).

Current gaps: the fine-grained saturating/nonsaturating push count (O(V²E)) and the relabel-to-front discharge ordering (O(V³), §24.5) are formalized in the companion section Section_24_5_Relabel_To_Front.

Notation conventions used in this section:

φ : a preflow on the network G
e(u) (as φ.excess u) : the net inflow at u
h : a height function V → ℕ
cf(u,v) (as φ.residualCapacity u v) : the residual capacity

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finset Classical

The preflow model

Net inflow ∑_{v} f(v,u) into a vertex u.

noncomputable def netInflow {V : Type*} [Fintype V] (f : V → V → ℝ) (u : V) : ℝ :=
  Finset.sum (Finset.univ : Finset V) (fun v => f v u)

A preflow on a flow network G: a skew-symmetric, capacity-respecting function that relaxes flow conservation to nonnegative excess everywhere except the source.

The three axioms are capacity (f u v ≤ c u v), skew symmetry (f u v = -f v u), and nonnegative excess at u ≠ s (0 ≤ ∑_v f(v,u)).

The preflow function.

Capacity constraint.

Skew symmetry.

Nonnegative excess at every vertex except the source.

              structure Preflow (V : Type*) [Fintype V] [DecidableEq V] (G : FlowNetwork V) where  f : V → V → ℝ  hcapacity : ∀ u v, f u v ≤ G.c u v  hskew_symm : ∀ u v, f u v = -f v u  hexcess_nonneg : ∀ u, u ≠ G.s → 0 ≤ netInflow f u

namespace Preflow

Net inflow at u: e(u) = ∑_v f(v,u).

noncomputable def excess {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u : V) : ℝ :=
  netInflow φ.f u

Skew symmetry implies the excess is the negation of the net outflow.


theorem excess_eq_neg_sum {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u : V) :
    φ.excess u = -Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v) := by
  unfold excess netInflow
  calc
    Finset.sum (Finset.univ : Finset V) (fun v => φ.f v u)
        = Finset.sum (Finset.univ : Finset V) (fun v => -φ.f u v) := by
      refine Finset.sum_congr rfl fun v hv => ?_
      exact φ.hskew_symm v u
    _ = -Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v) := by
      rw [Finset.sum_neg_distrib]

A vertex u is overflowing when it is neither source nor sink and has positive excess.

def isOverflowing {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u : V) : Prop :=
  u ≠ G.s ∧ u ≠ G.t ∧ 0 < φ.excess u

Residual capacity after a preflow: cf(u,v) = c(u,v) - f(u,v).

noncomputable def residualCapacity {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (u v : V) : ℝ :=
  G.c u v - φ.f u v

A residual edge has strictly positive residual capacity.

def residualEdge {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u v : V) : Prop :=
  φ.residualCapacity u v > 0

Reachability in the residual network.

def augmentingPathReachable {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (u v : V) : Prop :=
  Relation.ReflTransGen φ.residualEdge u v

Source reaches the sink in the residual network.

def hasAugmentingPath {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) : Prop :=
  φ.augmentingPathReachable G.s G.t

The double sum of a preflow over a set cancels by skew symmetry.


lemma skew_symm_cancel {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (S : Finset V) :
    Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v)) = 0 := by
  have hA : Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v)) =
      -(Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v))) := by
    calc
      Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v))
          = Finset.sum S (fun u => Finset.sum S (fun v => -φ.f v u)) := by
        refine Finset.sum_congr rfl fun u hu => Finset.sum_congr rfl fun v hv => ?_
        rw [φ.hskew_symm u v]
      _ = -(Finset.sum S (fun u => Finset.sum S (fun v => φ.f v u))) := by
        simp [Finset.sum_neg_distrib]
      _ = -(Finset.sum S (fun u => Finset.sum S (fun v => φ.f u v))) := by
        rw [Finset.sum_comm]
  linarith

If a preflow has zero excess at every non-source non-sink vertex, it is a feasible flow.

def toFlow {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (hnoExcess : ∀ u, u ≠ G.s → u ≠ G.t → φ.excess u = 0) :
    Flow V G where
  f := φ.f
  hcapacity := φ.hcapacity
  hskew_symm := φ.hskew_symm
  hconservation := by
    intro u hu_s hu_t
    have hexcess : φ.excess u = 0 := hnoExcess u hu_s hu_t
    have hneg : φ.excess u = -Finset.sum (Finset.univ : Finset V) (fun v => φ.f u v) :=
      φ.excess_eq_neg_sum u
    linarith

The augmenting-path predicate is unchanged under the flow conversion.

lemma toFlow_hasAugmentingPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G)
    (hnoExcess : ∀ u, u ≠ G.s → u ≠ G.t → φ.excess u = 0) :
    (φ.toFlow hnoExcess).hasAugmentingPath ↔ φ.hasAugmentingPath := by
  unfold Flow.hasAugmentingPath Flow.augmentingPathReachable
    Preflow.hasAugmentingPath Preflow.augmentingPathReachable
    Flow.residualEdge Flow.residualCapacity Preflow.residualEdge Preflow.residualCapacity
  rfl

end Preflow

Height functions and admissible edges

A valid height function for a preflow φ: h(s) = |V|, h(t) = 0, and every residual edge (u,v) satisfies h(u) ≤ h(v) + 1.

def IsValidHeight {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) : Prop :=
  h G.s = Fintype.card V ∧ h G.t = 0 ∧
    ∀ u v, φ.residualEdge u v → h u ≤ h v + 1

An admissible edge is a residual edge (u,v) with h(u) = h(v) + 1.

def admissibleEdge {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (u v : V) : Prop :=
  φ.residualEdge u v ∧ h u = h v + 1

The relabel operation

The set of heights of residual neighbors of u.

private noncomputable def relabelSet {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (u : V) : Finset ℕ :=
  ((Finset.univ : Finset V).filter (fun v => φ.residualEdge u v)).image h

The residual-neighbor height set is nonempty when u has a residual edge.

private lemma relabelSet_nonempty {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (u : V)
    (hres : ∃ v : V, φ.residualEdge u v) : (relabelSet φ h u).Nonempty := by
  rcases hres with ⟨v, hv⟩
  exact Finset.image_nonempty.mpr ⟨v, Finset.mem_filter.mpr ⟨Finset.mem_univ v, hv⟩⟩

The minimum height among the residual neighbors of u (used by relabel).

private noncomputable def relabelMin {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (u : V)
    (hres : ∃ v : V, φ.residualEdge u v) : ℕ :=
  (relabelSet φ h u).min' (relabelSet_nonempty φ h u hres)

relabelMin is at most the height of any residual neighbor.

private lemma relabelMin_le {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (u : V) (hres : ∃ v : V, φ.residualEdge u v)
    {b : V} (hb : φ.residualEdge u b) : relabelMin φ h u hres ≤ h b := by
  unfold relabelMin
  exact (Finset.isLeast_min' (relabelSet φ h u) (relabelSet_nonempty φ h u hres)).2
    (show h b ∈ ↑(relabelSet φ h u) from
      Finset.mem_image.mpr ⟨b, Finset.mem_filter.mpr ⟨Finset.mem_univ b, hb⟩, rfl⟩)

Under the relabel precondition (h u ≤ h v for every residual neighbor), h u is at most relabelMin.

private lemma le_relabelMin {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (u : V) (hres : ∃ v : V, φ.residualEdge u v)
    (hpre : ∀ v, φ.residualEdge u v → h u ≤ h v) : h u ≤ relabelMin φ h u hres := by
  unfold relabelMin
  exact Finset.le_min' (relabelSet φ h u) (relabelSet_nonempty φ h u hres) (h u)
    (by
      intro y hy
      rcases Finset.mem_image.mp hy with ⟨v, hvmem, rfl⟩
      exact hpre v (Finset.mem_filter.mp hvmem).2)

Relabel vertex u: raise its height to one plus the minimum height among its residual neighbors.

noncomputable def relabel {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (u : V) (hres : ∃ v : V, φ.residualEdge u v) :
    V → ℕ :=
  fun x => if x = u then 1 + relabelMin φ h u hres else h x

Relabeling sets the height of u to one plus relabelMin.

lemma relabel_eq_self {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (u : V) (hres : ∃ v : V, φ.residualEdge u v) :
    relabel φ h u hres u = 1 + relabelMin φ h u hres := by
  simp [relabel]

Relabeling preserves the height of every vertex except u.

lemma relabel_eq_of_ne {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (u : V) (hres : ∃ v : V, φ.residualEdge u v)
    {x : V} (hx : x ≠ u) : relabel φ h u hres x = h x := by
  simp [relabel, hx]

If every residual neighbor of u has height at least h(u) (the relabel precondition), relabeling u strictly increases its height.


lemma relabel_height_increase {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (u : V)
    (hres : ∃ v : V, φ.residualEdge u v)
    (hpre : ∀ v, φ.residualEdge u v → h u ≤ h v) :
    h u < relabel φ h u hres u := by
  rw [relabel_eq_self]
  have hle : h u ≤ relabelMin φ h u hres := le_relabelMin φ h u hres hpre
  omega

Relabeling u (with u ≠ s and u ≠ t) preserves the valid height function, provided the relabel precondition holds.


theorem relabel_validHeight {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ)
    (hvalid : IsValidHeight φ h) (u : V) (hu_ne_s : u ≠ G.s) (hu_ne_t : u ≠ G.t)
    (hres : ∃ v : V, φ.residualEdge u v)
    (hpre : ∀ v, φ.residualEdge u v → h u ≤ h v) :
    IsValidHeight φ (relabel φ h u hres) := by
  constructor
  · exact (relabel_eq_of_ne φ h u hres (Ne.symm hu_ne_s)).trans hvalid.1
  · constructor
    · exact (relabel_eq_of_ne φ h u hres (Ne.symm hu_ne_t)).trans hvalid.2.1
    · intro a b hres_ab
      by_cases hau : a = u
      · subst a
        have hb_ne_u : b ≠ u := by
          intro hb
          subst b
          have hself0 : φ.residualCapacity u u = 0 := by
            unfold Preflow.residualCapacity
            rw [G.hc_self u]
            have hf : φ.f u u = 0 := by
              have h := φ.hskew_symm u u
              linarith
            simp [hf]
          have hres0 : φ.residualCapacity u u > 0 := by
            simpa [Preflow.residualEdge] using hres_ab
          linarith
        rw [relabel_eq_self]
        have hmin_le : relabelMin φ h u hres ≤ h b := relabelMin_le φ h u hres hres_ab
        have hb_eq : relabel φ h u hres b = h b := relabel_eq_of_ne φ h u hres hb_ne_u
        omega
      · by_cases hbu : b = u
        · subst b
          have hvalid_edge : h a ≤ h u + 1 := hvalid.2.2 a u hres_ab
          rw [relabel_eq_of_ne φ h u hres hau, relabel_eq_self]
          have hle_min : h u ≤ relabelMin φ h u hres := le_relabelMin φ h u hres hpre
          omega
        · rw [relabel_eq_of_ne φ h u hres hau, relabel_eq_of_ne φ h u hres hbu]
          exact hvalid.2.2 a b hres_ab

The push operation

Net divergence of the single-edge update, summed over the first argument.


private lemma edgeDelta_sum_first {V : Type*} [Fintype V] [DecidableEq V]
    (δ : ℝ) (u v a : V) :
    (Finset.univ : Finset V).sum (fun x => Flow.edgeDelta δ u v x a) =
      (if a = v then δ else 0) - (if a = u then δ else 0) := by
  unfold Flow.edgeDelta
  rw [Finset.sum_sub_distrib]
  have hf : (Finset.univ : Finset V).sum (fun x => if x = u ∧ a = v then δ else 0) =
      (if a = v then δ else 0) := by
    by_cases hav : a = v
    · subst a
      simp
    · simp [hav]
  have hg : (Finset.univ : Finset V).sum (fun x => if x = v ∧ a = u then δ else 0) =
      (if a = u then δ else 0) := by
    by_cases hau : a = u
    · subst a
      simp
    · simp [hau]
  rw [hf, hg]

The residual capacity on a self-loop is always zero.


lemma residualCapacity_self {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u : V) : φ.residualCapacity u u = 0 := by
  unfold Preflow.residualCapacity
  rw [G.hc_self u]
  have hf : φ.f u u = 0 := by
    have h := φ.hskew_symm u u
    linarith
  simp [hf]

A residual edge never joins a vertex to itself.


lemma residualEdge_ne {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) {u v : V} (hres : φ.residualEdge u v) : u ≠ v := by
  intro huv
  subst v
  have h0 : φ.residualCapacity u u = 0 := residualCapacity_self φ u
  have hpos : φ.residualCapacity u u > 0 := by
    simpa [Preflow.residualEdge] using hres
  linarith

Push δ units of flow from u to v (with u ≠ v). The hypotheses assert that δ is nonnegative, bounded by the excess of u, and bounded by the residual capacity of (u,v).


noncomputable def pushBy {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u v : V) (huv : u ≠ v) (δ : ℝ) (hδ_nonneg : 0 ≤ δ)
    (hδ_le_excess : δ ≤ φ.excess u) (hδ_le_residual : δ ≤ φ.residualCapacity u v) :
    Preflow V G where
  f a b := φ.f a b + Flow.edgeDelta δ u v a b
  hcapacity := by
    intro a b
    unfold Flow.edgeDelta
    by_cases h1 : a = u ∧ b = v
    · rcases h1 with ⟨hau, hbv⟩
      subst a; subst b
      have hδ : δ ≤ G.c u v - φ.f u v := by
        unfold Preflow.residualCapacity at hδ_le_residual
        exact hδ_le_residual
      simp [huv]
      linarith
    · by_cases h2 : a = v ∧ b = u
      · rcases h2 with ⟨hav, hbu⟩
        subst a; subst b
        simp [huv]
        linarith [φ.hcapacity v u, hδ_nonneg]
      · have h1' : ¬(a = u ∧ b = v) := h1
        have h2' : ¬(a = v ∧ b = u) := h2
        simp [h1', h2']
        exact φ.hcapacity a b
  hskew_symm := by
    intro a b
    rw [φ.hskew_symm a b, Flow.edgeDelta_skew δ u v a b]
    ring
  hexcess_nonneg := by
    intro a ha_ne_s
    change 0 ≤ netInflow (fun x y => φ.f x y + Flow.edgeDelta δ u v x y) a
    unfold netInflow
    rw [Finset.sum_add_distrib]
    rw [edgeDelta_sum_first δ u v a]
    have hexcess_a : 0 ≤ (Finset.univ : Finset V).sum (fun x => φ.f x a) :=
      φ.hexcess_nonneg a ha_ne_s
    by_cases hau : a = u
    · subst a
      have hle : δ ≤ (Finset.univ : Finset V).sum (fun x => φ.f x u) := by
        unfold Preflow.excess netInflow at hδ_le_excess
        exact hδ_le_excess
      simp [huv]
      linarith
    · by_cases hav : a = v
      · subst a
        have hnonneg : 0 ≤ (Finset.univ : Finset V).sum (fun x => φ.f x v) :=
          φ.hexcess_nonneg v ha_ne_s
        simp [huv.symm]
        linarith
      · simp [hau, hav]
        exact hexcess_a

Pushing can only create one new residual edge: the reverse (v,u).


lemma pushBy_new_residualEdge {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (u v : V) (huv : u ≠ v) (δ : ℝ)
    (hδ_nonneg : 0 ≤ δ) (hδ_le_excess : δ ≤ φ.excess u)
    (hδ_le_residual : δ ≤ φ.residualCapacity u v)
    {a b : V} (hnew : (pushBy φ u v huv δ hδ_nonneg hδ_le_excess hδ_le_residual).residualEdge a b)
    (hold : ¬ φ.residualEdge a b) : a = v ∧ b = u := by
  have hcap : (pushBy φ u v huv δ hδ_nonneg hδ_le_excess hδ_le_residual).residualCapacity a b > 0 := hnew
  have hcap0 : φ.residualCapacity a b ≤ 0 := le_of_not_gt hold
  have hformula : (pushBy φ u v huv δ hδ_nonneg hδ_le_excess hδ_le_residual).residualCapacity a b =
      φ.residualCapacity a b - (if a = u ∧ b = v then δ else 0) +
        (if a = v ∧ b = u then δ else 0) := by
    unfold pushBy Preflow.residualCapacity Flow.edgeDelta
    ring
  rw [hformula] at hcap
  by_contra hnot
  have hnot_rev : ¬(a = v ∧ b = u) := hnot
  by_cases h1 : a = u ∧ b = v
  · rw [if_pos h1, if_neg hnot_rev] at hcap
    linarith
  · rw [if_neg h1, if_neg hnot_rev] at hcap
    linarith

A push on an admissible edge preserves the valid height function (heights are unchanged; the only new residual edge is the reverse edge, whose height condition follows from admissibility).


lemma pushBy_validHeight {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (h : V → ℕ) (hvalid : IsValidHeight φ h)
    (u v : V) (huv : u ≠ v) (δ : ℝ) (hδ_nonneg : 0 ≤ δ)
    (hδ_le_excess : δ ≤ φ.excess u) (hδ_le_residual : δ ≤ φ.residualCapacity u v)
    (hadm : h u = h v + 1) :
    IsValidHeight (pushBy φ u v huv δ hδ_nonneg hδ_le_excess hδ_le_residual) h := by
  constructor
  · exact hvalid.1
  · constructor
    · exact hvalid.2.1
    · intro a b hres
      by_cases hold : φ.residualEdge a b
      · exact hvalid.2.2 a b hold
      · have hab := pushBy_new_residualEdge φ u v huv δ hδ_nonneg hδ_le_excess hδ_le_residual
          hres hold
        rcases hab with ⟨rfl, rfl⟩
        rw [hadm]
        omega

The admissible push: push δ = min(e(u), cf(u,v)) from an overflowing u along a residual edge (u,v).

noncomputable def push {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}
    (φ : Preflow V G) (u v : V) (hu_ne_s : u ≠ G.s) (hres : φ.residualEdge u v) :
    Preflow V G :=
  let δ := min (φ.excess u) (φ.residualCapacity u v)
  pushBy φ u v (residualEdge_ne φ hres) δ
    (le_min (φ.hexcess_nonneg u hu_ne_s) (le_of_lt hres))
    (min_le_left _ _) (min_le_right _ _)

Height bound via reachability to the source

An overflowing vertex has at least one residual edge leaving it.


theorem exists_residualEdge_of_overflowing {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (u : V) (Variable name `hu_ne_s` is not explicitly referenced.

The binding can be removed (if unused) or named `_` (if used implicitly).

Note: This linter can be disabled with `set_option linter.unusedVariables false`hu_ne_s : u ≠ G.s)
    (hu_overflow : 0 < φ.excess u) : ∃ v : V, φ.residualEdge u v := by
  by_contra hnone
  have hnone : ∀ v, ¬φ.residualEdge u v := fun v hres => hnone ⟨v, hres⟩
  have hall_nonpos : ∀ v, φ.residualCapacity u v ≤ 0 := fun v => le_of_not_gt (hnone v)
  have hf_ge_cap : ∀ v, G.c u v ≤ φ.f u v := by
    intro v
    have h := hall_nonpos v
    unfold Preflow.residualCapacity at h
    linarith
  have hfin_nonpos : ∀ v, φ.f v u ≤ 0 := by
    intro v
    have hskew : φ.f u v = -φ.f v u := φ.hskew_symm u v
    have hge := hf_ge_cap v
    have hc_nonneg : 0 ≤ G.c u v := G.hc_nonneg u v
    linarith
  have hexcess_nonpos : φ.excess u ≤ 0 := by
    unfold Preflow.excess netInflow
    calc
      (Finset.univ : Finset V).sum (fun v => φ.f v u)
          ≤ (Finset.univ : Finset V).sum (fun v => (0 : ℝ)) :=
        Finset.sum_le_sum (fun v hv => hfin_nonpos v)
      _ = 0 := by simp
  linarith

Every list with repeated vertices decomposes into a duplicated segment.


private lemma exists_dup_decomp {α : Type*} [DecidableEq α] :
    ∀ {xs : List α}, ¬xs.Nodup →
      ∃ (x : α) (left middle right : List α),
        xs = left ++ x :: middle ++ x :: right := by
  intro xs
  induction xs with
  | nil =>
      intro h
      simp at h
  | cons a tail ih =>
      intro h
      by_cases ha : a ∈ tail
      · obtain ⟨middle, right, htail⟩ := List.mem_iff_append.mp ha
        exact ⟨a, [], middle, right, by rw [htail]; simp⟩
      · have htail : ¬tail.Nodup := fun htail => h (List.nodup_cons.mpr ⟨ha, htail⟩)
        obtain ⟨x, left, middle, right, htail_eq⟩ := ih htail
        exact ⟨x, a :: left, middle, right, by rw [htail_eq]; simp⟩

Any chain can be shortened to a simple (no-duplicates) chain with the same endpoints.


private lemma exists_nodup_chain_same_ends {α : Type*} [DecidableEq α]
    {r : α → α → Prop} :
    ∀ (n : ℕ) (xs : List α), xs.length ≤ n → xs ≠ [] →
      xs.IsChain r →
      ∃ ys : List α,
        ys ≠ [] ∧ ys.IsChain r ∧ ys.head? = xs.head? ∧
          ys.getLast? = xs.getLast? ∧ ys.Nodup := by
  intro n
  induction n with
  | zero =>
      intro xs hlen hne _
      have hnil : xs = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hlen)
      exact (hne hnil).elim
  | succ n ih =>
      intro xs hlen hne hchain
      by_cases hnodup : xs.Nodup
      · exact ⟨xs, hne, hchain, rfl, rfl, hnodup⟩
      · obtain ⟨x, left, middle, right, hxs⟩ := exists_dup_decomp hnodup
        let shorter := left ++ x :: right
        have hleft_middle : (left ++ x :: middle) <+: xs := by
          refine ⟨x :: right, ?_⟩
          rw [hxs]
        have hright : (x :: right) <:+ xs := by
          refine ⟨left ++ x :: middle, ?_⟩
          rw [hxs]
        have hchain_left_middle : (left ++ x :: middle).IsChain r :=
          hchain.prefix hleft_middle
        have hchain_left : left.IsChain r := hchain_left_middle.left_of_append
        have hchain_right : (x :: right).IsChain r := hchain.suffix hright
        have hchain_shorter : shorter.IsChain r := by
          dsimp [shorter]
          refine hchain_left.append hchain_right ?_
          intro a ha b hb
          have hbx : b = x := (show x = b by simpa using hb).symm
          rw [hbx]
          exact (List.isChain_append.1 hchain_left_middle).2.2 a ha x (by simp)
        have hhead_shorter : shorter.head? = xs.head? := by
          dsimp [shorter]
          rw [hxs]
          cases left <;> simp
        have hlast_shorter : shorter.getLast? = xs.getLast? := by
          dsimp [shorter]
          have hxright : (x :: right).getLast? = xs.getLast? := by
            rw [hxs, List.getLast?_append_of_ne_nil _ (by simp : (x :: right) ≠ [])]
          rw [List.getLast?_append_of_ne_nil _ (by simp : (x :: right) ≠ [])]
          exact hxright
        have hshorter_ne : shorter ≠ [] := by
          dsimp [shorter]
          simp
        have hlen_xs : xs.length = left.length + middle.length + right.length + 2 := by
          rw [hxs]
          simp only [List.length_append, List.length_cons]
          omega
        have hlen_shorter : shorter.length = left.length + right.length + 1 := by
          dsimp [shorter]
          simp only [List.length_append, List.length_cons]
          omega
        have hshorter_le : shorter.length ≤ n := by omega
        obtain ⟨ys, hys_ne, hys_chain, hys_head, hys_last, hys_nodup⟩ :=
          ih shorter hshorter_le hshorter_ne hchain_shorter
        exact ⟨ys, hys_ne, hys_chain, hys_head.trans hhead_shorter,
          hys_last.trans hlast_shorter, hys_nodup⟩

Along a residual chain a :: xs, the height of the head is at most the height of the last vertex plus the chain length.

lemma height_le_of_residual_chain {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ)
    (hedge : ∀ u v, φ.residualEdge u v → h u ≤ h v + 1) :
    ∀ {a : V} {xs : List V}, (a :: xs).IsChain φ.residualEdge →
      h a ≤ h ((a :: xs).getLast (by simp)) + xs.length := by
  intro a xs hchain
  induction xs generalizing a with
  | nil => simp
  | cons b xs ih =>
      have hrel : φ.residualEdge a b := hchain.rel_head
      have htail : (b :: xs).IsChain φ.residualEdge := hchain.tail
      have hb := ih htail
      have hle : h a ≤ h b + 1 := hedge a b hrel
      change h a ≤ h ((b :: xs).getLast (by simp)) + (b :: xs).length
      simp only [List.length_cons]
      omega

Same statement for an arbitrary nonempty chain.

lemma height_le_of_residual_chain_nonempty {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ)
    (hedge : ∀ u v, φ.residualEdge u v → h u ≤ h v + 1)
    {ys : List V} (hchain : ys.IsChain φ.residualEdge) (hne : ys ≠ []) :
    h (ys.head hne) ≤ h (ys.getLast hne) + (ys.length - 1) := by
  cases ys with
  | nil => cases hne rfl
  | cons a xs =>
      have hle := height_le_of_residual_chain φ h hedge (a := a) (xs := xs) hchain
      simp only [List.head_cons, List.length_cons] at hle ⊢
      omega

If heights satisfy the residual-edge inequality, then reachability in the residual network bounds the height drop by |V| - 1.


lemma height_le_of_reachability {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ)
    (hedge : ∀ u v, φ.residualEdge u v → h u ≤ h v + 1)
    {a b : V} (hreach : Relation.ReflTransGen φ.residualEdge a b) :
    h a ≤ h b + (Fintype.card V - 1) := by
  rcases List.exists_isChain_ne_nil_of_relationReflTransGen hreach with
    ⟨xs, hne, hchain, hhead, hlast⟩
  obtain ⟨ys, hyne, hychain, hyhead, hylast, hynodup⟩ :=
    exists_nodup_chain_same_ends xs.length xs le_rfl hne hchain
  have hys_head : ys.head? = some a := hyhead.trans (by
    exact (List.head?_eq_some_head hne).trans (congrArg some hhead))
  have hys_last : ys.getLast? = some b := hylast.trans (by
    exact (List.getLast?_eq_some_getLast hne).trans (congrArg some hlast))
  have hhead_a : ys.head hyne = a := by
    rw [List.head?_eq_some_head hyne] at hys_head
    exact Option.some.inj hys_head
  have hlast_b : ys.getLast hyne = b := by
    rw [List.getLast?_eq_some_getLast hyne] at hys_last
    exact Option.some.inj hys_last
  have hle := height_le_of_residual_chain_nonempty φ h hedge hychain hyne
  rw [hhead_a, hlast_b] at hle
  have hlen_le : ys.length ≤ Fintype.card V := by
    have hcard : ys.length = ys.toFinset.card := (List.toFinset_card_of_nodup hynodup).symm
    rw [hcard]
    exact Finset.card_le_card (by intro x hx; simp)
  have hlen_sub : ys.length - 1 ≤ Fintype.card V - 1 := by omega
  omega

Lemma 24.13 (CLRS). An overflowing vertex u ≠ s can reach the source in the residual network.


theorem exists_residualPath_to_source_of_overflowing {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} (φ : Preflow V G) (u : V) (Variable name `hu_ne_s` is not explicitly referenced.

The binding can be removed (if unused) or named `_` (if used implicitly).

Note: This linter can be disabled with `set_option linter.unusedVariables false`hu_ne_s : u ≠ G.s)
    (hu_overflow : 0 < φ.excess u) : Relation.ReflTransGen φ.residualEdge u G.s := by
  let X : Finset V := Finset.filter (fun v => Relation.ReflTransGen φ.residualEdge u v) Finset.univ
  by_contra hnot
  have hs_not_mem : G.s ∉ X := by
    intro h
    exact hnot ((Finset.mem_filter.mp h).2)
  have hcut_no_res : ∀ a, a ∈ X → ∀ b, b ∉ X → ¬ φ.residualEdge a b := by
    intro a ha b hb hres
    apply hb
    apply Finset.mem_filter.mpr
    exact ⟨Finset.mem_univ b, Relation.ReflTransGen.tail (Finset.mem_filter.mp ha).2 hres⟩
  have hf_eq_cap : ∀ a, a ∈ X → ∀ b, b ∉ X → φ.f a b = G.c a b := by
    intro a ha b hb
    have hnores := hcut_no_res a ha b hb
    have hcf_nonpos : φ.residualCapacity a b ≤ 0 := le_of_not_gt hnores
    have hle := φ.hcapacity a b
    unfold Preflow.residualCapacity at hcf_nonpos
    linarith
  have hsum_le_zero : (∑ a ∈ X, φ.excess a) ≤ 0 := by
    have hsplit : (∑ a ∈ X, φ.excess a) = ∑ a ∈ X, ∑ b ∈ Xᶜ, φ.f b a := by
      calc
        (∑ a ∈ X, φ.excess a) = ∑ a ∈ X, ∑ b : V, φ.f b a := by
          refine Finset.sum_congr rfl fun a ha => ?_
          rfl
        _ = ∑ a ∈ X, (∑ b ∈ X, φ.f b a + ∑ b ∈ Xᶜ, φ.f b a) := by
          refine Finset.sum_congr rfl fun a ha => ?_
          exact (Finset.sum_add_sum_compl X (fun b => φ.f b a)).symm
        _ = (∑ a ∈ X, ∑ b ∈ X, φ.f b a) + (∑ a ∈ X, ∑ b ∈ Xᶜ, φ.f b a) := by
          rw [Finset.sum_add_distrib]
        _ = 0 + (∑ a ∈ X, ∑ b ∈ Xᶜ, φ.f b a) := by
          congr 1
          rw [Finset.sum_comm]
          exact Preflow.skew_symm_cancel φ X
        _ = ∑ a ∈ X, ∑ b ∈ Xᶜ, φ.f b a := by simp
    have heq : (∑ a ∈ X, ∑ b ∈ Xᶜ, φ.f b a) = -∑ a ∈ X, ∑ b ∈ Xᶜ, G.c a b := by
      have h1 : (∑ a ∈ X, ∑ b ∈ Xᶜ, φ.f b a) = ∑ a ∈ X, ∑ b ∈ Xᶜ, -G.c a b := by
        refine Finset.sum_congr rfl fun a ha => Finset.sum_congr rfl fun b hb => ?_
        have hf_eq : φ.f a b = G.c a b := hf_eq_cap a ha b (by simpa using hb)
        rw [φ.hskew_symm b a, hf_eq]
      rw [h1]
      simp only [Finset.sum_neg_distrib]
    have hnonneg : 0 ≤ ∑ a ∈ X, ∑ b ∈ Xᶜ, G.c a b := by
      refine Finset.sum_nonneg fun a ha => Finset.sum_nonneg fun b hb => ?_
      exact G.hc_nonneg a b
    rw [hsplit, heq]
    linarith
  have hu_mem : u ∈ X := Finset.mem_filter.mpr ⟨Finset.mem_univ u, Relation.ReflTransGen.refl⟩
  have hsum_pos : 0 < ∑ a ∈ X, φ.excess a := by
    have hsplit : (∑ a ∈ X, φ.excess a) = (∑ a ∈ X.erase u, φ.excess a) + φ.excess u := by
      exact (X.sum_erase_add (fun a => φ.excess a) hu_mem).symm
    rw [hsplit]
    have hrest_nonneg : 0 ≤ ∑ a ∈ X.erase u, φ.excess a := by
      refine Finset.sum_nonneg fun a ha => ?_
      have ha_X : a ∈ X := Finset.mem_of_mem_erase ha
      have ha_ne_s : a ≠ G.s := by
        intro ha_eq_s
        apply hs_not_mem
        simpa [← ha_eq_s] using ha_X
      exact φ.hexcess_nonneg a ha_ne_s
    linarith
  linarith

Lemma 24.14 (CLRS). The height of any overflowing vertex u ≠ s is at most 2|V| - 1.


theorem height_le_of_overflowing {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (hvalid : IsValidHeight φ h)
    (u : V) (hu_ne_s : u ≠ G.s) (hu_overflow : 0 < φ.excess u) :
    h u ≤ 2 * Fintype.card V - 1 := by
  have hpath := exists_residualPath_to_source_of_overflowing φ u hu_ne_s hu_overflow
  have hle := height_le_of_reachability φ h hvalid.2.2 hpath
  rw [hvalid.1] at hle
  have hcard_pos : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
  omega

Correctness: a terminated preflow is a maximum flow

A valid height function rules out a source-to-sink residual path.


theorem noAugmentingPath_of_validHeight {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (hvalid : IsValidHeight φ h) :
    ¬ φ.hasAugmentingPath := by
  intro hpath
  have hle := height_le_of_reachability φ h hvalid.2.2 hpath
  rw [hvalid.1, hvalid.2.1] at hle
  have hcard_pos : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
  omega

Theorem (push-relabel correctness). If a preflow has a valid height function and no overflowing internal vertex, then it induces a maximum flow.


theorem maximal_of_no_overflow {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Preflow V G) (h : V → ℕ) (hvalid : IsValidHeight φ h)
    (hnoflow : ∀ u, u ≠ G.s → u ≠ G.t → φ.excess u = 0) :
    Flow.isMaximal (φ.toFlow hnoflow) := by
  have hnoPath : ¬ φ.hasAugmentingPath := noAugmentingPath_of_validHeight φ h hvalid
  have hnoPath_flow : ¬ (φ.toFlow hnoflow).hasAugmentingPath := by
    intro hpath
    exact hnoPath ((φ.toFlow_hasAugmentingPath hnoflow).mp hpath)
  exact (φ.toFlow hnoflow).maximal_of_noAugmentingPath hnoPath_flow

end Chapter26end CLRS

Imports

import CLRSLean.FourthEdition.Chapter_24.Section_24_4_Push_Relabel

24.5. Relabel-to-Front

This section completes the push-relabel maximum-flow analysis begun in CLRSLean.FourthEdition.Chapter_24.Section_24_4_Push_Relabel. There we established the preflow model, the height function, and the two local operations CLRS.Chapter26.push and CLRS.Chapter26.relabel, together with the correctness certificate CLRS.Chapter26.maximal_of_no_overflow. Here we count the operations.

The generic push-relabel algorithm repeatedly picks an overflowing vertex and applies a push or a relabel. A run of the algorithm is a sequence of basic operations (BasicOp), each either a relabel of an overflowing vertex or a push from an overflowing vertex along an admissible edge. We count relabels, saturating pushes, and nonsaturating pushes over a Run, and prove the three CLRS counting bounds:

Main results:

BasicOp, Run: a single basic operation and a length-n run of the generic algorithm.
Run.height_mono: heights are nondecreasing across a run.
Run.relabel_count_bound: at most 2|V|² relabel operations total.
Run.saturating_push_count_bound: at most O(|V|·|E|) saturating pushes.
Run.nonsaturating_push_count_bound: at most O(|V|²(|V|+|E|)) nonsaturating pushes, via the potential Φ = Σ_{overflowing u} h(u).
Run.generic_step_count_bound: the combined O(V²E) bound on the number of basic operations.

These bounds hold for any run of the generic algorithm, so they apply to the relabel-to-front schedule in particular. The relabel-to-front schedule is stronger: its DISCHARGE procedure walks a per-vertex neighbor list and, on relabeling a vertex, moves it to the front of the list L. That per-vertex list discipline gives the sharper O(V³) bound:

RelabelToFrontRun: a run satisfying the discharge discipline (between two relabel operations, no vertex is the source of more than one nonsaturating push).
RelabelToFrontRun.nonsaturating_push_count_bound: at most |V|·(relabels + 1) nonsaturating pushes, i.e. O(V³).
RelabelToFrontRun.step_count_bound_V3: the relabel-to-front algorithm performs at most 9|V|³ basic operations.

Notation conventions used in this section:

φ : a preflow on the network G
h : a height function V → ℕ
V (as Fintype.card V) : the number of vertices
E (as numEdges G) : the number of directed positive-capacity edges

              set_option autoImplicit truenamespace CLRSnamespace Chapter26universe uopen Finset Classicalopen scoped BigOperatorsvariable {V : Type u} [Fintype V] [DecidableEq V] {G : FlowNetwork V}

The number of edges

The set of directed edges (u,v) with positive capacity.

noncomputable def edgeSet (G : FlowNetwork V) : Finset (V × V) :=
  (Finset.univ : Finset (V × V)).filter (fun e => 0 < G.c e.1 e.2)

The number of directed edges (positive-capacity pairs).

noncomputable def numEdges (G : FlowNetwork V) : ℕ := (edgeSet G).card

Basic operations and runs

A single basic operation of the generic push-relabel algorithm: either a relabel of an overflowing vertex u, or a push from an overflowing u along an admissible residual edge (u,v). The preflow φ and height h are the state before the operation.

inductive BasicOp (V : Type u) [Fintype V] [DecidableEq V] (G : FlowNetwork V) : Type u where
  | relabel (φ : Preflow V G) (h : V → ℕ) (u : V) (hoverflow : φ.isOverflowing u)
      (hres : ∃ v : V, φ.residualEdge u v)
      (hpre : ∀ v, φ.residualEdge u v → h u ≤ h v) : BasicOp V G
  | push (φ : Preflow V G) (h : V → ℕ) (u v : V) (hoverflow : φ.isOverflowing u)
      (hres : φ.residualEdge u v) (hadm : h u = h v + 1) : BasicOp V G

namespace BasicOp

The preflow before the operation.

def beforeφ : BasicOp V G → Preflow V G
  | .relabel φ _ _ _ _ _ => φ
  | .push φ _ _ _ _ _ _ => φ

The height function before the operation.

def beforeh : BasicOp V G → V → ℕ
  | .relabel _ h _ _ _ _ => h
  | .push _ h _ _ _ _ _ => h

The preflow after the operation.

noncomputable def resultφ : BasicOp V G → Preflow V G
  | .relabel φ _ _ _ _ _ => φ
  | .push φ _ u v hoverflow hres _ => Chapter26.push φ u v hoverflow.1 hres

The height function after the operation.

noncomputable def resulth : BasicOp V G → V → ℕ
  | .relabel φ h u _ hres _ => Chapter26.relabel φ h u hres
  | .push _ h _ _ _ _ _ => h

Whether the operation is a relabel.

def isRelabel : BasicOp V G → Bool
  | .relabel .. => true
  | .push .. => false

Whether the operation is a relabel of the specific vertex u.

def relabelOf (u : V) : BasicOp V G → Bool
  | .relabel _ _ w _ _ _ => decide (w = u)
  | .push .. => false

Whether the operation is a push along the specific edge (u,v).

def pushOn (u v : V) : BasicOp V G → Bool
  | .push _ _ a b _ _ _ => decide (a = u ∧ b = v)
  | .relabel .. => false

Whether the operation is a saturating push (the residual capacity of the edge is exhausted, i.e. cf(u,v) ≤ e(u) so δ = cf(u,v)).

noncomputable def isSaturatingPush : BasicOp V G → Bool
  | .push φ _ u v _ _ _ => decide (φ.residualCapacity u v ≤ φ.excess u)
  | .relabel .. => false

Whether the operation is a nonsaturating push (the excess is exhausted, i.e. e(u) < cf(u,v) so δ = e(u)).

noncomputable def isNonsaturatingPush : BasicOp V G → Bool
  | .push φ _ u v _ _ _ => decide (φ.excess u < φ.residualCapacity u v)
  | .relabel .. => false

A saturating push along the specific edge (u,v).

noncomputable def saturatingPushOn (u v : V) : BasicOp V G → Bool
  | .push φ _ a b _ _ _ => decide (a = u ∧ b = v ∧ φ.residualCapacity a b ≤ φ.excess a)
  | .relabel .. => false

A single operation is exactly one of relabel, saturating push, or nonsaturating push.

lemma classification (o : BasicOp V G) :
    (if o.isRelabel then 1 else 0) + (if o.isSaturatingPush then 1 else 0) +
      (if o.isNonsaturatingPush then 1 else 0) = 1 := by
  cases o with
  | relabel φ h u ho hres hpre =>
      simp [isRelabel, isSaturatingPush, isNonsaturatingPush]
  | push φ h u v ho hres hadm =>
      by_cases hsat : φ.residualCapacity u v ≤ φ.excess u
      · simp [isRelabel, isSaturatingPush, isNonsaturatingPush, hsat]
      · have hlt : φ.excess u < φ.residualCapacity u v := lt_of_not_ge hsat
        simp [isRelabel, isSaturatingPush, isNonsaturatingPush, hsat, hlt]

Relabels are characterized by the vertex they relabel.


lemma sum_relabelOf_eq_isRelabel (o : BasicOp V G) :
    (∑ u : V, (if o.relabelOf u then 1 else 0 : ℕ)) = (if o.isRelabel then 1 else 0 : ℕ) := by
  cases o with
  | relabel φ h w ho hres hpre =>
      simp only [relabelOf, isRelabel]
      rw [Finset.sum_eq_single w]
      · simp
      · intro b _ hbw
        simp [hbw.symm]
      · intro hw
        simp at hw
  | push φ h u v ho hres hadm =>
      simp [relabelOf, isRelabel]

Saturating pushes are characterized by the edge they saturate.


lemma sum_saturatingPushOn_eq (o : BasicOp V G) :
    (∑ e : V × V, (if o.saturatingPushOn e.1 e.2 then 1 else 0 : ℕ)) =
      (if o.isSaturatingPush then 1 else 0 : ℕ) := by
  cases o with
  | relabel φ h u ho hres hpre =>
      simp [saturatingPushOn, isSaturatingPush]
  | push φ h u v ho hres hadm =>
      by_cases hsat : φ.residualCapacity u v ≤ φ.excess u
      · have hcard : ((Finset.univ.filter (fun e : V × V => u = e.1 ∧ v = e.2)).card) = 1 := by
          have hf : (Finset.univ.filter (fun e : V × V => u = e.1 ∧ v = e.2)) = {(u, v)} := by
            ext e
            simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_singleton]
            constructor
            · intro h
              exact Prod.ext h.1.symm h.2.symm
            · intro h
              cases h
              exact ⟨rfl, rfl⟩
          rw [hf]
          simp
        simp [saturatingPushOn, isSaturatingPush, hsat, Finset.sum_boole, hcard]
      · simp [saturatingPushOn, isSaturatingPush, hsat]

The height of any fixed vertex is nondecreasing across a single operation.

try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`
lemma height_mono (o : BasicOp V G) (u : V) : o.beforeh u ≤ o.resulth u := by
  cases o with
  | relabel φ h w ho hres hpre =>
      by_cases hwu : w = u
      · subst u
        exact le_of_lt (relabel_height_increase φ h w hres hpre)
      · try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`simpa [beforeh, resulth, relabel_eq_of_ne φ h w hres (Ne.symm hwu)]
  | push φ h u v ho hres hadm =>
      simp [beforeh, resulth]

A relabel operation strictly increases the height of the relabeled vertex.


lemma height_increase_of_relabel (o : BasicOp V G) {u : V} (hrel : o.relabelOf u = true) :
    o.beforeh u < o.resulth u := by
  cases o with
  | relabel φ h w ho hres hpre =>
      have hwu : w = u := by
        simpa [relabelOf] using (of_decide_eq_true hrel)
      subst u
      exact relabel_height_increase φ h w hres hpre
  | push φ h u v ho hres hadm =>
      simp [relabelOf] at hrel

end BasicOp

A run of the generic push-relabel algorithm: a sequence of n basic operations with the associated preflows and height functions.

structure Run (V : Type u) [Fintype V] [DecidableEq V] (G : FlowNetwork V) (n : ℕ) where
  φ : ℕ → Preflow V G
  h : ℕ → V → ℕ
  hvalid : ∀ i, IsValidHeight (φ i) (h i)
  op : ∀ i, i < n → BasicOp V G
  hop_beforeφ : ∀ i (hi : i < n), (op i hi).beforeφ = φ i
  hop_beforeh : ∀ i (hi : i < n), (op i hi).beforeh = h i
  hop_resultφ : ∀ i (hi : i < n), (op i hi).resultφ = φ (i + 1)
  hop_resulth : ∀ i (hi : i < n), (op i hi).resulth = h (i + 1)

namespace Runopen BasicOp (relabelOf pushOn saturatingPushOn isRelabel isSaturatingPush isNonsaturatingPush)

The operation at a Fin n step.

def opFin (R : Run V G n) (i : Fin n) : BasicOp V G :=
  R.op i.1 (Fin.isLt i)

The number of relabel operations in a run.

noncomputable def numRelabels (R : Run V G n) : ℕ :=
  ∑ i : Fin n, (if (R.opFin i).isRelabel then 1 else 0)

The number of saturating push operations in a run.

noncomputable def numSaturatingPushes (R : Run V G n) : ℕ :=
  ∑ i : Fin n, (if (R.opFin i).isSaturatingPush then 1 else 0)

The number of nonsaturating push operations in a run.

noncomputable def numNonsaturatingPushes (R : Run V G n) : ℕ :=
  ∑ i : Fin n, (if (R.opFin i).isNonsaturatingPush then 1 else 0)

The number of relabel operations of a specific vertex u.

noncomputable def numRelabelsOf (R : Run V G n) (u : V) : ℕ :=
  ∑ i : Fin n, (if (R.opFin i).relabelOf u then 1 else 0)

The number of saturating pushes along a specific edge (u,v).

noncomputable def numSaturatingPushesOn (R : Run V G n) (u v : V) : ℕ :=
  ∑ i : Fin n, (if (R.opFin i).saturatingPushOn u v then 1 else 0)

Height monotonicity

The height of any fixed vertex is nondecreasing across a single step.


lemma height_mono_step (R : Run V G n) (i : Fin n) (u : V) :
    R.h i.1 u ≤ R.h (i.1 + 1) u := by
  have hb := BasicOp.height_mono (R.opFin i) u
  have hb' : (R.opFin i).beforeh u = R.h i.1 u := by
    exact congrFun (R.hop_beforeh i.1 (Fin.isLt i)) u
  have hr' : (R.opFin i).resulth u = R.h (i.1 + 1) u := by
    exact congrFun (R.hop_resulth i.1 (Fin.isLt i)) u
  rw [← hb', ← hr']
  exact hb

Heights are nondecreasing across a run: i ≤ j implies h i u ≤ h j u.


lemma height_mono (R : Run V G n) {i j : ℕ} (hij : i ≤ j) (hj : j ≤ n) (u : V) :
    R.h i u ≤ R.h j u := by
  obtain ⟨d, rfl⟩ := Nat.exists_eq_add_of_le hij
  induction d with
  | zero => rfl
  | succ d ih =>
      have hle := ih
      have hstep : R.h (i + d) u ≤ R.h (i + (d + 1)) u := by
        have hi : i + d < n := by omega
        simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using
          height_mono_step R ⟨i + d, hi⟩ u
      omega

Relabel count bound

The height of u strictly increases between two distinct relabel steps of u.


lemma height_strict_between_relabels_of (R : Run V G n) {i j : Fin n} (hij : i.1 < j.1)
    {u : V} (hri : (R.opFin i).relabelOf u = true) (Variable name `hrj` is not explicitly referenced.

The binding can be removed (if unused) or named `_` (if used implicitly).

Note: This linter can be disabled with `set_option linter.unusedVariables false`hrj : (R.opFin j).relabelOf u = true) :
    R.h i.1 u < R.h j.1 u := by
  have hinc : R.h i.1 u < R.h (i.1 + 1) u := by
    have hb := BasicOp.height_increase_of_relabel (R.opFin i) hri
    rw [show R.opFin i = R.op i.1 (Fin.isLt i) from rfl] at hb
    rw [R.hop_beforeh i.1 (Fin.isLt i)] at hb
    rw [R.hop_resulth i.1 (Fin.isLt i)] at hb
    exact hb
  have hmono : R.h (i.1 + 1) u ≤ R.h j.1 u := by
    apply height_mono R
    · omega
    · omega
  omega

Each vertex is relabeled at most 2|V| times.


theorem relabel_count_bound_of (R : Run V G n) (u : V) :
    numRelabelsOf R u ≤ 2 * Fintype.card V := by
  classical
  let S : Finset (Fin n) :=
    (Finset.univ : Finset (Fin n)).filter (fun i => (R.opFin i).relabelOf u = true)
  have hcard : numRelabelsOf R u = S.card := by
    rw [numRelabelsOf]
    rw [Finset.sum_boole]
    rfl
  rw [hcard]
  let f : Fin n → ℕ := fun i => R.h i.1 u
  have hf_inj : Set.InjOn f (↑S : Set (Fin n)) := by
    intro a ha b hb hfab
    have ha' : (R.opFin a).relabelOf u = true := (Finset.mem_filter.mp ha).2
    have hb' : (R.opFin b).relabelOf u = true := (Finset.mem_filter.mp hb).2
    apply Fin.ext
    apply le_antisymm
    · by_contra hgt
      have hlt : b.1 < a.1 := by omega
      have hst := height_strict_between_relabels_of R hlt hb' ha'
      unfold f at hfab
      omega
    · by_contra hgt
      have hlt : a.1 < b.1 := by omega
      have hst := height_strict_between_relabels_of R hlt ha' hb'
      unfold f at hfab
      omega
  have hf_range : ∀ a : Fin n, a ∈ S → f a < 2 * Fintype.card V := by
    intro a ha
    have hrel' : (R.opFin a).relabelOf u = true := (Finset.mem_filter.mp ha).2
    have hoverflow : (R.φ a.1).isOverflowing u := by
      cases hop : R.opFin a with
      | relabel φ h w ho hres hpre =>
          have hwu : w = u := of_decide_eq_true (by simpa [relabelOf, hop] using hrel')
          have hbφ : φ = R.φ a.1 := by
            have h : (R.opFin a).beforeφ = R.φ a.1 := R.hop_beforeφ a.1 (Fin.isLt a)
            simpa [BasicOp.beforeφ, hop] using h
          subst u
          simpa [hbφ] using ho
      | push φ h u' v ho hres hadm =>
          simp [relabelOf, hop] at hrel'
    have hle := height_le_of_overflowing (R.φ a.1) (R.h a.1) (R.hvalid a.1) u
      hoverflow.1 hoverflow.2.2
    have hV : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
    unfold f
    omega
  calc
    S.card = (S.image f).card := by
      exact (Finset.card_image_iff.mpr hf_inj).symm
    _ ≤ (Finset.range (2 * Fintype.card V)).card := by
      apply Finset.card_le_card
      intro x hx
      rcases Finset.mem_image.mp hx with ⟨a, ha, rfl⟩
      have hlt : f a < 2 * Fintype.card V := hf_range a (by simpa using ha)
      exact Finset.mem_range.mpr hlt
    _ = 2 * Fintype.card V := by simp

The total number of relabel operations is at most 2|V|².


theorem relabel_count_bound (R : Run V G n) :
    numRelabels R ≤ 2 * Fintype.card V * Fintype.card V := by
  have hsum : numRelabels R = ∑ u : V, numRelabelsOf R u := by
    calc
      numRelabels R = ∑ i : Fin n, (if (R.opFin i).isRelabel then 1 else 0) := rfl
      _ = ∑ i : Fin n, ∑ u : V, (if (R.opFin i).relabelOf u then 1 else 0) := by
          apply Finset.sum_congr rfl
          intro i hi
          exact (BasicOp.sum_relabelOf_eq_isRelabel (R.opFin i)).symm
      _ = ∑ u : V, ∑ i : Fin n, (if (R.opFin i).relabelOf u then 1 else 0) := by
          rw [Finset.sum_comm]
      _ = ∑ u : V, numRelabelsOf R u := rfl
  calc
    numRelabels R = ∑ u : V, numRelabelsOf R u := hsum
    _ ≤ ∑ u : V, (2 * Fintype.card V) := by
      apply Finset.sum_le_sum
      intro u _
      exact relabel_count_bound_of R u
    _ = Fintype.card V * (2 * Fintype.card V) := by simp [Finset.sum_const, This simp argument is unused:
  nsmul_eq_mul

Hint: Omit it from the simp argument list.
  simp [Finset.sum_const,̵ ̵n̵s̵m̵u̵l̵_̵e̵q̵_̵m̵u̵l̵]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`nsmul_eq_mul]
    _ = 2 * Fintype.card V * Fintype.card V := by rw [mul_comm]

Saturating push count bound

The exact effect of pushBy on residual capacity.

lemma pushBy_residualCapacity_eq (φ : Preflow V G) (u v : V) (huv : u ≠ v) (δ : ℝ)
    (hδ_nonneg : 0 ≤ δ) (hδ_le_excess : δ ≤ φ.excess u)
    (hδ_le_residual : δ ≤ φ.residualCapacity u v) (a b : V) :
    (pushBy φ u v huv δ hδ_nonneg hδ_le_excess hδ_le_residual).residualCapacity a b =
      φ.residualCapacity a b - (if a = u ∧ b = v then δ else 0) +
        (if a = v ∧ b = u then δ else 0) := by
  unfold pushBy Preflow.residualCapacity Flow.edgeDelta
  ring

The exact effect of push on residual capacity.

lemma push_residualCapacity_eq (φ : Preflow V G) (u v : V) (hu_ne_s : u ≠ G.s)
    (hres : φ.residualEdge u v) (a b : V) :
    (push φ u v hu_ne_s hres).residualCapacity a b =
      φ.residualCapacity a b -
        (if a = u ∧ b = v then min (φ.excess u) (φ.residualCapacity u v) else 0) +
        (if a = v ∧ b = u then min (φ.excess u) (φ.residualCapacity u v) else 0) := by
  unfold push
  exact pushBy_residualCapacity_eq φ u v (residualEdge_ne φ hres)
    (min (φ.excess u) (φ.residualCapacity u v))
    (le_min (φ.hexcess_nonneg u hu_ne_s) (le_of_lt hres)) (min_le_left _ _)
    (min_le_right _ _) a b

A push that does not run along the reverse edge (v,u) cannot increase the residual capacity of (u,v).


lemma residualCapacity_le_of_not_reverse_push (φ : Preflow V G) (a b : V) (hu_ne_s : a ≠ G.s)
    (hres : φ.residualEdge a b) (u v : V) (hnot : ¬ (a = v ∧ b = u)) :
    (push φ a b hu_ne_s hres).residualCapacity u v ≤ φ.residualCapacity u v := by
  rw [push_residualCapacity_eq φ a b hu_ne_s hres u v]
  have hno_add : (if u = b ∧ v = a then min (φ.excess a) (φ.residualCapacity a b) else 0) = 0 := by
    by_cases h : u = b ∧ v = a
    · have hrev : a = v ∧ b = u := ⟨h.2.symm, h.1.symm⟩
      exact (hnot hrev).elim
    · simp [h]
  rw [hno_add]
  by_cases h : u = a ∧ v = b
  · rcases h with ⟨hau, hbv⟩
    subst u
    subst v
    have hmin_nonneg : 0 ≤ min (φ.excess a) (φ.residualCapacity a b) :=
      le_min (φ.hexcess_nonneg a hu_ne_s) (le_of_lt hres)
    simp only [if_true, and_self]
    linarith
  · simp [h]

A residual capacity that starts at 0 and becomes positive must at some intermediate step be increased by a push along the reverse edge.


lemma exists_reverse_push_of_residual_recovery (R : Run V G n) {u v : V} {i j : ℕ}
    (hij : i + 1 ≤ j) (hj : j ≤ n) (hzero : (R.φ (i + 1)).residualCapacity u v = 0)
    (hpos : (R.φ j).residualCapacity u v > 0) :
    ∃ k : Fin n, i + 1 ≤ k.1 ∧ k.1 < j ∧ (R.opFin k).pushOn v u = true := by
  classical
  have hmain := Nat.le_induction (m := i + 1)
    (P := fun t _ => t ≤ n →
      (R.φ (i + 1)).residualCapacity u v = 0 →
      (R.φ t).residualCapacity u v > 0 →
      ∃ k : Fin n, i + 1 ≤ k.1 ∧ k.1 < t ∧ (R.opFin k).pushOn v u = true)
    (base := by
      intro _ hzero hpos
      linarith)
    (succ := by
      intro t ht ih ht_succ_n hzero hpos
      by_cases hpred : (R.φ t).residualCapacity u v > 0
      · obtain ⟨k, hk1, hk2, hk3⟩ := ih (by omega) hzero hpred
        exact ⟨k, hk1, by omega, hk3⟩
      · have hnonpos : (R.φ t).residualCapacity u v ≤ 0 := le_of_not_gt hpred
        have hpush : (R.opFin ⟨t, by omega⟩).pushOn v u = true := by
          cases hop : R.op t (by omega) with
          | relabel φ h w ho hres hpre =>
              exfalso
              have hb : R.φ t = φ := by
                simpa [BasicOp.beforeφ, hop] using (R.hop_beforeφ t (by omega)).symm
              have hr : R.φ (t + 1) = φ := by
                simpa [BasicOp.resultφ, hop] using (R.hop_resultφ t (by omega)).symm
              have hpos' : (R.φ t).residualCapacity u v > 0 := by
                rw [hb, ← hr]
                exact hpos
              linarith
          | push φ h a b ho hres hadm =>
              have hstep_pos : (R.φ (t + 1)).residualCapacity u v > 0 := by
                have hr : (R.op t (by omega)).resultφ = R.φ (t + 1) :=
                  R.hop_resultφ t (by omega)
                simpa [hop, BasicOp.resultφ, hr] using hpos
              by_contra hnot
              have hle : (R.φ (t + 1)).residualCapacity u v ≤
                  (R.φ t).residualCapacity u v := by
                have hb : (R.op t (by omega)).beforeφ = R.φ t :=
                  R.hop_beforeφ t (by omega)
                have hr : (R.op t (by omega)).resultφ = R.φ (t + 1) :=
                  R.hop_resultφ t (by omega)
                have hnot' : ¬ (a = v ∧ b = u) := by
                  intro hab
                  apply hnot
                  change (R.op t (by omega)).pushOn v u = true
                  simp [pushOn, hop, hab]
                rw [← hb, ← hr]
                simpa [BasicOp.resultφ, BasicOp.beforeφ, hop] using
                  residualCapacity_le_of_not_reverse_push φ a b ho.1 hres u v hnot'
              linarith
        refine ⟨⟨t, by omega⟩, ?_, ?_, hpush⟩
        · exact ht
        · exact Nat.lt_succ_self t)
    j hij hj hzero hpos
  exact hmain

The height of u grows by at least two between two saturating pushes along (u,v).


lemma saturating_height_increase (R : Run V G n) {u v : V} {i j : Fin n} (hij : i.1 < j.1)
    (hsat_i : (R.opFin i).saturatingPushOn u v = true)
    (hsat_j : (R.opFin j).saturatingPushOn u v = true) :
    R.h i.1 u + 2 ≤ R.h j.1 u := by
  have hadm_i : R.h i.1 u = R.h i.1 v + 1 := by
    cases hop : R.opFin i with
    | relabel φ h w ho hres hpre =>
        simp [saturatingPushOn, hop] at hsat_i
    | push φ h a b ho hres hadm =>
        have hle : a = u ∧ b = v ∧ φ.residualCapacity a b ≤ φ.excess a :=
          of_decide_eq_true (by simpa [saturatingPushOn, hop] using hsat_i)
        rcases hle with ⟨ha, hb, _⟩
        have hb_h : R.h i.1 = h := by
          have h' : (R.opFin i).beforeh = R.h i.1 := R.hop_beforeh i.1 (Fin.isLt i)
          rw [← h']
          simp [BasicOp.beforeh, hop]
        subst a; subst b
        rw [hb_h]
        exact hadm
  have hzero : (R.φ (i.1 + 1)).residualCapacity u v = 0 := by
    cases hop : R.opFin i with
    | relabel φ h w ho hres hpre =>
        simp [saturatingPushOn, hop] at hsat_i
    | push φ h a b ho hres hadm =>
        have hle : a = u ∧ b = v ∧ φ.residualCapacity a b ≤ φ.excess a :=
          of_decide_eq_true (by simpa [saturatingPushOn, hop] using hsat_i)
        rcases hle with ⟨ha, hb, hsat⟩
        have hb_φ : R.φ i.1 = φ := by
          have h' : (R.opFin i).beforeφ = R.φ i.1 := R.hop_beforeφ i.1 (Fin.isLt i)
          rw [← h']
          simp [BasicOp.beforeφ, hop]
        have hr_φ : R.φ (i.1 + 1) = (R.opFin i).resultφ := (R.hop_resultφ i.1 (Fin.isLt i)).symm
        subst a; subst b
        rw [hr_φ]
        simp [BasicOp.resultφ, hop, push_residualCapacity_eq φ u v ho.1 hres u v, hsat,
          This simp argument is unused:
  min_eq_right hsat

Hint: Omit it from the simp argument list.
  simp [BasicOp.resultφ, hop, push_residualCapacity_eq φ u v ho.1 hres u v, hsat,
            m̵i̵n̵_̵e̵q̵_̵ri̵g̵h̵t̵ ̵h̵s̵a̵t̵,̵ ̵r̵esidualEdge_ne φ hres]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`min_eq_right hsat, residualEdge_ne φ hres]
  have hpos : (R.φ j.1).residualCapacity u v > 0 := by
    cases hop : R.opFin j with
    | relabel φ h w ho hres hpre =>
        simp [saturatingPushOn, hop] at hsat_j
    | push φ h a b ho hres hadm =>
        have hle : a = u ∧ b = v := by
          have h := of_decide_eq_true (by simpa [saturatingPushOn, hop] using hsat_j)
          exact ⟨h.1, h.2.1⟩
        have hb_φ : R.φ j.1 = φ := by
          have h' : (R.opFin j).beforeφ = R.φ j.1 := R.hop_beforeφ j.1 (Fin.isLt j)
          rw [← h']
          simp [BasicOp.beforeφ, hop]
        rcases hle with ⟨ha, hb⟩
        subst a; subst b
        rw [hb_φ]
        exact hres
  obtain ⟨k, hk1, hk2, hk3⟩ := exists_reverse_push_of_residual_recovery R (by omega : i.1 + 1 ≤ j.1)
    (le_of_lt (Fin.isLt j)) hzero hpos
  have hadm_k : R.h k.1 v = R.h k.1 u + 1 := by
    cases hop : R.op k.1 (Fin.isLt k) with
    | relabel φ h w ho hres hpre =>
        simp [opFin, pushOn, hop] at hk3
    | push φ h a b ho hres hadm =>
        have hle : a = v ∧ b = u := of_decide_eq_true (by simpa [opFin, pushOn, hop] using hk3)
        have hb_h : R.h k.1 = h := by
          have h' : (R.op k.1 (Fin.isLt k)).beforeh = R.h k.1 := R.hop_beforeh k.1 (Fin.isLt k)
          rw [← h']
          simp [BasicOp.beforeh, hop]
        rcases hle with ⟨ha, hb⟩
        subst a; subst b
        rw [hb_h]
        exact hadm
  have hadm_j : R.h j.1 u = R.h j.1 v + 1 := by
    cases hop : R.opFin j with
    | relabel φ h w ho hres hpre =>
        simp [saturatingPushOn, hop] at hsat_j
    | push φ h a b ho hres hadm =>
        have hle : a = u ∧ b = v := by
          have h := of_decide_eq_true (by simpa [saturatingPushOn, hop] using hsat_j)
          exact ⟨h.1, h.2.1⟩
        have hb_h : R.h j.1 = h := by
          have h' : (R.opFin j).beforeh = R.h j.1 := R.hop_beforeh j.1 (Fin.isLt j)
          rw [← h']
          simp [BasicOp.beforeh, hop]
        rcases hle with ⟨ha, hb⟩
        subst a; subst b
        rw [hb_h]
        exact hadm
  have h_iu_ku : R.h i.1 u ≤ R.h k.1 u := height_mono R (by omega) (by omega) u
  have h_kv_jv : R.h k.1 v ≤ R.h j.1 v := height_mono R (by omega) (by omega) v
  omega

Each edge admits at most 2|V| saturating pushes.


theorem saturating_push_count_bound_on (R : Run V G n) (u v : V) :
    numSaturatingPushesOn R u v ≤ 2 * Fintype.card V := by
  classical
  let S : Finset (Fin n) :=
    (Finset.univ : Finset (Fin n)).filter (fun i => (R.opFin i).saturatingPushOn u v = true)
  have hcard : numSaturatingPushesOn R u v = S.card := by
    rw [numSaturatingPushesOn]
    rw [Finset.sum_boole]
    rfl
  rw [hcard]
  let f : Fin n → ℕ := fun i => R.h i.1 u
  have hf_inj : Set.InjOn f (↑S : Set (Fin n)) := by
    intro a ha b hb hfab
    have ha' : (R.opFin a).saturatingPushOn u v = true := (Finset.mem_filter.mp ha).2
    have hb' : (R.opFin b).saturatingPushOn u v = true := (Finset.mem_filter.mp hb).2
    apply Fin.ext
    apply le_antisymm
    · by_contra hgt
      have hlt : b.1 < a.1 := by omega
      have hst := saturating_height_increase R hlt hb' ha'
      unfold f at hfab
      omega
    · by_contra hgt
      have hlt : a.1 < b.1 := by omega
      have hst := saturating_height_increase R hlt ha' hb'
      unfold f at hfab
      omega
  have hf_range : ∀ a : Fin n, a ∈ S → f a < 2 * Fintype.card V := by
    intro a ha
    have hsat' : (R.opFin a).saturatingPushOn u v = true := (Finset.mem_filter.mp ha).2
    have hoverflow : (R.φ a.1).isOverflowing u := by
      cases hop : R.opFin a with
      | relabel φ h w ho hres hpre =>
          simp [saturatingPushOn, hop] at hsat'
      | push φ h a' b ho hres hadm =>
          have hle : a' = u := by
            have h := of_decide_eq_true (by simpa [saturatingPushOn, hop] using hsat')
            exact h.1
          have hbφ : φ = R.φ a.1 := by
            have h : (R.opFin a).beforeφ = R.φ a.1 := R.hop_beforeφ a.1 (Fin.isLt a)
            simpa [BasicOp.beforeφ, hop] using h
          subst u
          simpa [hbφ] using ho
    have hle := height_le_of_overflowing (R.φ a.1) (R.h a.1) (R.hvalid a.1) u
      hoverflow.1 hoverflow.2.2
    have hV : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
    unfold f
    omega
  calc
    S.card = (S.image f).card := by
      exact (Finset.card_image_iff.mpr hf_inj).symm
    _ ≤ (Finset.range (2 * Fintype.card V)).card := by
      apply Finset.card_le_card
      intro x hx
      rcases Finset.mem_image.mp hx with ⟨a, ha, rfl⟩
      have hlt : f a < 2 * Fintype.card V := hf_range a (by simpa using ha)
      exact Finset.mem_range.mpr hlt
    _ = 2 * Fintype.card V := by simp

A saturating push on (u,v) requires some direction of {u,v} to have positive capacity: either (u,v) itself, or the reverse edge (v,u) (a saturating push may cancel flow on the reverse edge).


lemma saturating_pushOn_imp_cap (R : Run V G n) (u v : V) :
    numSaturatingPushesOn R u v = 0 ∨ 0 < G.c u v ∨ 0 < G.c v u := by
  classical
  by_cases hcap_uv : 0 < G.c u v
  · exact Or.inr (Or.inl hcap_uv)
  · by_cases hcap_vu : 0 < G.c v u
    · exact Or.inr (Or.inr hcap_vu)
    · left
      rw [numSaturatingPushesOn]
      rw [Finset.sum_eq_zero]
      intro i _
      by_cases hsat : (R.opFin i).saturatingPushOn u v = true
      · have hres : (R.φ i.1).residualEdge u v := by
          cases hop : R.opFin i with
          | relabel φ h w ho hres hpre =>
              simp [saturatingPushOn, hop] at hsat
          | push φ h a b ho hres hadm =>
              have hle : a = u ∧ b = v := by
                have h := of_decide_eq_true (by simpa [saturatingPushOn, hop] using hsat)
                exact ⟨h.1, h.2.1⟩
              have hbφ : φ = R.φ i.1 := by
                have h : (R.opFin i).beforeφ = R.φ i.1 := R.hop_beforeφ i.1 (Fin.isLt i)
                simpa [BasicOp.beforeφ, hop] using h
              rcases hle with ⟨ha, hb⟩
              subst a; subst b
              simpa [hbφ] using hres
        have hc_uv_nonneg : 0 ≤ G.c u v := G.hc_nonneg u v
        have hc_vu_nonneg : 0 ≤ G.c v u := G.hc_nonneg v u
        have hc_uv_zero : G.c u v = 0 := le_antisymm (le_of_not_gt hcap_uv) hc_uv_nonneg
        have hc_vu_zero : G.c v u = 0 := le_antisymm (le_of_not_gt hcap_vu) hc_vu_nonneg
        have hcap_vu : (R.φ i.1).f v u ≤ G.c v u := (R.φ i.1).hcapacity v u
        have hskew : (R.φ i.1).f u v = -((R.φ i.1).f v u) := (R.φ i.1).hskew_symm u v
        unfold Preflow.residualEdge Preflow.residualCapacity at hres
        linarith
      · simp [hsat]

The sum of f over univ, restricted by membership in s, equals the sum over s.

try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`
private lemma sum_filter_univ_eq {s : Finset (V × V)} {f : V × V → ℕ} :
    (∑ x : V × V, (if x ∈ s then f x else 0)) = ∑ x ∈ s, f x := by
  classical
  have hfilter : (Finset.univ : Finset (V × V)).filter (fun x => x ∈ s) = s := by
    ext x
    simp
  try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`simpa [hfilter] using (Finset.sum_filter (fun x => x ∈ s) f).symm

The sum of f over univ, restricted by swapped membership in s, equals the sum of f ∘ swap over s.

try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`
private lemma sum_filter_univ_swap_eq {s : Finset (V × V)} {f : V × V → ℕ} :
    (∑ x : V × V, (if x.swap ∈ s then f x else 0)) = ∑ x ∈ s, f x.swap := by
  classical
  have hfilter : (Finset.univ : Finset (V × V)).filter (fun x => x ∈ s) = s := by
    ext x
    simp
  have h1 : (∑ x : V × V, (if x.swap ∈ s then f x else 0)) =
      ∑ x : V × V, (if x ∈ s then f x.swap else 0) := by
    exact Equiv.sum_comp (Equiv.prodComm (α := V) (β := V)) (fun x => (if x ∈ s then f x.swap else 0))
  have h2 : (∑ x : V × V, (if x ∈ s then f x.swap else 0)) = ∑ x ∈ s, f x.swap := by
    try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`simpa [hfilter] using (Finset.sum_filter (fun x => x ∈ s) (fun x => f x.swap)).symm
  rw [h1, h2]

The total number of saturating pushes is at most 4|V|·|E|.


theorem saturating_push_count_bound (R : Run V G n) :
    numSaturatingPushes R ≤ 4 * Fintype.card V * numEdges G := by
  classical
  have hsum : numSaturatingPushes R = ∑ e : V × V, numSaturatingPushesOn R e.1 e.2 := by
    calc
      numSaturatingPushes R = ∑ i : Fin n, (if (R.opFin i).isSaturatingPush then 1 else 0) := rfl
      _ = ∑ i : Fin n, ∑ e : V × V, (if (R.opFin i).saturatingPushOn e.1 e.2 then 1 else 0) := by
          apply Finset.sum_congr rfl
          intro i hi
          exact (BasicOp.sum_saturatingPushOn_eq (R.opFin i)).symm
      _ = ∑ e : V × V, ∑ i : Fin n, (if (R.opFin i).saturatingPushOn e.1 e.2 then 1 else 0) := by
          rw [Finset.sum_comm]
      _ = ∑ e : V × V, numSaturatingPushesOn R e.1 e.2 := rfl
  have hle : (∑ e : V × V, numSaturatingPushesOn R e.1 e.2) ≤
      (∑ e ∈ edgeSet G, numSaturatingPushesOn R e.1 e.2) +
        (∑ e ∈ edgeSet G, numSaturatingPushesOn R e.2 e.1) := by
    calc
      (∑ e : V × V, numSaturatingPushesOn R e.1 e.2) ≤
          ∑ e : V × V, ((if e ∈ edgeSet G then numSaturatingPushesOn R e.1 e.2 else 0) +
            (if e.swap ∈ edgeSet G then numSaturatingPushesOn R e.1 e.2 else 0)) := by
        apply Finset.sum_le_sum
        intro e _
        have h := saturating_pushOn_imp_cap R e.1 e.2
        cases h with
        | inl hz => simp [hz]
        | inr hcap =>
            cases hcap with
            | inl h_uv =>
                have he : e ∈ edgeSet G := Finset.mem_filter.mpr ⟨Finset.mem_univ e, h_uv⟩
                simp [he]
            | inr h_vu =>
                have he : e.swap ∈ edgeSet G := Finset.mem_filter.mpr ⟨Finset.mem_univ e.swap, h_vu⟩
                simp [he]
      _ = (∑ e ∈ edgeSet G, numSaturatingPushesOn R e.1 e.2) +
          (∑ e ∈ edgeSet G, numSaturatingPushesOn R e.2 e.1) := by
        rw [Finset.sum_add_distrib]
        congr 1
        · exact sum_filter_univ_eq
        · exact sum_filter_univ_swap_eq
  calc
    numSaturatingPushes R = ∑ e : V × V, numSaturatingPushesOn R e.1 e.2 := hsum
    _ ≤ (∑ e ∈ edgeSet G, numSaturatingPushesOn R e.1 e.2) +
        (∑ e ∈ edgeSet G, numSaturatingPushesOn R e.2 e.1) := hle
    _ ≤ (∑ e ∈ edgeSet G, (2 * Fintype.card V)) +
        (∑ e ∈ edgeSet G, (2 * Fintype.card V)) := by
        apply Nat.add_le_add
        · apply Finset.sum_le_sum
          intro e _
          exact saturating_push_count_bound_on R e.1 e.2
        · apply Finset.sum_le_sum
          intro e _
          exact saturating_push_count_bound_on R e.2 e.1
    _ = 4 * Fintype.card V * numEdges G := by
      rw [numEdges, edgeSet]
      simp only [Finset.sum_const, nsmul_eq_mul]
      nlinarith

Potential and nonsaturating push count bound

The set of overflowing vertices of a preflow.

noncomputable def overflowSet (φ : Preflow V G) : Finset V :=
  (Finset.univ : Finset V).filter (fun u => φ.isOverflowing u)

The potential Φ = Σ_{overflowing u} h(u).

noncomputable def potential (φ : Preflow V G) (h : V → ℕ) : ℕ :=
  ∑ u ∈ overflowSet φ, h u

Sum of the single-edge skew update over the first argument.


private lemma edgeDelta_sum_first' (δ : ℝ) (u v a : V) :
    (Finset.univ : Finset V).sum (fun x => Flow.edgeDelta δ u v x a) =
      (if a = v then δ else 0) - (if a = u then δ else 0) := by
  unfold Flow.edgeDelta
  rw [Finset.sum_sub_distrib]
  have hf : (Finset.univ : Finset V).sum (fun x => if x = u ∧ a = v then δ else 0) =
      (if a = v then δ else 0) := by
    by_cases hav : a = v
    · subst a; simp
    · simp [hav]
  have hg : (Finset.univ : Finset V).sum (fun x => if x = v ∧ a = u then δ else 0) =
      (if a = u then δ else 0) := by
    by_cases hau : a = u
    · subst a; simp
    · simp [hau]
  rw [hf, hg]

Telescoping: ∑ i in range n, (f (i+1) - f i) = f n - f 0.


private lemma sum_range_sub_eq (f : ℕ → ℤ) (n : ℕ) :
    ∑ i ∈ Finset.range n, (f (i + 1) - f i) = f n - f 0 := by
  induction n with
  | zero => simp
  | succ n ih =>
      rw [Finset.sum_range_succ, ih]
      ring

The potential is bounded by 2|V|².


lemma potential_le (φ : Preflow V G) (h : V → ℕ) (hvalid : IsValidHeight φ h) :
    potential φ h ≤ 2 * Fintype.card V * Fintype.card V := by
  calc
    potential φ h = ∑ u ∈ overflowSet φ, h u := rfl
    _ ≤ ∑ u ∈ overflowSet φ, (2 * Fintype.card V) := by
      apply Finset.sum_le_sum
      intro u hu
      have hoverflow : φ.isOverflowing u := (Finset.mem_filter.mp hu).2
      have hle : h u ≤ 2 * Fintype.card V - 1 :=
        height_le_of_overflowing φ h hvalid u hoverflow.1 hoverflow.2.2
      omega
    _ = (overflowSet φ).card * (2 * Fintype.card V) := by
      simp [Finset.sum_const, This simp argument is unused:
  nsmul_eq_mul

Hint: Omit it from the simp argument list.
  simp [Finset.sum_const,̵ ̵n̵s̵m̵u̵l̵_̵e̵q̵_̵m̵u̵l̵]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`nsmul_eq_mul]
    _ ≤ Fintype.card V * (2 * Fintype.card V) := by
      exact Nat.mul_le_mul_right (2 * Fintype.card V) (Finset.card_le_univ (overflowSet φ))
    _ = 2 * Fintype.card V * Fintype.card V := by rw [mul_comm]

The exact change of the potential under a relabel.


private lemma potential_relabel_eq (φ : Preflow V G) (h : V → ℕ) (u : V)
    (hres : ∃ v : V, φ.residualEdge u v) (hoverflow : φ.isOverflowing u) :
    ((potential φ (relabel φ h u hres) : ℤ) - (potential φ h : ℤ)) =
      ((relabel φ h u hres u : ℕ) : ℤ) - (h u : ℤ) := by
  unfold potential overflowSet
  rw [Nat.cast_sum, Nat.cast_sum]
  rw [← Finset.sum_sub_distrib]
  rw [Finset.sum_eq_single u]
  · intro b hb hbu
    rw [relabel_eq_of_ne φ h u hres hbu]
    simp
  · intro hu
    have : u ∈ (Finset.univ : Finset V).filter (fun u => φ.isOverflowing u) :=
      Finset.mem_filter.mpr ⟨Finset.mem_univ u, hoverflow⟩
    exact (hu this).elim

A push increases the potential by at most 2|V|.

try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`
lemma potential_push_le (φ : Preflow V G) (h : V → ℕ) (u v : V) (hu_ne_s : u ≠ G.s)
    (hres : φ.residualEdge u v) (hadm : h u = h v + 1) (hvalid : IsValidHeight φ h)
    (hoverflow : φ.isOverflowing u) :
    ((potential (push φ u v hu_ne_s hres) h : ℤ) - (potential φ h : ℤ)) ≤ 2 * Fintype.card V := by
  let φ' := push φ u v hu_ne_s hres
  have hsubset : overflowSet φ' ⊆ overflowSet φ ∪ {v} := by
    intro a ha
    have ha' : φ'.isOverflowing a := (Finset.mem_filter.mp ha).2
    by_cases hav : a = v
    · rw [Finset.mem_union]
      right
      try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`simpa [hav]
    · rw [Finset.mem_union]
      left
      apply Finset.mem_filter.mpr
      constructor
      · exact Finset.mem_univ a
      · have hne_s : a ≠ G.s := ha'.1
        have hne_t : a ≠ G.t := ha'.2.1
        have hpos' : 0 < φ'.excess a := ha'.2.2
        have hle_excess : φ'.excess a ≤ φ.excess a := by
          unfold φ' push pushBy Preflow.excess netInflow
          rw [Finset.sum_add_distrib]
          rw [edgeDelta_sum_first' (min (∑ w : V, φ.f w u) (φ.residualCapacity u v)) u v a]
          have hno_add : (if a = v then min (∑ w : V, φ.f w u) (φ.residualCapacity u v) else 0) = 0 := by
            simp [hav]
          rw [hno_add]
          have hnonneg : 0 ≤ (if a = u then min (∑ w : V, φ.f w u) (φ.residualCapacity u v) else 0) := by
            split
            · exact le_min (φ.hexcess_nonneg u hu_ne_s) (le_of_lt hres)
            · simp
          linarith
        exact ⟨hne_s, hne_t, lt_of_lt_of_le hpos' hle_excess⟩
  have hdiff_le : ((potential φ' h : ℤ) - (potential φ h : ℤ)) ≤ (h v : ℤ) := by
    unfold potential
    have hsum_le : (∑ x ∈ overflowSet φ', h x) ≤ (∑ x ∈ overflowSet φ, h x) + h v := by
      have hle_subset : (∑ x ∈ overflowSet φ', h x) ≤ ∑ x ∈ overflowSet φ ∪ {v}, h x :=
        Finset.sum_le_sum_of_subset_of_nonneg hsubset (fun _ _ _ => Nat.zero_le _)
      have hle_union : (∑ x ∈ overflowSet φ ∪ {v}, h x) ≤ (∑ x ∈ overflowSet φ, h x) + h v := by
        have hdecomp : (∑ x ∈ overflowSet φ ∪ {v}, h x) =
            (∑ x ∈ overflowSet φ, h x) + (∑ x ∈ ({v} : Finset V) \ overflowSet φ, h x) := by
          rw [show overflowSet φ ∪ {v} = overflowSet φ ∪ (({v} : Finset V) \ overflowSet φ) by
            ext x
            by_cases hx : x ∈ overflowSet φ <;> simp [hx]]
          rw [Finset.sum_union]
          exact Finset.disjoint_sdiff
        have hle_singleton : (∑ x ∈ ({v} : Finset V) \ overflowSet φ, h x) ≤ h v := by
          have hsub : (∑ x ∈ ({v} : Finset V) \ overflowSet φ, h x) ≤ ∑ x ∈ ({v} : Finset V), h x :=
            Finset.sum_le_sum_of_subset_of_nonneg Finset.sdiff_subset (fun _ _ _ => Nat.zero_le _)
          simpa using hsub
        rw [hdecomp]
        exact Nat.add_le_add_left hle_singleton (∑ x ∈ overflowSet φ, h x)
      exact le_trans hle_subset hle_union
    have hz : ((∑ x ∈ overflowSet φ', h x : ℕ) : ℤ) ≤ ((∑ x ∈ overflowSet φ, h x : ℕ) : ℤ) + (h v : ℤ) := by
      exact_mod_cast hsum_le
    omega
  have hv_le : (h v : ℤ) ≤ 2 * Fintype.card V := by
    have hu_le : h u ≤ 2 * Fintype.card V - 1 :=
      height_le_of_overflowing φ h hvalid u hoverflow.1 hoverflow.2.2
    have hV : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
    have hadm' : (h u : ℤ) = (h v : ℤ) + 1 := by omega
    have hu_le_z : (h u : ℤ) ≤ (2 * Fintype.card V : ℤ) := by
      have h' : h u ≤ 2 * Fintype.card V := by omega
      exact_mod_cast h'
    nlinarith
  nlinarith

A nonsaturating push decreases the potential by at least one.

try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`
lemma potential_nonsaturating_push_le (φ : Preflow V G) (h : V → ℕ) (u v : V)
    (hu_ne_s : u ≠ G.s) (hres : φ.residualEdge u v) (hadm : h u = h v + 1)
    (hoverflow : φ.isOverflowing u) (hnonsat : φ.excess u < φ.residualCapacity u v) :
    ((potential (push φ u v hu_ne_s hres) h : ℤ) - (potential φ h : ℤ)) ≤ -1 := by
  let φ' := push φ u v hu_ne_s hres
  have hu_not : ¬ φ'.isOverflowing u := by
    intro h
    have hpos : 0 < φ'.excess u := h.2.2
    have hexcess : φ'.excess u = 0 := by
      unfold φ' push pushBy Preflow.excess netInflow
      rw [Finset.sum_add_distrib]
      rw [edgeDelta_sum_first' (min (∑ w : V, φ.f w u) (φ.residualCapacity u v)) u v u]
      have hmin : min (∑ w : V, φ.f w u) (φ.residualCapacity u v) = ∑ w : V, φ.f w u := by
        apply min_eq_left
        exact le_of_lt hnonsat
      rw [hmin]
      simp [residualEdge_ne φ hres]
    linarith
  have hsubset : overflowSet φ' ⊆ (overflowSet φ \ {u}) ∪ {v} := by
    intro a ha
    have ha' : φ'.isOverflowing a := (Finset.mem_filter.mp ha).2
    by_cases hav : a = v
    · rw [Finset.mem_union]
      right
      try 'simp' instead of 'simpa'

Note: This linter can be disabled with `set_option linter.unnecessarySimpa false`simpa [hav]
    · rw [Finset.mem_union]
      left
      apply Finset.mem_sdiff.mpr
      constructor
      · apply Finset.mem_filter.mpr
        constructor
        · exact Finset.mem_univ a
        · have hne_s : a ≠ G.s := ha'.1
          have hne_t : a ≠ G.t := ha'.2.1
          have hpos' : 0 < φ'.excess a := ha'.2.2
          have hle_excess : φ'.excess a ≤ φ.excess a := by
            unfold φ' push pushBy Preflow.excess netInflow
            rw [Finset.sum_add_distrib]
            rw [edgeDelta_sum_first' (min (∑ w : V, φ.f w u) (φ.residualCapacity u v)) u v a]
            have hno_add : (if a = v then min (∑ w : V, φ.f w u) (φ.residualCapacity u v) else 0) = 0 := by
              simp [hav]
            rw [hno_add]
            have hnonneg : 0 ≤ (if a = u then min (∑ w : V, φ.f w u) (φ.residualCapacity u v) else 0) := by
              split
              · exact le_min (φ.hexcess_nonneg u hu_ne_s) (le_of_lt hres)
              · simp
            linarith
          exact ⟨hne_s, hne_t, lt_of_lt_of_le hpos' hle_excess⟩
      · intro hau
        apply hu_not
        exact (Finset.mem_singleton.mp hau) ▸ ha'
  have hu_mem : u ∈ overflowSet φ := Finset.mem_filter.mpr ⟨Finset.mem_univ u, hoverflow⟩
  have hdiff_le : ((potential φ' h : ℤ) - (potential φ h : ℤ)) ≤ -1 := by
    unfold potential
    have hsum_le : (∑ x ∈ overflowSet φ', h x) + h u ≤ (∑ x ∈ overflowSet φ, h x) + h v := by
      have hle_subset : (∑ x ∈ overflowSet φ', h x) ≤ ∑ x ∈ (overflowSet φ \ {u}) ∪ {v}, h x :=
        Finset.sum_le_sum_of_subset_of_nonneg hsubset (fun _ _ _ => Nat.zero_le _)
      have hle_add : (∑ x ∈ overflowSet φ', h x) + h u ≤
          (∑ x ∈ (overflowSet φ \ {u}) ∪ {v}, h x) + h u :=
        Nat.add_le_add_right hle_subset (h u)
      have hle_union : (∑ x ∈ (overflowSet φ \ {u}) ∪ {v}, h x) ≤
          (∑ x ∈ overflowSet φ \ {u}, h x) + h v := by
        have hdecomp : (∑ x ∈ (overflowSet φ \ {u}) ∪ {v}, h x) =
            (∑ x ∈ overflowSet φ \ {u}, h x) + (∑ x ∈ ({v} : Finset V) \ (overflowSet φ \ {u}), h x) := by
          rw [show (overflowSet φ \ {u}) ∪ {v} =
              (overflowSet φ \ {u}) ∪ (({v} : Finset V) \ (overflowSet φ \ {u})) by
            ext x
            by_cases hx : x ∈ overflowSet φ \ {u} <;> simp [hx]]
          rw [Finset.sum_union]
          exact Finset.disjoint_sdiff
        have hle_singleton : (∑ x ∈ ({v} : Finset V) \ (overflowSet φ \ {u}), h x) ≤ h v := by
          have hsub : (∑ x ∈ ({v} : Finset V) \ (overflowSet φ \ {u}), h x) ≤
              ∑ x ∈ ({v} : Finset V), h x :=
            Finset.sum_le_sum_of_subset_of_nonneg Finset.sdiff_subset (fun _ _ _ => Nat.zero_le _)
          simpa using hsub
        rw [hdecomp]
        exact Nat.add_le_add_left hle_singleton (∑ x ∈ overflowSet φ \ {u}, h x)
      have hsum_sdiff : (∑ x ∈ overflowSet φ \ {u}, h x) + h u = ∑ x ∈ overflowSet φ, h x := by
        simpa using (Finset.sum_sdiff (Finset.singleton_subset_iff.mpr hu_mem) :
          (∑ x ∈ overflowSet φ \ {u}, h x) + (∑ x ∈ ({u} : Finset V), h x) = ∑ x ∈ overflowSet φ, h x)
      have hle_mid : (∑ x ∈ (overflowSet φ \ {u}) ∪ {v}, h x) + h u ≤
          (∑ x ∈ overflowSet φ, h x) + h v := by
        omega
      exact le_trans hle_add hle_mid
    have hz : ((∑ x ∈ overflowSet φ', h x : ℕ) : ℤ) + (h u : ℤ) ≤
        ((∑ x ∈ overflowSet φ, h x : ℕ) : ℤ) + (h v : ℤ) := by
      exact_mod_cast hsum_le
    have hadm' : (h u : ℤ) = (h v : ℤ) + 1 := by omega
    omega
  exact hdiff_le

The potential increases across a single step by at most the total height increase plus 2|V| times the number of saturating pushes, minus one per nonsaturating push.


private lemma potential_step_bound_tight (R : Run V G n) (i : Fin n) :
    ((potential (R.φ (i.1 + 1)) (R.h (i.1 + 1)) : ℤ) - (potential (R.φ i.1) (R.h i.1) : ℤ)) ≤
      (∑ x : V, (((R.h (i.1 + 1) x : ℕ) : ℤ) - (R.h i.1 x : ℤ))) +
      (2 * Fintype.card V : ℤ) * (if (R.opFin i).isSaturatingPush then 1 else 0) -
      (if (R.opFin i).isNonsaturatingPush then 1 else 0) := by
  cases hop : R.opFin i with
  | relabel φ h u ho hres hpre =>
      have hb_φ : φ = R.φ i.1 := by
        have h' : (R.opFin i).beforeφ = R.φ i.1 := R.hop_beforeφ i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.beforeφ, hop]
      have hb_h : h = R.h i.1 := by
        have h' : (R.opFin i).beforeh = R.h i.1 := R.hop_beforeh i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.beforeh, hop]
      have hr_φ : R.φ (i.1 + 1) = R.φ i.1 := by
        have h' : (R.opFin i).resultφ = R.φ (i.1 + 1) := R.hop_resultφ i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.resultφ, hop, hb_φ]
      let hres' : ∃ v : V, (R.φ i.1).residualEdge u v := by simpa [hb_φ] using hres
      have hr_h : R.h (i.1 + 1) = Chapter26.relabel (R.φ i.1) (R.h i.1) u hres' := by
        have h' : (R.opFin i).resulth = R.h (i.1 + 1) := R.hop_resulth i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.resulth, hop, hb_φ, hb_h]
      have hdiff := potential_relabel_eq (R.φ i.1) (R.h i.1) u hres' (by simpa [hb_φ] using ho)
      have hsum_eq : (∑ w : V, (((Chapter26.relabel (R.φ i.1) (R.h i.1) u hres' w : ℕ) : ℤ) - (R.h i.1 w : ℤ))) =
          ((Chapter26.relabel (R.φ i.1) (R.h i.1) u hres' u : ℕ) : ℤ) - (R.h i.1 u : ℤ) := by
        rw [Finset.sum_eq_single u]
        · intro b _ hbu
          rw [relabel_eq_of_ne (R.φ i.1) (R.h i.1) u hres' hbu]
          simp
        · intro hu
          simp at hu
      rw [hr_φ, hr_h, hdiff, hsum_eq]
      simp [isSaturatingPush, isNonsaturatingPush, This simp argument is unused:
  hop

Hint: Omit it from the simp argument list.
  simp [isSaturatingPush, isNonsaturatingPush,̵ ̵h̵o̵p̵]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`hop]
  | push φ h u v ho hres hadm =>
      have hb_φ : φ = R.φ i.1 := by
        have h' : (R.opFin i).beforeφ = R.φ i.1 := R.hop_beforeφ i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.beforeφ, hop]
      have hb_h : h = R.h i.1 := by
        have h' : (R.opFin i).beforeh = R.h i.1 := R.hop_beforeh i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.beforeh, hop]
      have hr_φ : R.φ (i.1 + 1) = Chapter26.push (R.φ i.1) u v (by simpa [hb_φ] using ho.1)
          (by simpa [hb_φ] using hres) := by
        have h' : (R.opFin i).resultφ = R.φ (i.1 + 1) := R.hop_resultφ i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.resultφ, hop, hb_φ]
      have hr_h : R.h (i.1 + 1) = R.h i.1 := by
        have h' : (R.opFin i).resulth = R.h (i.1 + 1) := R.hop_resulth i.1 (Fin.isLt i)
        rw [← h']
        simp [BasicOp.resulth, hop, hb_h]
      have hsum_zero : (∑ w : V, (((R.h i.1 w : ℕ) : ℤ) - (R.h i.1 w : ℤ))) = 0 := by
        simp
      by_cases hsat : φ.residualCapacity u v ≤ φ.excess u
      · have hle := potential_push_le (R.φ i.1) (R.h i.1) u v (by simpa [hb_φ] using ho.1)
            (by simpa [hb_φ] using hres) (by simpa [hb_h] using hadm) (R.hvalid i.1)
            (by simpa [hb_φ] using ho)
        have hnot_lt : ¬ φ.excess u < φ.residualCapacity u v := not_lt_of_ge hsat
        rw [hr_φ, hr_h, hsum_zero]
        simp [isSaturatingPush, isNonsaturatingPush, This simp argument is unused:
  hop

Hint: Omit it from the simp argument list.
  simp [isSaturatingPush, isNonsaturatingPush, ho̵p̵,̵ ̵h̵sat, hnot_lt]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`hop, hsat, hnot_lt]
        nlinarith [hle]
      · have hlt : φ.excess u < φ.residualCapacity u v := lt_of_not_ge hsat
        have hle := potential_nonsaturating_push_le (R.φ i.1) (R.h i.1) u v (by simpa [hb_φ] using ho.1)
            (by simpa [hb_φ] using hres) (by simpa [hb_h] using hadm) (by simpa [hb_φ] using ho)
            (by simpa [hb_φ] using hlt)
        rw [hr_φ, hr_h, hsum_zero]
        simp [isSaturatingPush, isNonsaturatingPush, This simp argument is unused:
  hop

Hint: Omit it from the simp argument list.
  simp [isSaturatingPush, isNonsaturatingPush, ho̵p̵,̵ ̵h̵sat, hlt]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`hop, hsat, hlt]
        nlinarith [hle]

The total height increase across a run is at most 2|V| per vertex.


private lemma height_le_add_bound : ∀ (n : ℕ) (R : Run V G n) (u : V),
    R.h n u ≤ R.h 0 u + 2 * Fintype.card V := by
  intro n
  induction n with
  | zero =>
      intro R u
      omega
  | succ m ih =>
      intro R u
      let R' : Run V G m := {
        φ := R.φ
        h := R.h
        hvalid := R.hvalid
        op := fun i hi => R.op i (Nat.lt_trans hi (Nat.lt_succ_self m))
        hop_beforeφ := fun i hi => R.hop_beforeφ i (Nat.lt_trans hi (Nat.lt_succ_self m))
        hop_beforeh := fun i hi => R.hop_beforeh i (Nat.lt_trans hi (Nat.lt_succ_self m))
        hop_resultφ := fun i hi => R.hop_resultφ i (Nat.lt_trans hi (Nat.lt_succ_self m))
        hop_resulth := fun i hi => R.hop_resulth i (Nat.lt_trans hi (Nat.lt_succ_self m)) }
      have hb := ih R' u
      change R.h m u ≤ R.h 0 u + 2 * Fintype.card V at hb
      cases hop : R.op m (Nat.lt_succ_self m) with
      | relabel φ h w ho hres hpre =>
          by_cases hwu : w = u
          · subst u
            have hoverflow : (R.φ (m + 1)).isOverflowing w := by
              have hrφ : R.φ (m + 1) = φ := by
                simpa [BasicOp.resultφ, hop] using
                  (R.hop_resultφ m (Nat.lt_succ_self m)).symm
              rw [hrφ]
              exact ho
            have hle' := height_le_of_overflowing (R.φ (m + 1)) (R.h (m + 1)) (R.hvalid (m + 1)) w
              hoverflow.1 hoverflow.2.2
            omega
          · have hstep : R.h (m + 1) u = R.h m u := by
              rw [← R.hop_resulth m (Nat.lt_succ_self m), ← R.hop_beforeh m (Nat.lt_succ_self m)]
              simp [BasicOp.resulth, BasicOp.beforeh, hop, relabel_eq_of_ne φ h w hres (Ne.symm hwu)]
            omega
      | push φ h a b ho hres hadm =>
          have hstep : R.h (m + 1) u = R.h m u := by
            rw [← R.hop_resulth m (Nat.lt_succ_self m), ← R.hop_beforeh m (Nat.lt_succ_self m)]
            simp [BasicOp.resulth, BasicOp.beforeh, hop]
          omega

The potential telescopes over a run.

private lemma potential_telescope (R : Run V G n) :
    ((potential (R.φ n) (R.h n) : ℤ) = (potential (R.φ 0) (R.h 0) : ℤ) +
      ∑ i ∈ Finset.range n, (((potential (R.φ (i + 1)) (R.h (i + 1)) : ℤ) -
        (potential (R.φ i) (R.h i) : ℤ)))) := by
  have h := sum_range_sub_eq (fun i => (potential (R.φ i) (R.h i) : ℤ)) n
  omega

The total number of nonsaturating pushes is bounded by O(|V|²(|V|+|E|)).


theorem nonsaturating_push_count_bound (R : Run V G n) :
    numNonsaturatingPushes R ≤ 12 * Fintype.card V * Fintype.card V * (Fintype.card V + numEdges G) := by
  classical
  let Vc := Fintype.card V
  have htel := potential_telescope R
  have hnonneg : 0 ≤ (potential (R.φ n) (R.h n) : ℤ) := by
    exact Int.natCast_nonneg (potential (R.φ n) (R.h n))
  have hinit_ℕ : potential (R.φ 0) (R.h 0) ≤ 2 * Vc * Vc := by
    exact potential_le (R.φ 0) (R.h 0) (R.hvalid 0)
  have hrel_inc_ℕ : (∑ u : V, (R.h n u - R.h 0 u)) ≤ 2 * Vc * Vc := by
    have hbound : ∀ u, R.h n u - R.h 0 u ≤ 2 * Fintype.card V := by
      intro u
      have h : R.h n u ≤ R.h 0 u + 2 * Fintype.card V := height_le_add_bound n R u
      omega
    calc
      (∑ u : V, (R.h n u - R.h 0 u)) ≤ ∑ u : V, (2 * Fintype.card V) := by
        apply Finset.sum_le_sum
        intro u _
        exact hbound u
      _ = Fintype.card V * (2 * Fintype.card V) := by simp [Finset.sum_const, This simp argument is unused:
  nsmul_eq_mul

Hint: Omit it from the simp argument list.
  simp [Finset.sum_const,̵ ̵n̵s̵m̵u̵l̵_̵e̵q̵_̵m̵u̵l̵]

Note: This linter can be disabled with `set_option linter.unusedSimpArgs false`nsmul_eq_mul]
      _ = 2 * Vc * Vc := by dsimp [Vc]; rw [mul_comm]
  have hsum_le : (∑ i ∈ Finset.range n,
      (((potential (R.φ (i + 1)) (R.h (i + 1)) : ℤ) - (potential (R.φ i) (R.h i) : ℤ)))) ≤
      (∑ u : V, (((R.h n u : ℕ) : ℤ) - (R.h 0 u : ℤ))) +
        (2 * Vc : ℤ) * (numSaturatingPushes R : ℤ) -
        (numNonsaturatingPushes R : ℤ) := by
    have hfin : (∑ i : Fin n,
        ((potential (R.φ (i.1 + 1)) (R.h (i.1 + 1)) : ℤ) - (potential (R.φ i.1) (R.h i.1) : ℤ))) ≤
        (∑ u : V, (((R.h n u : ℕ) : ℤ) - (R.h 0 u : ℤ))) +
          (2 * Vc : ℤ) * (numSaturatingPushes R : ℤ) -
          (numNonsaturatingPushes R : ℤ) := by
      calc
        (∑ i : Fin n,
          ((potential (R.φ (i.1 + 1)) (R.h (i.1 + 1)) : ℤ) - (potential (R.φ i.1) (R.h i.1) : ℤ))) ≤
          ∑ i : Fin n, ((∑ u : V, (((R.h (i.1 + 1) u : ℕ) : ℤ) - (R.h i.1 u : ℤ))) +
            (2 * Vc : ℤ) * (if (R.opFin i).isSaturatingPush then 1 else 0) -
            (if (R.opFin i).isNonsaturatingPush then 1 else 0)) := by
            apply Finset.sum_le_sum
            intro i _
            exact potential_step_bound_tight R i
        _ = (∑ u : V, (((R.h n u : ℕ) : ℤ) - (R.h 0 u : ℤ))) +
            (2 * Vc : ℤ) * (∑ i : Fin n, (if (R.opFin i).isSaturatingPush then 1 else 0)) -
            (∑ i : Fin n, (if (R.opFin i).isNonsaturatingPush then 1 else 0)) := by
            rw [Finset.sum_sub_distrib, Finset.sum_add_distrib]
            congr 1
            congr 1
            · rw [Finset.sum_comm]
              apply Finset.sum_congr rfl
              intro u _
              have htel_u := sum_range_sub_eq (fun i => (R.h i u : ℤ)) n
              rw [Finset.sum_fin_eq_sum_range]
              exact (Finset.sum_congr rfl (fun x hx => by
                simp [Finset.mem_range.mp hx])).trans htel_u
            · rw [← Finset.mul_sum]
        _ = (∑ u : V, (((R.h n u : ℕ) : ℤ) - (R.h 0 u : ℤ))) +
            (2 * Vc : ℤ) * (numSaturatingPushes R : ℤ) -
            (numNonsaturatingPushes R : ℤ) := by
            simp [numSaturatingPushes, numNonsaturatingPushes]
    have hfin' : (∑ i ∈ Finset.range n,
        ((potential (R.φ (i + 1)) (R.h (i + 1)) : ℤ) - (potential (R.φ i) (R.h i) : ℤ))) =
        (∑ i : Fin n,
          ((potential (R.φ (i.1 + 1)) (R.h (i.1 + 1)) : ℤ) - (potential (R.φ i.1) (R.h i.1) : ℤ))) := by
      rw [Finset.sum_fin_eq_sum_range]
      apply Finset.sum_congr rfl
      intro i hi
      simp [Finset.mem_range.mp hi]
    rw [hfin']
    exact hfin
  have hsum_cast : (∑ u : V, (((R.h n u : ℕ) : ℤ) - (R.h 0 u : ℤ))) =
      ((∑ u : V, (R.h n u - R.h 0 u) : ℕ) : ℤ) := by
    rw [Nat.cast_sum]
    apply Finset.sum_congr rfl
    intro u _
    have hmono : R.h 0 u ≤ R.h n u := height_mono R (Nat.zero_le n) (Nat.le_refl n) u
    exact (Int.ofNat_sub hmono).symm
  have hmain_ℤ : (numNonsaturatingPushes R : ℤ) ≤
      (potential (R.φ 0) (R.h 0) : ℤ) +
        (∑ u : V, (((R.h n u : ℕ) : ℤ) - (R.h 0 u : ℤ))) +
        (2 * Vc : ℤ) * (numSaturatingPushes R : ℤ) := by
    have hsum' := hsum_le
    have : (potential (R.φ 0) (R.h 0) : ℤ) + (∑ i ∈ Finset.range n,
        ((potential (R.φ (i + 1)) (R.h (i + 1)) : ℤ) - (potential (R.φ i) (R.h i) : ℤ))) ≥ 0 := by
      simpa [htel] using hnonneg
    omega
  have hmain_ℕ : numNonsaturatingPushes R ≤ 2 * Vc * Vc + (∑ u : V, (R.h n u - R.h 0 u)) +
      2 * Vc * numSaturatingPushes R := by
    have hinit_z : (potential (R.φ 0) (R.h 0) : ℤ) ≤ ((2 * Vc * Vc : ℕ) : ℤ) := by
      exact_mod_cast hinit_ℕ
    have hz : (numNonsaturatingPushes R : ℤ) ≤
        ((2 * Vc * Vc + (∑ u : V, (R.h n u - R.h 0 u)) + 2 * Vc * numSaturatingPushes R : ℕ) : ℤ) := by
      rw [hsum_cast] at hmain_ℤ
      have hcast : ((2 * Vc * numSaturatingPushes R : ℕ) : ℤ) = (2 * (Vc : ℤ)) * (numSaturatingPushes R : ℤ) := by
        norm_num
      have hcast_add : ((2 * Vc * Vc + (∑ u : V, (R.h n u - R.h 0 u)) + 2 * Vc * numSaturatingPushes R : ℕ) : ℤ) =
          ((2 * Vc * Vc : ℕ) : ℤ) + ((∑ u : V, (R.h n u - R.h 0 u) : ℕ) : ℤ) + ((2 * Vc * numSaturatingPushes R : ℕ) : ℤ) := by
        simp only [Nat.cast_add]
      nlinarith [hmain_ℤ, hinit_z, hcast, hcast_add]
    exact_mod_cast hz
  have hsat := saturating_push_count_bound R
  have hV : 1 ≤ Vc := Fintype.card_pos_iff.mpr ⟨G.s⟩
  dsimp [Vc] at hmain_ℕ hrel_inc_ℕ hsat ⊢
  nlinarith [hmain_ℕ, hrel_inc_ℕ, hsat, hV]

Every step is exactly one of relabel, saturating push, or nonsaturating push.


theorem op_count_decomp (R : Run V G n) :
    n = numRelabels R + numSaturatingPushes R + numNonsaturatingPushes R := by
  have hclass : (∑ i : Fin n, (1 : ℕ)) =
      ∑ i : Fin n, ((if (R.opFin i).isRelabel then 1 else 0) +
         (if (R.opFin i).isSaturatingPush then 1 else 0) +
         (if (R.opFin i).isNonsaturatingPush then 1 else 0)) := by
    apply Finset.sum_congr rfl
    intro i _
    exact (BasicOp.classification (R.opFin i)).symm
  calc
    n = ∑ i : Fin n, (1 : ℕ) := by simp
    _ = ∑ i : Fin n, ((if (R.opFin i).isRelabel then 1 else 0) +
           (if (R.opFin i).isSaturatingPush then 1 else 0) +
           (if (R.opFin i).isNonsaturatingPush then 1 else 0)) := hclass
    _ = numRelabels R + numSaturatingPushes R + numNonsaturatingPushes R := by
        rw [Finset.sum_add_distrib, Finset.sum_add_distrib]
        simp [numRelabels, numSaturatingPushes, numNonsaturatingPushes]

The combined O(V²E) bound on the number of basic operations of the generic push-relabel algorithm.


theorem generic_step_count_bound (R : Run V G n) :
    n ≤ 12 * Fintype.card V * Fintype.card V * Fintype.card V +
        12 * Fintype.card V * Fintype.card V * numEdges G +
        4 * Fintype.card V * numEdges G + 4 * Fintype.card V * Fintype.card V := by
  have hdecomp : n = numRelabels R + numSaturatingPushes R + numNonsaturatingPushes R :=
    op_count_decomp R
  rw [hdecomp]
  have hr : numRelabels R ≤ 2 * Fintype.card V * Fintype.card V := relabel_count_bound R
  have hs : numSaturatingPushes R ≤ 4 * Fintype.card V * numEdges G := saturating_push_count_bound R
  have hn : numNonsaturatingPushes R ≤ 12 * Fintype.card V * Fintype.card V *
      (Fintype.card V + numEdges G) := nonsaturating_push_count_bound R
  nlinarith

end Run

The relabel-to-front discharge order

namespace BasicOp

The active vertex of a basic operation: the relabeled vertex, or the source of the push.

def opVertex : BasicOp V G → V
  | .relabel _ _ u _ _ _ => u
  | .push _ _ u _ _ _ _ => u

end BasicOp

The number of directed edges is at most |V|².


theorem numEdges_le_card_mul_card (G : FlowNetwork V) :
    numEdges G ≤ Fintype.card V * Fintype.card V := by
  unfold numEdges edgeSet
  calc
    ((Finset.univ : Finset (V × V)).filter (fun e => 0 < G.c e.1 e.2)).card
        ≤ (Finset.univ : Finset (V × V)).card := Finset.card_le_card (Finset.filter_subset _ _)
    _ = Fintype.card V * Fintype.card V := by
        rw [Finset.card_univ, Fintype.card_prod]

A relabel-to-front run is a run of the generic push-relabel algorithm that respects the discharge discipline of CLRS §26.5. The DISCHARGE procedure walks current[u] through a per-vertex neighbor list N[u] and, on exhausting it, relabels u and moves it to the front of the list L. The observable consequence of that list discipline is that between two relabel operations no vertex is the source of more than one nonsaturating push, which is exactly the condition recorded here. (A nonsaturating push is the final operation of a DISCHARGE call, so the number of nonsaturating pushes equals the number of DISCHARGE calls.)

The underlying generic run.

The discharge discipline: between two relabels, no vertex is the source of more than one nonsaturating push.

              structure RelabelToFrontRun (V : Type u) [Fintype V] [DecidableEq V]
    (G : FlowNetwork V) (n : ℕ) where  run : Run V G n  discharge_discipline :
    ∀ ⦃i j : ℕ⦄ (hi : i < n) (hj : j < n) (Variable name `hij` is not explicitly referenced.

The binding can be removed (if unused) or named `_` (if used implicitly).

Note: This linter can be disabled with `set_option linter.unusedVariables false`hij : i < j),
      (run.op i hi).isNonsaturatingPush = true →
      (run.op j hj).isNonsaturatingPush = true →
      (∀ k (hk : k < n), i < k → k < j → (run.op k hk).isRelabel = false) →
      BasicOp.opVertex (run.op i hi) ≠ BasicOp.opVertex (run.op j hj)

namespace RelabelToFrontRunvariable {V : Type u} [Fintype V] [DecidableEq V] {G : FlowNetwork V} {n : ℕ}

The set of relabel operations occurring strictly before index i.

noncomputable def relabelsBeforeSet (R : Run V G n) (i : Fin n) : Finset (Fin n) :=
  (Finset.univ : Finset (Fin n)).filter (fun k => (k : ℕ) < i.1 ∧ (R.opFin k).isRelabel = true)

The number of relabel operations occurring strictly before index i.

noncomputable def relabelsBefore (R : Run V G n) (i : Fin n) : ℕ :=
  (relabelsBeforeSet R i).card

relabelsBefore counts a subset of all relabels, so it is at most the total relabel count.


lemma relabelsBefore_le_numRelabels (R : Run V G n) (i : Fin n) :
    relabelsBefore R i ≤ Run.numRelabels R := by
  unfold relabelsBefore relabelsBeforeSet
  rw [Run.numRelabels, Finset.sum_boole]
  apply Finset.card_le_card
  intro k hk
  exact Finset.mem_filter.mpr ⟨Finset.mem_univ k, (Finset.mem_filter.mp hk).2.2⟩

The before-set is monotone in the index.

lemma relabelsBeforeSet_mono (R : Run V G n) {i j : Fin n} (hij : i.1 ≤ j.1) :
    relabelsBeforeSet R i ⊆ relabelsBeforeSet R j := by
  intro k hk
  have hk' := Finset.mem_filter.mp hk
  exact Finset.mem_filter.mpr ⟨Finset.mem_univ k, ⟨lt_of_lt_of_le hk'.2.1 hij, hk'.2.2⟩⟩

If i < j have the same relabelsBefore value, no relabel occurs strictly between them.


lemma no_relabel_between_of_relabelsBefore_eq (R : Run V G n) {i j : Fin n}
    (hij : i.1 < j.1) (h : relabelsBefore R i = relabelsBefore R j) (k : Fin n)
    (hik : i.1 < k.1) (hkj : k.1 < j.1) :
    (R.opFin k).isRelabel = false := by
  by_cases hkrel : (R.opFin k).isRelabel = true
  · have hk_in_j : k ∈ relabelsBeforeSet R j := by
      exact Finset.mem_filter.mpr ⟨Finset.mem_univ k, ⟨hkj, hkrel⟩⟩
    have hk_not_in_i : k ∉ relabelsBeforeSet R i := by
      intro hkin
      have hlt := (Finset.mem_filter.mp hkin).2.1
      omega
    have hsubset : relabelsBeforeSet R i ⊆ relabelsBeforeSet R j :=
      relabelsBeforeSet_mono R (Nat.le_of_lt hij)
    have hproper : relabelsBeforeSet R i ⊂ relabelsBeforeSet R j :=
      ⟨hsubset, fun hsup => hk_not_in_i (hsup hk_in_j)⟩
    have hlt_card : relabelsBefore R i < relabelsBefore R j := by
      unfold relabelsBefore
      exact Finset.card_lt_card hproper
    omega
  · have hfalse : (R.opFin k).isRelabel = false := by
      cases hb : (R.opFin k).isRelabel <;> simp_all
    exact hfalse

Between two relabels, two nonsaturating pushes with equal relabelsBefore values discharge distinct vertices, so equal vertices force equal indices.


lemma opVertex_inj_of_nonsat (R : RelabelToFrontRun V G n) {i j : Fin n}
    (hi : (R.run.opFin i).isNonsaturatingPush = true)
    (hj : (R.run.opFin j).isNonsaturatingPush = true)
    (hrb : relabelsBefore R.run i = relabelsBefore R.run j)
    (hvertex : BasicOp.opVertex (R.run.opFin i) = BasicOp.opVertex (R.run.opFin j)) :
    i = j := by
  by_cases hij : i.1 = j.1
  · exact Fin.ext hij
  · exfalso
    have hlt : i.1 < j.1 ∨ j.1 < i.1 := by omega
    rcases hlt with hlt | hlt
    · have hno := no_relabel_between_of_relabelsBefore_eq R.run hlt hrb
      have hdisc := R.discharge_discipline (i := i.1) (j := j.1) (Fin.isLt i) (Fin.isLt j) hlt hi hj
        (fun k hk hik hkj => hno ⟨k, hk⟩ (by simpa using hik) (by simpa using hkj))
      exact hdisc hvertex
    · have hrb' : relabelsBefore R.run j = relabelsBefore R.run i := hrb.symm
      have hno := no_relabel_between_of_relabelsBefore_eq R.run hlt hrb'
      have hdisc := R.discharge_discipline (i := j.1) (j := i.1) (Fin.isLt j) (Fin.isLt i) hlt hj hi
        (fun k hk hik hkj => hno ⟨k, hk⟩ (by simpa using hik) (by simpa using hkj))
      exact hdisc hvertex.symm

The relabel-to-front discharge order bounds the number of nonsaturating pushes by (|V|·(relabels + 1)), i.e. O(V³).


theorem nonsaturating_push_count_bound (R : RelabelToFrontRun V G n) :
    Run.numNonsaturatingPushes R.run ≤ (Run.numRelabels R.run + 1) * Fintype.card V := by
  classical
  let Rf := R.run
  let S : Finset (Fin n) :=
    (Finset.univ : Finset (Fin n)).filter (fun i => (Rf.opFin i).isNonsaturatingPush = true)
  have hS : Run.numNonsaturatingPushes Rf = S.card := by
    rw [Run.numNonsaturatingPushes, Finset.sum_boole]
    rfl
  rw [hS]
  let f : Fin n → ℕ × V := fun i => (relabelsBefore Rf i, BasicOp.opVertex (Rf.opFin i))
  have hf_inj : Set.InjOn f (↑S : Set (Fin n)) := by
    intro i hi j hj hfij
    have hi' : (Rf.opFin i).isNonsaturatingPush = true := (Finset.mem_filter.mp hi).2
    have hj' : (Rf.opFin j).isNonsaturatingPush = true := (Finset.mem_filter.mp hj).2
    have hrb : relabelsBefore Rf i = relabelsBefore Rf j := by
      exact congrArg Prod.fst hfij
    have hv : BasicOp.opVertex (Rf.opFin i) = BasicOp.opVertex (Rf.opFin j) := by
      exact congrArg Prod.snd hfij
    exact opVertex_inj_of_nonsat R hi' hj' hrb hv
  have hcard_image : S.card = (S.image f).card := by
    exact (Finset.card_image_iff.mpr hf_inj).symm
  calc
    S.card = (S.image f).card := hcard_image
    _ ≤ ((Finset.range (Run.numRelabels Rf + 1)) ×ˢ (Finset.univ : Finset V)).card := by
        apply Finset.card_le_card
        intro x hx
        rcases Finset.mem_image.mp hx with ⟨i, hiS, hxi⟩
        rw [← hxi]
        exact Finset.mem_product.mpr ⟨
          Finset.mem_range.mpr (Nat.lt_succ_of_le (relabelsBefore_le_numRelabels Rf i)),
          Finset.mem_univ (BasicOp.opVertex (Rf.opFin i))⟩
    _ = (Run.numRelabels Rf + 1) * Fintype.card V := by
        rw [Finset.card_product, Finset.card_range, Finset.card_univ]

The combined O(V²E) generic bound already bounds relabels and saturating pushes; the discharge order additionally bounds nonsaturating pushes by (|V|·(relabels + 1)). Assembled, this gives the sharper relabel-to-front O(V³) bound on the number of basic operations.

theorem step_count_bound (R : RelabelToFrontRun V G n) :
    n ≤ 2 * Fintype.card V * Fintype.card V + 4 * Fintype.card V * numEdges G +
      (2 * Fintype.card V * Fintype.card V + 1) * Fintype.card V := by
  have hdecomp := Run.op_count_decomp R.run
  have hr : Run.numRelabels R.run ≤ 2 * Fintype.card V * Fintype.card V :=
    Run.relabel_count_bound R.run
  have hs : Run.numSaturatingPushes R.run ≤ 4 * Fintype.card V * numEdges G :=
    Run.saturating_push_count_bound R.run
  have hn : Run.numNonsaturatingPushes R.run ≤
      (Run.numRelabels R.run + 1) * Fintype.card V := nonsaturating_push_count_bound R
  nlinarith

The relabel-to-front algorithm performs at most 9|V|³ basic operations.

theorem step_count_bound_V3 (R : RelabelToFrontRun V G n) :
    n ≤ 9 * Fintype.card V * Fintype.card V * Fintype.card V := by
  have h := step_count_bound R
  have hE : numEdges G ≤ Fintype.card V * Fintype.card V := numEdges_le_card_mul_card G
  have hV : 1 ≤ Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
  nlinarith

              end RelabelToFrontRunend Chapter26end CLRS

Definitions and proofs

CLRSLean.FourthEdition.Chapter_24.Section_24_5_Relabel_To_Front.Execution

An initialized relabel-to-front execution with persistent current-neighbor lists.

Initialization writes the complete flow table and height/excess/cursor tables. The scheduler scans inactive entries and rejected neighbors, pushes using cached excess and two indexed arc writes, and relabels with a counted minimum scan. A reversed processed prefix supports constant-cost discharge completion; moving it to the front uses a counted reverse-onto loop. Relabeling immediately moves the current vertex to the front, where its discharge continues.

The ordering, quiet-prefix, and skipped-neighbor invariants are preserved by the controller itself. Its operation trace therefore satisfies the native discharge discipline without an input certificate. The native cubic operation bound proves that the concrete fuelled run terminates; its returned preflow is a maximum flow.

The work theorem counts actual initialization writes, controller/cursor visits, minimum-scan visits, and moved list cells from this run. The scalar/indexed RAM charge assigns a fixed 32-unit allowance to each such event. Exact real arithmetic and indexed tables are primitives in this model; this is not a persistent Lean function-evaluator time bound, a mutable-array refinement, or a bit-complexity claim for arbitrary real capacities.

              namespace CLRS.Chapter26.RelabelExecutionopen Finset Classicalset_option backward.isDefEq.respectTransparency falsevariable {V : Type*} [Fintype V] [DecidableEq V] {G : FlowNetwork V}noncomputable def initialFunction (G : FlowNetwork V) (u v : V) : ℝ :=
  if u = G.s then G.c G.s v else if v = G.s then -G.c G.s u else 0theorem initialFunction_skew (G : FlowNetwork V) (u v : V) :
    initialFunction G u v = -initialFunction G v u := by
  by_cases hu : u = G.s <;> by_cases hv : v = G.s <;>
    simp [initialFunction, hu, hv, G.hc_self]theorem initialFunction_capacity (G : FlowNetwork V) (u v : V) :
    initialFunction G u v ≤ G.c u v := by
  by_cases hu : u = G.s
  · subst u; simp [initialFunction]
  · by_cases hv : v = G.s
    · subst v
      simp only [initialFunction, if_neg hu, ↓reduceIte]
      linarith [G.hc_nonneg G.s u, G.hc_nonneg u G.s]
    · simpa [initialFunction, hu, hv] using G.hc_nonneg u vtheorem initialFunction_excess (G : FlowNetwork V) (u : V) (hu : u ≠ G.s) :
    netInflow (initialFunction G) u = G.c G.s u := by
  unfold netInflow
  simp [initialFunction, hu]

Indexed writes over an explicit finite enumeration. Counter increments occur at the same recursive nodes that install the returned cells.

def writeCells {ι α : Type*} [DecidableEq ι] (value : ι → α) (base : ι → α) :
    List ι → (ι → α) × Nat
  | [] => (base, 0)
  | i :: is =>
      let tail := writeCells value base is
      (Function.update tail.1 i (value i), tail.2 + 1)

              @[simp] theorem writeCells_count {ι α : Type*} [DecidableEq ι]
    (value base : ι → α) (is : List ι) : (writeCells value base is).2 = is.length := by
  induction is with
  | nil => rfl
  | cons i is ih => simpa [writeCells] using ihtheorem writeCells_value {ι α : Type*} [DecidableEq ι]
    (value base : ι → α) (is : List ι) (a : ι) :
    (writeCells value base is).1 a = if a ∈ is then value a else base a := by
  induction is with
  | nil => simp [writeCells]
  | cons i is ih => by_cases h : a = i <;> simp [writeCells, Function.update, h, ih]noncomputable def tabulate {ι α : Type*} [Fintype ι] [DecidableEq ι]
    (value : ι → α) (default : α) : (ι → α) × Nat :=
  writeCells value (fun _ => default) univ.toList@[simp] theorem tabulate_value {ι α : Type*} [Fintype ι] [DecidableEq ι]
    (value : ι → α) (default : α) : (tabulate value default).1 = value := by
  funext a; simp [tabulate, writeCells_value]@[simp] theorem tabulate_count {ι α : Type*} [Fintype ι] [DecidableEq ι]
    (value : ι → α) (default : α) : (tabulate value default).2 = Fintype.card ι := by
  simp [tabulate]noncomputable def initialCells (G : FlowNetwork V) : (V × V → ℝ) × Nat :=
  tabulate (fun p => initialFunction G p.1 p.2) 0@[simp] theorem initialCells_value (G : FlowNetwork V) (u v : V) :
    (initialCells G).1 (u,v) = initialFunction G u v := by simp [initialCells]

noncomputable def initialPreflow (G : FlowNetwork V) : Preflow V G where
  f := fun u v => (initialCells G).1 (u,v)
  hcapacity := by simpa using initialFunction_capacity G
  hskew_symm := by simpa using initialFunction_skew G
  hexcess_nonneg := by
    intro u hu
    simp only [initialCells_value]
    rw [initialFunction_excess G u hu]
    exact G.hc_nonneg G.s udef initialHeight (G : FlowNetwork V) (u : V) : Nat := if u = G.s then Fintype.card V else 0

theorem initial_valid (G : FlowNetwork V) : IsValidHeight (initialPreflow G) (initialHeight G) := by
  refine ⟨by simp [initialHeight], by simp [initialHeight, Ne.symm G.hs_ne_t], ?_⟩
  intro u v hr
  by_cases hu : u = G.s
  · subst u
    have hz : (initialPreflow G).residualCapacity G.s v = 0 := by
      simp [Preflow.residualCapacity, initialPreflow, initialFunction]
    exact (show False from by change 0 < _ at hr; rw [hz] at hr; linarith).elim
  · simp [initialHeight, hu]

Push changes only its two endpoint excesses.


theorem push_excess (φ : Preflow V G) (u v : V) (hu : u ≠ G.s)
    (hr : φ.residualEdge u v) (a : V) :
    (push φ u v hu hr).excess a = φ.excess a +
      (if a = v then min (φ.excess u) (φ.residualCapacity u v) else 0) -
      (if a = u then min (φ.excess u) (φ.residualCapacity u v) else 0) := by
  unfold push pushBy Preflow.excess netInflow
  rw [Finset.sum_add_distrib]
  have hed (δ : ℝ) : ∑ x : V, Flow.edgeDelta δ u v x a =
      (if a = v then δ else 0) - (if a = u then δ else 0) := by
    unfold Flow.edgeDelta
    rw [Finset.sum_sub_distrib]
    have hf : (∑ x : V, if x = u ∧ a = v then δ else 0) = (if a = v then δ else 0) := by
      by_cases ha : a = v
      · subst a; simp
      · simp [ha]
    have hg : (∑ x : V, if x = v ∧ a = u then δ else 0) = (if a = u then δ else 0) := by
      by_cases ha : a = u
      · subst a; simp
      · simp [ha]
    rw [hf, hg]
  rw [hed]
  ring

theorem push_valid (φ : Preflow V G) (h : V → Nat) (hv : IsValidHeight φ h)
    (u v : V) (hu : φ.isOverflowing u) (hr : φ.residualEdge u v)
    (ha : h u = h v + 1) : IsValidHeight (push φ u v hu.1 hr) h := by
  unfold push
  exact pushBy_validHeight φ h hv _ _ _ _ _ _ _ ha

theorem push_new_admissible (φ : Preflow V G) (h : V → Nat)
    (u v : V) (hu : φ.isOverflowing u) (hr : φ.residualEdge u v)
    (ha : h u = h v + 1) (a b : V)
    (hab : admissibleEdge (push φ u v hu.1 hr) h a b) : admissibleEdge φ h a b := by
  refine ⟨?_, hab.2⟩
  by_contra hn
  have hnew := pushBy_new_residualEdge φ u v (residualEdge_ne φ hr)
    (min (φ.excess u) (φ.residualCapacity u v))
    (le_min (φ.hexcess_nonneg u hu.1) (le_of_lt hr))
    (min_le_left _ _) (min_le_right _ _) hab.1 hn
  rcases hnew with ⟨rfl, rfl⟩
  have hh := hab.2
  omega

A skipped neighbor stays ineligible until this source is relabeled.

def CursorInvariant (φ : Preflow V G) (h : V → Nat) (cursor : V → List V) : Prop :=
  ∀ u v, v ∉ cursor u → φ.residualEdge u v → h u ≤ h v

              theorem cursor_push (φ : Preflow V G) (h : V → Nat) (cursor : V → List V)
    (hc : CursorInvariant φ h cursor) (u v : V) (hu : φ.isOverflowing u)
    (hr : φ.residualEdge u v) (ha : h u = h v + 1) :
    CursorInvariant (push φ u v hu.1 hr) h cursor := by
  intro a b hb hnew
  by_cases hold : φ.residualEdge a b
  · exact hc a b hb hold
  · have hrev := pushBy_new_residualEdge φ u v (residualEdge_ne φ hr)
      (min (φ.excess u) (φ.residualCapacity u v))
      (le_min (φ.hexcess_nonneg u hu.1) (le_of_lt hr))
      (min_le_left _ _) (min_le_right _ _) hnew hold
    rcases hrev with ⟨rfl, rfl⟩
    omega

theorem cursor_relabel (φ : Preflow V G) (h : V → Nat) (cursor : V → List V)
    (hc : CursorInvariant φ h cursor) (u : V) (hr : ∃ v, φ.residualEdge u v)
    (hpre : ∀ v, φ.residualEdge u v → h u ≤ h v) :
    CursorInvariant φ (relabel φ h u hr) (Function.update cursor u univ.toList) := by
  intro a b hb hab
  by_cases ha : a = u
  · subst a; simp at hb
  · have hold : b ∉ cursor a := by simpa [Function.update, ha] using hb
    have hle := hc a b hold hab
    have hup := (relabel_height_increase φ h u hr hpre).le
    rw [relabel_eq_of_ne φ h u hr ha]
    by_cases hbu : b = u
    · subst b; exact hle.trans hup
    · rwa [relabel_eq_of_ne φ h u hr hbu]def Internal (G : FlowNetwork V) (u : V) : Prop := u ≠ G.s ∧ u ≠ G.tdef Ordered (φ : Preflow V G) (h : V → Nat) (L : List V) : Prop :=
  L.Pairwise (fun a b => ¬ admissibleEdge φ h b a)structure Machine (G : FlowNetwork V) where
  φ : Preflow V G
  h : V → Nat
  excessCache : V → ℝ
  cache_correct : ∀ u, u ≠ G.s → excessCache u = φ.excess u
  valid : IsValidHeight φ h
  past : List V
  todo : List V
  nodup : (past.reverse ++ todo).Nodup
  complete : ∀ v, v ∈ past.reverse ++ todo ↔ Internal G v
  ordered : Ordered φ h (past.reverse ++ todo)
  quiet : ∀ v ∈ past.reverse, ¬ φ.isOverflowing v
  cursor : V → List V
  cursor_bound : ∀ v, (cursor v).length ≤ Fintype.card V
  skipped : CursorInvariant φ h cursordef Machine.done (s : Machine G) : List V := s.past.reversenoncomputable def selectInternal (G : FlowNetwork V) : List V → List V × Nat
  | [] => ([], 0)
  | u :: us =>
      let tail := selectInternal G us
      (if Internal G u then u :: tail.1 else tail.1, tail.2 + 1)@[simp] theorem selectInternal_value (G : FlowNetwork V) (xs : List V) :
    (selectInternal G xs).1 = xs.filter (fun v => decide (Internal G v)) := by
  induction xs with
  | nil => rfl
  | cons u us ih => by_cases hu : Internal G u <;> simp [selectInternal, hu, ih]@[simp] theorem selectInternal_count (G : FlowNetwork V) (xs : List V) :
    (selectInternal G xs).2 = xs.length := by
  induction xs with
  | nil => rfl
  | cons u us ih => simpa [selectInternal] using ih

noncomputable def initialMachine (G : FlowNetwork V) : Machine G where
  φ := initialPreflow G
  h := (tabulate (initialHeight G) 0).1
  excessCache := (tabulate (G.c G.s) 0).1
  cache_correct := by intro u hu; simpa [initialPreflow, Preflow.excess] using (initialFunction_excess G u hu).symm
  valid := by simpa using initial_valid G
  past := []
  todo := (selectInternal G univ.toList).1
  nodup := by simpa using (Finset.nodup_toList (univ : Finset V)).filter _
  complete := by simp
  ordered := by
    simp only [List.reverse_nil, List.nil_append, selectInternal_value]
    apply List.pairwise_iff_getElem.mpr
    intro i j hi hj hij hadm
    have hia : (univ.toList.filter (fun v => decide (Internal G v)))[i] ≠ G.s := by
      have hm := List.getElem_mem hi
      exact (of_decide_eq_true (List.mem_filter.mp hm).2).1
    have hja : (univ.toList.filter (fun v => decide (Internal G v)))[j] ≠ G.s := by
      have hm := List.getElem_mem hj
      exact (of_decide_eq_true (List.mem_filter.mp hm).2).1
    have he := hadm.2
    simp only [tabulate_value] at he
    change (if (univ.toList.filter (fun v => decide (Internal G v)))[j] = G.s then Fintype.card V else 0) =
      (if (univ.toList.filter (fun v => decide (Internal G v)))[i] = G.s then Fintype.card V else 0) + 1 at he
    rw [if_neg hja, if_neg hia] at he
    omega
  quiet := by simp
  cursor := (tabulate (fun _ : V => (univ.toList : List V)) []).1
  cursor_bound := by simp
  skipped := by intro u v hv; simp at hvnoncomputable def credit (s : Machine G) : Nat :=
  s.todo.length + ∑ v, (s.cursor v).lengththeorem credit_initial (G : FlowNetwork V) :
    credit (initialMachine G) ≤ Fintype.card V + Fintype.card V * Fintype.card V := by
  have hl := List.length_filter_le (fun v => decide (Internal G v)) (univ.toList : List V)
  simp only [Finset.length_toList, Finset.card_univ] at hl
  simpa [credit, initialMachine] using Nat.add_le_add_right hl (Fintype.card V * Fintype.card V)theorem ordered_push (s : Machine G) (u v : V) (hu : s.φ.isOverflowing u)
    (hr : s.φ.residualEdge u v) (ha : s.h u = s.h v + 1) :
    Ordered (push s.φ u v hu.1 hr) s.h (s.done ++ s.todo) := by
  apply s.ordered.imp
  intro a b hold hn
  exact hold (push_new_admissible s.φ s.h u v hu hr ha b a hn)

theorem current_not_done (s : Machine G) {u : V} {us : List V} (ht : s.todo = u :: us) :
    u ∉ s.done := by
  have hn := s.nodup
  rw [ht, List.nodup_append] at hn
  intro hu
  exact hn.2.2 u hu u (by simp) rfltheorem current_internal (s : Machine G) {u : V} {us : List V} (ht : s.todo = u :: us) :
    Internal G u := (s.complete u).1 (by simp [ht])

theorem push_quiet_done (s : Machine G) {u : V} {us : List V} (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) :
    ∀ a ∈ s.done, ¬ (push s.φ u v hu.1 hr).isOverflowing a := by
  intro a haD hover
  have hau : a ≠ u := by intro h; subst a; exact current_not_done s ht haD
  have hav : a ≠ v := by
    intro h; subst a
    have hord := List.pairwise_append.mp s.ordered
    exact hord.2.2 v haD u (by simp [ht]) ⟨hr, ha⟩
  have he : (push s.φ u v hu.1 hr).excess a = s.φ.excess a := by
    rw [push_excess]; simp [hau, hav]
  exact s.quiet a haD ⟨hover.1, hover.2.1, by simpa [he] using hover.2.2⟩noncomputable def skipCurrent (s : Machine G) (u : V) (us : List V)
    (ht : s.todo = u :: us) (hq : ¬ s.φ.isOverflowing u) : Machine G :=
  { s with
    past := u :: s.past
    todo := us
    nodup := by simpa [ht, Machine.done, List.reverse_cons, List.append_assoc] using s.nodup
    complete := by intro v; simpa [ht, Machine.done, List.reverse_cons, List.append_assoc] using s.complete v
    ordered := by simpa [ht, Machine.done, List.reverse_cons, List.append_assoc] using s.ordered
    quiet := by
      intro v hv
      simp only [List.reverse_cons] at hv
      rcases List.mem_append.mp hv with hv | hv
      · exact s.quiet v hv
      · simpa using (List.mem_singleton.mp hv) ▸ hq }theorem credit_skip (s : Machine G) (u : V) (us : List V)
    (ht : s.todo = u :: us) (hq : ¬ s.φ.isOverflowing u) :
    credit (skipCurrent s u us ht hq) + 1 = credit s := by
  simp [credit, skipCurrent, ht]
  omega

noncomputable def advanceCursor (s : Machine G) (u v : V) (vs : List V)
    (hc : s.cursor u = v :: vs) (hn : ¬ admissibleEdge s.φ s.h u v) : Machine G :=
  { s with
    cursor := Function.update s.cursor u vs
    cursor_bound := by
      intro a
      by_cases ha : a = u
      · subst a; simp only [Function.update_self]
        have hb := s.cursor_bound u; rw [hc] at hb; simpa using Nat.le_trans (Nat.le_succ _) hb
      · simpa [Function.update, ha] using s.cursor_bound a
    skipped := by
      intro a b hb hr
      by_cases ha : a = u
      · subst a
        simp only [Function.update_self] at hb
        by_cases hbv : b = v
        · subst b
          have hv := s.valid.2.2 u v hr
          have hne : s.h u ≠ s.h v + 1 := fun he => hn ⟨hr, he⟩
          omega
        · apply s.skipped u b ?_ hr
          simp [hc, hb, hbv]
      · apply s.skipped a b ?_ hr
        simpa [Function.update, ha] using hb }

theorem credit_advanceCursor (s : Machine G) (u v : V) (vs : List V)
    (hc : s.cursor u = v :: vs) (hn : ¬ admissibleEdge s.φ s.h u v) :
    credit (advanceCursor s u v vs hc hn) + 1 = credit s := by
  unfold credit
  have hfun : (fun a => ((advanceCursor s u v vs hc hn).cursor a).length) =
      Function.update (fun a => (s.cursor a).length) u vs.length := by
    funext a
    by_cases ha : a = u <;> simp [advanceCursor, Function.update, ha]
  rw [hfun, Finset.sum_update_of_mem (Finset.mem_univ u)]
  have hs := Finset.sum_erase_add (univ : Finset V) (fun a => (s.cursor a).length) (mem_univ u)
  rw [hc] at hs
  simp only [List.length_cons] at hs
  simp only [advanceCursor]
  rw [Finset.sdiff_singleton_eq_erase]
  omega


theorem ordered_relabel (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (hr : ∃ v, s.φ.residualEdge u v)
    (hp : ∀ v, s.φ.residualEdge u v → s.h u ≤ s.h v) :
    Ordered s.φ (relabel s.φ s.h u hr) (u :: (s.done ++ us)) := by
  have hn : (u :: (s.done ++ us)).Nodup := List.perm_middle.nodup (by simpa [ht, Machine.done] using s.nodup)
  have hnot := (List.nodup_cons.mp hn).1
  have ho : Ordered s.φ s.h (s.done ++ us) := by
    exact s.ordered.sublist (by rw [ht]; exact List.Sublist.append (List.Sublist.refl _) (List.sublist_cons_self _ _))
  apply List.Pairwise.cons
  · intro a ha hadm
    have hau : a ≠ u := by intro he; subst a; exact hnot ha
    have old := s.valid.2.2 a u hadm.1
    have inc := relabel_height_increase s.φ s.h u hr hp
    have eqn := hadm.2
    rw [relabel_eq_of_ne s.φ s.h u hr hau] at eqn
    omega
  · apply List.Pairwise.imp_of_mem _ ho
    intro a b ha hb hold hnew
    have hau : a ≠ u := by intro he; subst a; exact hnot ha
    have hbu : b ≠ u := by intro he; subst b; exact hnot hb
    apply hold
    refine ⟨hnew.1, ?_⟩
    simpa only [relabel_eq_of_ne s.φ s.h u hr hau,
      relabel_eq_of_ne s.φ s.h u hr hbu] using hnew.2

A literal residual-neighbor scan: one candidate visit at every list cell.

noncomputable def scanMinimum (φ : Preflow V G) (h : V → Nat) (u : V) :
    List V → WithTop Nat × Nat
  | [] => (⊤, 0)
  | v :: vs =>
      let tail := scanMinimum φ h u vs
      (if φ.residualEdge u v then min (h v : WithTop Nat) tail.1 else tail.1, tail.2 + 1)

              @[simp] theorem scanMinimum_visits (φ : Preflow V G) (h : V → Nat) (u : V) (vs : List V) :
    (scanMinimum φ h u vs).2 = vs.length := by
  induction vs with
  | nil => rfl
  | cons v vs ih => simpa [scanMinimum] using ihtheorem scanMinimum_value (φ : Preflow V G) (h : V → Nat) (u : V) (vs : List V) :
    (scanMinimum φ h u vs).1 = ((vs.filter fun v => decide (φ.residualEdge u v)).map h).minimum := by
  induction vs with
  | nil => simp [scanMinimum]
  | cons v vs ih => by_cases hv : φ.residualEdge u v <;> simp [scanMinimum, hv, ih, List.minimum_cons]noncomputable def scannedRelabel (φ : Preflow V G) (h : V → Nat) (u : V) : V → Nat :=
  let least := (scanMinimum φ h u univ.toList).1.untopD 0
  Function.update h u (1 + least)

theorem scannedRelabel_eq (φ : Preflow V G) (h : V → Nat) (u : V)
    (hr : ∃ v, φ.residualEdge u v) : scannedRelabel φ h u = relabel φ h u hr := by
  let S := ((univ : Finset V).filter (fun v => φ.residualEdge u v)).image h
  have hS : S.Nonempty := by
    obtain ⟨v, hv⟩ := hr
    exact ⟨h v, mem_image.mpr ⟨v, mem_filter.mpr ⟨mem_univ _, hv⟩, rfl⟩⟩
  have heq : (scanMinimum φ h u univ.toList).1 = (S.min' hS : WithTop Nat) := by
    rw [scanMinimum_value]
    apply (List.minimum_eq_coe_iff (m := S.min' hS)).mpr
    constructor
    · obtain ⟨v, hv, he⟩ := mem_image.mp (Finset.min'_mem S hS)
      exact List.mem_map.mpr ⟨v, List.mem_filter.mpr ⟨by simp, by simpa using (mem_filter.mp hv).2⟩, he⟩
    · intro a ha
      obtain ⟨v, hv, rfl⟩ := List.mem_map.mp ha
      exact Finset.min'_le S _ (mem_image.mpr ⟨v, mem_filter.mpr ⟨mem_univ _,
        by simpa using (List.mem_filter.mp hv).2⟩, rfl⟩)
  funext a
  by_cases hau : a = u
  · subst a
    simp only [scannedRelabel, heq, Function.update_self]
    calc
      _ = 1 + S.min' hS := congrArg (1 + ·) (WithTop.untopD_coe 0 (S.min' hS))
      _ = _ := by unfold relabel; simp only [↓reduceIte]; rfl
  · simp [scannedRelabel, hau, relabel_eq_of_ne φ h u hr hau]

Reverse the processed prefix directly onto the remaining suffix. Each visited cell performs one cons; no repeated append traversal is hidden in a discharge.

def reverseOnto {α : Type*} : List α → List α → List α × Nat
  | [], acc => (acc, 0)
  | a :: as, acc =>
      let tail := reverseOnto as (a :: acc)
      (tail.1, tail.2 + 1)

              @[simp] theorem reverseOnto_value {α : Type*} (xs acc : List α) :
    (reverseOnto xs acc).1 = xs.reverse ++ acc := by
  induction xs generalizing acc with
  | nil => simp [reverseOnto]
  | cons a as ih => simp [reverseOnto, ih, List.reverse_cons, List.append_assoc]@[simp] theorem reverseOnto_count {α : Type*} (xs acc : List α) :
    (reverseOnto xs acc).2 = xs.length := by
  induction xs generalizing acc with
  | nil => rfl
  | cons a as ih => simp [reverseOnto, ih]

noncomputable def relabelCurrent (s : Machine G) (u : V) (us : List V)
    (ht : s.todo = u :: us) (hu : s.φ.isOverflowing u)
    (hr : ∃ v, s.φ.residualEdge u v)
    (hp : ∀ v, s.φ.residualEdge u v → s.h u ≤ s.h v) : Machine G where
  φ := s.φ
  h := scannedRelabel s.φ s.h u
  excessCache := s.excessCache
  cache_correct := s.cache_correct
  valid := by rw [scannedRelabel_eq _ _ _ hr]; exact relabel_validHeight s.φ s.h s.valid u hu.1 hu.2.1 hr hp
  past := []
  todo := u :: (reverseOnto s.past us).1
  nodup := by simpa only [List.reverse_nil, List.nil_append, reverseOnto_value, Machine.done] using List.perm_middle.nodup (by simpa [ht, Machine.done] using s.nodup)
  complete := by intro a; simpa [ht, Machine.done, List.mem_append, or_assoc, or_left_comm] using s.complete a
  ordered := by rw [scannedRelabel_eq _ _ _ hr]; simpa [Machine.done] using ordered_relabel s u us ht hr hp
  quiet := by simp
  cursor := Function.update s.cursor u univ.toList
  cursor_bound := by intro a; by_cases ha : a = u <;> simp [Function.update, ha, s.cursor_bound]
  skipped := by rw [scannedRelabel_eq _ _ _ hr]; exact cursor_relabel s.φ s.h s.cursor s.skipped u hr hp

theorem credit_relabel (s : Machine G) (u : V) (us : List V)
    (ht : s.todo = u :: us) (hu : s.φ.isOverflowing u)
    (hr : ∃ v, s.φ.residualEdge u v)
    (hp : ∀ v, s.φ.residualEdge u v → s.h u ≤ s.h v) :
    credit (relabelCurrent s u us ht hu hr hp) ≤ credit s + 2 * Fintype.card V := by
  have hl := List.Nodup.length_le_card s.nodup
  rw [ht] at hl
  have hsum := Finset.sum_erase_add (univ : Finset V) (fun a => (s.cursor a).length) (mem_univ u)
  have hfun : (fun a => ((relabelCurrent s u us ht hu hr hp).cursor a).length) =
      Function.update (fun a => (s.cursor a).length) u (Fintype.card V) := by
    funext a; by_cases ha : a = u <;> simp [relabelCurrent, Function.update, ha]
  unfold credit
  rw [hfun, Finset.sum_update_of_mem (mem_univ u), Finset.sdiff_singleton_eq_erase]
  simp only [relabelCurrent, ht, List.length_cons, reverseOnto_value, List.length_append] at *
  omegadef pushCells (f : V → V → ℝ) (u v : V) (δ : ℝ) : V → V → ℝ :=
  Function.update (Function.update f u (Function.update (f u) v (f u v + δ)))
    v (Function.update (f v) u (f v u - δ))automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`Used `tac1 <;> tac2` where `(tac1; tac2)` would suffice

Note: This linter can be disabled with `set_option linter.unnecessarySeqFocus false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`

automatically included section variable(s) unused in theorem `CLRS.Chapter26.RelabelExecution.pushCells_eq`:
  [Fintype V]
consider restructuring your `variable` declarations so that the variables are not in scope or explicitly omit them:
  omit [Fintype V] in theorem ...

Note: This linter can be disabled with `set_option linter.unusedSectionVars false`theorem pushCells_eq (f : V → V → ℝ) (u v : V) (huv : u ≠ v) (δ : ℝ) :
    pushCells f u v δ = fun a b => f a b + Flow.edgeDelta δ u v a b := by
  funext a b
  by_cases hau : a = u <;> by_cases hav : a = v <;>
    by_cases hbu : b = u <;> by_cases hbv : b = v <;>
    simp_all [pushCells, Function.update, Flow.edgeDelta] Used `tac1 <;> tac2` where `(tac1; tac2)` would suffice

Note: This linter can be disabled with `set_option linter.unnecessarySeqFocus false`<;> ringtheorem preflow_ext {φ ψ : Preflow V G} (h : φ.f = ψ.f) : φ = ψ := by
  cases φ; cases ψ; cases h; rfl

noncomputable def cachedPush (s : Machine G) (u v : V) (hu : u ≠ G.s)
    (hr : s.φ.residualEdge u v) : Preflow V G := by
  let δ := min (s.excessCache u) (s.φ.residualCapacity u v)
  let φ' := pushBy s.φ u v (residualEdge_ne s.φ hr) δ
    (by dsimp [δ]; rw [s.cache_correct u hu]; exact le_min (s.φ.hexcess_nonneg u hu) hr.le)
    (by dsimp [δ]; rw [s.cache_correct u hu]; exact min_le_left _ _)
    (by dsimp [δ]; exact min_le_right _ _)
  let f' := pushCells s.φ.f u v δ
  have hf : f' = φ'.f := pushCells_eq s.φ.f u v (residualEdge_ne s.φ hr) δ
  exact { f := f'
          hcapacity := by rw [hf]; exact φ'.hcapacity
          hskew_symm := by rw [hf]; exact φ'.hskew_symm
          hexcess_nonneg := by rw [hf]; exact φ'.hexcess_nonneg }@[simp] theorem cachedPush_eq (s : Machine G) (u v : V) (hu : u ≠ G.s)
    (hr : s.φ.residualEdge u v) : cachedPush s u v hu hr = push s.φ u v hu hr := by
  apply preflow_ext
  simp [cachedPush, push, pushBy, pushCells_eq _ _ _ (residualEdge_ne s.φ hr), s.cache_correct u hu]noncomputable def pushedCache (s : Machine G) (u v : V) : V → ℝ :=
  let δ := min (s.excessCache u) (s.φ.residualCapacity u v)
  Function.update (Function.update s.excessCache u (s.excessCache u - δ)) v (s.excessCache v + δ)

theorem pushedCache_correct (s : Machine G) (u v : V) (hu : u ≠ G.s)
    (hr : s.φ.residualEdge u v) (a : V) (has : a ≠ G.s) :
    pushedCache s u v a = (cachedPush s u v hu hr).excess a := by
  rw [cachedPush_eq, push_excess]
  have huv := residualEdge_ne s.φ hr
  by_cases hau : a = u <;> by_cases hav : a = v <;>
    simp_all [pushedCache, Function.update, s.cache_correct]

noncomputable def pushCurrent (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) : Machine G := by
  let φ' := cachedPush s u v hu.1 hr
  have hvalid : IsValidHeight φ' s.h := by simpa [φ'] using push_valid s.φ s.h s.valid u v hu hr ha
  have hord : Ordered φ' s.h (s.done ++ s.todo) := by simpa [φ'] using ordered_push s u v hu hr ha
  have hquiet : ∀ a ∈ s.done, ¬ φ'.isOverflowing a := by simpa [φ'] using push_quiet_done s ht v hu hr ha
  have hskip : CursorInvariant φ' s.h s.cursor := by simpa [φ'] using cursor_push s.φ s.h s.cursor s.skipped u v hu hr ha
  exact if hnCache : s.excessCache u < s.φ.residualCapacity u v then
    let hn : s.φ.excess u < s.φ.residualCapacity u v := by simpa [s.cache_correct u hu.1] using hnCache
    { φ := φ', h := s.h, valid := hvalid
      excessCache := pushedCache s u v
      cache_correct := pushedCache_correct s u v hu.1 hr
      past := u :: s.past, todo := us
      nodup := by simpa [ht, Machine.done, List.reverse_cons, List.append_assoc] using s.nodup
      complete := by intro a; simpa [ht, Machine.done, List.reverse_cons, List.append_assoc] using s.complete a
      ordered := by simpa [ht, Machine.done, List.reverse_cons, List.append_assoc] using hord
      quiet := by
        intro a hm
        simp only [List.reverse_cons] at hm
        rcases List.mem_append.mp hm with hm | hm
        · exact hquiet a hm
        · have hau : a = u := List.mem_singleton.mp hm
          subst a
          intro hover
          have hex : φ'.excess u = 0 := by
            dsimp [φ']
            rw [cachedPush_eq, push_excess]
            simp [residualEdge_ne s.φ hr, min_eq_left hn.le]
          have hx := hover.2.2
          rw [hex] at hx
          linarith
      cursor := s.cursor, cursor_bound := s.cursor_bound, skipped := hskip }
    else
    { φ := φ', h := s.h, valid := hvalid
      excessCache := pushedCache s u v
      cache_correct := pushedCache_correct s u v hu.1 hr
      past := s.past, todo := s.todo, nodup := s.nodup, complete := s.complete,
      ordered := hord, quiet := hquiet
      cursor := s.cursor, cursor_bound := s.cursor_bound, skipped := hskip }theorem pushCurrent_φ (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) :
    (pushCurrent s u us ht v hu hr ha).φ = push s.φ u v hu.1 hr := by
  by_cases hn : s.φ.excess u < s.φ.residualCapacity u v <;> simp [pushCurrent, s.cache_correct u hu.1, hn]theorem pushCurrent_h (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) : (pushCurrent s u us ht v hu hr ha).h = s.h := by
  by_cases hn : s.φ.excess u < s.φ.residualCapacity u v <;> simp [pushCurrent, s.cache_correct u hu.1, hn]theorem pushCurrent_done_mono (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) :
    ∀ a ∈ s.done, a ∈ (pushCurrent s u us ht v hu hr ha).done := by
  by_cases hn : s.φ.excess u < s.φ.residualCapacity u v <;> intro a hm
  all_goals simp only [Machine.done, List.mem_reverse] at hm
  all_goals simp [pushCurrent, s.cache_correct u hu.1, hn, Machine.done, hm]theorem pushCurrent_nonsat_done (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) (hn : s.φ.excess u < s.φ.residualCapacity u v) :
    u ∈ (pushCurrent s u us ht v hu hr ha).done := by simp [pushCurrent, s.cache_correct u hu.1, hn, Machine.done]theorem credit_push (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) :
    credit (pushCurrent s u us ht v hu hr ha) ≤ credit s := by
  by_cases hn : s.φ.excess u < s.φ.residualCapacity u v <;> simp [pushCurrent, s.cache_correct u hu.1, hn, credit, ht]

One executed basic operation, including its preceding cursor/list scans.

structure BasicResult (s : Machine G) where
  op : BasicOp V G
  after : Machine G
  beforeφ : op.beforeφ = s.φ
  beforeh : op.beforeh = s.h
  resultφ : op.resultφ = after.φ
  resulth : op.resulth = after.h
  scans : Nat
  moves : Nat
  minimumVisits : Nat
  minimumVisits_eq : minimumVisits = Fintype.card V * (if op.isRelabel then 1 else 0)
  scan_credit : scans + credit after ≤ credit s + 2 * Fintype.card V * (if op.isRelabel then 1 else 0)
  move_bound : moves ≤ 2 * Fintype.card V * (if op.isRelabel then 1 else 0)
  done_mono : op.isRelabel = false → ∀ a ∈ s.done, a ∈ after.done
  nonsat_done : op.isNonsaturatingPush = true → op.opVertex ∈ after.done
  source_fresh : op.opVertex ∉ s.done

noncomputable def relabelResult (s : Machine G) (u : V) (us : List V)
    (ht : s.todo = u :: us) (hu : s.φ.isOverflowing u)
    (hr : ∃ v, s.φ.residualEdge u v)
    (hp : ∀ v, s.φ.residualEdge u v → s.h u ≤ s.h v) : BasicResult s where
  op := .relabel s.φ s.h u hu hr hp
  after := relabelCurrent s u us ht hu hr hp
  beforeφ := rfl
  beforeh := rfl
  resultφ := rfl
  resulth := (scannedRelabel_eq _ _ _ hr).symm
  scans := 0
  moves := (reverseOnto s.past us).2
  minimumVisits := (scanMinimum s.φ s.h u univ.toList).2
  minimumVisits_eq := by simp [BasicOp.isRelabel]
  scan_credit := by simpa [BasicOp.isRelabel] using credit_relabel s u us ht hu hr hp
  move_bound := by
    have hl := List.Nodup.length_le_card s.nodup
    simp only [List.length_append, List.length_reverse] at hl
    simp only [BasicOp.isRelabel, ↓reduceIte, Nat.mul_one, reverseOnto_count]
    omega
  done_mono := by simp [BasicOp.isRelabel]
  nonsat_done := by simp [BasicOp.isNonsaturatingPush]
  source_fresh := current_not_done s ht



noncomputable def pushResult (s : Machine G) (u : V) (us : List V) (ht : s.todo = u :: us)
    (v : V) (hu : s.φ.isOverflowing u) (hr : s.φ.residualEdge u v)
    (ha : s.h u = s.h v + 1) : BasicResult s where
  op := .push s.φ s.h u v hu hr ha
  after := pushCurrent s u us ht v hu hr ha
  beforeφ := rfl
  beforeh := rfl
  resultφ := (pushCurrent_φ s u us ht v hu hr ha).symm
  resulth := (pushCurrent_h s u us ht v hu hr ha).symm
  scans := 0
  moves := 0
  minimumVisits := 0
  minimumVisits_eq := by simp [BasicOp.isRelabel]
  scan_credit := by simpa [BasicOp.isRelabel] using credit_push s u us ht v hu hr ha
  move_bound := by simp
  done_mono := by intro _; exact pushCurrent_done_mono s u us ht v hu hr ha
  nonsat_done := by
    intro hn
    have hn' : s.φ.excess u < s.φ.residualCapacity u v := by
      simpa [BasicOp.isNonsaturatingPush] using hn
    exact pushCurrent_nonsat_done s u us ht v hu hr ha hn'
  source_fresh := current_not_done s ht

Pull a result back across one actual administrative cursor/list step.

noncomputable def BasicResult.prependScan {s t : Machine G}
    (hp : t.φ = s.φ) (hh : t.h = s.h)
    (hd : ∀ a ∈ s.done, a ∈ t.done) (hc : credit t + 1 = credit s)
    (r : BasicResult t) : BasicResult s where
  op := r.op
  after := r.after
  beforeφ := r.beforeφ.trans hp
  beforeh := r.beforeh.trans hh
  resultφ := r.resultφ
  resulth := r.resulth
  scans := r.scans + 1
  moves := r.moves
  minimumVisits := r.minimumVisits
  minimumVisits_eq := r.minimumVisits_eq
  scan_credit := by have h := r.scan_credit; omega
  move_bound := r.move_bound
  done_mono := by intro hn a ha; exact r.done_mono hn a (hd a ha)
  nonsat_done := r.nonsat_done
  source_fresh := by intro hs; exact r.source_fresh (hd _ hs)

              structure Finished (s : Machine G) where
  quiet : ∀ u, ¬ s.φ.isOverflowing u
  scans : Nat
  scan_bound : scans ≤ credit s

noncomputable def Finished.prependScan {s t : Machine G}
    (hp : t.φ = s.φ) (hc : credit t + 1 = credit s) (r : Finished t) : Finished s where
  quiet := by rw [← hp]; exact r.quiet
  scans := r.scans + 1
  scan_bound := by have h := r.scan_bound; omegaabbrev Next (s : Machine G) := Finished s ⊕ BasicResult s

Scan current neighbors and inactive list entries until a basic operation or a completed flow is reached. Administrative steps strictly consume credit.


noncomputable def next (s : Machine G) : Next s :=
  match ht : s.todo with
  | [] => .inl
      { quiet := by
          intro u hu
          have hm : u ∈ s.done ++ s.todo := (s.complete u).2 ⟨hu.1, hu.2.1⟩
          have hd : u ∈ s.done := by simpa [ht] using hm
          exact s.quiet u hd hu
        scans := 0
        scan_bound := Nat.zero_le _ }
  | u :: us =>
      if huCache : 0 < s.excessCache u then
        let hu : s.φ.isOverflowing u := ⟨(current_internal s ht).1, (current_internal s ht).2, by
          simpa [s.cache_correct u (current_internal s ht).1] using huCache⟩
        match hc : s.cursor u with
        | [] =>
            let hr := exists_residualEdge_of_overflowing s.φ u hu.1 hu.2.2
            let hp : ∀ v, s.φ.residualEdge u v → s.h u ≤ s.h v :=
              fun v hv => s.skipped u v (by simp [hc]) hv
            .inr (relabelResult s u us ht hu hr hp)
        | v :: vs =>
            if ha : admissibleEdge s.φ s.h u v then
              .inr (pushResult s u us ht v hu ha.1 ha.2)
            else
              let t := advanceCursor s u v vs hc ha
              match next t with
              | .inl r => .inl (r.prependScan (s := s) (t := t) rfl (credit_advanceCursor s u v vs hc ha))
              | .inr r => .inr (r.prependScan (s := s) (t := t) rfl rfl (fun _ hx => hx)
                  (credit_advanceCursor s u v vs hc ha))
      else
        let hu : ¬ s.φ.isOverflowing u := by
          intro hover; exact huCache (by simpa [s.cache_correct u hover.1] using hover.2.2)
        let t := skipCurrent s u us ht hu
        match next t with
        | .inl r => .inl (r.prependScan (s := s) (t := t) rfl (credit_skip s u us ht hu))
        | .inr r => .inr (r.prependScan (s := s) (t := t) rfl rfl
            (by intro a ha; simpa [Machine.done, t, skipCurrent, or_comm] using List.mem_cons_of_mem u (by simpa [Machine.done] using ha))
            (credit_skip s u us ht hu))
termination_by credit s
 decreasing_by
  · have h := credit_advanceCursor s u v vs hc ha
    omega
  · have h := credit_skip s u us ht hu
    omega

              inductive Trace : Machine G → Machine G → Nat → Type _
  | nil (s : Machine G) : Trace s s 0
  | cons {s t : Machine G} {n : Nat} (r : BasicResult s)
      (tail : Trace r.after t n) : Trace s t (n + 1)namespace Tracenoncomputable def state {s t : Machine G} {n : Nat} (tr : Trace s t n) : Nat → Machine G :=
  match tr with
  | .nil s => fun _ => s
  | .cons r tail => fun i => match i with | 0 => s | k + 1 => tail.state k@[simp] theorem state_zero {s t : Machine G} {n : Nat} (tr : Trace s t n) : tr.state 0 = s := by
  cases tr <;> rfl@[simp] theorem state_end {s t : Machine G} {n : Nat} (tr : Trace s t n) : tr.state n = t := by
  induction tr with
  | nil => rfl
  | cons r tail ih => exact ihnoncomputable def result {s t : Machine G} {n : Nat} (tr : Trace s t n)
    (i : Nat) (hi : i < n) : BasicResult (tr.state i) :=
  match tr with
  | .nil _ => False.elim (by omega)
  | .cons r tail => match i with
      | 0 => r
      | k + 1 => tail.result k (by omega)@[simp] theorem result_after {s t : Machine G} {n : Nat} (tr : Trace s t n)
    (i : Nat) (hi : i < n) : (tr.result i hi).after = tr.state (i + 1) := by
  induction tr generalizing i with
  | nil => omega
  | cons r tail ih =>
      cases i with
      | zero => simp [result, state]
      | succ k => exact ih k (by omega)

noncomputable def toRun {s t : Machine G} {n : Nat} (tr : Trace s t n) : Run V G n where
  φ i := (tr.state i).φ
  h i := (tr.state i).h
  hvalid i := (tr.state i).valid
  op i hi := (tr.result i hi).op
  hop_beforeφ i hi := (tr.result i hi).beforeφ
  hop_beforeh i hi := (tr.result i hi).beforeh
  hop_resultφ i hi := by rw [(tr.result i hi).resultφ, result_after]
  hop_resulth i hi := by rw [(tr.result i hi).resulth, result_after]

theorem done_mono_interval {s t : Machine G} {n : Nat} (tr : Trace s t n)
    {i j : Nat} (hij : i ≤ j) (hj : j ≤ n)
    (hn : ∀ k (hk : k < n), i ≤ k → k < j → (tr.result k hk).op.isRelabel = false) :
    ∀ a ∈ (tr.state i).done, a ∈ (tr.state j).done := by
  induction j with
  | zero =>
      have heq : i = 0 := by omega
      subst i
      exact fun _ h => h
  | succ j ih =>
      by_cases heq : i = j + 1
      · subst i; exact fun _ h => h
      · have hjn : j < n := by omega
        have hmid := ih (by omega) (by omega) (by
          intro k hk hik hkj; exact hn k hk hik (by omega))
        intro a ha
        have h := (tr.result j hjn).done_mono (hn j hjn (by omega) (by omega)) a (hmid a ha)
        simpa using h

noncomputable def toRelabelToFrontRun {s t : Machine G} {n : Nat}
    (tr : Trace s t n) : RelabelToFrontRun V G n where
  run := tr.toRun
  discharge_discipline := by
    intro i j hi hj hij hni _ hnone heq
    have hm := (tr.result i hi).nonsat_done hni
    rw [result_after] at hm
    have hmono := tr.done_mono_interval (i := i + 1) (j := j) (by omega) (by omega)
      (by intro k hk hik hkj; exact hnone k hk (by omega) hkj)
    have hin := hmono _ hm
    have heq' : (tr.result i hi).op.opVertex = (tr.result j hj).op.opVertex := heq
    rw [heq'] at hin
    exact (tr.result j hj).source_fresh hintheorem length_bound {s t : Machine G} {n : Nat} (tr : Trace s t n) :
    n ≤ 9 * Fintype.card V * Fintype.card V * Fintype.card V :=
  tr.toRelabelToFrontRun.step_count_bound_V3noncomputable def scans {s t : Machine G} {n : Nat} : Trace s t n → Nat
  | .nil _ => 0
  | .cons r tail => r.scans + tail.scansnoncomputable def moves {s t : Machine G} {n : Nat} : Trace s t n → Nat
  | .nil _ => 0
  | .cons r tail => r.moves + tail.movesnoncomputable def relabels {s t : Machine G} {n : Nat} : Trace s t n → Nat
  | .nil _ => 0
  | .cons r tail => (if r.op.isRelabel then 1 else 0) + tail.relabelstheorem relabels_eq {s t : Machine G} {n : Nat} (tr : Trace s t n) :
    tr.relabels = tr.toRun.numRelabels := by
  induction tr with
  | nil => simp [relabels, Run.numRelabels]
  | cons r tail ih =>
      simp only [relabels, Run.numRelabels, Fin.sum_univ_succ, Run.opFin, toRun, result]
      congr 1theorem scans_credit {s t : Machine G} {n : Nat} (tr : Trace s t n) :
    tr.scans + credit t ≤ credit s + 2 * Fintype.card V * tr.relabels := by
  induction tr with
  | nil => simp [scans, relabels]
  | cons r tail ih =>
      have h := r.scan_credit
      simp only [scans, relabels, Nat.mul_add]
      omegatheorem moves_bound {s t : Machine G} {n : Nat} (tr : Trace s t n) :
    tr.moves ≤ 2 * Fintype.card V * tr.relabels := by
  induction tr with
  | nil => simp [moves, relabels]
  | cons r tail ih =>
      have h := r.move_bound
      simp only [moves, relabels, Nat.mul_add]
      omeganoncomputable def minimumVisits {s t : Machine G} {n : Nat} : Trace s t n → Nat
  | .nil _ => 0
  | .cons r tail => r.minimumVisits + tail.minimumVisitstheorem minimumVisits_eq {s t : Machine G} {n : Nat} (tr : Trace s t n) :
    tr.minimumVisits = Fintype.card V * tr.relabels := by
  induction tr with
  | nil => simp [minimumVisits, relabels]
  | cons r tail ih => simp [minimumVisits, relabels, r.minimumVisits_eq, ih, Nat.mul_add]end Tracestructure Execution (s : Machine G) (fuel : Nat) where
  last : Machine G
  steps : Nat
  trace : Trace s last steps
  terminal : Option (Finished last)
  exhausted : terminal = none → steps = fuel

noncomputable def execute (s : Machine G) : (fuel : Nat) → Execution s fuel
  | 0 => ⟨s, 0, .nil s, none, fun _ => rfl⟩
  | fuel + 1 => match next s with
      | .inl fin => ⟨s, 0, .nil s, some fin, by simp⟩
      | .inr r =>
          let tail := execute r.after fuel
          { last := tail.last
            steps := tail.steps + 1
            trace := .cons r tail.trace
            terminal := tail.terminal
            exhausted := by intro hn; rw [tail.exhausted hn] }def budget (V : Type*) [Fintype V] := 9 * Fintype.card V * Fintype.card V * Fintype.card V + 1

theorem execute_terminal (s : Machine G) : (execute s (budget V)).terminal ≠ none := by
  intro hn
  have h := (execute s (budget V)).trace.length_bound
  rw [(execute s (budget V)).exhausted hn] at h
  simp only [budget] at h
  omeganoncomputable def completed (s : Machine G) : Finished (execute s (budget V)).last :=
  (execute s (budget V)).terminal.get (Option.isSome_iff_ne_none.mpr (execute_terminal s))theorem completed_excess_zero (s : Machine G) (u : V) (hs : u ≠ G.s) (ht : u ≠ G.t) :
    (execute s (budget V)).last.φ.excess u = 0 := by
  have h := (completed s).quiet u
  have hnonneg := (execute s (budget V)).last.φ.hexcess_nonneg u hs
  by_contra hn
  exact h ⟨hs, ht, lt_of_le_of_ne hnonneg (Ne.symm hn)⟩noncomputable def maximumFlow (s : Machine G) : Flow V G :=
  (execute s (budget V)).last.φ.toFlow (completed_excess_zero s)theorem maximumFlow_isMaximal (s : Machine G) : (maximumFlow s).isMaximal :=
  maximal_of_no_overflow _ _ (execute s (budget V)).last.valid (completed_excess_zero s)noncomputable def initializedFlow (G : FlowNetwork V) : Flow V G := maximumFlow (initialMachine G)theorem initialized_maximum_flow (G : FlowNetwork V) : (initializedFlow G).isMaximal :=
  maximumFlow_isMaximal _

Actual cursor advances/inactive-entry scans, plus terminal scans, list traversal on move-to-front, and a full vertex scan for each relabel. Pushes contribute one basic-operation unit. The scalar/indexed implementation expands these units below.

noncomputable def controllerWork (s : Machine G) : Nat :=
  let r := execute s (budget V)
  r.steps + r.trace.scans + (completed s).scans + r.trace.moves +
    r.trace.minimumVisits



theorem controllerWork_bound (s : Machine G) :
    controllerWork s ≤ 19 * Fintype.card V * Fintype.card V * Fintype.card V + credit s := by
  let r := execute s (budget V)
  have hn := r.trace.length_bound
  have hscan := r.trace.scans_credit
  have hfin := (completed s).scan_bound
  have hmove := r.trace.moves_bound
  have hrel : r.trace.relabels ≤ 2 * Fintype.card V * Fintype.card V := by
    rw [Trace.relabels_eq]; exact r.trace.toRun.relabel_count_bound
  change r.steps + r.trace.scans + (completed s).scans + r.trace.moves +
    r.trace.minimumVisits ≤ _
  rw [Trace.minimumVisits_eq]
  change (completed s).scans ≤ credit r.last at hfin
  nlinarith

theorem initialized_controllerWork_le (G : FlowNetwork V) :
    controllerWork (initialMachine G) ≤ 21 * Fintype.card V * Fintype.card V * Fintype.card V := by
  have h := controllerWork_bound (initialMachine G)
  have hc := credit_initial G
  have hp : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
  have h1 : Fintype.card V ≤ Fintype.card V * Fintype.card V := Nat.le_mul_self _
  have h2 : Fintype.card V * Fintype.card V ≤ Fintype.card V * Fintype.card V * Fintype.card V :=
    Nat.le_mul_of_pos_right _ hp
  nlinarith

The initialization's actual cell writes and internal-list candidate visits.

noncomputable def initializationWork (G : FlowNetwork V) : Nat :=
  (initialCells G).2 + (tabulate (initialHeight G) 0).2 + (tabulate (G.c G.s) 0).2 +
    (tabulate (fun _ : V => (univ.toList : List V)) []).2 + (selectInternal G univ.toList).2

@[simp] theorem initializationWork_eq (G : FlowNetwork V) :
    initializationWork G = Fintype.card V * Fintype.card V + 4 * Fintype.card V := by
  simp [initializationWork, initialCells, Fintype.card_prod]
  omega

Scalar/indexed RAM charge: a fixed allowance of 32 primitive operations per cursor/list test, push/relabel dispatch, moved list cell, or minimum-scan cell. Indexed table lookup/update and exact real arithmetic are unit primitives. This is not a bound on persistent-function evaluation or machine bit complexity.

noncomputable def Trace.work {s t : Machine G} {n : Nat} : Trace s t n → Nat
  | .nil _ => 0
  | .cons r tail => 32 * (1 + r.scans + r.moves + r.minimumVisits) + tail.work

theorem Trace.work_eq {s t : Machine G} {n : Nat} (tr : Trace s t n) :
    tr.work = 32 * (n + tr.scans + tr.moves + tr.minimumVisits) := by
  induction tr with
  | nil => simp [work, scans, moves, minimumVisits]
  | cons r tail ih => simp only [work, scans, moves, minimumVisits, ih]; omega

The returned measured construction-and-run charge. The last summand includes the actual scans that discover termination and its final empty-list test.

noncomputable def initializedWork (G : FlowNetwork V) : Nat :=
  32 * initializationWork G + (execute (initialMachine G) (budget V)).trace.work +
    32 * ((completed (initialMachine G)).scans + 1)



theorem initializedWork_eq (G : FlowNetwork V) : initializedWork G =
    32 * (initializationWork G + controllerWork (initialMachine G) + 1) := by
  unfold initializedWork controllerWork
  rw [Trace.work_eq]
  dsimp only
  omega



theorem initialized_work_le_cubic (G : FlowNetwork V) :
    initializedWork G ≤ 864 * Fintype.card V * Fintype.card V * Fintype.card V := by
  rw [initializedWork_eq, initializationWork_eq]
  have h := initialized_controllerWork_le G
  have hp : 0 < Fintype.card V := Fintype.card_pos_iff.mpr ⟨G.s⟩
  have h1 : Fintype.card V ≤ Fintype.card V * Fintype.card V := Nat.le_mul_self _
  have h2 : Fintype.card V * Fintype.card V ≤ Fintype.card V * Fintype.card V * Fintype.card V :=
    Nat.le_mul_of_pos_right _ hp
  nlinarith

One concrete initialized run supplies both maximum flow and the cubic charge.

theorem initialized_correct_and_cost (G : FlowNetwork V) :
    (initializedFlow G).isMaximal ∧
      initializedWork G ≤ 864 * Fintype.card V * Fintype.card V * Fintype.card V :=
  ⟨initialized_maximum_flow G, initialized_work_le_cubic G⟩

end CLRS.Chapter26.RelabelExecution

Imports

import Mathlib
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.Ford_Fulkerson_Augmentation

Theorem 24.6. Max-Flow Min-Cut

This file proves the complete Max-Flow Min-Cut equivalence (CLRS Theorem 24.6). For a feasible flow, the following conditions are equivalent:

the flow is maximal;
the residual network has no source-to-sink augmenting path;
some source-to-sink cut has capacity equal to the flow value.

Main results:

Flow.eq_cutCapacity_implies_maximal: equality with one cut capacity certifies maximality.
Flow.maximal_iff_noAugmentingPath: maximality is equivalent to the absence of an augmenting path.
Flow.maximal_iff_exists_cut_value_eq: maximality is equivalent to the existence of a cut whose capacity equals the flow value.

Current gaps: none for the mathematical Max-Flow Min-Cut equivalence. Executable Ford--Fulkerson and Edmonds--Karp algorithms are developed separately.

              set_option autoImplicit truenamespace CLRSnamespace Chapter26open Finset Classical

Every consecutive pair from a List.IsChain chain satisfies the relation.


lemma forall_zip_edges_of_isChain {V : Type*} {r : V → V → Prop} {a : V} {l : List V}
    (h : List.IsChain r (a :: l)) : ∀ (u v : V), (u, v) ∈ List.zip (a :: l) l → r u v := by
  have h_eq : l = [] ∨ ∃ (b : V) (l' : List V), l = b :: l' := by
    cases l
    · left; rfl
    · right; refine ⟨_, _, rfl⟩
  rcases h_eq with (hl | ⟨b, l', hl⟩)
  · subst hl; simp
  · subst hl
    have h_cons_cons := (List.isChain_cons_cons (a := a) (b := b) (l := l')).mp h
    rcases h_cons_cons with ⟨h_rel, h_chain⟩
    intro u v h_mem
    have h_zip : List.zip (a :: b :: l') (b :: l') = (a, b) :: List.zip (b :: l') l' := by simp
    simp [h_zip] at h_mem
    rcases h_mem with (⟨rfl, rfl⟩ | h_rest)
    · exact h_rel
    · exact forall_zip_edges_of_isChain h_chain u v h_rest

If the value of a flow equals the capacity of some cut, the flow is maximal. This is the easy direction of Theorem 24.6.

theorem Flow.eq_cutCapacity_implies_maximal {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) (S : Finset V) (hs : G.s ∈ S) (ht : G.t ∉ S)
    (h_eq : φ.value = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v))) :
    Flow.isMaximal φ := by
  intro ψ
  have hψ_le : ψ.value ≤ Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) :=
    Flow.value_le_cut_capacity φ ψ S hs ht
  linarith

A feasible flow is maximal exactly when its residual network contains no source-to-sink augmenting path.

theorem Flow.maximal_iff_noAugmentingPath {V : Type*} [Fintype V] [DecidableEq V]
    {G : FlowNetwork V} (φ : Flow V G) :
    φ.isMaximal ↔ ¬φ.hasAugmentingPath := by
  constructor
  · intro hmax hpath
    exact φ.not_maximal_of_hasAugmentingPath hpath hmax
  · exact φ.maximal_of_noAugmentingPath

Max-Flow Min-Cut Theorem (CLRS Theorem 24.6). A feasible flow is maximal exactly when some cut separating source and sink has capacity equal to the flow value.

theorem Flow.maximal_iff_exists_cut_value_eq {V : Type*} [Fintype V]
    [DecidableEq V] {G : FlowNetwork V} (φ : Flow V G) :
    φ.isMaximal ↔
      ∃ S : Finset V, G.s ∈ S ∧ G.t ∉ S ∧
        φ.value = Finset.sum S (fun u => Finset.sum (Sᶜ) (fun v => G.c u v)) := by
  constructor
  · intro hmax
    exact φ.exists_cut_value_eq_of_noAugmentingPath
      ((φ.maximal_iff_noAugmentingPath).mp hmax)
  · rintro ⟨S, hs, ht, hvalue⟩
    exact φ.eq_cutCapacity_implies_maximal S hs ht hvalue

end Chapter26end CLRS

Scope and implementation notes

Imports

import CLRSLean.Chapter_26
import CLRSLean.FourthEdition.Chapter_24.Section_24_1_Flow_Networks
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.Ford_Fulkerson_Augmentation
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S1_ShortestAugmentingPath
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S2_EK_Loop
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S3_WorkAnalysis
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S4_ExecutableBFS
import CLRSLean.FourthEdition.Chapter_24.Section_24_2_Edmonds_Karp.S5_SparseExecution
import CLRSLean.FourthEdition.Chapter_24.Section_24_3_Bipartite_Matching
import CLRSLean.FourthEdition.Chapter_24.Section_24_4_Push_Relabel
import CLRSLean.FourthEdition.Chapter_24.Section_24_5_Relabel_To_Front
import CLRSLean.FourthEdition.Chapter_24.Section_24_5_Relabel_To_Front.Execution
import CLRSLean.FourthEdition.Chapter_24.Section_24_6_MaxFlow_MinCut

Current source

Sections 24.1--24.6 are native fourth-edition sections (flow networks, the Ford–Fulkerson method with the Edmonds-Karp correctness and work-analysis development, maximum bipartite matching, the push-relabel preflow model and its operation count, an initialized relabel-to-front execution, and the max-flow min-cut theorem), imported directly from Section 24.1, Section 24.2, Section 24.3, Section 24.4, Section 24.5, and Section 24.6. Section 24.6 is named after the theorem it proves (Theorem 24.6). Declarations retain the legacy CLRS.Chapter26 namespace during the compatibility period; the third-edition-numbered imports CLRSLean.Chapter_26 and CLRSLean.Chapter_26.Section_26_* forward to these sources.

Implementation details

The supporting implementation pages remain available outside the main sidebar:

Coverage boundary

The native sections prove the flow/cut identities, maximum bipartite matching, push-relabel invariants, and max-flow min-cut. Two constructed executions now connect maximum-flow output and work to their own state traces.

SparseEK.execute consumes a duplicate-free list of every positive-capacity arc, builds forward/reverse support buckets, and uses its counted support BFS and saved parent chain for each augmentation. It returns a maximum flow with at most 2VE augmentations and work at most 130VE² when E>0; empty support costs at most V+2. Here V includes isolated vertices and E counts positive-capacity arcs. The proof follows this BFS-selected timeline; it does not identify it with the older classical-choice sequence.

RelabelExecution.initializedFlow constructs the source-saturated preflow, heights, excess cache, current-neighbor cursors, and internal-vertex list. Its actual scan/push/relabel/move controller preserves the list discipline and terminates at a maximum flow without an input schedule or terminal certificate. The same trace counts initialization writes, cursor/list visits, minimum scans, and moved cells. The stated weighted scalar/indexed RAM charge is at most 864V³; the underlying basic-operation count is at most 9V³.

These models use exact-real arithmetic and indexed table, dictionary, queue, and bucket primitives. They exclude persistent-container evaluation/copying, allocation, and bit complexity; the relabel-to-front execution is not a mutable-array refinement. Neither execution needs integral capacities.

See docs/clrs-fourth-edition-map.csv for the section-level mapping and docs/migrations/clrs4.md for compatibility and deprecation policy.

CLRS, fourth edition · Chapter 24 of 35